;;; s7 test suite ;;; ;;; sources include ;;; clisp test suite ;;; sbcl test suite ;;; Paul Dietz's CL test suite (gcl/ansi-tests/*) ;;; R Kelsey, W Clinger, and J Rees r5rs.html (and r7rs.html) ;;; A Jaffer's r4rstest.scm (the inspiration for this...) ;;; guile test suite ;;; gauche test suite ;;; sacla test suite ;;; Kent Dybvig's "The Scheme Programming Language" ;;; Brad Lucier and Peter Bex ;;; GSL tests ;;; Abramowitz and Stegun, "Handbook of Mathematical Functions" ;;; the arprec package of David Bailey et al ;;; Maxima, William Schelter et al ;;; N Higham, "Accuracy and Stability of Numerical Algorithms" ;;; various mailing lists and websites (see individual cases below) (unless (defined? 'full-s7test) ; snd-test has a variable named full-test, and includes this file (define full-s7test #f)) ; this includes some time-consuming stuff (define with-bignums (provided? 'gmp)) ; scheme number has any number of bits ; we assume s7_double is double, and s7_int is int64_t ; a few of the bignum tests assume the default bignum-precision is 128 ; using a different default affects number->string primarily (define with-complex (provided? 'complex-numbers)) (define with-windows (provided? 'windows)) (define immutable-unquote (provided? 'immutable-unquote)) (unless (defined? 's7test-exits) (define s7test-exits #t)) ; use (with-let (rootlet) (define s7test-exits #f)) if using repl (unless (defined? 'asan-flags) (define asan-flags "")) (define username (getenv "USER")) (unless (defined? 'most-positive-fixnum) (define-constant most-positive-fixnum (*s7* 'most-positive-fixnum)) (define-constant most-negative-fixnum (*s7* 'most-negative-fixnum))) ;(set! (*s7* 'print-length) 32) ; old default, changed to 12 to match Snd, 23-Jul-21, now it's 40? ;(set! (hook-functions *load-hook*) (list (lambda (hook) (format () "loading ~S...~%" (hook 'name))))) ;;; to loop s7test under gdb until it crashes: #| gdb repl set pagination off break _exit commands run end ;;; repl.c can randomize *s7* parameters before calling s7_load |# ;;; ---------------- pure-s7 ---------------- (define pure-s7 (provided? 'pure-s7)) (when pure-s7 (define (make-polar mag ang) (if (and (real? mag) (real? ang)) (complex (* mag (cos ang)) (* mag (sin ang))) (error 'wrong-type-arg "make-polar args should be real"))) (define make-rectangular complex) (define (char-ci=? . chars) (apply char=? (map char-upcase chars))) (define (char-ci<=? . chars) (apply char<=? (map char-upcase chars))) (define (char-ci>=? . chars) (apply char>=? (map char-upcase chars))) (define (char-ci? . chars) (apply char>? (map char-upcase chars))) (define (string-ci=? . strs) (apply string=? (map string-upcase strs))) (define (string-ci<=? . strs) (apply string<=? (map string-upcase strs))) (define (string-ci>=? . strs) (apply string>=? (map string-upcase strs))) (define (string-ci? . strs) (apply string>? (map string-upcase strs))) (define (list->string lst) (apply string lst)) (define (list->vector lst) (apply vector lst)) (define (let->list e) (if (let? e) (reverse! (map values e)) (error 'wrong-type-arg "let->list argument should be an environment: ~A" e))) (define* (string->list str (start 0) end) (if (and (string? str) (integer? start) (not (negative? start)) (or (not end) (and (integer? end) (>= end start)))) (map values (substring str start (or end (length str)))) (error 'wrong-type-arg "string->list argument should be a string: ~A" str))) (define (string-length str) (if (string? str) (length str) (if (and (openlet? str) (defined? 'string-length str #t)) ((let-ref str 'string-length) str) (error 'wrong-type-arg "string-length argument should be a string: ~A" str)))) (define (string-fill! str chr . args) (if (string? str) (apply fill! str chr args) (if (and (openlet? str) (defined? 'string-fill str #t)) (apply (let-ref str 'string-fill!) str chr args) (error 'wrong-type-arg "string-fill! argument should be a string: ~A" str)))) (define* (vector->list vect (start 0) end) ; this ignores (*s7* 'max-list-length) (if (and (vector? vect) (integer? start) (not (negative? start)) (or (not end) (and (integer? end) (>= end start)))) (if start (let ((stop (or end (length vect)))) (if (= start stop) () (map values (subvector vect start stop)))) (map values vect)) (error 'wrong-type-arg "vector->list argument should be a vector: ~A" vect))) (define (vector-length vect) (if (vector? vect) (length vect) (error 'wrong-type-arg "vector-length argument should be a vector: ~A" vect))) (define (vector-fill! vect val . args) (if (vector? vect) (apply fill! vect val args) (error 'wrong-type-arg "vector-fill! argument should be a vector: ~A" str))) (define (vector-append . args) (if (null? args) #() (if (vector? (car args)) (apply append args) (error 'wrong-type-arg "vector-append arguments should be vectors: ~A" args)))) (define* (char-ready? p) (and p (not (input-port? p)) (error 'wrong-type-arg "char-ready? arg should be an input port"))) (define (set-current-output-port port) (error 'undefined-function "set-current-output-port is not in pure-s7")) (define (set-current-input-port port) (error 'undefined-function "set-current-input-port is not in pure-s7")) (define (exact? n) (if (number? n) (rational? n) (if (and (openlet? n) (defined? 'exact? n #t)) ((let-ref n 'exact?) n) (error 'wrong-type-arg "exact? argument should be a number: ~A" n)))) (define (inexact? x) (if (number? x) (not (rational? x)) (if (and (openlet? n) (defined? 'inexact? n #t)) ((let-ref n 'inexact?) n) (error 'wrong-type-arg "inexact? argument should be a number: ~A" x)))) (define (inexact->exact x) (if (not (number? x)) (error 'wrong-type-arg "inexact->exact argument should be a number: ~A" x) (if (rational? x) x (rationalize x)))) (define (exact->inexact x) (if (number? x) (* x 1.0) (error 'wrong-type-arg "exact->inexact argument should be a number: ~A" x))) (define (integer-length i) (if (integer? i) (if (memv i '(9223372036854775807 -9223372036854775808)) 63 (ceiling (log (if (< i 0) (- i) (+ i 1)) 2))) (if (and (openlet? i) (defined? 'integer-length i #t)) ((let-ref i 'integer-length) i) (error 'wrong-type-arg "integer-length argument should be an integer: ~A" x)))) (define-macro (call-with-values producer consumer) `(,consumer (,producer))) (define-macro (multiple-value-bind vars expression . body) ; named "receive" in srfi-8 which strikes me as perverse (if (or (symbol? vars) (negative? (length vars))) `((lambda ,vars ,@body) ,expression) `((lambda* (,@vars . ,(gensym)) ,@body) ,expression))) (define-macro (multiple-value-set! vars expr . body) (let ((local-vars (map (lambda (n) (gensym)) vars))) `((lambda* (,@local-vars . ,(gensym)) ,@(map (lambda (n ln) `(set! ,n ,ln)) vars local-vars) ,@body) ,expr))) (define-macro (cond-expand . clauses) (letrec ((traverse (lambda (tree) (if (pair? tree) (cons (traverse (car tree)) (if (null? (cdr tree)) () (traverse (cdr tree)))) (if (memq tree '(and or not else)) tree (and (symbol? tree) (provided? tree))))))) `(cond ,@(map (lambda (clause) (cons (traverse (car clause)) (if (null? (cdr clause)) '(#f) (cdr clause)))) clauses)))) ) ;;; ---------------- end pure-s7 ---------------- (define tmp-output-file "tmp1.r5rs") (define tmp-data-file "test.dat") (define bold-text (format #f "~C[1m" #\escape)) (define unbold-text (format #f "~C[22m" #\escape)) (set! (hook-functions *unbound-variable-hook*) ()) (set! (hook-functions *missing-close-paren-hook*) ()) (define s7test-output #f) ; if a string, it's treated as a logfile ;(set! (*s7* 'gc-stats) 4) ; 4=stack ;(set! (*s7* 'undefined-identifier-warnings) #t) ;(set! (*s7* 'debug) 2) ;(set! ((funclet trace-in) '*debug-port*) #f) ;(set! (*s7* 'profile) 1) (define old-stdin *stdin*) (define old-stdout *stdout*) (define old-stderr *stderr*) (define *max-arity* #x20000000) (define (-s7-stack-top-) (*s7* 'stack-top)) (when full-s7test (system "rm libc_s7.*") (system "rm libgdbm_s7.*") (system "rm libgsl_s7.*") (system "rm libm_s7.*")) ;;; -------------------------------------------------------------------------------- (if (and (defined? 'current-time) ; in Snd (defined? 'mus-rand-seed)) (set! (mus-rand-seed) (current-time))) (define (ok? otst ola oexp) (let ((result (catch #t ola (lambda (type info) (if (not (eq? oexp 'error)) (begin (apply format #t info) (newline))) 'error)))) (if (not (equal? result oexp)) (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp)))) (define original-test-macro #f) (unless (defined? 'test) (set! original-test-macro #t) (define-macro (test tst expected) ;(display tst *stderr*) (newline *stderr*) ;; `(ok? ',tst (lambda () (eval-string (format #f "~S" ',tst))) ,expected)) ;; `(ok? ',tst (lambda () (eval ',tst)) ,expected)) ;; `(ok? ',tst (lambda () ,tst) ,expected)) ;; `(ok? ',tst (lambda () (eval-string (object->string ,tst :readable))) ,expected)) ;; `(ok? ',tst (let () (define (_s7_) ,tst)) ,expected)) ;; `(ok? ',tst (lambda () (let ((_s7_ #f)) (set! _s7_ ,tst))) ,expected)) ;; `(ok? ',tst (lambda () (let ((_s7_ ,tst)) _s7_)) ,expected)) ;; `(ok? ',tst (catch #t (lambda () (lambda* ((_a_ ,tst)) _a_)) (lambda any (lambda () 'error))) ,expected)) ;; `(ok? ',tst (lambda () (do ((_a_ ,tst)) (#t _a_))) ,expected)) ;; `(ok? ',tst (lambda () (call-with-exit (lambda (_a_) (_a_ ,tst)))) ,expected)) ;; `(ok? ',tst (lambda () (values ,tst)) ,expected)) ;; `(ok? ',tst (lambda () (define (_s7_ _a_) _a_) (_s7_ ,tst)) ,expected)) ;; `(ok? ',tst (lambda () (define* (_s7_ (_a_ #f)) (or _a_)) (_s7_ ,tst)) ,expected)) ;; `(ok? ',tst (lambda () (caadr (catch 'receive (lambda () (throw 'receive ,tst)) (lambda any any)))) ,expected)) ;; `(ok? ',tst (lambda () (stacktrace (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (> (random 100) 50)) ,tst) ,expected)) (list 'ok? (list quote tst) (list-values lambda () tst) expected)) ) (define (tok? otst ola) (let* ((data #f) (result (catch #t ola (lambda args (set! data args) 'error)))) (if (or (not result) (eq? result 'error)) (format #t "~A: ~A got ~S ~A~%~%" (port-line-number) otst result (or data ""))))) (define-macro (test-t tst) ;(display tst *stderr*) (newline *stderr*) `(tok? ',tst (lambda () ,tst))) (define-macro (test-e tst op arg) ;(display tst *stderr*) (newline *stderr*) `(let ((result (catch #t (lambda () ,tst) (lambda args 'error)))) (if (not (eq? result 'error)) (format #t "~A: (~A ~S) got ~S but expected 'error~%~%" (port-line-number) ,op ,arg result)))) (define (op-error op result expected) (case op ((acosh) (/ (magnitude (- (cosh result) (cosh expected))) (max 0.001 (magnitude (cosh expected))))) ((asin) (/ (min (magnitude (- (sin result) (sin expected))) (magnitude (- result expected))) (max 0.001 (* 10 (magnitude (sin expected)))))) ((acos) (/ (min (magnitude (- (cos result) (cos expected))) (magnitude (- result expected))) (max 0.001 (magnitude (cos expected))))) ((asinh) (/ (magnitude (- (sinh result) (sinh expected))) (max 0.001 (magnitude (sinh expected))))) ((atanh) (/ (min (magnitude (- (tanh result) (tanh expected))) (magnitude (- result expected))) (max 0.001 (magnitude (tanh expected))))) ((atan) (/ (min (magnitude (- (tan result) (tan expected))) (magnitude (- result expected))) (max 0.001 (magnitude (tan expected))))) ((cosh) (/ (min (magnitude (- result expected)) (magnitude (+ result expected))) (max 0.001 (magnitude expected)))) (else (/ (magnitude (- result expected)) (max 0.001 (magnitude expected)))))) ;;; relative error (/ (abs (- x res) (abs x))) (define (number-ok? tst result expected) (unless (eqv? result expected) (if (or (not (number? result)) (not (eq? (nan? expected) (nan? result))) (and (pair? tst) (> (/ (magnitude (- result expected)) (max 0.001 (magnitude expected))) 1e-5) (> (op-error (car tst) result expected) 1e-5))) (format #t "~A: ~A got ~A~Abut expected ~A~%~%" (port-line-number) tst result (if (and (rational? result) (not (rational? expected))) (format #f " (~A) " (* 1.0 result)) " ") expected)))) (define (nok? otst ola oexp) (let ((result (catch #t ola (lambda args 'error)))) (number-ok? otst result oexp))) (if (not (defined? 'num-test)) (define-macro (num-test tst expected) ;(display tst *stderr*) (newline *stderr*) ;; `(nok? ',tst (lambda () ,tst) ,expected)) ;; `(nok? ',tst (let () (define (_s7_) ,tst)) ,expected)) (list-values 'nok? (list-values quote tst) (list-values lambda () tst) expected))) (define-macro (num-test-1 proc val tst expected) `(let ((result (catch #t (lambda () ,tst) (lambda args 'error)))) (number-ok? (list ,proc ,val) result ,expected))) (define-macro (num-test-2 proc val1 val2 tst expected) `(let ((result (catch #t (lambda () ,tst) (lambda args 'error)))) (number-ok? (list ,proc ,val1 ,val2) result ,expected))) (define (string-wi=? s1 s2) ; string=? ignoring white-space (let ((iter1 (make-iterator s1)) (iter2 (make-iterator s2))) (let wi-loop ((i1 (iterate iter1)) (i2 (iterate iter2))) (if (eq? i1 i2) (or (eq? i1 #) (wi-loop (iterate iter1) (iterate iter2))) (if (and (char? i1) (char-whitespace? i1)) (wi-loop (iterate iter1) i2) (and (char? i2) (char-whitespace? i2) (wi-loop i1 (iterate iter2)))))))) (test (string-wi=? "" "") #t) (test (string-wi=? "" " ") #t) (test (string-wi=? "" " a") #f) (test (string-wi=? "a" " a") #t) (test (string-wi=? "a " " a") #t) (test (string-wi=? " a " "a") #t) (test (string-wi=? " a " " a") #t) (test (string-wi=? "\n a\n " "a") #t) (test (string-wi=? "aa" " a") #f) (test (string-wi=? "aa" " a a ") #t) (test (string-wi=? "aa" "aa ") #t) ;; ---------------- (define-macro (test-wi tst res) `(let ((val ,tst)) (unless (string-wi=? val ,res) (format *stderr* "~A: ~S got ~S but expected ~S~%" (port-line-number) ',tst val ,res)))) ;; ---------------- (define (reinvert n op1 op2 arg) (let ((body (op2 (op1 arg)))) (do ((i3 1 (+ i3 1))) ((= i3 n) body) (set! body (op2 (op1 body)))))) (define (recompose n op arg) (define (recompose-1 n) (if (= n 1) (op arg) (op (recompose-1 (- n 1))))) (recompose-1 n)) (if (setter 'val) (set! (setter 'val) #f)) ; might get here from snd-test (define _ht_ (make-hash-table)) (define _undef_ (car (with-input-from-string "(#_asdf 1 2)" read))) ;;; -------------------------------------------------------------------------------- ;;; some coverage tests that are bolixed-up by methods below (these tests actually belong elsewhere) ;;; vector_set_p_pip always goes to unchecked or vector_set_p_ppp? (let () (define (h1 size) ; vector_ref_p_pi from tvect, put here since 'vector-ref is methodized below (let ((v (make-vector size))) (do ((i 0 (+ i 1))) ((= i size) (vector-ref v 0)) (vector-set! v i 2)))) (test (h1 2) 2)) (let () ; g_dynamic_wind_init from texit (define (dwfib n) (dynamic-wind (lambda () (if (negative? n) (display "oops"))) (lambda () (if (<= n 2) n (+ (dwfib (- n 1)) (dwfib (- n 2))))) #f)) (test (dwfib 5) 8)) (let () ; g_dynamic_wind_body (define (dw size) (do ((i 0 (+ i 1)) (x 0)) ((= i size) x) (dynamic-wind #f (lambda () (set! x i)) #f))) (test (dw 2) 1)) (let () ; stop_is_safe from tfft (define (f) (let ((i 0) (n 2)) (do ((k 0 (+ k 1))) ((= k 1) i) (do () ((>= i n)) (set! i (+ i 1)))))) (test (f) 2)) (let () (define (cpy1 x y) ; opt_dox, copy_if_end_ok tcopy (do ((i 0 (+ i 1)) (len (length x))) ((= i len) y) (int-vector-set! y i (int-vector-ref x i)))) (let ((x (make-int-vector 1 123)) (y (make-int-vector 1 0))) (cpy1 x y) (test y (make-int-vector 1 123)))) (let () ; list_increment_p_pip_unchecked tref (define (ft7) (let ((size 4)) (let ((v (make-list size 0))) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j size)) (set! (v j) (+ (v j) 1)))) v))) (test (ft7) (list 1 1 1 1))) (let ((v #2d((3 2 1) (6 5 4))) (b1 1) (b2 0)) ; vector_ref_p_pii (define (f) (do ((val 0) (i 0 (+ i 1))) ((= i 1) val) (set! val (real-part (v b1 b2))))) (test (f) 6)) (let ((v #2d((3 2 1) (6 5 4))) (b1 0) (b2 0)) ; vector_ref_p_pii_direct (define (f) (do ((val 0) (i 0 (+ i 1))) ((= i 1) val) (set! val (real-part (v (+ b1 1) b2))))) (test (f) 6)) (test (eval-string "#2d(1 2)") 'error) ;reading constant vector, we need a list that fully specifies the vector's elements: (1 2) (let () (define (f coeffs rmp0) ; g_fv_set_unchecked (float-vector-set! coeffs 0 (+ (float-vector-ref coeffs 0) rmp0)) coeffs) (test (f (float-vector 0 1 2) .5) #r(0.5 1.0 2.0))) (let () ; typed_normal_vector_set_p_pip_direct, tvect (define (h6) (let ((v (make-vector 3 #(1 0) vector?))) (do ((i 0 (+ i 1))) ((= i 3) (vector-ref v 0 0)) (vector-set! v i #(2 3))))) (test (h6) 2)) (let () ;typed_vector_set_p_pip_unchecked, tmisc (define (f) (let ((v0 (make-vector 3 'x symbol?))) (do ((i 0 (+ i 1))) ((= i 3) v0) (set! (v0 0) 'a)))) (test (f) #(a x x))) (let () (define (sum-i1111) ; int_vector_ref_i_7piii, tvect (let ((sum 0) (v (make-int-vector (list 3 3 3) 3))) (do ((k 0 (+ k 1))) ((= k 1) sum) (do ((i 0 (+ i 1))) ((= i 1)) (do ((n 0 (+ n 1))) ((= n 3)) (set! sum (+ sum (int-vector-ref v k i n)))))))) (test (sum-i1111) 9)) (let () (define (j11) ; vector_set_p_piip_direct tvect (let ((v (make-vector (list 3 3)))) (do ((k 0 (+ k 1))) ((= k 3) (v 0 0)) (do ((i 0 (+ i 1))) ((= i 3)) (set! (v k i) 21))))) (test (j11) 21)) (let () ;byte_vector_ref_i_7pi (define (f) (let ((imbv (immutable! (byte-vector 0 1 2)))) (do ((i 0 (+ i 1))) ((= i 3) (imbv 0)) (imbv 0)))) (test (f) 0)) ;;; op_let_opassq_old -- this needs to be top-level (define (_f_aq p e) (let ((op (assq p e))) (list op))) (define (_g_aq) (let ((p 1) (e '((1 a) (2 b)))) (_f_aq p e))) (_g_aq) (test (_g_aq) '((1 a))) ;;; -------------------------------------------------------------------------------- ;;; before starting, make a test c-object (unless (defined? 'with-block) (define with-block (not (provided? 'windows)))) (if with-block (begin (call-with-output-file "s7test-block.c" (lambda (p) (format p " #include #include #include #include #include \"s7.h\" static s7_scheme *s7; /* c-object tests */ typedef struct { size_t size; double *data; } g_block; static s7_int g_block_type = 0, g_simple_block_type = 0, g_c_tag_type = 0, g_c_tag1_type = 0, g_cycle_type = 0, block_gc_loc = 0; static s7_pointer g_block_methods, g_tag1_methods; static s7_pointer g_block_let(s7_scheme *sc, s7_pointer args) { #define g_block_let_help \"(block-let block) returns the block'e let.\" if (s7_c_object_type(s7_car(args)) != g_block_type) return(s7_wrong_type_arg_error(sc, \"block-let\", 1, s7_car(args), \"a block\")); return(s7_c_object_let(s7_car(args))); } static s7_int max_vector_length = 0; static s7_pointer make_block_1(s7_scheme *sc, s7_int size, bool cleared) { g_block *g; s7_pointer new_g; if ((size < 0) || (size > max_vector_length)) return(s7_out_of_range_error(sc, \"make-block\", 1, s7_make_integer(sc, size), \"it should be positive and less than (*s7* 'max-vector-length)\")); g = (cleared) ? (g_block *)calloc(1, sizeof(g_block) + (size * sizeof(double))) : (g_block *)malloc(sizeof(g_block) + (size * sizeof(double))); g->size = (size_t)size; if (g->size > 0) g->data = (double *)((void *)g + sizeof(g_block)); else g->data = NULL; new_g = s7_make_c_object(sc, g_block_type, (void *)g); s7_c_object_set_let(sc, new_g, g_block_methods); s7_openlet(sc, new_g); return(new_g); } static s7_pointer make_block(s7_scheme *sc, s7_int size) {return(make_block_1(sc, size, true));} static s7_pointer make_block_raw(s7_scheme *sc, s7_int size) {return(make_block_1(sc, size, false));} static s7_pointer g_make_block(s7_scheme *sc, s7_pointer args) { #define g_make_block_help \"(make-block size) returns a new block of the given size\" s7_pointer arg1 = s7_car(args); if (!s7_is_integer(arg1)) return(s7_wrong_type_arg_error(sc, \"make-block\", 1, arg1, \"an integer\")); return(make_block(sc, s7_integer(arg1))); } static s7_pointer g_make_simple_block(s7_scheme *sc, s7_pointer args) { #define g_make_simple_block_help \"(make-simple-block size) returns a new simple-block of the given size\" g_block *g; s7_pointer new_g; s7_int size; s7_pointer arg1 = s7_car(args); if (!s7_is_integer(arg1)) return(s7_wrong_type_arg_error(sc, \"make-simple-block\", 1, arg1, \"an integer\")); size = s7_integer(arg1); if ((size < 0) || (size > max_vector_length)) return(s7_out_of_range_error(sc, \"make-simple-block\", 1, arg1, \"it should be positive and less than (*s7* 'max-vector-length)\")); g = (g_block *)calloc(1, sizeof(g_block) + (size * sizeof(double))); g->size = (size_t)size; if (g->size > 0) g->data = (double *)((void *)g + sizeof(g_block)); else g->data = NULL; new_g = s7_make_c_object(sc, g_simple_block_type, (void *)g); return(new_g); } static s7_pointer g_make_c_tag(s7_scheme *sc, s7_pointer args) { s7_int *tag = malloc(sizeof(s7_int)); *tag = 23; return(s7_make_c_object(sc, g_c_tag_type, (void *)tag)); } static void g_c_tag_free(void *val) { free(val); } static s7_pointer g_make_c_tag1(s7_scheme *sc, s7_pointer args) { s7_pointer new_tag1; s7_int *tag = malloc(sizeof(s7_int)); *tag = 23; new_tag1 = s7_make_c_object(sc, g_c_tag1_type, (void *)tag); s7_c_object_set_let(sc, new_tag1, g_tag1_methods); s7_openlet(sc, new_tag1); return(new_tag1); } typedef struct {s7_pointer obj;} g_cycle; static s7_pointer g_make_cycle(s7_scheme *sc, s7_pointer args) { g_cycle *g = (g_cycle *)malloc(sizeof(g_cycle)); g->obj = s7_car(args); return(s7_make_c_object(sc, g_cycle_type, (void *)g)); } static s7_pointer g_cycle_ref(s7_scheme *sc, s7_pointer args) { g_cycle *g; if (s7_list_length(sc, args) != 1) return(s7_wrong_number_of_args_error(sc, \"cycle-ref takes 1 argument: ~~S\", args)); g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type); if (!g) s7_error(sc, s7_make_symbol(sc, \"wrong-type-arg\"), s7_list(sc, 1, s7_make_string_wrapper(sc, \"object passed to cycle-ref is not a cycle object\"))); return(g->obj); } static s7_pointer g_cycle_to_list(s7_scheme *sc, s7_pointer args) { g_cycle *g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type); if (!g) s7_error(sc, s7_make_symbol(sc, \"wrong-type-arg\"), s7_list(sc, 1, s7_make_string_wrapper(sc, \"object passed to cycle->list is not a cycle object\"))); return(s7_cons(sc, g->obj, s7_nil(sc))); } static s7_pointer g_cycle_set(s7_scheme *sc, s7_pointer args) { g_cycle *g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type); if (!g) s7_error(sc, s7_make_symbol(sc, \"wrong-type-arg\"), s7_list(sc, 1, s7_make_string_wrapper(sc, \"object passed to cycle-set! is not a cycle object\"))); g->obj = s7_cadr(args); return(g->obj); } static s7_pointer g_cycle_implicit_set(s7_scheme *sc, s7_pointer args) { g_cycle *g; s7_pointer val; s7_int index; if (s7_list_length(sc, args) != 3) return(s7_wrong_number_of_args_error(sc, \"cycle-set! takes 3 arguments: ~~S\", args)); g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type); if (!g) s7_error(sc, s7_make_symbol(sc, \"wrong-type-arg\"), s7_list(sc, 1, s7_make_string_wrapper(sc, \"object passed to implicit cycle-set! is not a cycle object\"))); if ((!s7_is_integer(s7_cadr(args))) || (s7_integer(s7_cadr(args)) != 0)) return(s7_out_of_range_error(sc, \"implicit cycle-set!\", 2, s7_cadr(args), \"it should be 0\")); g->obj = s7_caddr(args); return(g->obj); } static s7_pointer g_cycle_copy(s7_scheme *sc, s7_pointer args) { s7_pointer obj = s7_car(args); g_cycle *g; g = (g_cycle *)s7_c_object_value_checked(s7_car(args), g_cycle_type); if (!g) return(s7_f(sc)); /* obj might not be a cycle object if destination is one */ return(g_make_cycle(sc, s7_list(sc, 1, g->obj))); } static void g_cycle_mark(void *val) { s7_mark(((g_cycle *)val)->obj); } static void g_cycle_free(void *val) { free(val); } static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args) { #define g_block_help \"(block ...) returns a block c-object with the arguments as its contents.\" #define g_block_sig s7_make_circular_signature(sc, 1, 2, s7_make_symbol(sc, \"block?\"), s7_make_symbol(sc, \"real?\")) s7_pointer p = args, b; size_t len = s7_list_length(sc, args); g_block *g = (g_block *)malloc(sizeof(g_block) + (len * sizeof(double))); g->size = (size_t)len; if (g->size > 0) g->data = (double *)((void *)g + sizeof(g_block)); else g->data = NULL; b = s7_make_c_object(sc, g_block_type, (void *)g); s7_c_object_set_let(sc, b, g_block_methods); s7_openlet(sc, b); for (size_t i = 0; i < len; i++, p = s7_cdr(p)) g->data[i] = s7_number_to_real(sc, s7_car(p)); /* if (s7_is_openlet(s7_car(p))) g->data[i] = s7_number_to_real(sc, s7_let_ref(sc, p, s7_make_symbol(sc, \"value\"))) */ return(b); } static s7_pointer block_p_d(s7_scheme *sc, s7_double x) { g_block *g = (g_block *)malloc(sizeof(g_block) + sizeof(double)); s7_pointer new_g; g->size = 1; g->data = (double *)((void *)g + sizeof(g_block)); g->data[0] = x; new_g = s7_make_c_object(sc, g_block_type, (void *)g); s7_c_object_set_let(sc, new_g, g_block_methods); s7_openlet(sc, new_g); return(new_g); } static bool is_NaN(s7_double x) {return(x != x);} #if __cplusplus #define is_inf(x) std::isinf(x) #else #define is_inf(x) isinf(x) #endif static char *g_block_display(s7_scheme *sc, void *value) { s7_pointer ffp = NULL, pl = NULL, oom = NULL; /* can't be static if threads or multiple s7's -- maybe add initializer? */ g_block *b = (g_block *)value; s7_int i, len, old_len, loc, bytes, prec; char *buf; ffp = s7_make_symbol(sc, \"float-format-precision\"); pl = s7_make_symbol(sc, \"print-length\"); oom = s7_make_symbol(sc, \"out-of-memory\"); prec = s7_integer(s7_starlet_ref(sc, ffp)); if (prec >= 16) prec = 3; len = b->size; old_len = s7_integer(s7_starlet_ref(sc, pl)); if (len > old_len) len = old_len; buf = (char *)malloc((len + 1) * 64); if (!buf) s7_error(sc, oom, s7_list(sc, 1, s7_make_string_wrapper(sc, \"unable to allocate string to display block\"))); buf[0] = (char)0; loc = snprintf(buf, (len + 1) * 64, \"(block\"); for (i = 0; i < len; i++) { char *flt = (char *)(buf + loc); if (is_NaN(b->data[i])) bytes = snprintf(flt, 64, \" +nan.0\"); else if (is_inf(b->data[i])) bytes = snprintf(flt, 64, \" %cinf.0\", (b->data[i] >= 0.0) ? '+' : '-'); else bytes = snprintf(flt, 64, \" %.*f\", (int)prec, b->data[i]); loc += (bytes > 64) ? 64 : bytes; } if (b->size > old_len) {buf[loc++] = ' '; buf[loc++] = '.'; buf[loc++] = '.'; buf[loc++] = '.';} buf[loc] = ')'; buf[loc + 1] = 0; return(buf); } static char *g_block_display_readably(s7_scheme *sc, void *value) { s7_int i, loc, bytes; g_block *b = (g_block *)value; s7_int len = b->size; char *buf = (char *)malloc((len + 1) * 64); buf[0] = (char)0; loc = snprintf(buf, (len + 1) * 64, \"(block\"); for (i = 0; i < len; i++) { char *flt = (char *)(buf + loc); if (is_NaN(b->data[i])) bytes = snprintf(flt, 64, \" +nan.0\"); else if (is_inf(b->data[i])) bytes = snprintf(flt, 64, \" %cinf.0\", (b->data[i] >= 0.0) ? '+' : '-'); else bytes = snprintf(flt, 64, \" %.16g\", b->data[i]); loc += (bytes > 64) ? 64 : bytes; } buf[loc] = ')'; buf[loc + 1] = 0; return(buf); } static s7_pointer g_block_to_string(s7_scheme *sc, s7_pointer args) { s7_pointer obj = s7_car(args); s7_pointer choice; char *descr; if (s7_is_pair(s7_cdr(args))) choice = s7_cadr(args); else choice = s7_t(sc); if (choice == s7_make_keyword(sc, \"readable\")) descr = g_block_display_readably(sc, s7_c_object_value(obj)); else descr = g_block_display(sc, s7_c_object_value(obj)); obj = s7_make_string(sc, descr); free(descr); return(obj); } static s7_pointer g_block_gc_free(s7_scheme *sc, s7_pointer obj) { free(s7_c_object_value(obj)); return(NULL); } static bool g_blocks_are_eql(void *val1, void *val2) { s7_int i, len; g_block *b1 = (g_block *)val1; g_block *b2 = (g_block *)val2; if (val1 == val2) return(true); len = b1->size; if (len != b2->size) return(false); if ((len & 1) == 0) for (i = 0; i < len; i++) { if (b1->data[i] != b2->data[i]) return(false); i++; if (b1->data[i] != b2->data[i]) return(false); } else for (i = 0; i < len; i++) if (b1->data[i] != b2->data[i]) return(false); return(true); } static s7_pointer g_blocks_are_equal(s7_scheme *sc, s7_pointer args) { return(s7_make_boolean(sc, g_blocks_are_eql((void *)s7_c_object_value(s7_car(args)), (void *)s7_c_object_value(s7_cadr(args))))); } static s7_pointer g_block_gc_mark(s7_scheme *sc, s7_pointer p) { /* nothing to mark because we protect g_block_methods below, and all blocks get the same let */ return(p); } static s7_pointer g_is_block(s7_scheme *sc, s7_pointer args) { #define g_is_block_help \"(block? obj) returns #t if obj is a block.\" #define g_is_block_sig s7_make_signature(sc, 2, s7_make_symbol(sc, \"boolean?\"), s7_t(sc)) return(s7_make_boolean(sc, s7_c_object_type(s7_car(args)) == g_block_type)); } static s7_pointer g_is_simple_block(s7_scheme *sc, s7_pointer args) { #define g_is_simple_block_help \"(simple-block? obj) returns #t if obj is a simple-block.\" return(s7_make_boolean(sc, s7_c_object_type(s7_car(args)) == g_simple_block_type)); } static s7_pointer block_ref_p_pp(s7_scheme *sc, s7_pointer obj, s7_pointer ind) { g_block *g; size_t index; g = (g_block *)s7_c_object_value_checked(obj, g_block_type); if (!g) { g = (g_block *)s7_c_object_value_checked(obj, g_simple_block_type); if (!g) s7_wrong_type_arg_error(sc, \"block-ref\", 1, obj, \"a block\"); } if (s7_is_integer(ind)) index = (size_t)s7_integer(ind); else { if (s7_is_symbol(ind)) /* ((block 'empty) b) etc (i.e. block method access) */ { s7_pointer val = s7_symbol_local_value(sc, ind, g_block_methods); if ((!s7_is_eq(s7_undefined(sc), val)) && (ind != val)) /* else! */ return(val); } return(s7_wrong_type_arg_error(sc, \"block-ref\", 2, ind, \"an integer\")); } if (index < g->size) return(s7_make_real(sc, g->data[index])); return(s7_out_of_range_error(sc, \"(implicit) block-ref\", 2, ind, \"it should be less than block length\")); } static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer args) { #define g_block_ref_help \"(block-ref b i) returns the block value at index i.\" #define g_block_ref_sig s7_make_signature(sc, 3, s7_t(sc), s7_make_symbol(sc, \"block?\"), s7_make_symbol(sc, \"integer?\")) if (s7_list_length(sc, args) != 2) return(s7_wrong_number_of_args_error(sc, \"block-ref takes 2 arguments: ~~S\", args)); return(block_ref_p_pp(sc, s7_car(args), s7_cadr(args))); } static s7_double block_ref_d_7pi(s7_scheme *sc, s7_pointer p, s7_int index) { g_block *g; g = (g_block *)s7_c_object_value_checked(p, g_block_type); if (!g) { g = (g_block *)s7_c_object_value_checked(p, g_simple_block_type); if (!g) s7_wrong_type_arg_error(sc, \"block-ref\", 1, p, \"a block\"); } if ((index < 0) || (index >= g->size)) s7_out_of_range_error(sc, \"block-ref\", 2, s7_make_integer(sc, index), (index >= 0) ? \"it should be less than block length\" : \"it should be non-negative\"); return(g->data[index]); } static s7_pointer block_set_p_ppp(s7_scheme *sc, s7_pointer obj, s7_pointer ind, s7_pointer val) { g_block *g; s7_int index; if (s7_is_immutable(obj)) return(s7_wrong_type_arg_error(sc, \"block-set!\", 1, obj, \"a mutable block\")); g = (g_block *)s7_c_object_value_checked(obj, g_block_type); if (!g) { g = (g_block *)s7_c_object_value_checked(obj, g_simple_block_type); if (!g) s7_wrong_type_arg_error(sc, \"block-ref\", 1, obj, \"a block\"); } if (!s7_is_integer(ind)) return(s7_wrong_type_arg_error(sc, \"block-set!\", 2, ind, \"an integer\")); index = s7_integer(ind); if ((index >= 0) && (index < g->size)) { g->data[index] = s7_number_to_real(sc, val); return(val); } return(s7_out_of_range_error(sc, \"block-set\", 2, ind, \"it should be less than block length\")); } static s7_pointer g_block_set(s7_scheme *sc, s7_pointer args) { #define g_block_set_help \"(block-set! b i x) sets the block value at index i to x.\" #define g_block_set_sig s7_make_signature(sc, 4, s7_make_symbol(sc, \"real?\"), s7_make_symbol(sc, \"block?\"), s7_make_symbol(sc, \"integer?\"), s7_make_symbol(sc, \"float?\")) /* real? as return type, not float? because we return caddr(args) below, not the floatified version of it */ /* c_object_set functions need to check that they have been passed the correct number of arguments */ if (s7_list_length(sc, args) != 3) return(s7_wrong_number_of_args_error(sc, \"block-set! takes 3 arguments: ~~S\", args)); return(block_set_p_ppp(sc, s7_car(args), s7_cadr(args), s7_caddr(args))); } static s7_double block_set_d_7pid(s7_scheme *sc, s7_pointer p, s7_int index, s7_double x) { g_block *g; if (s7_is_immutable(p)) s7_wrong_type_arg_error(sc, \"block-set!\", 1, p, \"a mutable block\"); g = (g_block *)s7_c_object_value_checked(p, g_block_type); if (!g) { g = (g_block *)s7_c_object_value_checked(p, g_simple_block_type); if (!g) s7_wrong_type_arg_error(sc, \"block-ref\", 1, p, \"a block\"); } if ((index < 0) || (index >= g->size)) s7_out_of_range_error(sc, \"block-set!\", 2, s7_make_integer(sc, index), (index >= 0) ? \"it should be less than block length\" : \"it should be non-negative\"); g->data[index] = x; return(x); } static s7_pointer g_block_length(s7_scheme *sc, s7_pointer args) { g_block *g = (g_block *)s7_c_object_value(s7_car(args)); return(s7_make_integer(sc, g->size)); } static s7_int get_start_and_end(s7_scheme *sc, s7_pointer args, s7_int *start, s7_int end) { if (s7_is_pair(s7_cdr(args))) { s7_pointer p = s7_cadr(args); if (s7_is_integer(p)) { s7_int nstart = s7_integer(p); if ((nstart < 0) || (nstart >= end)) {s7_out_of_range_error(sc, \"subblock\", 2, p, \"it should be less than block length\"); return(0);} *start = nstart; } if (s7_is_pair(s7_cddr(args))) { p = s7_caddr(args); if (s7_is_integer(p)) { s7_int nend = s7_integer(p); if (nend <= *start) {s7_out_of_range_error(sc, \"subblock\", 3, p, \"it should be greater than the start point\"); return(0);} if (nend < end) end = nend; }}} return(end - *start); } static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args) { s7_pointer new_g; g_block *g, *g1; size_t len; s7_int start = 0; s7_pointer obj = s7_car(args); if (s7_c_object_type(obj) != g_block_type) /* obj might not be a block object if destination is one */ { if (s7_is_float_vector(obj)) { s7_pointer v; s7_pointer dest = s7_cadr(args); g = (g_block *)s7_c_object_value(dest); len = g->size; if (s7_is_null(sc, s7_cddr(args))) { if (len > s7_vector_length(obj)) len = s7_vector_length(obj); if (len > 0) memcpy((void *)(g->data), (void *)(s7_float_vector_elements(obj)), len * sizeof(s7_double)); return(dest); } v = s7_make_float_vector_wrapper(sc, len, g->data, 1, NULL, false); s7_gc_protect_via_stack(sc, v); s7_copy(sc, s7_cons(sc, obj, s7_cons(sc, v, s7_cddr(args)))); s7_gc_unprotect_via_stack(sc, v); return(dest); } return(s7_f(sc)); } g = (g_block *)s7_c_object_value(obj); len = g->size; if (s7_is_pair(s7_cdr(args))) { new_g = s7_cadr(args); if (s7_is_immutable(new_g)) return(s7_wrong_type_arg_error(sc, \"block-copy!\", 0, new_g, \"a mutable block\")); if (s7_c_object_type(new_g) != g_block_type) /* fall back on the float-vector code using a wrapper */ { s7_pointer v = s7_make_float_vector_wrapper(sc, len, g->data, 1, NULL, false); s7_gc_protect_via_stack(sc, v); new_g = s7_copy(sc, s7_cons(sc, v, s7_cdr(args))); s7_gc_unprotect_via_stack(sc, v); return(new_g); } if (s7_is_pair(s7_cddr(args))) len = get_start_and_end(sc, s7_cdr(args), &start, len); } else new_g = make_block_raw(sc, len); g1 = (g_block *)s7_c_object_value(new_g); if (g1->size < len) len = g1->size; if (len > 0) memcpy((void *)(g1->data), (void *)(g->data + start), len * sizeof(double)); return(new_g); } static s7_pointer g_blocks_are_equivalent(s7_scheme *sc, s7_pointer args) { #define g_blocks_are_equivalent_help \"(equivalent? block1 block2)\" s7_pointer v1, v2; g_block *g1, *g2; bool result; size_t len; s7_pointer arg1 = s7_car(args); s7_pointer arg2 = s7_cadr(args); if (!s7_is_c_object(arg2)) return(s7_f(sc)); if (arg1 == arg2) return(s7_make_boolean(sc, true)); if (s7_is_let(arg1)) /* (block-let (block)) */ return(s7_make_boolean(sc, false)); /* checked == above */ g1 = (g_block *)s7_c_object_value(arg1); g2 = (g_block *)s7_c_object_value_checked(arg2, g_block_type); if (!g2) return(s7_make_boolean(sc, false)); len = g1->size; if (len != g2->size) return(s7_make_boolean(sc, false)); v1 = s7_make_float_vector_wrapper(sc, len, g1->data, 1, NULL, false); s7_gc_protect_via_stack(sc, v1); v2 = s7_make_float_vector_wrapper(sc, len, g2->data, 1, NULL, false); s7_gc_protect_via_stack(sc, v2); result = s7_is_equivalent(sc, v1, v2); s7_gc_unprotect_via_stack(sc, v1); s7_gc_unprotect_via_stack(sc, v2); return(s7_make_boolean(sc, result)); } static s7_pointer g_block_append(s7_scheme *sc, s7_pointer args) { #define g_block_append_help \"(append block...) returns a new block containing the argument blocks concatenated.\" s7_int i, len = 0; s7_pointer p, new_g; g_block *g; if (s7_is_null(sc, args)) return(s7_nil(sc)); /* (with-let (append)) ?! */ for (i = 1, p = args; s7_is_pair(p); p = s7_cdr(p), i++) { g_block *g1; g1 = (g_block *)s7_c_object_value_checked(s7_car(p), g_block_type); if (!g1) return(s7_wrong_type_arg_error(sc, \"block-append\", i, s7_car(p), \"a block\")); len += g1->size; } new_g = make_block_raw(sc, len); g = (g_block *)s7_c_object_value(new_g); for (i = 0, p = args; s7_is_pair(p); p = s7_cdr(p)) { g_block *g1; g1 = (g_block *)s7_c_object_value(s7_car(p)); if (g1->size > 0) { memcpy((void *)(g->data + i), (void *)(g1->data), g1->size * sizeof(double)); i += g1->size; }} return(new_g); } #if (((defined(SIZEOF_VOID_P)) && (SIZEOF_VOID_P == 4)) || ((defined(__SIZEOF_POINTER__)) && (__SIZEOF_POINTER__ == 4)) || (!defined(__LP64__))) #define Vectorized #else #if (defined(__GNUC__) && __GNUC__ >= 5) #define Vectorized __attribute__((optimize(\"tree-vectorize\"))) #else #define Vectorized #endif #endif static s7_pointer g_block_reverse(s7_scheme *sc, s7_pointer args) { size_t i, j; g_block *g, *g1; s7_pointer new_g; if (!s7_is_null(sc, s7_cdr(args))) return(s7_wrong_number_of_args_error(sc, \"(block-)reverse\", args)); g = (g_block *)s7_c_object_value(s7_car(args)); new_g = make_block_raw(sc, g->size); g1 = (g_block *)s7_c_object_value(new_g); for (i = 0, j = g->size - 1; i < g->size; i++, j--) g1->data[i] = g->data[j]; return(new_g); } #define LOOP_8(Code) do {Code; Code; Code; Code; Code; Code; Code; Code;} while (0) static s7_pointer g_block_reverse_in_place(s7_scheme *sc, s7_pointer args) /* Vectorized is slower */ { #define g_block_reverse_in_place_help \"(block-reverse! block) returns block with its data reversed.\" size_t i, j; g_block *g; double *d1, *d2; s7_pointer obj = s7_car(args); if (s7_is_immutable(obj)) return(s7_wrong_type_arg_error(sc, \"block-reverse!\", 0, obj, \"a mutable block\")); g = (g_block *)s7_c_object_value_checked(obj, g_block_type); if (!g) return(s7_wrong_type_arg_error(sc, \"block-reverse!\", 0, obj, \"a block\")); if (g->size < 2) return(obj); d1 = g->data; d2 = (double *)(d1 + g->size - 1); if ((g->size & 0x3f) == 0) /* need even number of 32's (we're moving two at a time) */ { while (d1 < d2) { s7_double c; LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c); LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c); LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c); LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c); }} else if ((g->size & 0xf) == 0) { while (d1 < d2) { s7_double c; LOOP_8(c = *d1; *d1++ = *d2; *d2-- = c); }} else while (d1 < d2) {s7_double c; c = *d1; *d1++ = *d2; *d2-- = c;} return(obj); } static Vectorized void block_memclr64(double *data, size_t bytes) { size_t i; for (i = 0; i < bytes; ) { LOOP_8(data[i++] = 0.0); } } static s7_pointer g_block_fill(s7_scheme *sc, s7_pointer args) { s7_pointer obj = s7_car(args); s7_pointer val; size_t i, len; s7_int start = 0; double fill_val; g_block *g; double *data; if (s7_is_immutable(obj)) return(s7_wrong_type_arg_error(sc, \"block-fill!\", 0, obj, \"a mutable block\")); val = s7_cadr(args); g = (g_block *)s7_c_object_value(obj); fill_val = s7_number_to_real(sc, val); len = g->size; if (s7_is_pair(s7_cddr(args))) len = get_start_and_end(sc, s7_cdr(args), &start, len); data = (double *)(g->data + start); if (fill_val == 0.0) { if ((g->size & 0x7) == 0) block_memclr64(data, len); else memset((void *)data, 0, len * sizeof(double)); } else if ((g->size & 0x3) == 0) for (i = 0; i < len; ) {data[i++] = fill_val; data[i++] = fill_val; data[i++] = fill_val; data[i++] = fill_val;} else for (i = 0; i < len; i++) data[i] = fill_val; return(obj); } static s7_pointer g_blocks(s7_scheme *sc, s7_pointer args) { return(s7_copy(sc, s7_list(sc, 1, args))); } static s7_pointer g_2_values(s7_scheme *sc, s7_pointer args) { return(s7_values(sc, s7_list(sc, 2, s7_car(args), s7_cadr(args)))); } static s7_pointer g_subblock(s7_scheme *sc, s7_pointer args) { #define g_subblock_help \"(subblock block (start 0) end) returns a portion of the block.\" s7_pointer p, new_g; s7_pointer obj = s7_car(args); s7_int start = 0, new_len, i; g_block *g, *g1; g = (g_block *)s7_c_object_value_checked(obj, g_block_type); if (!g) return(s7_wrong_type_arg_error(sc, \"subblock\", 1, obj, \"a block\")); new_len = get_start_and_end(sc, args, &start, g->size); new_g = make_block_raw(sc, new_len); g1 = (g_block *)s7_c_object_value(new_g); if (new_len > 0) memcpy((void *)(g1->data), (void *)(g->data + start), new_len * sizeof(double)); return(new_g); } static s7_pointer g_block_release_methods(s7_scheme *sc, s7_pointer args) { s7_gc_unprotect_at(sc, block_gc_loc); return(s7_f(sc)); } /* s7_init and s7_free */ static s7_pointer make_and_free(s7_scheme *sc, s7_pointer args) { s7_scheme *s7; s7 = s7_init(); s7_eval_c_string(sc, \"(+ 1 1)\"); /* or load some file? */ s7_free(s7); return(s7_f(sc)); } /* function port tests */ static unsigned char *fout = NULL; static unsigned int fout_size = 0, fout_loc = 0; static void foutput(s7_scheme *sc, unsigned char c, s7_pointer port) { if (fout_size == fout_loc) { if (fout_size == 0) { fout_size = 128; fout = (unsigned char *)malloc(fout_size * sizeof(unsigned char)); } else { fout_size += 128; fout = (unsigned char *)realloc(fout, fout_size * sizeof(unsigned char)); }} fout[fout_loc++] = c; } static s7_pointer fout_open(s7_scheme *sc, s7_pointer args) { return(s7_open_output_function(sc, foutput)); } static s7_pointer fout_get_output(s7_scheme *sc, s7_pointer args) { foutput(sc, 0, s7_car(args)); /* make sure it's null-terminated */ return(s7_make_string_with_length(sc, (const char *)fout, fout_loc - 1)); } static s7_pointer fout_close(s7_scheme *sc, s7_pointer args) { fout_loc = 0; return(s7_car(args)); } static const char *fin = NULL; static unsigned int fin_size = 0, fin_loc = 0; static s7_pointer finput(s7_scheme *sc, s7_read_t peek, s7_pointer port) { switch (peek) { case S7_READ_CHAR: return(s7_make_character(sc, fin[fin_loc++])); case S7_PEEK_CHAR: return(s7_make_character(sc, fin[fin_loc])); case S7_READ_LINE: { unsigned int i; s7_pointer result; for (i = fin_loc; (i < fin_size) && (fin[i] != '\\n'); i++); result = s7_make_string_with_length(sc, (char *)(fin + fin_loc), i - fin_loc); fin_loc = i + 1; return(result); } case S7_IS_CHAR_READY: return(s7_make_boolean(sc, fin_loc < fin_size)); case S7_READ: return(s7_error(sc, s7_make_symbol(sc, \"read-error\"), s7_make_string_wrapper(sc, \"can't read yet!\"))); default: return(s7_error(sc, s7_make_symbol(sc, \"read-error\"), s7_make_string_wrapper(sc, \"unknown s7_input_function choice\"))); } } static s7_pointer fin_open(s7_scheme *sc, s7_pointer args) { /* arg = string to read */ s7_pointer str; fin_loc = 0; str = s7_car(args); if (!s7_is_string(str)) return(s7_wrong_type_arg_error(sc, \"fin_open\", 1, s7_car(args), \"a string\")); fin = s7_string(str); /* assume caller will GC protect the string */ fin_size = s7_string_length(str); return(s7_open_input_function(sc, finput)); } /* values-from-C tests */ static s7_pointer g_cvals(s7_scheme *sc, s7_pointer args) {return(s7_values(sc, args));} static s7_pointer g_mvals(s7_scheme *sc, s7_pointer args) {return(s7_cons(sc, s7_make_symbol(sc, \"values\"), args));} /* dilambda test */ static s7_pointer g_dilambda_test(s7_scheme *sc, s7_pointer args) {return(s7_f(sc));} static s7_pointer g_set_dilambda_test(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} /* hash-table tests */ static s7_pointer g_hloc(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, 0));} static s7_pointer g_heq(s7_scheme *sc, s7_pointer args) {return(s7_make_boolean(sc, s7_is_eq(s7_car(args), s7_cadr(args))));} /* optimizer tests */ static s7_pointer g_cf00(s7_scheme *sc, s7_pointer args) {return(s7_f(sc));} static s7_pointer g_cf10(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer g_cf11(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer g_cs11(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer g_cf20(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer g_cf21(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer g_cf22(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));} static s7_pointer g_cf30(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer g_cf31(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer g_cf32(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));} static s7_pointer g_cf33(s7_scheme *sc, s7_pointer args) {return(s7_caddr(args));} static s7_pointer g_cf41(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer g_cf42(s7_scheme *sc, s7_pointer args) {return(s7_cadr(args));} static s7_pointer g_cf43(s7_scheme *sc, s7_pointer args) {return(s7_caddr(args));} static s7_pointer g_cf44(s7_scheme *sc, s7_pointer args) {return(s7_cadddr(args));} static s7_pointer g_rs11(s7_scheme *sc, s7_pointer args) {return(s7_make_integer(sc, s7_integer(s7_car(args)) + 1));} static s7_pointer g_cf51(s7_scheme *sc, s7_pointer args) {return(s7_car(args));} static s7_pointer sload(s7_scheme *sc, s7_pointer args) { if (s7_is_string(s7_car(args))) { if (s7_is_pair(s7_cdr(args))) { if (s7_is_let(s7_cadr(args))) return(s7_load_with_environment(sc, s7_string(s7_car(args)), s7_cadr(args))); return(s7_wrong_type_arg_error(sc, \"load\", 2, s7_cadr(args), \"an environment\")); } return(s7_load(sc, s7_string(s7_car(args)))); } return(s7_wrong_type_arg_error(sc, \"load\", 1, s7_car(args), \"file name\")); } static s7_pointer scall(s7_scheme *sc, s7_pointer args) {return(s7_call(sc, s7_car(args), s7_cadr(args)));} static s7_pointer sread(s7_scheme *sc, s7_pointer args) { if (s7_is_pair(args)) return(s7_read(sc, s7_car(args))); return(s7_read(sc, s7_current_input_port(sc))); } static s7_pointer swind(s7_scheme *sc, s7_pointer args) {return(s7_dynamic_wind(sc, s7_car(args), s7_cadr(args), s7_caddr(args)));} static s7_pointer seval(s7_scheme *sc, s7_pointer args) { if (s7_is_pair(s7_cdr(args))) return(s7_eval(sc, s7_car(args), s7_cadr(args))); return(s7_eval(sc, s7_car(args), s7_curlet(sc))); } static s7_pointer sevalstr(s7_scheme *sc, s7_pointer args) { if (s7_is_string(s7_car(args))) { if (s7_is_pair(s7_cdr(args))) { if (s7_is_let(s7_cadr(args))) return(s7_eval_c_string_with_environment(sc, s7_string(s7_car(args)), s7_cadr(args))); return(s7_wrong_type_arg_error(sc, \"eval-string\", 2, s7_cadr(args), \"an environment\")); } return(s7_eval_c_string_with_environment(sc, s7_string(s7_car(args)), s7_curlet(sc))); } return(s7_wrong_type_arg_error(sc, \"eval-string\", 1, s7_car(args), \"string of code\")); } void block_init(s7_scheme *sc); void block_init(s7_scheme *sc) { s7_pointer cur_env, meq_func, bref; max_vector_length = s7_integer(s7_let_ref(sc, s7_symbol_value(sc, s7_make_symbol(sc, \"*s7*\")), s7_make_symbol(sc, \"max-vector-length\"))); cur_env = s7_outlet(sc, s7_curlet(sc)); g_block_type = s7_make_c_type(sc, \"\"); s7_c_type_set_gc_free(sc, g_block_type, g_block_gc_free); s7_c_type_set_equal(sc, g_block_type, g_blocks_are_eql); s7_c_type_set_is_equal(sc, g_block_type, g_blocks_are_equal); s7_c_type_set_is_equivalent(sc, g_block_type, g_blocks_are_equivalent); s7_c_type_set_gc_mark(sc, g_block_type, g_block_gc_mark); s7_c_type_set_ref(sc, g_block_type, g_block_ref); s7_c_type_set_set(sc, g_block_type, g_block_set); s7_c_type_set_length(sc, g_block_type, g_block_length); s7_c_type_set_copy(sc, g_block_type, g_block_copy); s7_c_type_set_reverse(sc, g_block_type, g_block_reverse); s7_c_type_set_fill(sc, g_block_type, g_block_fill); s7_c_type_set_to_string(sc, g_block_type, g_block_to_string); s7_define_safe_function(sc, \"make-block\", g_make_block, 1, 0, false, g_make_block_help); s7_define_typed_function(sc, \"block\", g_to_block, 0, 0, true, g_block_help, g_block_sig); bref = s7_define_typed_function(sc, \"block-ref\", g_block_ref, 2, 0, false, g_block_ref_help, g_block_ref_sig); s7_c_type_set_getter(sc, g_block_type, s7_name_to_value(sc, \"block-ref\")); s7_symbol_set_initial_value(sc, bref, s7_symbol_value(sc, bref)); s7_define_typed_function(sc, \"block-set!\", g_block_set, 3, 0, false, g_block_set_help, g_block_set_sig); s7_c_type_set_setter(sc, g_block_type, s7_name_to_value(sc, \"block-set!\")); s7_define_safe_function(sc, \"block-let\", g_block_let, 1, 0, false, g_block_let_help); s7_define_safe_function(sc, \"subblock\", g_subblock, 1, 0, true, g_subblock_help); s7_define_safe_function(sc, \"block-append\", g_block_append, 0, 0, true, g_block_append_help); s7_define_safe_function(sc, \"block-reverse!\", g_block_reverse_in_place, 1, 0, false, g_block_reverse_in_place_help); s7_define_typed_function(sc, \"block?\", g_is_block, 1, 0, false, g_is_block_help, g_is_block_sig); s7_define_safe_function_star(sc, \"values2\", g_2_values, \"arg1 arg2\", \"values test for function*\"); s7_define_function_star(sc, \"unsafe-values2\", g_2_values, \"arg1 arg2\", \"values test for function*\"); s7_define_safe_function_star(sc, \"blocks1\", g_blocks, \"(frequency 4)\", \"test for function*\"); s7_define_safe_function_star(sc, \"blocks\", g_blocks, \"(frequency 4) (scaler 1)\", \"test for function*\"); s7_define_safe_function_star(sc, \"blocks3\", g_blocks, \"(frequency 4) (scaler 1) (asdf 32)\", \"test for function*\"); s7_define_safe_function_star(sc, \"blocks4\", g_blocks, \"(frequency 4) (scaler 1) (asdf 32) etc\", \"test for function*\"); s7_define_function_star(sc, \"unsafe-blocks1\", g_blocks, \"(frequency 4)\", \"test for function*\"); s7_define_function_star(sc, \"unsafe-blocks\", g_blocks, \"(frequency 4) (scaler 1)\", \"test for function*\"); s7_define_function_star(sc, \"unsafe-blocks3\", g_blocks, \"(frequency 4) (scaler 1) (asdf 32)\", \"test for function*\"); s7_define_function_star(sc, \"unsafe-blocks4\", g_blocks, \"(frequency 4) (scaler 1) (asdf 32) etc\", \"test for function*\"); s7_define_safe_function_star(sc, \"blocks5\", g_blocks, \"(frequency 4) :allow-other-keys\", \"test for function*\"); g_block_methods = s7_eval_c_string(sc, \"(openlet (immutable! (inlet 'float-vector? (lambda (p) #t) \\\n\ 'signature (lambda (p) (list #t 'block? 'integer?)) \\\n\ 'arity (lambda (p) (cons 1 1)) \\\n\ 'aritable? (lambda (p args) (= args 1)) \\\n\ 'vector-dimensions (lambda (p) (list (length p))) \\\n\ 'empty (lambda (p) (zero? (length p))) \\\n\ 'vector-ref block-ref \\\n\ 'vector-set! block-set! \\\n\ 'subsequence subblock \\\n\ 'append block-append \\\n\ 'reverse! block-reverse!)))\"); block_gc_loc = s7_gc_protect(sc, g_block_methods); s7_define_safe_function(sc, \"block-release-methods\", g_block_release_methods, 0, 0, false, NULL); g_simple_block_type = s7_make_c_type(sc, \"\"); s7_define_safe_function(sc, \"make-simple-block\", g_make_simple_block, 1, 0, false, g_make_simple_block_help); s7_c_type_set_gc_free(sc, g_simple_block_type, g_block_gc_free); s7_c_type_set_gc_mark(sc, g_simple_block_type, g_block_gc_mark); s7_c_type_set_length(sc, g_simple_block_type, g_block_length); s7_c_type_set_ref(sc, g_simple_block_type, g_block_ref); s7_c_type_set_getter(sc, g_simple_block_type, s7_name_to_value(sc, \"block-ref\")); s7_c_type_set_set(sc, g_simple_block_type, g_block_set); s7_c_type_set_setter(sc, g_simple_block_type, s7_name_to_value(sc, \"block-set!\")); s7_define_safe_function(sc, \"simple-block?\", g_is_simple_block, 1, 0, false, g_is_simple_block_help); s7_set_p_d_function(sc, s7_name_to_value(sc, \"block\"), block_p_d); s7_set_d_7pi_function(sc, s7_name_to_value(sc, \"block-ref\"), block_ref_d_7pi); s7_set_d_7pid_function(sc, s7_name_to_value(sc, \"block-set!\"), block_set_d_7pid); s7_set_p_pp_function(sc, s7_name_to_value(sc, \"block-ref\"), block_ref_p_pp); s7_set_p_ppp_function(sc, s7_name_to_value(sc, \"block-set!\"), block_set_p_ppp); g_c_tag_type = s7_make_c_type(sc, \"c-tag\"); s7_define_safe_function(sc, \"make-c-tag\", g_make_c_tag, 0, 0, false, \"no help here\"); s7_c_type_set_free(sc, g_c_tag_type, g_c_tag_free); g_c_tag1_type = s7_make_c_type(sc, \"c-tag1\"); s7_define_safe_function(sc, \"make-c-tag1\", g_make_c_tag1, 0, 0, false, \"no help here\"); s7_c_type_set_free(sc, g_c_tag1_type, g_c_tag_free); s7_c_type_set_equal(sc, g_c_tag1_type, NULL); s7_c_type_set_is_equal(sc, g_c_tag1_type, NULL); s7_c_type_set_is_equivalent(sc, g_c_tag1_type, NULL); s7_c_type_set_ref(sc, g_c_tag1_type, NULL); s7_c_type_set_set(sc, g_c_tag1_type, NULL); s7_c_type_set_length(sc, g_c_tag1_type, NULL); s7_c_type_set_copy(sc, g_c_tag1_type, NULL); s7_c_type_set_fill(sc, g_c_tag1_type, NULL); s7_c_type_set_reverse(sc, g_c_tag1_type, NULL); s7_c_type_set_to_list(sc, g_c_tag1_type, NULL); s7_c_type_set_to_string(sc, g_c_tag1_type, NULL); s7_c_type_set_getter(sc, g_c_tag1_type, NULL); s7_c_type_set_setter(sc, g_c_tag1_type, NULL); g_tag1_methods = s7_eval_c_string(sc, \"(openlet (immutable! (inlet 'copy (lambda (src dest) 123))))\"); s7_gc_protect(sc, g_tag1_methods); g_cycle_type = s7_make_c_type(sc, \"cycle\"); s7_define_safe_function(sc, \"make-cycle\", g_make_cycle, 1, 0, false, \"no help here\"); s7_define_safe_function(sc, \"cycle\", g_make_cycle, 1, 0, false, \"no help here\"); /* for print readably */ s7_c_type_set_mark(sc, g_cycle_type, g_cycle_mark); s7_c_type_set_free(sc, g_cycle_type, g_cycle_free); s7_c_type_set_to_list(sc, g_cycle_type, g_cycle_to_list); s7_c_type_set_copy(sc, g_cycle_type, g_cycle_copy); s7_c_type_set_ref(sc, g_cycle_type, g_cycle_ref); s7_c_type_set_set(sc, g_cycle_type, g_cycle_implicit_set); s7_define_safe_function(sc, \"cycle-ref\", g_cycle_ref, 1, 0, false, \"no help here\"); s7_define_safe_function(sc, \"cycle-set!\", g_cycle_set, 2, 0, false, \"no help here\"); s7_define_function(sc, \"s7-init-and-free\", make_and_free, 0, 0, false, NULL); s7_define_safe_function(sc, \"function-open-output\", fout_open, 0, 0, false, \"\"); s7_define_safe_function(sc, \"function-get-output\", fout_get_output, 1, 0, false, \"\"); s7_define_safe_function(sc, \"function-close-output\", fout_close, 1, 0, false, \"\"); s7_define_safe_function(sc, \"function-open-input\", fin_open, 1, 0, false, \"\"); s7_define_safe_function(sc, \"hash_heq\", g_heq, 2, 0, false, \"hash-table test\"); s7_define_safe_function(sc, \"hash_hloc\", g_hloc, 1, 0, false, \"hash-table test\"); s7_define_safe_function(sc, \"cf00\", g_cf00, 0, 0, false, \"\"); s7_define_safe_function(sc, \"cf10\", g_cf10, 1, 0, false, \"\"); s7_define_safe_function(sc, \"cf11\", g_cf11, 1, 0, false, \"\"); s7_define_safe_function(sc, \"cs11\", g_cs11, 1, 0, false, \"\"); s7_define_safe_function(sc, \"rs11\", g_rs11, 1, 0, false, \"\"); s7_define_safe_function(sc, \"cf20\", g_cf20, 2, 0, false, \"\"); s7_define_safe_function(sc, \"cf21\", g_cf21, 2, 0, false, \"\"); s7_define_safe_function(sc, \"cf22\", g_cf22, 2, 0, false, \"\"); s7_define_safe_function(sc, \"cf30\", g_cf30, 3, 0, false, \"\"); s7_define_safe_function(sc, \"cf31\", g_cf31, 3, 0, false, \"\"); s7_define_safe_function(sc, \"cf32\", g_cf32, 3, 0, false, \"\"); s7_define_safe_function(sc, \"cf33\", g_cf33, 3, 0, false, \"\"); s7_define_safe_function(sc, \"cf41\", g_cf41, 4, 0, false, \"\"); s7_define_safe_function(sc, \"cf42\", g_cf42, 4, 0, false, \"\"); s7_define_safe_function(sc, \"cf43\", g_cf43, 4, 0, false, \"\"); s7_define_safe_function(sc, \"cf44\", g_cf44, 4, 0, false, \"\"); s7_define_safe_function(sc, \"cf51\", g_cf51, 5, 0, false, \"\"); s7_define_function(sc, \"sload\", sload, 1, 1, false, \"test s7_load\"); s7_define_function(sc, \"scall\", scall, 2, 0, false, \"test s7_call\"); s7_define_function(sc, \"sread\", sread, 0, 1, false, \"test s7_read\"); s7_define_function(sc, \"swind\", swind, 3, 0, false, \"test s7_dynamic_wind\"); s7_define_function(sc, \"seval\", seval, 1, 1, false, \"test s7_eval\"); s7_define_function(sc, \"sevalstr\", sevalstr, 1, 1, false, \"test s7_eval_c_string\"); s7_define_safe_function(sc, \"dilambda_test\", g_dilambda_test, 0, 0, false, \"\"); s7_define_safe_function(sc, \"set_dilambda_test\", g_set_dilambda_test, 1, 0, false, \"\"); s7_set_setter(sc, s7_name_to_value(sc, \"dilambda_test\"), s7_name_to_value(sc, \"set_dilambda_test\")); s7_define_macro(sc, \"c-macro-with-values\", g_mvals, 0, 0, true, \"c-macro values test\"); s7_define_function(sc, \"c-function-with-values\", g_cvals, 0, 0, true, \"c-function values test\"); s7_define_function(sc, \"safe-c-function-with-2-values\", g_cvals, 2, 0, false, \"c-function values test\"); } "))) (let ((flags (string-append (if (provided? 'debugging) "-g3" "-g -O2") " " asan-flags))) (cond ((provided? 'osx) (system (string-append "gcc -c s7test-block.c " flags)) (system "gcc s7test-block.o -o s7test-block.so -dynamic -bundle -undefined suppress -flat_namespace")) ((or (provided? 'freebsd) (provided? 'netbsd)) (system (string-append "cc -fPIC -c s7test-block.c " flags)) (system "cc s7test-block.o -shared -o s7test-block.so -lm -lc")) ((provided? 'openbsd) (system (string-append "clang -fPIC -c s7test-block.c " flags)) (system "clang s7test-block.o -shared -o s7test-block.so -lm -lc")) ((provided? 'solaris) (system "gcc -fPIC -c s7test-block.c") (system "gcc s7test-block.o -shared -o s7test-block.so -G -ldl -lm")) (else (system (string-append "gcc -fPIC -c s7test-block.c " flags)) (system "gcc s7test-block.o -shared -o s7test-block.so -ldl -lm -Wl,-export-dynamic")))) (let ((e (sublet (curlet) (cons 'init_func 'block_init)))) (load "s7test-block.so" e)) (define _c_obj_ (make-block 16)) (unless (immutable? (block-let _c_obj_)) (format *stderr* "~S's let is mutable~%" _c_obj_))) ; with-block ;; else... (define _c_obj_ (c-pointer 0))) ; not with-block (define _null_ (c-pointer 0)) (when (provided? 'linux) (if (and (provided? 'system-extras) (not (file-exists? "ffitest.c")) (file-exists? "tools/ffitest.c")) (system "cp tools/ffitest.c .")) (if (provided? 'gmp) (system (string-append (if (provided? 'clang) "clang" "gcc") " -o ffitest ffitest.c -g3 -Wall -fPIC s7.o -DWITH_GMP -lgmp -lmpfr -lmpc " asan-flags " -lm -I. -ldl -Wl,-export-dynamic")) (system (string-append (if (provided? 'clang) "clang" "gcc") " -o ffitest ffitest.c -g3 -Wall -fPIC s7.o " asan-flags " -lm -I. -ldl -Wl,-export-dynamic"))) (format *stderr* "ffitest ") (system "ffitest")) #| (define (ok1? otst ola oexp) (let ((result (catch 'all-done ola (lambda args (if (not (eq? oexp 'error)) (begin (display args) (newline))) 'error)))) (if (not (equal? result oexp)) (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) otst result oexp)))) (define-macro (test tst expected) `(ok1? ',tst (lambda () (if (null? (hook-functions *error-hook*)) (set! (hook-functions *error-hook*) (list (lambda (hook) (apply format *stderr* (hook 'data)) (newline *stderr*) (set! (hook 'result) 'error) (throw 'all-done))))) ,tst) ,expected)) |# (when full-s7test (test (s7-init-and-free) #f)) ;;; -------------------------------------------------------------------------------- ;;; eq? (test (eq? 'a 3) #f) (test (eq? #t 't) #f) (test (eq? "abs" 'abc) #f) (test (eq? "hi" '(hi)) #f) (test (eq? "hi" "hi") #f) (test (eq? "()" ()) #f) (test (eq? '(1) '(1)) #f) (test (eq? '(#f) '(#f)) #f) (test (eq? #\a #\b) #f) (test (eq? #t #t) #t) (test (eq? #f #f) #t) (test (eq? #f #t) #f) (test (eq? (null? ()) #t) #t) (test (eq? (null? '(a)) #f) #t) (test (eq? (cdr '(a)) ()) #t) (test (eq? 'a 'a) #t) (test (eq? 'a 'b) #f) (test (eq? 'a (string->symbol "a")) #t) (test (eq? (symbol "a") (string->symbol "a")) #t) (test (eq? :a :a) #t) (test (eq? :a 'a) #f) (test (eq? ':a 'a) #f) (test (eq? ':a ':a) #t) (test (eq? :a a:) #f) (test (eq? ':a 'a:) #f) (test (eq? 'a: 'a:) #t) (test (eq? ':a: 'a:) #f) (test (eq? 'a (symbol "a")) #t) (test (eq? :: '::) #t) (test (eq? ':a (symbol->keyword (symbol "a"))) #t) ; but not a: (test (eq? '(a) '(b)) #f) (test (let ((x '(a . b))) (eq? x x)) #t) (test (let ((x (cons 'a 'b))) (eq? x x)) #t) (test (eq? (cons 'a 'b) (cons 'a 'b)) #f) (test (eq? "abc" "cba") #f) (test (let ((x "hi")) (eq? x x)) #t) (test (eq? (string #\h #\i) (string #\h #\i)) #f) (test (eq? #(a) #(b)) #f) (test (let ((x (vector 'a))) (eq? x x)) #t) (test (eq? (vector 'a) (vector 'a)) #f) (test (eq? car car) #t) (test (eq? car cdr) #f) (test (let ((x (lambda () 1))) (eq? x x)) #t) (test (let ((x (lambda () 1))) (let ((y x)) (eq? x y))) #t) (test (let ((x (lambda () 1))) (let ((y (lambda () 1))) (eq? x y))) #f) (test (eq? 'abc 'abc) #t) (test (eq? eq? eq?) #t) (test (eq? (if #f 1) 1) #f) (test (eq? () '(#||#)) #t) (test (eq? () '(#|@%$&|#)) #t) (test (eq? '#||#hi 'hi) #t) ; ?? (test (eq? '; a comment hi 'hi) #t) ; similar: (test (cadr '#| a comment |#(+ 1 2)) 1) (test `(+ 1 ,@#||#(list 2 3)) '(+ 1 2 3)) (test `(+ 1 ,#||#(+ 3 4)) '(+ 1 7)) ;; but not splitting the ",@" or splitting a number: (test (+ 1 2.0+#||#3i) 'error) (test `(+ 1 ,#||#@(list 2 3)) 'error) (test (eq? #||# (#|%%|# append #|^|#) #|?|# (#|+|# list #|<>|#) #||#) #t) (test (eq? '() ;a comment '()) #t) (test (eq? 3/4 3) #f) (test (eq? '() '()) #t) (test (eq? '() '( )) #t) (test (eq? '()'()) #t) (test (eq? '()(list)) #t) (test (eq? () (list)) #t) (test (eq? (begin) (append)) #t) (test (let ((lst (list 1 2 3))) (eq? lst (apply list lst))) #f) ; changed 26-Sep-11 ;(test (eq? 1/0 1/0) #f) ;(test (let ((+nan.0 1/0)) (eq? +nan.0 +nan.0)) #f) ;; these are "unspecified" so any boolean value is ok (test (eq? ''2 '2) #f) (test (eq? '2 '2) #t) ; unspecified?? (test (eq? '2 2) #t) (test (eq? ''2 ''2) #f) (test (eq? ''#\a '#\a) #f) (test (eq? '#\a #\a) #t) ; was #f (test (eq? 'car car) #f) (test (eq? '()()) #t) (test (eq? ''() '()) #f) (test (eq? ' () ' ()) #t) (test (eq? '#f #f) #t) (test (eq? '#f '#f) #t) (test (eq? #f ' #f) #t) (test (eq? '()'()) #t) ; no space (test (#||# eq? #||# #f #||# #f #||#) #t) (test (eq? (current-input-port) (current-input-port)) #t) (test (let ((f (lambda () (quote (1 . "H"))))) (eq? (f) (f))) #t) (test (let ((f (lambda () (cons 1 (string #\H))))) (eq? (f) (f))) #f) (test (eq? *stdin* *stdin*) #t) (test (eq? *stdout* *stderr*) #f) (test (eq? *stdin* *stderr*) #f) (test (eq? else else) #t) (test (eq? :else else) #f) (test (eq? :else 'else) #f) (test (eq? :if if) #f) (test (eq? 'if 'if) #t) (test (eq? :if :if) #t) (test (eq? (string) (string)) #t) ; was #f (test (eq? (string) "") #t) ; was #f -- changed 29-Jun-21 (test (eq? (vector) (vector)) #f) (test (eq? (vector) #()) #f) (test (eq? (list) (list)) #t) (test (eq? (list) ()) #t) (test (eq? (hash-table) (hash-table)) #f) (test (eq? (curlet) (curlet)) #t) (test (eq? (rootlet) (rootlet)) #t) (test (eq? (funclet abs) (funclet abs)) #t) ; or any other built-in... (test (eq? letrec* letrec*) #t) (test (eq? (current-input-port) (current-input-port)) #t) (test (eq? (current-error-port) (current-error-port)) #t) (test (eq? (current-output-port) (current-output-port)) #t) (test (eq? (current-input-port) (current-output-port)) #f) (test (eq? (string #\a) (string #\a)) #f) (test (eq? "a" "a") #f) (test (eq? #(1) #(1)) #f) (test (let ((a "hello") (b "hello")) (eq? a b)) #f) (test (let ((a "foo")) (eq? a (copy a))) #f) (test (let ((p (c-pointer 0))) (eq? p (copy p))) #f) (test (let ((p (c-pointer 0))) (let ((p1 p)) (eq? p p1))) #t) (test (let () (define (g x) x) (define (u x) g) (define (f) (eq? g (u g))) (f)) #t) ; guile mailing list (begin #| ; |# (display "")) (newline) (test (; eq? ';! (;)()# );((")"; ;"#|)#"" '#|";"|#(#|;|#); ;# ;\;"#"#f )#t) (test (+ #| this is a comment |# 2 #| and this is another |# 3) 5) (test (eq? #| a comment |# #f #f) #t) (test (eq? #| a comment |##f #f) #t) ; ?? (test (eq? #| a comment | ##f|##f #f) #t) ; ?? (test (eq? #||##||##|a comment| ##f|##f #f) #t) (test (+ ;#| 3 ;|# 4) 7) (test (+ #| ; |# 3 4) 7) #! (format *stderr* "#! ignored?~%") !# #| (format *stderr* "#| ignored?~%") |# (test (eq? (if #f #t) (if #f 3)) #t) (test (eq?) 'error) ; "this comment is missing a double-quote (test (eq? #t) 'error) #| "this comment is missing a double-quote |# (test (eq? #t #t #t) 'error) #| and this has redundant starts #| #| |# (test (eq? #f . 1) 'error) (test (eq #f #f) 'error) (define (feq) (let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector) (vector 1) (list 1) 'f 't #\t))) (let ((len (length things))) (do ((i 0 (+ i 1))) ((= i (- len 1))) (do ((j (+ i 1) (+ j 1))) ((= j len)) (if (eq? (vector-ref things i) (vector-ref things j)) (format #t ";feq: (eq? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))) (feq) ;;; these are defined at user-level in s7 -- why are other schemes so coy about them? (test (eq? (if #f #f) #) #t) (test (eq? (symbol->value '_?__undefined__?_) #) #t) (test (eq? # #) #t) (test (eq? # #) #t) (test (eq? # #) #t) (test (eq? # #) #f) (test (eq? # ()) #f) (test (eq? # _undef_) #f) (test (eq? _undef_ _undef_) #t) (test (procedure? #_abs) #t) ; #_abs evaluates to itself, a procedure (test (procedure? '#_abs) #t) ; #_abs is a procedure (the value, not its name, just as '32 is 32 and both are integers) (test (procedure? 'abs) #f) (test (eq? abs #_abs) #t) (test (eq? 'abs '#_abs) #f) (test (eq? #_abs '#_abs) #t) (test (let () (define-macro (hi a) `(+ 1 ,a)) (eq? hi hi)) #t) (test (let () (define (hi a) (+ 1 a)) (eq? hi hi)) #t) (test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (eq? x x)) #t) (test (eq? quasiquote quasiquote) #t) (test (eq? `quasiquote 'quasiquote) #t) (test (eq? 'if (keyword->symbol :if)) #t) (test (eq? 'if (string->symbol "if")) #t) (test (eq? (copy lambda) (copy 'lambda)) #f) (test (eq? if 'if) #f) (test (eq? if `if) #f) (test (eq? if (keyword->symbol :if)) #f) (test (eq? if (string->symbol "if")) #f) (test (eq? lambda and) #f) (test (eq? let let*) #f) (test (eq? quote quote) #t) (test (eq? '"hi" '"hi") #f) ; guile also (test (eq? '3 3) #t) (test (eq? '"" "") #t) ; nil_string now (these 3 were false originally) (test (eq? '"" '"") #t) (test (eq? "" "") #t) (test (eq? #() #()) #f) (test (eq? '#() #()) #f) (test (eq? '#() '#()) #f) (test (let ((v #())) (eq? v #())) #f) (test (let ((v #())) (eq? v v)) #t) (test (call/cc (lambda (return) (return (eq? return return)))) #t) (test (let ((r #f)) (call/cc (lambda (return) (set! r return) #f)) (eq? r r)) #t) (test (eq? _unbound_variable_ #f) 'error) (when with-block (let ((b (make-block 4))) (test (eq? b b) #t) (test (equal? b b) #t) (test (block? b) #t) (test (block? #()) #f) (test (block? #f) #f) (set! (b 0) 32) (test (b 0) 32.0) (let () (define (hi b i) (b i)) (test (hi b 0) 32.0)) (let () (define (hi b) (b 0)) (test (hi b) 32.0)) (let () (define (hi b) (b)) (test (hi b) 'error)) ;was 32!? (test b (block 32.0 0.0 0.0 0.0)) (test (let? (block-let b)) #t) (test (((block-let b) 'float-vector?) b) #t) (test (object->string b) "(block 32.000 0.000 0.000 0.000)") (let ((b1 (make-block 4))) (test (eq? b b1) #f)) (let ((b (block 1 2))) (test (vector-ref b 0) 1.0) (test (vector-set! b 0 3) 3) (test b (block 3 2))) (test (map abs b) (list 32.0 0.0 0.0 0.0))) (let ((b (block 1 2 3))) (test (reverse b) (block 3 2 1)) (test b (block 1 2 3)) (test (reverse b 1) 'error) (test (reverse! b) (block 3 2 1)) (test (reverse! b 1) 'error) (test b (block 3 2 1)) (test (b 'a) 'error) (test (b) 'error) (test (procedure? (b 'empty)) #t) (test (b 'empty #f) 'error) (test ((b 'empty) b) #f) (test ((b 'empty)) 'error) (test ((b 'empty) b 123) 'error) (test ((b 'empty) 123) 'error) (test ((block) 'a) 'error)) (when full-s7test (define (iota-block len) (let ((b (make-block len))) (do ((i 0 (+ i 1))) ((= i len) b) (block-set! b i i)))) (do ((i 0 (+ i 1))) ((= i 512)) (let* ((b (iota-block i)) (b1 (reverse b)) (b2 (reverse! b))) (unless (equal? b1 b2) (format *stderr* "reverse iota-block ~D: ~A~% ~A~%" i b1 b2))))) ;; check map/for-each (test (let () (define (func) ((lambda () (map (vector 0 1 2) '(1))))) (func)) '(1)) (let ((b (block 1 2 3))) (test ((lambda () (map b '(1)))) '(2.0)) (test (let () (define (func) ((lambda () (for-each b '(1))))) (func)) #) (test (let () (define (func) ((lambda () (map b '(1))))) (func)) '(2.0)) (test (let () (define (func) ((lambda () (map b '(xyx 1))))) (func)) 'error) (test (let () (define (func) ((lambda () (map (vector 1 2) '(xyx 1))))) (func)) 'error) (test (let () (define (func) ((lambda () (map b '(3 1))))) (func)) 'error) (test (let () (define (func) ((lambda () (map b '(#(1) 1))))) (func)) 'error)) (test (object->string (block +nan.0)) "(block +nan.0)") (test (object->string (block +inf.0)) "(block +inf.0)") (test (object->string (block -inf.0)) "(block -inf.0)") (test (object->string (block pi)) "(block 3.142)") (test (object->string (block +nan.0) :readable) "(block +nan.0)") (test (object->string (block +inf.0) :readable) "(block +inf.0)") (test (object->string (block -inf.0) :readable) "(block -inf.0)") (test (object->string (block pi) :readable) "(block 3.141592653589793)") ; (block pi) would be better (let-temporarily (((*s7* 'float-format-precision) 8)) (test (object->string (block pi)) "(block 3.14159265)")) (let ((v (make-vector 2 (block 1.0) block?))) (test (block? (v 0)) #t) (vector-set! v 0 (block 2.0)) (test (block-ref (vector-ref v 0) 0) 2.0) (test (#_block-ref (vector-ref v 0) 0) 2.0) (test (vector-set! v 0 #f) 'error) (test (signature v) (let ((lst (list 'block? 'vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst))) (let ((h (make-hash-table 8 #f (cons symbol? block?)))) (hash-table-set! h 'a (block 1.0)) (test (block? (h 'a)) #t) (test (block-ref (h 'a) 0) 1.0) (test (hash-table-set! h 'b 'asdf) 'error) (test (hash-table-set! h "b" (block)) 'error) (test (signature h) '(block? hash-table? symbol?))) (let ((h (make-hash-table 8 #f (cons #t block?)))) (hash-table-set! h 'a (block 2.0)) (test (block? (h 'a)) #t) (test (block-ref (h 'a) 0) 2.0) (test (hash-table-set! h 'b 'asdf) 'error) (test (hash-table-set! h "b" (block)) (block)) (test (signature h) '(block? hash-table? #t))) (let ((h (make-hash-table 8 #f (cons symbol? #t)))) (hash-table-set! h 'a (block 2.0)) (test (block? (h 'a)) #t) (test (block-ref (h 'a) 0) 2.0) (test (hash-table-set! h 'b 'asdf) 'asdf) (test (hash-table-set! h "b" (block)) 'error) (test (signature h) '(#t hash-table? symbol?)) (test (block-ref (block 1.0 2.0 3.0) else) 'error)) (test (make-hash-table 8 #f (cons #t #f)) 'error) (test (make-hash-table 8 #f ()) 'error) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) (test (signature (make-hash-table 8 #f (cons #t #t))) sig)) ; same as (signature (make-hash-table 8 #f [#f])) (test (blocks) (list 4 1)) (test (blocks :frequency 2) (list 2 1)) (let ((freq :frequency)) (test (blocks freq 2) (list 2 1))) (let ((freq :scaler)) (test (blocks freq 2) (list 4 2))) (let ((c #f)) (test (blocks (if c 100 :frequency) 10) (list 10 1))) (test (blocks :scaler 3 :frequency 2) (list 2 3)) (test (blocks :scaler 3 :phase 1) 'error) (test (map blocks '(1 2 3)) '((1 1) (2 1) (3 1))) (test (map blocks '( 1 2 3) '(4 5 6)) '((1 4) (2 5) (3 6))) (test (documentation blocks) "test for function*") (test (apply blocks '(:frequency 5 :scaler 4)) '(5 4)) (test (let () (define (b1) (blocks 100)) (b1)) '(100 1)) (test (let () (define (b1) (blocks 10 2)) (b1)) '(10 2)) (test (procedure? blocks) #t) (unless (or with-bignums (> (*s7* 'debug) 0)) ; debug turns off s7-optimize (test (s7-optimize '((block-append (make-block 2) (block)))) (block 0 0))) ; segfault due to plist overuse (let ((b1 (block 1)) (b2 (block 2)) (x1 2.0) (x2 3.0) (i 0) (j 0) (x 0.0)) (define (g1) ; opt_d_dd_fff_rev (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (+ (* x1 (block-ref b1 i)) (* x2 (block-ref b2 j)))))) (test (g1) 8.0) (define (g2) ; opt_d_dd_fff (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (+ (* (block-ref b1 i) x1) (* (block-ref b2 j) x2))))) (test (g2) 8.0)) (test (unsafe-blocks) (list 4 1)) (test (unsafe-blocks :frequency 2) (list 2 1)) (test (unsafe-blocks :scaler 3 :frequency 2) (list 2 3)) (test (unsafe-blocks :scaler 3 :phase 1) 'error) (test (map unsafe-blocks '(1 2 3)) '((1 1) (2 1) (3 1))) (test (map unsafe-blocks '( 1 2 3) '(4 5 6)) '((1 4) (2 5) (3 6))) (test (documentation unsafe-blocks) "test for function*") (test (apply unsafe-blocks '(:frequency 5 :scaler 4)) '(5 4)) (test (let () (define (b1) (unsafe-blocks 100)) (b1)) '(100 1)) (test (let () (define (b1) (unsafe-blocks 10 2)) (b1)) '(10 2)) (test (procedure? unsafe-blocks) #t) (test (blocks3 (car (list :a))) 'error) (test (let () (define (func) (blocks3 (car (list :a)))) (func)) 'error) (test (let () (define (func) (unsafe-blocks :asdf)) (func)) 'error) ; hop_safe_c_function_star_a bug (test (unsafe-blocks 3 :asdf) 'error) (test (let () (define (func) (unsafe-blocks 3 :asdf)) (func)) 'error) ; hop_c_aa bug (test (let () (define (func) (unsafe-blocks1 :asdf)) (func)) 'error) ; ?? (test (let () (define (func) (unsafe-blocks1 :fdsa)) (func)) 'error) ; ?? (test (unsafe-blocks1 3 :asdf) 'error) (test (let () (define (func) (unsafe-blocks1 3 :asdf)) (func)) 'error) (test (let () (define (func) (unsafe-blocks3 :asdf)) (func)) 'error) (test (unsafe-blocks3 3 :asdf) 'error) (test (catch #t (lambda () (blocks3 1 2 3)) (lambda (t i) (apply format *stderr* i))) '(1 2 3)) (test (let () (define (func) (unsafe-blocks3 3 :asdf)) (func)) 'error) (test (let () (define (func) (unsafe-blocks3 1 3 :asdf)) (func)) 'error) ; ?? all 6 (test (unsafe-blocks3 1 3 :asdf) 'error) (test (let () (define (func) (unsafe-blocks3 1 3 :asdf)) (func)) 'error) (test (let () (define (func) (unsafe-blocks3 1 3 :fdsa)) (func)) 'error) (test (unsafe-blocks3 1 3 :fdsa) 'error) (test (let () (define (func) (unsafe-blocks3 1 3 :fdsa)) (func)) 'error) (test (let () (define (func) (unsafe-blocks1 :asdf)) (func)) 'error) ; h_c_a (test (let () (define (func) (unsafe-blocks1 :fdsa)) (func)) 'error) (test (let () (define (func) (unsafe-blocks3 1 3 :asdf)) (func)) 'error) ; h_c_fx (test (unsafe-blocks3 1 3 :asdf) 'error) (test (let () (define (func) (unsafe-blocks3 1 3 :asdf)) (func)) 'error) (test (let () (define (func) (unsafe-blocks3 1 3 :fdsa)) (func)) 'error) (test (unsafe-blocks3 1 3 :fdsa) 'error) (test (let () (define (func) (unsafe-blocks3 1 3 :fdsa)) (func)) 'error) (test (let () (define (func) (blocks :asdf)) (func)) 'error) (test (blocks 3 :asdf) 'error) (test (let () (define (func) (blocks 3 :asdf)) (func)) 'error) (test (blocks1 :asdf) 'error) (test (let () (define (func) (blocks1 :asdf)) (func)) 'error) ; h_safe_c_d (test (let () (define (func) (blocks1 :fdsa)) (func)) 'error) (test (let ((sk :rest)) (define (func) (blocks1 sk)) (func)) 'error) (test (blocks1 3 :asdf) 'error) (test (let () (define (func) (blocks1 3 :asdf)) (func)) 'error) (test (let () (define (func) (blocks3 :asdf)) (func)) 'error) (test (blocks3 3 :asdf) 'error) (test (let () (define (func) (blocks3 3 :asdf)) (func)) 'error) (test (let () (define (func) (blocks3 1 3 :asdf)) (func)) 'error) (test (blocks3 1 3 :asdf) 'error) (test (let () (define (func) (blocks3 1 3 :asdf)) (func)) 'error) ; h_safe_c_d (test (let () (define (func) (blocks3 1 3 :fdsa)) (func)) 'error) (test (blocks3 1 3 :fdsa) 'error) (test (let () (define (func) (blocks4 :asdf)) (func)) 'error) (test (blocks4 1 2 3 :etc) 'error) (test (let () (define (func) (blocks4 3 :asdf)) (func)) 'error) (test (let () (define (func) (blocks4 1 2 3 :etc)) (func)) 'error) (test (blocks4 1 3 :fdsa) 'error) (test (let () (define (func) (blocks4 1 2 3 :fdsa)) (func)) 'error) (test (blocks4 1 2 3 :fdsa) 'error) (test (blocks5) '(4)) (test (blocks5 :frequency 440) '(440)) (test (blocks5 :frequency 440 :amplitude 1.0) '(440)) (test (blocks5 1) '(1)) (test (blocks5 1 2) 'error) ; error: blocks5: too many arguments: (1 2) (test (blocks5 :a 1 :b 2) '(4)) (test (blocks5 :a 1 :b 2 :frequency 440 :c 3) '(440)) (test (let () (define (f) (blocks5 :a 1 :frequency 440)) (f)) '(440)) (test (blocks5 :x) 'error) ; value missing (test (let () (define (f) (object->string (blocks5 (values :ho)))) (f)) 'error) (test (let () (define (f) (object->string (blocks5 (car (list :ho))))) (f)) 'error) (test (let () (define (f) (object->string (blocks4 (car (list :ho))))) (f)) 'error) (test (let () (define (f) (blocks5 :ho)) (f)) 'error) (test (let () (define (f) (blocks5 (symbol->keyword 'oops))) (f)) 'error) (test (let () (define (f) (blocks5 (string->keyword 'oops))) (f)) 'error) (test (blocks5 frequency: 440) '(440)) (test (blocks5 frequency: 440 amplitude: 1.0) '(440)) (test (blocks5 a: 1 :b 2) '(4)) (test (blocks5 :a 1 b: 2 frequency: 440 :c 3) '(440)) (test (call/cc (setter (block))) 'error) (test (call-with-exit (setter (block))) 'error) (test (call-with-input-string "123" (setter (block))) 'error) (let ((b (make-simple-block 4))) (test (eq? b b) #t) (test (equal? b b) #t) (test (simple-block? b) #t) (test (simple-block? #()) #f) (test (simple-block? #f) #f) (set! (b 0) 32) (test (b 0) 32.0) (test (length b) 4) (test (substring (object->string b) 0 17) "#< ") (test (substring (object->string b :readable) 0 17) "#< ") (let ((iter (make-iterator b))) (test (iterate iter) 32.0) (test (iter) 0.0) (test (object->string iter) "#>")) (test (copy b) 'error) (test (reverse b) 'error) (test (reverse! b) 'error) (test (fill! b) 'error) (let ((b1 (make-simple-block 4))) (copy b b1) (test (equal? b b1) #f) (test (b1 0) 32.0) (test (append b b1) 'error)) (s7-optimize '((b 0)))) (test (make-vector 12 "ho" simple-block?) 'error) (test (signature (make-vector 12 (make-simple-block 1) simple-block?)) (let ((L (list 'simple-block? 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (make-vector 12 "ho" block?) 'error) (test (signature (make-vector 12 (make-block 1) block?)) (let ((L (list 'block? 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (make-vector 12 "ho" c-tag?) 'error) (test (signature (make-vector 12 (make-c-tag) c-tag?)) 'error) (test (let ((h (make-hash-table 8 #f (cons symbol? simple-block?)))) (hash-table-set! h 'a 1234)) 'error) (test (let ((h (make-hash-table 8 #f (cons symbol? simple-block?)))) (signature h)) '(simple-block? hash-table? symbol?)) (test (let ((h (make-hash-table 8 #f (cons simple-block? symbol?)))) (hash-table-set! h (make-simple-block 1) 'a)) 'a) (test (let ((h (make-hash-table 8 #f (cons simple-block? symbol?)))) (signature h)) '(symbol? hash-table? simple-block?)) (let ((g (make-cycle "123"))) (test (cycle-ref g) "123") (test (substring (object->string g) 0 8) "#string g :readable) "(cycle \"123\")") (test (cycle-set! g "321") "321") (test (cycle-ref g) "321") (test (equal? g 21) #f) (test (equal? g g) #t) (test (equal? g (make-cycle #\a)) #f) (test (equal? g (make-cycle "321")) #t) (test (equal? g (cycle "321")) #t) (test (set! (g 0) 1) 1) (test (set! (g 0 1) 2) 'error) (cycle-set! g g) (let ((g1 (make-cycle g))) (test (equal? g g1) #t)) (set! (g 0) #f) (test (cycle-ref g) #f) (set! (g 0) g) (test (substring (object->string g) 0 11) "#1=#string g :readable) "(let ((<1> (cycle #f))) (set! (<1> 0) <1>) <1>)") (let ((L (list 1))) (cycle-set! g L) (set! (L 0) g) (test-wi (object->string g :readable) "(let ((<1> (cycle #f))) (set! (<1> 0) (let (( (list #f))) (set-car! <1>) )) <1>)")) (let ((g2 (make-cycle g))) (test (equal? g g2) #f)) (let ((L (list 1))) (set-cdr! L L) (test-wi (object->string (make-cycle L) :readable) "(let ((<2> (cycle #f)) (<1> (list 1))) (set! (<2> 0) <1>) (set-cdr! <1> <1>) <2>)")) (let ((L (list (cycle 2) 3))) (set-cdr! (cdr L) L) (test-wi (object->string L :readable) "(let ((<1> (list (cycle 2) 3))) (set-cdr! (cdr <1>) <1>) <1>)")) (let ((L2 (make-list 3 #f)) (C (cycle #f)) (V1 (make-vector 3 #f))) (set! (L2 0) V1) (set! (V1 0) C) (set! (C 0) C) (set! (V1 1) L2) (test-wi (object->string L2 :readable) "(let ((<3> (list #f #f #f)) (<2> (vector #f #f #f)) (<1> (cycle #f))) (set-car! <3> <2>) (set! (<2> 0) <1>) (set! (<2> 1) <3>) (set! (<1> 0) <1>) <3>)")) (let ((L (list #f)) (C (make-cycle #f))) (set! (L 0) C) (let ((IT (make-iterator L))) (set! (C 0) IT) (test-wi (object->string IT :readable) "(let ((<1> #f) (<3> (list #f)) (<2> (cycle #f))) (set! <1> (make-iterator <3>)) (set-car! <3> <2>) (set! (<2> 0) <1>) <1>)"))) (let ((cy (make-cycle #f)) (it (make-iterator (make-list 3 #f))) (cp (c-pointer 1 (make-list 3 #f)))) (set! (((object->let cp) 'c-type) 1) cy) (set! ((iterator-sequence it) 1) it) (set! (cy 0) it) (test-wi (object->string cp :readable) "(let ((<4> (list #f #f #f)) (<3> (cycle #f)) (<1> #f) (<2> (list #f #f #f))) (set! <1> (make-iterator <2>)) (set! (<4> 1) <3>) (set! (<3> 0) <1>) (set! (<2> 1) <1>) (c-pointer 1 <4> #f))"))) (test (let->list (make-cycle 1)) (list (rootlet))) (let ((b (make-c-tag))) (test (eq? b b) #t) (test (equal? b b) #t) (test (b 0) 'error) (test (length b) #f) (test (substring (object->string b :readable) 0 8) "#string b))) (test (substring str 0 8) "#)) (let ((iter (make-iterator b))) (test (iterate iter) #) (test (object->string iter) "#")) (test (copy b) 'error) (test (reverse b) 'error) (test (reverse! b) 'error) (test (fill! b) 'error) (let ((b1 (make-c-tag))) (copy b b1) (test (equal? b b1) #f) (test (append b b1) 'error)) (test (setter (make-c-tag)) #f)) (let ((b (make-c-tag1))) ; checking NULL fields (test (eq? b b) #t) (test (equal? b b) #t) (test (b 0) 'error) (test (length b) #f) (test (substring (object->string b :readable) 0 8) "#string b))) (test (substring str 0 8) "#)) (let ((iter (make-iterator b))) (test (iterate iter) #) (test (object->string iter) "#")) (test (copy b) 'error) (test (reverse b) 'error) (test (reverse! b) 'error) (test (fill! b) 'error) (let ((b1 (make-c-tag))) (copy b b1) (test (equal? b b1) #f) (test (append b b1) 'error)) (test (setter (make-c-tag1)) #f)) (define (fv32) (let ((b (block 1 2 3 4)) (f (make-float-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) f) (set! (f i) (+ (b i) 1.0))))) (test (fv32) (float-vector 2.0 3.0 4.0 5.0)) (define (fv33) (let ((b (block 1 2 3 4)) (f (make-block 4))) (do ((i 0 (+ i 1))) ((= i 4) f) (set! (f i) (+ (b i) 1.0))))) (test (fv33) (block 2.0 3.0 4.0 5.0)) (define (fv34) (let ((b (block 1 2 3 4)) (f (make-vector 4))) (do ((k 0 (+ k 1))) ((= k 1) f) (do ((i 0 (+ i 1))) ((= i 4)) (set! (f i) (b i)))))) (test (fv34) (vector 1.0 2.0 3.0 4.0))) (when with-block (test (pair? (*s7* 'c-types)) #t)) ;;; a ridiculous optimizer typo... (test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a a))) #f) (test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a . a))) #t) (test (let ((sym 'a)) (define (hi a) (eq? (cdr a) sym)) (hi '(a . b))) #f) (for-each (lambda (arg) (let ((x arg) (y arg)) (if (not (eq? x x)) (format #t ";(eq? x x) of ~A -> #f?~%" x)) (if (not (eq? x arg)) (format #t ";(eq? x arg) of ~A ~A -> #f?~%" x arg)) (if (not (eq? x y)) (format #t ";(eq? x y) of ~A ~A -> #f?~%" x y)))) ;; actually I hear that #f is ok here for numbers (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3/4 #\f (lambda (a) (+ a 1)) :hi (if #f #f) # #)) ;; this used to include 3.14 and 1+i but that means the (eq? x x) case differs from the (eq? 3.14 3.14) case (define comment-start (port-line-number)) #| :'(1(1)) (1 (1)) :'(1#(1)) (1# (1)) |# (if (not (= (- (port-line-number) comment-start) 7)) (format *stderr* ";block comment newline counter: ~D ~D~%" comment-start (port-line-number))) (test (eval-string "|#") 'error) ;;; this comes from G Sussman (let () (define (counter count) (lambda () (set! count (+ 1 count)) count)) (define c1 (counter 0)) (define c2 (counter 0)) (test (eq? c1 c2) #f) (test (eq? c1 c1) #t) (test (eq? c2 c2) #t) (test (let ((p (lambda (x) x))) (eqv? p p)) #t) (for-each (lambda (arg) (if (not ((lambda (p) (eq? p p)) arg)) (format #t "~A not eq? to itself?~%" arg))) (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) # # '(1 2 . 3) (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) lst) (vector) (string) (list) (let ((x 3)) (lambda (y) (+ x y)))))) ;;; this for r7rs (test (eq? #t #true) #t) (test (eq? #f #false) #t) (test (eq? () (map values ())) #t) (let () (define (f2) f2) (test (eq? f2 (f2)) #t)) (letrec ((f2 (lambda () f2))) (test (eq? f2 (f2)) #t)) ;;; -------------------------------------------------------------------------------- ;;; eqv? (test (eqv? 'a 3) #f) (test (eqv? #t 't) #f) (test (eqv? "abs" 'abc) #f) (test (eqv? "hi" '(hi)) #f) (test (eqv? "()" ()) #f) (test (eqv? '(1) '(1)) #f) (test (eqv? '(#f) '(#f)) #f) (test (eqv? #\a #\b) #f) (test (eqv? #\a #\a) #t) (test (eqv? (integer->char 255) (string-ref (string #\x (integer->char 255) #\x) 1)) #t) (test (eqv? (integer->char #xf0) (integer->char #x70)) #f) (test (eqv? #\space #\space) #t) (test (let ((x (string-ref "hi" 0))) (eqv? x x)) #t) (test (eqv? #t #t) #t) (test (eqv? #f #f) #t) (test (eqv? #f #t) #f) (test (eqv? (null? ()) #t) #t) (test (eqv? (null? '(a)) #f) #t) (test (eqv? (cdr '(a)) '()) #t) (test (eqv? 'a 'a) #t) (test (eqv? 'a 'b) #f) (test (eqv? 'a (string->symbol "a")) #t) (test (eqv? '(a) '(b)) #f) (test (let ((x '(a . b))) (eqv? x x)) #t) (test (let ((x (cons 'a 'b))) (eqv? x x)) #t) (test (eqv? (cons 'a 'b) (cons 'a 'b)) #f) (test (eqv? "abc" "cba") #f) (test (let ((x "hi")) (eqv? x x)) #t) (test (eqv? (string #\h #\i) (string #\h #\i)) #f) (test (eqv? #(a) #(b)) #f) (test (let ((x (vector 'a))) (eqv? x x)) #t) (test (eqv? (vector 'a) (vector 'a)) #f) (test (eqv? car car) #t) (test (eqv? car cdr) #f) (test (let ((x (lambda () 1))) (eqv? x x)) #t) (test (eqv? (lambda () 1) (lambda () 1)) #f) (test (let () (define (make-adder x) (lambda (y) (+ x y))) (eqv? (make-adder 1) (make-adder 1))) #f) (test (eqv? 9/2 9/2) #t) (test (eqv? quote quote) #t) (test (eqv? () ()) #t) (test (eqv? () '()) #t) ;(test (eqv? "" "") #f) (test (eqv? "hi" "hi") #f) ; unspecified (test (eqv? #() #()) #f) ; unspecified, but in s7 (eqv? () ()) is #t (test (eqv? (vector) (vector)) #f) (let ((c1 (let ((x 32)) (lambda () x))) (c2 (let ((x 123)) (lambda () x)))) (test (eqv? c1 c2) #f) (test (eqv? c1 c1) #t)) (test (eqv? most-positive-fixnum most-positive-fixnum) #t) (test (eqv? most-positive-fixnum most-negative-fixnum) #f) (test (eqv? 9223372036854775807 9223372036854775806) #f) (test (eqv? 9223372036854775807 -9223372036854775808) #f) (test (eqv? -9223372036854775808 -9223372036854775808) #t) (test (eqv? 123456789/2 123456789/2) #t) (test (eqv? 123456789/2 123456787/2) #f) (test (eqv? -123456789/2 -123456789/2) #t) (test (eqv? 2/123456789 2/123456789) #t) (test (eqv? -2/123456789 -2/123456789) #t) (test (eqv? 2147483647/2147483646 2147483647/2147483646) #t) (test (eqv? 3/4 12/16) #t) (test (eqv? 1/1 1) #t) (test (eqv? 312689/99532 833719/265381) #f) (test (let ((x 3.141)) (eqv? x x)) #t) (test (let ((x 1+i)) (eqv? x x)) #t) (test (let* ((x 3.141) (y x)) (eqv? x y)) #t) (test (let* ((x 1+i) (y x)) (eqv? x y)) #t) (test (let* ((x 3/4) (y x)) (eqv? x y)) #t) (test (eqv? 1.0 1.0) #t) (test (eqv? 0.6 0.6) #t) (test (eqv? 0.6 0.60) #t) (test (eqv? 1+i 1+i) #t) (test (eqv? -3.14 -3.14) #t) (test (eqv? 1e2 1e2) #t) (test (eqv? 1 1.0) #f) (test (eqv? 1/2 0.5) #f) (test (eqv? 1 1/1) #t) (test (eqv? 0.5 5e-1) #t) (test (eqv? 1/0 1/0) #f) (test (eqv? +nan.0 +nan.0) #f) (test (eqv? (cons 'a 'b) (cons 'a 'c)) #f) (test (eqv? eqv? eqv?) #t) (test (eqv? #(1) #(1)) #f) (test (eqv? '(1) '(1)) #f) (test (eqv? '() '()) #t) (test (eqv? '() (list)) #t) (test (eqv? '(()) '(())) #f) (test (eqv? (list 'abs 'cons) '(abs cons)) #f) (define (feqv) (let ((things (vector #t #f #\space '() "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector) (vector 1) (list 1) 'f 't #\t))) (let ((len (length things))) (do ((i 0 (+ i 1))) ((= i (- len 1))) (do ((j (+ i 1) (+ j 1))) ((= j len)) (if (eqv? (vector-ref things i) (vector-ref things j)) (format #t ";(eqv? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))) (feqv) (test (eqv?) 'error) (test (eqv? #t) 'error) (test (eqv? #t #t #t) 'error) (test (eqv #f #f) 'error) (test (eqv? ''2 '2) #f) (test (eqv? '2 '2) #t) (test (eqv? '2 2) #t) (test (eqv? ''2 ''2) #f) (test (eqv? ''#\a '#\a) #f) (test (eqv? '#\a #\a) #t) (test (eqv? 'car car) #f) (test (eqv? ''() '()) #f) (test (eqv? '#f #f) #t) (test (eqv? '#f '#f) #t) (test (eqv? # #) #t) (test (eqv? # #) #t) (test (eqv? # #) #t) (test (eqv? (if #f #f) #) #t) (test (eqv? # #) #f) (test (eqv? # '()) #f) (test (let () (define-macro (hi a) `(+ 1 ,a)) (eqv? hi hi)) #t) (test (let () (define (hi a) (+ 1 a)) (eqv? hi hi)) #t) (test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (eqv? x x)) #t) (test (eqv? else else) #t) (test (let ((p (lambda (x) x))) (eqv? p p)) #t) (test (eqv? # _undef_) #f) (test (eqv? _undef_ _undef_) #t) (test (eqv? :a 'a) #f) (test (eqv? :a a:) #f) (test (eqv? :a :a) #t) (when with-bignums (test (eqv? (bignum "1+i") (bignum "1+i")) #t) (test (eqv? (bignum "1+i") 1+i) #t) (test (eqv? 1+i (bignum "1+i")) #t) (test (eqv? (bignum "2.0") (bignum "2.0")) #t) (test (eqv? (bignum "2.0") (bignum "1.0")) #f) (test (eqv? (bignum +nan.0) (bignum 2.0)) #f) (test (eqv? (bignum +nan.0) 2.0) #f) (test (eqv? (bignum +nan.0) +nan.0) #f) (test (eqv? (complex +nan.0 1.0) (bignum (complex +nan.0 1.0))) #f)) ;; from M Weaver: (test (list (eqv? +0.0 -0.0) (eqv? (complex +0.0 1.0) (complex -0.0 1.0)) (eqv? (complex 1.0 +0.0) (complex 1.0 -0.0))) '(#t #t #t)) (test (list ;(eq? +0.0 -0.0) (eq? (complex +0.0 1.0) (complex -0.0 1.0)) (eq? (complex 1.0 +0.0) (complex 1.0 -0.0))) '(#f #f)) (test (list (eq? +0 -0) (eq? (complex +0 1) (complex -0 1)) (eq? (complex 1 +0) (complex 1 -0))) '(#t #f #t)) ;;; -------------------------------------------------------------------------------- ;;; equal? (test (equal? 'a 3) #f) (test (equal? #t 't) #f) (test (equal? "abs" 'abc) #f) (test (equal? "hi" '(hi)) #f) (test (equal? "()" '()) #f) (test (equal? '(1) '(1)) #t) (test (equal? '(#f) '(#f)) #t) (test (equal? '(()) '(() . ())) #t) (test (equal? #\a #\b) #f) (test (equal? #\a #\a) #t) (test (let ((x (string-ref "hi" 0))) (equal? x x)) #t) (test (equal? #t #t) #t) (test (equal? #f #f) #t) (test (equal? #f #t) #f) (test (equal? (null? '()) #t) #t) (test (equal? (null? '(a)) #f) #t) (test (equal? (cdr '(a)) '()) #t) (test (equal? 'a 'a) #t) (test (equal? 'a 'b) #f) (test (equal? 'a (string->symbol "a")) #t) (test (equal? '(a) '(b)) #f) (test (equal? '(a) '(a)) #t) (test (let ((x '(a . b))) (equal? x x)) #t) (test (let ((x (cons 'a 'b))) (equal? x x)) #t) (test (equal? (cons 'a 'b) (cons 'a 'b)) #t) (test (equal?(cons 'a 'b)(cons 'a 'b)) #t) ; no space (test (equal? "abc" "cba") #f) (test (equal? "abc" "abc") #t) (test (let ((x "hi")) (equal? x x)) #t) (test (equal? (string #\h #\i) (string #\h #\i)) #t) (test (equal? #(a) #(b)) #f) (test (equal? #(a) #(a)) #t) (test (let ((x (vector 'a))) (equal? x x)) #t) (test (equal? (vector 'a) (vector 'a)) #t) (test (equal? #(1 2) (vector 1 2)) #t) (test (equal? #(1.0 2/3) (vector 1.0 2/3)) #t) (test (equal? #(1 2) (vector 1 2.0)) #f) ; 2 not equal 2.0! (test (equal? '(1 . 2) (cons 1 2)) #t) (test (equal? '(1 #||# . #||# 2) (cons 1 2)) #t) (test (- '#||#1) -1) ; hmm (test (equal? #(1 "hi" #\a) (vector 1 "hi" #\a)) #t) (test (equal? #((1 . 2)) (vector (cons 1 2))) #t) (test (equal? #(1 "hi" #\a (1 . 2)) (vector 1 "hi" #\a (cons 1 2))) #t) (test (equal? #(#f hi (1 2) 1 "hi" #\a (1 . 2)) (vector #f 'hi (list 1 2) 1 "hi" #\a (cons 1 2))) #t) (test (equal? #(#(1) #(1)) (vector (vector 1) (vector 1))) #t) (test (equal? #(()) (vector '())) #t) (test (equal? #("hi" "ho") (vector "hi" '"ho")) #t) (test (equal? `#(1) #(1)) #t) (test (equal? ``#(1) #(1)) #t) (test (equal? '`#(1) #(1)) #t) (test (equal? ''#(1) #(1)) #f) (test (equal? ''#(1) '#(1)) #f) (test (equal? '(1) ' ( 1 )) #t) (test (equal? (list 1 "hi" #\a) '(1 "hi" #\a)) #t) (test (equal? (list 1.0 2/3) '(1.0 2/3)) #t) (test (equal? (list 1 2) '(1 2.0)) #f) (test (equal? #(1.0+1.0i) (vector 1.0+1.0i)) #t) (test (equal? (list 1.0+1.0i) '(1.0+1.0i)) #t) (test (equal? '((())) (list (list (list)))) #t) (test (equal? '((())) (cons (cons () ()) ())) #t) (test (equal? car car) #t) (test (equal? car cdr) #f) (test (let ((x (lambda () 1))) (equal? x x)) #t) (test (equal? (lambda () 1) (lambda () 1)) #f) (test (equal? 9/2 9/2) #t) (test (equal? #((())) #((()))) #t) (test (equal? "123""123") #t);no space (test (equal? """") #t)#|nospace|# (test (equal? #()#()) #t) (test (equal? #()()) #f) (test (equal? ()"") #f) (test (equal? "hi""hi") #t) (test (equal? # #) #t) (test (equal? # #) #t) (test (equal? # #) #t) (test (equal? (if #f #f) #) #t) (test (equal? # #) #f) (test (equal? (values) #) #f) (test (equal? (values) (values)) #t) (test (equal? # #) #f) (test (equal? (values) #) #t) (test (equal? # (values)) #t) (test (equal? # ()) #f) (test (let () (define-macro (hi a) `(+ 1 ,a)) (equal? hi hi)) #t) (test (let () (define (hi a) (+ 1 a)) (equal? hi hi)) #t) (test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (equal? x x)) #t) (test (equal? ``"" '"") #t) (test (let ((pws (dilambda (lambda () 1) (lambda (x) x)))) (equal? pws pws)) #t) (test (equal? if :if) #f) (test (equal? (list 'abs 'cons) '(abs cons)) #t) (test (equal? '(1) '(list 1)) #f) (test (equal? # _undef_) #f) (test (equal? _undef_ _undef_) #t) (test (equal? (list (values)) (list #)) #t) (test (equal? most-positive-fixnum most-positive-fixnum) #t) (test (equal? most-positive-fixnum most-negative-fixnum) #f) (test (equal? pi pi) #t) (test (equal? 9223372036854775807 9223372036854775806) #f) (test (equal? 9223372036854775807 -9223372036854775808) #f) (test (equal? -9223372036854775808 -9223372036854775808) #t) (test (equal? 123456789/2 123456789/2) #t) (test (equal? 123456789/2 123456787/2) #f) (test (equal? -123456789/2 -123456789/2) #t) (test (equal? 2/123456789 2/123456789) #t) (test (equal? -2/123456789 -2/123456789) #t) (test (equal? 2147483647/2147483646 2147483647/2147483646) #t) (test (equal? 3/4 12/16) #t) (test (equal? 1/1 1) #t) (test (equal? 312689/99532 833719/265381) #f) (test (let ((x 3.141)) (equal? x x)) #t) (test (let ((x 1+i)) (equal? x x)) #t) (test (let* ((x 3.141) (y x)) (equal? x y)) #t) (test (let* ((x 1+i) (y x)) (equal? x y)) #t) (test (let* ((x 3/4) (y x)) (equal? x y)) #t) (test (equal? '(+ '1) '(+ 1)) #f) ; !? (test (equal? '(1/0) '(1/0)) #f) (test (equal? '1/0 '1/0) #f) (test (+ '1 '2) 3) (test (equal? '(+nan.0) '(+nan.0)) #f) (test (equal? (list +nan.0) (list +nan.0)) #f) (test (equal? (vector +nan.0) (vector +nan.0)) #f) (test (let ((V (vector +nan.0))) (equal? V (copy V))) #f) ; sigh... (test (let ((V (vector +nan.0))) (equal? V V)) #t) (test (equal? #(1/0) #(1/0)) #f) (test (equal? #r(0.0) #r(-0.0)) #t) (test (equal? (float-vector) (int-vector)) #t) (test (equal? (vector) (byte-vector)) #t) (test (equal? (string) (byte-vector)) #f) (test (equal? (make-vector 0 #f) (make-float-vector 0 1.0)) #t) (test (equal? (make-vector 0 #f boolean?) (make-float-vector 0 1.0)) #t) (test (equal? (make-vector '(0 1) #f boolean?) (make-float-vector 0 1.0)) #f) (test (equal? (make-vector '(0 1) #f boolean?) (make-float-vector '(0 1) 1.0)) #t) (let ((it1 (make-iterator (int-vector 1 2 3))) (it2 (make-iterator (int-vector 1 2 3)))) (test (equal? it1 it2) #t)) (let ((it1 (make-iterator (int-vector 1 2 3))) (it2 (make-iterator (vector pi)))) (test (equal? it1 it2) #f)) (let ((it1 (make-iterator (int-vector 1 2 3))) (it2 (make-iterator (int-vector 1 2 3)))) (test (equivalent? it1 it2) #t)) (let ((it1 (make-iterator (int-vector 1 2 3))) (it2 (make-iterator (vector 1.0 2.0 3.0)))) (test (equivalent? it1 it2) #t)) (test (equal? 3 3) #t) (test (equal? 3 3.0) #f) (test (equal? 3.0 3.0) #t) (test (equal? 3-4i 3-4i) #t) (test (equal? (string #\c) "c") #t) (test (equal? equal? equal?) #t) (test (equal? (cons 1 (cons 2 3)) '(1 2 . 3)) #t) (test (equal? '() '()) #t) (test (equal? '() (list)) #t) (test (equal? ' a 'a) #t) (test (equal? "\n" "\n") #t) (test (equal? #f ((lambda () #f))) #t) (test (equal? (+) 0) #t) (test (equal? (recompose 32 list '(1)) (recompose 32 list (list 1))) #t) (test (equal? (recompose 100 list '(1)) (recompose 100 list (list 1))) #t) (test (equal? (recompose 32 vector 1) (recompose 32 vector 1)) #t) (test (equal? (reinvert 32 list vector 1) (reinvert 32 list vector 1)) #t) (test (equal? (recompose 32 (lambda (a) (cons 1 a)) ()) (recompose 32 (lambda (a) (cons 1 a)) ())) #t) (test (equal? (recompose 32 (lambda (a) (list 1 a)) ()) (recompose 32 (lambda (a) (list 1 a)) ())) #t) (test (equal? "asd""asd") #t) ; is this the norm? (let ((streq (lambda (a b) (equal? a b)))) (test (streq "asd""asd") #t)) (define (fequal) (let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector 1) (list 1) 'f 't #\t))) (let ((len (length things))) (do ((i 0 (+ i 1))) ((= i (- len 1))) (do ((j (+ i 1) (+ j 1))) ((= j len)) (if (equal? (vector-ref things i) (vector-ref things j)) (format #t ";(equal? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j)))))))) (fequal) (test (equal?) 'error) (test (equal? #t) 'error) (test (equal? #t #t #t) 'error) (test (equal #t #t) 'error) (when with-block (let ((b (make-block 4))) (test (equal? b b) #t) (let ((b1 (make-block 4))) (test (equal? b b1) #t) (set! (b 1) 1.0) (test (equal? b b1) #f)))) (test (let ((p (c-pointer 0))) (equal? p (copy p))) #t) (test (call-with-exit (lambda (return) (return (equal? return return)))) #t) (test (call-with-exit (lambda (return) (call-with-exit (lambda (quit) (return (equal? return quit)))))) #f) (test (call/cc (lambda (return) (return (equal? return return)))) #t) (test (let hiho ((i 0)) (equal? hiho hiho)) #t) (test (let hiho ((i 0)) (let hoho ((i 0)) (equal? hiho hoho))) #f) (test (equal? + *) #f) (test (equal? lambda lambda) #t) (test (equal? lambda lambda*) #f) (test (equal? let let) #t) (test (equal? let letrec) #f) (test (equal? define define) #t) (test (equal? + ((lambda (a) a) +)) #t) (test (let ((x "hi")) (define (hi) x) (equal? (hi) (hi))) #t) ;; so (eq? 3/4 3/4) is #f, (eqv? 3/4 3/4) is #t, ;; (eqv? #(1) #(1)) is #f, (equal? #(1) #(1)) is #t ;; (equal? 3 3.0) is #f, (= 3 3.0) is #t ;; in s7 ;; (eq? 0.0 0.0) is #t, ;; (eq? 2.0 2.0) is #f (test (equal? .0 0.) #t) (test (equal? (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) # #) (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) # #)) #t) (test (equal? (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) # #) (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) # #)) #t) (test (equal? (make-string 3 #\null) (make-string 3 #\null)) #t) (test (equal? (make-list 3) (make-list 3)) #t) (test (equal? (make-vector 3) (make-vector 3)) #t) (unless with-bignums (test (equal? (random-state 100) (random-state 100)) #t)) (test (equal? (list 1) (immutable! (list 1))) #t) ; we also ignore shared lists, and if safety>1, list constants via quote shouldn't change equal? (test (equal? (list 1) '(1)) #t) (test (equal? (current-input-port) (current-input-port)) #t) (test (equal? (current-input-port) (current-output-port)) #f) (test (equal? *stdin* *stderr*) #f) (test (let ((l1 (list 'a 'b)) (l2 (list 'a 'b 'a 'b))) (set! (cdr (cdr l1)) l1) (set! (cdr (cdr (cdr (cdr l2)))) l2) (equal? l1 l2)) #t) (test (let ((l1 (list 'a 'b)) (l2 (list 'a 'b 'a))) (set! (cdr (cdr l1)) l1) (set! (cdr (cdr (cdr l2))) l2) (equal? l1 l2)) #f) (test (let ((v1 (vector 1 2 3)) (v2 (vector 1 2 3))) (set! (v1 1) v1) (set! (v2 1) v2) (equal? v1 v2)) #t) (test (let ((v1 (vector 1 2 3)) (v2 (vector 1 2 4))) (set! (v1 1) v1) (set! (v2 1) v2) (equal? v1 v2)) #f) (let ((L (list 1 1))) (set-cdr! (cdr L) L) (let ((L1 (list 1))) (set-cdr! L1 L1) (test (equal? L L1) #t) (let ((L2 (list 1 1 1))) (set-cdr! (cddr L2) L2) (test (equal? L L2) #t) (let ((L3 (list 1))) (set-cdr! L3 L) (test (equal? L L3) #t) (set-cdr! L3 L2) (test (equal? L L3) #t))))) (let ((L (list 1 2))) (set-cdr! (cdr L) L) (let ((L1 (list 1 2 1))) (set-cdr! (cddr L1) (cdr L1)) (test (equal? L L1) #t))) (when with-bignums (test (equal? (/ (* 5 most-positive-fixnum) (* 3 most-negative-fixnum)) -46116860184273879035/27670116110564327424) #t) (test (equal? +nan.0 (bignum 2.0)) #f) (test (equal? +nan.0 (bignum 2)) #f) (test (equal? +nan.0 (bignum 1/2)) #f) (test (equal? +nan.0 (bignum 2.0+i)) #f) (test (equal? (bignum 2.0) +nan.0) #f) (test (equivalent? (bignum 2.0) +nan.0) #f) (test (equivalent? +nan.0 (bignum 2.0)) #f) (test (equal? 2.0 (bignum 2.0)) #t) (test (equal? 2 (bignum 2)) #t) (test (eqv? 2 (bignum 2)) #t) (test (= 2 (bignum 2)) #t) (test (equal? (bignum 2.0) 2.0) #t) (test (equal? (bignum 2) 2) #t) (test (eqv? (bignum 2) 2) #t) (test (= (bignum 2) 2) #t)) ;;; cyclic hash key tests (let* ((H1 (hash-table)) (I1 (inlet 'a H1))) (set! (H1 'a) I1) (let* ((H2 (hash-table)) (I2 (inlet 'a H2))) (set! (H2 'a) I2) (test (equal? H1 H2) #t) (test (equivalent? H1 H2) #t))) (let* ((H1 (hash-table)) (I1 (immutable! (openlet (inlet 'a H1))))) (set! (H1 'a) I1) (let* ((H2 (hash-table)) (I2 (immutable! (openlet (inlet 'a H2))))) (set! (H2 'a) I2) (test (equal? H1 H2) #t) (test (equivalent? H1 H2) #t))) (let* ((H1 (hash-table)) (I1 (inlet 'a H1))) (set! (H1 I1) I1) (let* ((H2 (hash-table)) (I2 (inlet 'a H2))) (set! (H2 I2) I2) (test (equal? H1 H2) #t) (test (equivalent? H1 H2) #t))) (let* ((H1 (hash-table)) (I1 (inlet 'a H1)) (V1 (make-vector 4 I1))) (set! (H1 V1) I1) (let* ((H2 (hash-table)) (I2 (inlet 'a H2)) (V2 (make-vector 4 I2))) (set! (H2 V2) I2) (test (equal? H1 H2) #t) (test (equivalent? H1 H2) #t))) (let ((H1 (list 1)) (H2 (list 1))) (let ((V1 (vector H1)) (V2 (vector H2))) (set! (H2 0) V2) (set! (H1 0) V1) (test (equal? H1 H2) #t) (test (equivalent? H1 H2) #t) (test (object->string H1) "#1=(#(#1#))"))) (let ((H1 (inlet 'a 1)) (H2 (inlet 'a 1))) (let ((V1 (vector H1)) (V2 (vector H2))) (set! (H2 'a) V2) (set! (H1 'a) V1) (test (equal? H1 H2) #t) (test (equivalent? H1 H2) #t) (test (object->string H1) "#1=(inlet 'a #(#1#))"))) (let ((H1 (hash-table)) (H2 (hash-table)) (H3 (hash-table))) (let ((V1 (vector H1)) (V2 (vector H2))) (set! (H2 V2) H2) (set! (H1 V1) H1) (set! (H3 H1) 2) (test (H3 H2) 2))) (let ((H1 (hash-table)) (H2 (hash-table))) (let ((V1 (vector H1)) (V2 (vector H2))) (set! (H2 V2) H2) (set! (H1 V1) H1) (test (object->string V1) "#1=#(#2=(hash-table #1# #2#))") (test (equal? V1 V2) #t) (test (equivalent? V1 V2) #t))) (let ((H1 (hash-table)) (H2 (hash-table))) (let ((V1 (vector H1)) (V2 (vector H2))) (set! (H2 V2) H2) (set! (H1 V1) H1) (test (object->string H1) "#1=(hash-table #(#1#) #1#)") (test (equal? H1 H2) #t) (test (equivalent? H1 H2) #t))) ;;; -------------------------------------------------------------------------------- ;;; equivalent? (test (equivalent? 'a 3) #f) (test (equivalent? #t 't) #f) (test (equivalent? "abs" 'abc) #f) (test (equivalent? "hi" '(hi)) #f) (test (equivalent? "()" '()) #f) (test (equivalent? '(1) '(1)) #t) (test (equivalent? '(#f) '(#f)) #t) (test (equivalent? '(()) '(() . ())) #t) (test (equivalent? #\a #\b) #f) (test (equivalent? #\a #\a) #t) (test (let ((x (string-ref "hi" 0))) (equivalent? x x)) #t) (test (equivalent? #t #t) #t) (test (equivalent? #f #f) #t) (test (equivalent? #f #t) #f) (test (equivalent? (null? '()) #t) #t) (test (equivalent? (null? '(a)) #f) #t) (test (equivalent? (cdr '(a)) '()) #t) (test (equivalent? 'a 'a) #t) (test (equivalent? 'a 'b) #f) (test (equivalent? :a a:) #t) (test (equivalent? :a 123) #f) (test (equivalent? :a 'a) #f) (test (equivalent? 'a :a) #f) (test (equivalent? 'a (string->symbol "a")) #t) (test (equivalent? '(a) '(b)) #f) (test (equivalent? '(a) '(a)) #t) (test (let ((x '(a . b))) (equivalent? x x)) #t) (test (let ((x (cons 'a 'b))) (equivalent? x x)) #t) (test (equivalent? (cons 'a 'b) (cons 'a 'b)) #t) (test (equivalent?(cons 'a 'b)(cons 'a 'b)) #t) ; no space (test (equivalent? "abc" "cba") #f) (test (equivalent? "abc" "abc") #t) (test (let ((x "hi")) (equivalent? x x)) #t) (test (equivalent? (string #\h #\i) (string #\h #\i)) #t) (test (equivalent? #(a) #(b)) #f) (test (equivalent? #(a) #(a)) #t) (test (let ((x (vector 'a))) (equivalent? x x)) #t) (test (equivalent? (vector 'a) (vector 'a)) #t) (test (equivalent? #(1 2) (vector 1 2)) #t) (test (equivalent? #(1.0 2/3) (vector 1.0 2/3)) #t) (test (equivalent? #(1 2) (vector 1 2.0)) #t) (test (equivalent? '(1 . 2) (cons 1 2)) #t) (test (equivalent? '(1 #||# . #||# 2) (cons 1 2)) #t) (test (- '#||#1) -1) ; hmm (test (equivalent? #(1 "hi" #\a) (vector 1 "hi" #\a)) #t) (test (equivalent? #((1 . 2)) (vector (cons 1 2))) #t) (test (equivalent? #(1 "hi" #\a (1 . 2)) (vector 1 "hi" #\a (cons 1 2))) #t) (test (equivalent? #(#f hi (1 2) 1 "hi" #\a (1 . 2)) (vector #f 'hi (list 1 2) 1 "hi" #\a (cons 1 2))) #t) (test (equivalent? #(#(1) #(1)) (vector (vector 1) (vector 1))) #t) (test (equivalent? #(()) (vector '())) #t) (test (equivalent? #("hi" "ho") (vector "hi" '"ho")) #t) (test (equivalent? `#(1) #(1)) #t) (test (equivalent? ``#(1) #(1)) #t) (test (equivalent? '`#(1) #(1)) #t) (test (equivalent? ''#(1) #(1)) #f) (test (equivalent? ''#(1) '#(1)) #f) (test (equivalent? (list 1 "hi" #\a) '(1 "hi" #\a)) #t) (test (equivalent? (list 1.0 2/3) '(1.0 2/3)) #t) (test (equivalent? (list 1 2) '(1 2.0)) #t) (test (equivalent? #(1.0+1.0i) (vector 1.0+1.0i)) #t) (test (equivalent? (list 1.0+1.0i) '(1.0+1.0i)) #t) (test (equivalent? '((())) (list (list (list)))) #t) (test (equivalent? car car) #t) (test (equivalent? car cdr) #f) (test (let ((x (lambda () 1))) (equivalent? x x)) #t) (test (equivalent? (lambda () 1) (lambda () 1)) #t) (test (equivalent? 9/2 9/2) #t) (test (equivalent? #((())) #((()))) #t) (test (equivalent? "123""123") #t);no space (test (equivalent? """") #t)#|nospace|# (test (equivalent? #()#()) #t) (test (equivalent? #()()) #f) (test (equivalent? ()"") #f) (test (equivalent? "hi""hi") #t) (test (equivalent? # #) #t) (test (equivalent? # #) #t) (test (equivalent? # #) #t) (test (equivalent? (if #f #f) #) #t) (test (equivalent? # #) #f) (test (equivalent? # '()) #f) (test (equivalent? (values) #) #f) (test (equivalent? # (values)) #f) (test (equivalent? (values) (values)) #t) (test (equivalent? # #) #f) (test (equivalent? (values) #) #t) (test (equivalent? # (values)) #t) (test (equivalent? # _undef_) #f) (test (equivalent? _undef_ _undef_) #t) (test (let () (define-macro (hi a) `(+ 1 ,a)) (equivalent? hi hi)) #t) (test (let () (define (hi a) (+ 1 a)) (equivalent? hi hi)) #t) (test (let ((x (lambda* (hi (a 1)) (+ 1 a)))) (equivalent? x x)) #t) (test (equivalent? ``"" '"") #t) (test (let ((pws (dilambda (lambda () 1) (lambda (x) x)))) (equivalent? pws pws)) #t) (test (equivalent? if :if) #f) (test (equivalent? (list 'abs 'cons) '(abs cons)) #t) (test (equivalent? (make-int-vector 2 0) (vector 0 0)) #t) (test (equivalent? (make-int-vector 2 0) (make-vector 2 0)) #t) (test (equivalent? (make-int-vector 2 0) (make-int-vector 2 0)) #t) (test (equivalent? (make-int-vector 2 0) (make-float-vector 2)) #t) (test (equivalent? (vector 0.0 0) (make-float-vector 2 0.0)) #t) (test (equivalent? (make-int-vector 2 0) (vector 0 1.0)) #f) (test (equivalent? (make-float-vector 1 +nan.0) (make-float-vector 1 +nan.0)) #t) (test (call-with-input-file "s7test.scm" (lambda (port) (equivalent? (call-with-input-file "s7test.scm" (lambda (p) p)) port))) #f) (test (equivalent? (make-iterator "") (make-iterator "")) #t) (test (equivalent? (make-iterator (inlet :a 1)) (make-iterator (inlet :a 1) (cons #f #f))) #t) (test (equivalent? (make-iterator (hash-table 'a 1) (cons #f #f)) (make-iterator (hash-table 'a 1) (cons #f #f))) #t) (test (equivalent? (make-iterator #()) (make-iterator #())) #t) (test (equivalent? (make-iterator '(1 2 3)) (make-iterator '(1 2 3))) #t) (test (equivalent? (make-iterator '(1 2 3)) (make-iterator '(1 2 3 4))) #f) (test (equivalent? (int-vector 1 2) (byte-vector 1 2)) #t) (test (equivalent? (vector 1 2) (byte-vector 1 2)) #t) ; but (equivalent? (vector #\a) "a") -> #f (test (equivalent? (float-vector 1 2) (byte-vector 1 2)) #t) ; (equivalent? 1 1.0) -> #t (let ((str "123")) (let ((i1 (make-iterator str)) (i2 (make-iterator str))) (test (equal? i1 i2) #t) (test (equivalent? i1 i2) #t) (iterate i1) (test (equal? i1 i2) #f) (test (equivalent? i1 i2) #f) (iterate i2) (test (equal? i1 i2) #t) (test (equivalent? i1 i2) #t))) (let ((i1 (make-iterator "123")) (i2 (make-iterator "123"))) (test (equivalent? i1 i2) #t) (iterate i1) (test (equivalent? i1 i2) #f) (iterate i2) (test (equivalent? i1 i2) #t)) (let ((i1 (make-iterator (vector 1 2 3))) (i2 (make-iterator (int-vector 1 2 3)))) (test (equivalent? i1 i2) #t) (iterate i1) (test (equivalent? i1 i2) #f) (iterate i2) (test (equivalent? i1 i2) #t)) (let ((i1 (make-iterator (vector 1 2 3))) (i2 (make-iterator (vector 1 2 3)))) (test (equal? i1 i2) #t) (test (equivalent? i1 i2) #t) (iterate i1) (test (equal? i1 i2) #f) (test (equivalent? i1 i2) #f) (iterate i2) (test (equal? i1 i2) #t) (test (equivalent? i1 i2) #t)) (let ((str (hash-table 'a 1 'b 2))) (let ((i1 (make-iterator str)) (i2 (make-iterator str))) (test (equal? i1 i2) #t) (test (equivalent? i1 i2) #t) (iterate i1) (test (equal? i1 i2) #f) (test (equivalent? i1 i2) #f) (iterate i2) (test (equal? i1 i2) #t) (test (equivalent? i1 i2) #t))) (let ((i1 (make-iterator (list 1 2 3))) (i2 (make-iterator (list 1 2 3)))) (test (equivalent? i1 i2) #t) (iterate i1) (test (equivalent? i1 i2) #f) (iterate i2) (test (equivalent? i1 i2) #t)) ;;; opt bug (test (equivalent? ''(1) (list 1)) #f) (test (equivalent? ''(1+i) '(1+i)) #f) (test (equivalent? '(1) (list 1)) #t) (test (equivalent? '(1) ''(1)) #f) (test (equivalent? (list 1) ''(1)) #f) (test (equivalent? (list 1) '(1)) #t) (test (equivalent? ''(1) ''(1)) #t) (test (equivalent? '''(1) ''(1)) #f) (let () (define-macro (mac a) `(+ 1 ,a)) (define-macro (mac1 a) `(+ 1 ,a)) (define-macro (mac2 a) `(+ 2 ,a)) (define-macro (mac3 a b) `(+ ,b ,a)) (test (equivalent? mac mac1) #t) (test (equivalent? mac mac2) #f) (test (equivalent? mac1 mac3) #f) (test (equivalent? mac3 mac3) #t) (let () (define-macro (mac4 a) `(+ 1 ,a)) (test (equivalent? mac mac4) #t)) ; was #f (define-bacro (mac5 a) `(+ 1 ,a)) (test (equivalent? mac mac5) #f) (define-bacro (mac6 a) `(+ 1 ,a)) (test (equivalent? mac5 mac6) #t)) (test (equivalent? most-positive-fixnum most-positive-fixnum) #t) (test (equivalent? most-positive-fixnum most-negative-fixnum) #f) (test (equivalent? pi pi) #t) (test (equivalent? 9223372036854775807 9223372036854775806) #f) (test (equivalent? 9223372036854775807 -9223372036854775808) #f) (test (equivalent? -9223372036854775808 -9223372036854775808) #t) (test (equivalent? 123456789/2 123456789/2) #t) (test (equivalent? 123456789/2 123456787/2) #f) (test (equivalent? -123456789/2 -123456789/2) #t) (test (equivalent? 2/123456789 2/123456789) #t) (test (equivalent? -2/123456789 -2/123456789) #t) (test (equivalent? 2147483647/2147483646 2147483647/2147483646) #t) (test (equivalent? 3/4 12/16) #t) (test (equivalent? 1/1 1) #t) (test (equivalent? 312689/99532 833719/265381) #f) (test (let ((x 3.141)) (equivalent? x x)) #t) (test (let ((x 1+i)) (equivalent? x x)) #t) (test (let* ((x 3.141) (y x)) (equivalent? x y)) #t) (test (let* ((x 1+i) (y x)) (equivalent? x y)) #t) (test (let* ((x 3/4) (y x)) (equivalent? x y)) #t) (test (equivalent? .1 1/10) #t) (test (equivalent? pi '(1 2)) #f) (if with-bignums (test (equivalent? (cosh (bignum "128")) 1.943854202997297546111336844178739036366E55) #t) (test (equivalent? (cosh 128) 1.943854202997297e+55) #f)) (test (equivalent? (float-vector (cosh 128)) (float-vector 1.943854202997297e+55)) #f) ; can't decide about this -- see floats_are_equivalent ;;; here (* (*s7* 'equivalent-float-epsilon) (cosh 128)) = 1.943854202997298e+40 ;;; (- (cosh 128) 1.943854202997297e+55) = 2.722258935367508e+39 (when with-block (test (equivalent? (block (cosh 128)) (block 1.943854202997297e+55)) #f) (test (equivalent? (block) (inlet 'a 1)) #f)) (test (let ((x 3.141)) (equivalent? x x)) #t) (test (equivalent? 3 3) #t) (test (equivalent? 3 3.0) #t) (test (equivalent? 3.0 3.0) #t) (test (equivalent? 3-4i 3-4i) #t) (test (equivalent? 1/0 0/0) #t) (test (equivalent? 1/0 (- 1/0)) #t) ; but they print as +nan.0 (this is C based I think), and equal? here is #f (test (equivalent? (real-part (log 0)) (- (real-part (log 0)))) #f) (test (equivalent? (log 0) (log 0)) #t) (test (equivalent? 0/0+i 0/0+i) #t) (test (equivalent? 0/0+i 0/0-i) #f) (test (equivalent? (list 3) (list 3.0)) #t) (test (equivalent? (list 3.0) (list 3.0)) #t) (test (equivalent? (list 3-4i) (list 3-4i)) #t) (test (equivalent? (list 1/0) (list 0/0)) #t) (test (equivalent? (list (log 0)) (list (log 0))) #t) (test (equivalent? (list 0/0+i) (list 0/0+i)) #t) (test (equivalent? (vector 3) (vector 3.0)) #t) (test (equivalent? (vector 3.0) (vector 3.0)) #t) (test (equivalent? (vector 3-4i) (vector 3-4i)) #t) (test (equivalent? (vector 1/0) (vector 0/0)) #t) (test (equivalent? (vector (log 0)) (vector (log 0))) #t) (test (equivalent? (vector 0/0+i) (vector 0/0+i)) #t) (test (equivalent? (string #\c) "c") #t) (test (equivalent? equivalent? equivalent?) #t) (test (equivalent? (cons 1 (cons 2 3)) '(1 2 . 3)) #t) (test (equivalent? '() '()) #t) (test (equivalent? '() (list)) #t) (test (equivalent? ' a 'a) #t) (test (equivalent? "\n" "\n") #t) (test (equivalent? #f ((lambda () #f))) #t) (test (equivalent? (+) 0) #t) (test (equivalent? (recompose 32 list '(1)) (recompose 32 list (list 1))) #t) (test (equivalent? (recompose 100 list '(1)) (recompose 100 list (list 1))) #t) (test (equivalent? (recompose 32 vector 1) (recompose 32 vector 1)) #t) (test (equivalent? (reinvert 32 list vector 1) (reinvert 32 list vector 1)) #t) (test (equivalent? (recompose 32 (lambda (a) (cons 1 a)) ()) (recompose 32 (lambda (a) (cons 1 a)) ())) #t) (test (equivalent? (recompose 32 (lambda (a) (list 1 a)) ()) (recompose 32 (lambda (a) (list 1 a)) ())) #t) (test (equivalent? "asd""asd") #t) ; is this the norm? (let ((streq (lambda (a b) (equivalent? a b)))) (test (streq "asd""asd") #t)) (let ((things (vector #t #f #\space () "" 0 1 3/4 1+i 1.5 '(1 .2) #() (vector 1) (list 1) 'f 't #\t))) (let ((len (length things))) (do ((i 0 (+ i 1))) ((= i (- len 1))) (do ((j (+ i 1) (+ j 1))) ((= j len)) (if (equivalent? (vector-ref things i) (vector-ref things j)) (format #t ";(equivalent? ~A ~A) -> #t?~%" (vector-ref things i) (vector-ref things j))))))) (test (equivalent?) 'error) (test (equivalent? #t) 'error) (test (equivalent? #t #t #t) 'error) (test (call-with-exit (lambda (return) (return (equivalent? return return)))) #t) (test (call-with-exit (lambda (return) (call-with-exit (lambda (quit) (return (equivalent? return quit)))))) #f) (test (call/cc (lambda (return) (return (equivalent? return return)))) #t) (test (let hiho ((i 0)) (equivalent? hiho hiho)) #t) (test (let hiho ((i 0)) (let hoho ((i 0)) (equivalent? hiho hoho))) #f) (test (equivalent? + *) #f) (test (equivalent? lambda lambda) #t) (test (equivalent? lambda lambda*) #f) (test (equivalent? let let) #t) (test (equivalent? let letrec) #f) (test (equivalent? define define) #t) (test (equivalent? + ((lambda (a) a) +)) #t) (test (let ((x "hi")) (define (hi) x) (equivalent? (hi) (hi))) #t) (test (equivalent? (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) # #) (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) (list) (cons 1 2) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) # #)) #t) (test (equivalent? (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) # #) (vector "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs quasiquote 3 3/4 1.0+1.0i #\f (if #f #f) # #)) #t) (test (equivalent? (make-string 3 #\null) (make-string 3 #\null)) #t) (test (equivalent? (make-list 3) (make-list 3)) #t) (test (equivalent? (make-vector 3) (make-vector 3)) #t) (test (equivalent? (make-float-vector 3 1.0) (vector 1 1 1)) #t) (test (equivalent? (int-vector 1) (int-vector 2)) #f) (test (equivalent? (int-vector 1) (int-vector 1)) #t) (test (equivalent? (float-vector 0.0) (float-vector +nan.0)) #f) (test (equivalent? (float-vector +nan.0) (float-vector +nan.0)) #t) (let-temporarily (((*s7* 'equivalent-float-epsilon) 0.0)) (test (equivalent? (float-vector 0.0) (float-vector +nan.0)) #f) (test (equivalent? (float-vector +nan.0) (float-vector +nan.0)) #t) (test (equivalent? (float-vector 0.0) (float-vector 0.0)) #t) (test (equivalent? (float-vector 0.0) (float-vector 1e-15)) #f) (set! (*s7* 'equivalent-float-epsilon) 0.01) (test (equivalent? (float-vector 0.0) (float-vector 1e-15)) #t) (test (equivalent? (float-vector 0.0) (float-vector 0.005)) #t) (test (equivalent? (float-vector 0.0) (float-vector 0.02)) #f)) (test (equivalent? (float-vector 1) (float-vector 1)) #t) (test (equivalent? (float-vector 1) (float-vector 0)) #f) (test (equivalent? (float-vector 1 2 3 4 5 6) (float-vector 1 2 3 4 5 6)) #t) (test (equivalent? (float-vector 1 2 3 4 5 6) (float-vector 1 2 0 4 5 6)) #f) (let () (define (fvequiv) (do ((i 1 (+ i 1))) ((= i 20)) (let ((v1 (make-float-vector i)) (v2 (make-float-vector i)) (v3 (make-float-vector i))) (do ((j 0 (+ j 1))) ((= j i) (set! (v3 (random i)) 32) (unless (equivalent? v1 v2) (format *stderr* "~S != ~S~%" v1 v2)) (when (equivalent? v1 v3) (format *stderr* "~S == ~S~%" v1 v3))) (set! (v1 j) j) (set! (v2 j) j) (set! (v3 j) j))))) (fvequiv)) (unless with-bignums (test (equivalent? (random-state 100) (random-state 100)) #t)) (test (equivalent? (current-input-port) (current-input-port)) #t) (test (equivalent? (current-input-port) (current-output-port)) #f) (test (equivalent? *stdin* *stderr*) #f) (test (equivalent? (let () (define-macro* (a_func (an_arg (lambda () #t))) `,an_arg) (a_func)) (let () (define-macro (a_func an_arg) `,an_arg) (a_func (lambda () #t)))) #t) ; was #f (test (equivalent? (- 4/3 1 -63.0) 190/3) #t) (test (equivalent? 190/3 (- 4/3 1 -63.0)) #t) (test (equivalent? (+ -1 4/3 63.0) 190/3) #t) (unless with-bignums (set! (*s7* 'equivalent-float-epsilon) 1e-15) ; just in case (test (equivalent? (+ 5e-16 +nan.0) +nan.0) #t) (test (equivalent? (+ 0+5e-16i +nan.0) +nan.0) #t) (test (equivalent? (+ 1/0 0+5e-16i) 1/0) #t) (test (equivalent? 1/0 (+ 1/0 0+5e-16i)) #t) (test (equivalent? 0 (+ 0 5e-16)) #t) (test (equivalent? 0 (- 0 1/1428571428571429)) #t) (test (equivalent? 0 (+ 0 0+5e-16i)) #t) (test (equivalent? 0 (+ 0 0-1/1428571428571429i)) #t) (test (equivalent? 0 (+ 0 1e-11)) #f) (test (equivalent? 0 0) #t) (test (equivalent? 0 1/1000) #f) (test (equivalent? 0 0.0) #t) (test (equivalent? 0 1e-16) #t) (test (equivalent? 0 0+i) #f) (test (equivalent? 0 1e-16+i) #f) (test (equivalent? 0 0+1e-16i) #t) (test (equivalent? 0 1e-300) #t) (test (equivalent? 0 0+1e-300i) #t) (test (equivalent? 0 1/0) #f) (test (equivalent? 0 (- 0/0)) #f) (test (equivalent? 0 (log 0)) #f) (test (equivalent? 1 (+ 1 5e-16)) #t) (test (equivalent? 1 (- 1 1/1428571428571429)) #t) (test (equivalent? 1 (+ 1 0+5e-16i)) #t) (test (equivalent? 1 (+ 1 0-1/1428571428571429i)) #t) (test (equivalent? 1 (+ 1 1e-11)) #f) (test (equivalent? 1 1) #t) (test (equivalent? 1 1.0) #t) (test (equivalent? 1 1e-16) #f) (test (equivalent? 1 1e4) #f) (test (equivalent? 1 0+i) #f) (test (equivalent? 1 1e-16+i) #f) (test (equivalent? 1 (complex 1 1/0)) #f) (test (equivalent? 1 (complex (real-part (log 0)) 1)) #f) (test (equivalent? 1 (complex 1 (real-part (log 0)))) #f) (test (equivalent? 1000 (+ 1000 5e-16)) #t) (test (equivalent? 1000 (- 1000 1/1428571428571429)) #t) (test (equivalent? 1000 (+ 1000 0+5e-16i)) #t) (test (equivalent? 1000 (+ 1000 0-1/1428571428571429i)) #t) (test (equivalent? 1000 (+ 1000 1e-11)) #f) (test (equivalent? 1000 (+ 1000 1e-14)) #t) (test (equivalent? 1000 1000) #t) (test (equivalent? 1000 1/1000) #f) (test (equivalent? 1000 1e4) #f) (test (equivalent? 1/1000 (+ 1/1000 5e-16)) #t) (test (equivalent? 1/1000 (- 1/1000 1/1428571428571429)) #t) (test (equivalent? 1/1000 (+ 1/1000 0+5e-16i)) #t) (test (equivalent? 1/1000 (+ 1/1000 0-1/1428571428571429i)) #t) (test (equivalent? 1/1000 (+ 1/1000 1e-11)) #f) (test (equivalent? 1/1000 0) #f) (test (equivalent? 1/1000 1/1000) #t) (test (equivalent? 1/1000 0.0) #f) (test (equivalent? 1/1000 1e-16) #f) (test (equivalent? 1/1000 1e-16+i) #f) (test (equivalent? 1/1000 0+1e-16i) #f) (test (equivalent? 1/1000 1e-300) #f) (test (equivalent? 1/1000 0+1e-300i) #f) (test (equivalent? 1/1000 1/0) #f) (test (equivalent? 0.0 (+ 0.0 5e-16)) #t) (test (equivalent? 0.0 (- 0.0 1/1428571428571429)) #t) (test (equivalent? 0.0 (+ 0.0 0+5e-16i)) #t) (test (equivalent? 0.0 (+ 0.0 0-1/1428571428571429i)) #t) (test (equivalent? 0.0 (+ 0.0 1e-11)) #f) (test (equivalent? 0.0 0) #t) (test (equivalent? 0.0 1/1000) #f) (test (equivalent? 0.0 0.0) #t) (test (equivalent? 0.0 1e-16) #t) (test (equivalent? 0.0 0+i) #f) (test (equivalent? 0.0 1+i) #f) (test (equivalent? 0.0 1e-16+i) #f) (test (equivalent? 0.0 0+1e-16i) #t) (test (equivalent? 0.0 1e-300) #t) (test (equivalent? 0.0 0+1e-300i) #t) (test (equivalent? 0.0 1/0) #f) (test (equivalent? 0.0 (real-part (log 0))) #f) (test (equivalent? 0.0 (- (real-part (log 0)))) #f) (test (equivalent? 0.0 (- 0/0)) #f) (test (equivalent? 0.0 (log 0)) #f) (test (equivalent? 1.0 (+ 1.0 5e-16)) #t) (test (equivalent? 1.0 (- 1.0 1/1428571428571429)) #t) (test (equivalent? 1.0 (+ 1.0 0+5e-16i)) #t) (test (equivalent? 1.0 (+ 1.0 0-1/1428571428571429i)) #t) (test (equivalent? 1.0 (+ 1.0 1e-11)) #f) (test (equivalent? 1.0 1) #t) (test (equivalent? 1.0 1.0) #t) (test (equivalent? 1.0 1e-16+i) #f) (test (equivalent? 1.0 0+1e-16i) #f) (test (equivalent? 1.0 1e-300) #f) (test (equivalent? 1.0 0+1e-300i) #f) (test (equivalent? 1.0 1/0) #f) (test (equivalent? 1.0 (- 0/0)) #f) (test (equivalent? 1.0 (complex 1/0 1)) #f) (test (equivalent? 1.0 (complex 1 1/0)) #f) (test (equivalent? 1.0 (complex 1 (real-part (log 0)))) #f) (test (equivalent? 1e-16 (+ 1e-16 5e-16)) #t) (test (equivalent? 1e-16 (- 1e-16 1/1428571428571429)) #t) (test (equivalent? 1e-16 (+ 1e-16 0+5e-16i)) #t) (test (equivalent? 1e-16 (+ 1e-16 0-1/1428571428571429i)) #t) (test (equivalent? 1e-16 (+ 1e-16 1e-11)) #f) (test (equivalent? 1e-16 0) #t) (test (equivalent? 1e-16 1/1000) #f) (test (equivalent? 1e-16 0.0) #t) (test (equivalent? 1e-16 1e-16) #t) (test (equivalent? 1e-16 1e-16+i) #f) (test (equivalent? 1e-16 0+1e-16i) #t) (test (equivalent? 1e-16 1e-300) #t) (test (equivalent? 1e-16 0+1e-300i) #t) (test (equivalent? 1e-16 1/0) #f) (test (equivalent? 1e4 (+ 1e4 5e-16)) #t) (test (equivalent? 1e4 (- 1e4 1/1428571428571429)) #t) (test (equivalent? 1e4 (+ 1e4 0+5e-16i)) #t) (test (equivalent? 1e4 (+ 1e4 0-1/1428571428571429i)) #t) (test (equivalent? 1e4 (+ 1e4 1e-11)) #f) (test (equivalent? 1e4 1000) #f) (test (equivalent? 1e4 1/1000) #f) (test (equivalent? 1e4 1e-16) #f) (test (equivalent? 1e4 1e4) #t) (test (equivalent? 1e4 1e-16+i) #f) (test (equivalent? 1e4 0+1e-16i) #f) (test (equivalent? 1e4 1e-300) #f) (test (equivalent? 1e4 0+1e-300i) #f) (test (equivalent? 1e4 1/0) #f) (test (equivalent? 0+i (+ 0+i 5e-16)) #t) (test (equivalent? 0+i (- 0+i 1/1428571428571429)) #t) (test (equivalent? 0+i (+ 0+i 0+5e-16i)) #t) (test (equivalent? 0+i (+ 0+i 0-1/1428571428571429i)) #t) (test (equivalent? 0+i (+ 0+i 1e-11)) #f) (test (equivalent? 0+i 0) #f) (test (equivalent? 0+i 1/1000) #f) (test (equivalent? 0+i 0.0) #f) (test (equivalent? 0+i 1e-16) #f) (test (equivalent? 0+i 0+i) #t) (test (equivalent? 0+i 1+i) #f) (test (equivalent? 0+i 1e-16+i) #t) (test (equivalent? 0+i 0+1e-16i) #f) (test (equivalent? 0+i 1e-300) #f) (test (equivalent? 0+i 0+1e-300i) #f) (test (equivalent? 0+i 1/0) #f) (test (equivalent? 0+i (real-part (log 0))) #f) (test (equivalent? 0+i (- (real-part (log 0)))) #f) (test (equivalent? 0+i (- 0/0)) #f) (test (equivalent? 0+i (log 0)) #f) (test (equivalent? 0+i (complex 1/0 1)) #f) (test (equivalent? 0+i (complex 1 1/0)) #f) (test (equivalent? 0+i (complex 1/0 1/0)) #f) (test (equivalent? 0+i (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? 1+i (+ 1+i 5e-16)) #t) (test (equivalent? 1+i (- 1+i 1/1428571428571429)) #t) (test (equivalent? 1+i (+ 1+i 0+5e-16i)) #t) (test (equivalent? 1+i (+ 1+i 0-1/1428571428571429i)) #t) (test (equivalent? 1+i (+ 1+i 1e-11)) #f) (test (equivalent? 1+i 0+i) #f) (test (equivalent? 1+i 1+i) #t) (test (equivalent? 1+i 1e-16+i) #f) (test (equivalent? 1+i 0+1e-16i) #f) (test (equivalent? 1+i 1e-300) #f) (test (equivalent? 1+i 0+1e-300i) #f) (test (equivalent? 1e-16+i (+ 1e-16+i 5e-16)) #t) (test (equivalent? 1e-16+i (- 1e-16+i 1/1428571428571429)) #t) (test (equivalent? 1e-16+i (+ 1e-16+i 0+5e-16i)) #t) (test (equivalent? 1e-16+i (+ 1e-16+i 0-1/1428571428571429i)) #t) (test (equivalent? 1e-16+i (+ 1e-16+i 1e-11)) #f) (test (equivalent? 1e-16+i 0) #f) (test (equivalent? 1e-16+i 1e-16) #f) (test (equivalent? 1e-16+i 1e4) #f) (test (equivalent? 1e-16+i 0+i) #t) (test (equivalent? 1e-16+i 1+i) #f) (test (equivalent? 1e-16+i 1e-16+i) #t) (test (equivalent? 1e-16+i 0+1e-16i) #f) (test (equivalent? 1e-16+i 1e-300) #f) (test (equivalent? 1e-16+i 0+1e-300i) #f) (test (equivalent? 1e-16+i 1/0) #f) (test (equivalent? 1e-16+i (real-part (log 0))) #f) (test (equivalent? 1e-16+i (- (real-part (log 0)))) #f) (test (equivalent? 1e-16+i (- 0/0)) #f) (test (equivalent? 1e-16+i (log 0)) #f) (test (equivalent? 1e-16+i (complex 1/0 1)) #f) (test (equivalent? 1e-16+i (complex 1 1/0)) #f) (test (equivalent? 1e-16+i (complex 1/0 1/0)) #f) (test (equivalent? 1e-16+i (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? 0+1e-16i (+ 0+1e-16i 5e-16)) #t) (test (equivalent? 0+1e-16i (- 0+1e-16i 1/1428571428571429)) #t) (test (equivalent? 0+1e-16i (+ 0+1e-16i 0+5e-16i)) #t) (test (equivalent? 0+1e-16i (+ 0+1e-16i 0-1/1428571428571429i)) #t) (test (equivalent? 0+1e-16i (+ 0+1e-16i 1e-11)) #f) (test (equivalent? 0+1e-16i 0) #t) (test (equivalent? 0+1e-16i 1/1000) #f) (test (equivalent? 0+1e-16i 0.0) #t) (test (equivalent? 0+1e-16i 1e-16) #t) (test (equivalent? 0+1e-16i 0+i) #f) (test (equivalent? 0+1e-16i 1+i) #f) (test (equivalent? 0+1e-16i 1e-16+i) #f) (test (equivalent? 0+1e-16i 0+1e-16i) #t) (test (equivalent? 0+1e-16i 1e-300) #t) (test (equivalent? 0+1e-16i 0+1e-300i) #t) (test (equivalent? 0+1e-16i 1/0) #f) (test (equivalent? 0+1e-16i (real-part (log 0))) #f) (test (equivalent? 0+1e-16i (- (real-part (log 0)))) #f) (test (equivalent? 0+1e-16i (- 0/0)) #f) (test (equivalent? 0+1e-16i (log 0)) #f) (test (equivalent? 1e-300 (+ 1e-300 5e-16)) #t) (test (equivalent? 1e-300 (- 1e-300 1/1428571428571429)) #t) (test (equivalent? 1e-300 (+ 1e-300 0+5e-16i)) #t) (test (equivalent? 1e-300 (+ 1e-300 0-1/1428571428571429i)) #t) (test (equivalent? 1e-300 (+ 1e-300 1e-11)) #f) (test (equivalent? 1e-300 0) #t) (test (equivalent? 1e-300 1/1000) #f) (test (equivalent? 1e-300 0.0) #t) (test (equivalent? 1e-300 1e-16) #t) (test (equivalent? 1e-300 1e-16+i) #f) (test (equivalent? 1e-300 0+1e-16i) #t) (test (equivalent? 1e-300 1e-300) #t) (test (equivalent? 1e-300 0+1e-300i) #t) (test (equivalent? 1e-300 1/0) #f) (test (equivalent? 1e-300 (- 0/0)) #f) (test (equivalent? 1e-300 (log 0)) #f) (test (equivalent? 0+1e-300i (+ 0+1e-300i 5e-16)) #t) (test (equivalent? 0+1e-300i (- 0+1e-300i 1/1428571428571429)) #t) (test (equivalent? 0+1e-300i (+ 0+1e-300i 0+5e-16i)) #t) (test (equivalent? 0+1e-300i (+ 0+1e-300i 0-1/1428571428571429i)) #t) (test (equivalent? 0+1e-300i (+ 0+1e-300i 1e-11)) #f) (test (equivalent? 0+1e-300i 0) #t) (test (equivalent? 0+1e-300i 1000) #f) (test (equivalent? 0+1e-300i 1/1000) #f) (test (equivalent? 0+1e-300i 0.0) #t) (test (equivalent? 0+1e-300i 1e-16) #t) (test (equivalent? 0+1e-300i 0+i) #f) (test (equivalent? 0+1e-300i 1e-16+i) #f) (test (equivalent? 0+1e-300i 0+1e-16i) #t) (test (equivalent? 0+1e-300i 1e-300) #t) (test (equivalent? 0+1e-300i 0+1e-300i) #t) (test (equivalent? 0+1e-300i 1/0) #f) (test (equivalent? 0+1e-300i (- 0/0)) #f) (test (equivalent? 1/0 (+ 1/0 5e-16)) #t) (test (equivalent? 1/0 (- 1/0 1/1428571428571429)) #t) (test (equivalent? 1/0 (+ 1/0 0+5e-16i)) #t) (test (equivalent? 1/0 (+ 1/0 0-1/1428571428571429i)) #t) (test (equivalent? 1/0 0) #f) (test (equivalent? 1/0 1/0) #t) (test (equivalent? 1/0 (real-part (log 0))) #f) (test (equivalent? 1/0 (- (real-part (log 0)))) #f) (test (equivalent? 1/0 (- 0/0)) #t) (test (equivalent? 1/0 (log 0)) #f) (test (equivalent? 1/0 (complex 1/0 1)) #f) (test (equivalent? 1/0 (complex 1 1/0)) #f) (test (equivalent? 1/0 (complex 1/0 1/0)) #f) (test (equivalent? 1/0 (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? 1/0 (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? 1/0 (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? 1/0 (complex (real-part (log 0)) 1)) #f) (test (equivalent? 1/0 (complex 1 (real-part (log 0)))) #f) (test (equivalent? (real-part (log 0)) (+ (real-part (log 0)) 5e-16)) #t) (test (equivalent? (real-part (log 0)) (- (real-part (log 0)) 1/1428571428571429)) #t) (test (equivalent? (real-part (log 0)) (+ (real-part (log 0)) 0+5e-16i)) #t) (test (equivalent? (real-part (log 0)) (+ (real-part (log 0)) 0-1/1428571428571429i)) #t) (test (equivalent? (real-part (log 0)) 0) #f) (test (equivalent? (real-part (log 0)) 1e-16+i) #f) (test (equivalent? (real-part (log 0)) 0+1e-16i) #f) (test (equivalent? (real-part (log 0)) 1e-300) #f) (test (equivalent? (real-part (log 0)) 0+1e-300i) #f) (test (equivalent? (real-part (log 0)) 1/0) #f) (test (equivalent? (real-part (log 0)) (real-part (log 0))) #t) (test (equivalent? (real-part (log 0)) (- (real-part (log 0)))) #f) (test (equivalent? (real-part (log 0)) (- 0/0)) #f) (test (equivalent? (real-part (log 0)) (log 0)) #f) (test (equivalent? (real-part (log 0)) (complex 1/0 1)) #f) (test (equivalent? (real-part (log 0)) (complex 1 1/0)) #f) (test (equivalent? (real-part (log 0)) (complex 1/0 1/0)) #f) (test (equivalent? (real-part (log 0)) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (real-part (log 0)) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (real-part (log 0)) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (real-part (log 0)) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (real-part (log 0)) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (- (real-part (log 0))) (+ (- (real-part (log 0))) 5e-16)) #t) (test (equivalent? (- (real-part (log 0))) (- (- (real-part (log 0))) 1/1428571428571429)) #t) (test (equivalent? (- (real-part (log 0))) (+ (- (real-part (log 0))) 0+5e-16i)) #t) (test (equivalent? (- (real-part (log 0))) (+ (- (real-part (log 0))) 0-1/1428571428571429i)) #t) (test (equivalent? (- (real-part (log 0))) 1e-16+i) #f) (test (equivalent? (- (real-part (log 0))) 0+1e-16i) #f) (test (equivalent? (- (real-part (log 0))) 1e-300) #f) (test (equivalent? (- (real-part (log 0))) 0+1e-300i) #f) (test (equivalent? (- (real-part (log 0))) 1/0) #f) (test (equivalent? (- (real-part (log 0))) (real-part (log 0))) #f) (test (equivalent? (- (real-part (log 0))) (- (real-part (log 0)))) #t) (test (equivalent? (- (real-part (log 0))) (- 0/0)) #f) (test (equivalent? (- (real-part (log 0))) (log 0)) #f) (test (equivalent? (- (real-part (log 0))) (complex 1/0 1)) #f) (test (equivalent? (- (real-part (log 0))) (complex 1 1/0)) #f) (test (equivalent? (- (real-part (log 0))) (complex 1/0 1/0)) #f) (test (equivalent? (- (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (- (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (- (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (- (real-part (log 0))) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (- (real-part (log 0))) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (- 0/0) (+ (- 0/0) 5e-16)) #t) (test (equivalent? (- 0/0) (- (- 0/0) 1/1428571428571429)) #t) (test (equivalent? (- 0/0) (+ (- 0/0) 0+5e-16i)) #t) (test (equivalent? (- 0/0) (+ (- 0/0) 0-1/1428571428571429i)) #t) (test (equivalent? (- 0/0) 0) #f) (test (equivalent? (- 0/0) 1e-300) #f) (test (equivalent? (- 0/0) 0+1e-300i) #f) (test (equivalent? (- 0/0) 1/0) #t) (test (equivalent? (- 0/0) (real-part (log 0))) #f) (test (equivalent? (- 0/0) (- (real-part (log 0)))) #f) (test (equivalent? (- 0/0) (- 0/0)) #t) (test (equivalent? (- 0/0) (log 0)) #f) (test (equivalent? (- 0/0) (complex 1/0 1)) #f) (test (equivalent? (- 0/0) (complex 1 1/0)) #f) (test (equivalent? (- 0/0) (complex 1/0 1/0)) #f) (test (equivalent? (- 0/0) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (- 0/0) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (- 0/0) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (- 0/0) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (- 0/0) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (log 0) (+ (log 0) 5e-16)) #t) (test (equivalent? (log 0) (- (log 0) 1/1428571428571429)) #t) (test (equivalent? (log 0) (+ (log 0) 0+5e-16i)) #t) (test (equivalent? (log 0) (+ (log 0) 0-1/1428571428571429i)) #t) (test (equivalent? (log 0) 0) #f) (test (equivalent? (log 0) 1/0) #f) (test (equivalent? (log 0) (real-part (log 0))) #f) (test (equivalent? (log 0) (- (real-part (log 0)))) #f) (test (equivalent? (log 0) (- 0/0)) #f) (test (equivalent? (log 0) (log 0)) #t) (test (equivalent? (log 0) (complex 1/0 1)) #f) (test (equivalent? (log 0) (complex 1 1/0)) #f) (test (equivalent? (log 0) (complex 1/0 1/0)) #f) (test (equivalent? (log 0) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (log 0) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (log 0) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (log 0) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (log 0) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 1) (+ (complex 1/0 1) 5e-16)) #t) (test (equivalent? (complex 1/0 1) (- (complex 1/0 1) 1/1428571428571429)) #t) (test (equivalent? (complex 1/0 1) (+ (complex 1/0 1) 0+5e-16i)) #t) (test (equivalent? (complex 1/0 1) (+ (complex 1/0 1) 0-1/1428571428571429i)) #t) (test (equivalent? (complex 1/0 1) 0) #f) (test (equivalent? (complex 1/0 1) 1) #f) (test (equivalent? (complex 1/0 1) 1e-16+i) #f) (test (equivalent? (complex 1/0 1) 0+1e-16i) #f) (test (equivalent? (complex 1/0 1) 1e-300) #f) (test (equivalent? (complex 1/0 1) 0+1e-300i) #f) (test (equivalent? (complex 1/0 1) 1/0) #f) (test (equivalent? (complex 1/0 1) (real-part (log 0))) #f) (test (equivalent? (complex 1/0 1) (- (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 1) (- 0/0)) #f) (test (equivalent? (complex 1/0 1) (log 0)) #f) (test (equivalent? (complex 1/0 1) (complex 1/0 1)) #t) (test (equivalent? (complex 1/0 1) (complex 1 1/0)) #f) (test (equivalent? (complex 1/0 1) (complex 1/0 1/0)) #f) (test (equivalent? (complex 1/0 1) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (complex 1/0 1) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 1) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 1) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (complex 1/0 1) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (complex 1 1/0) (+ (complex 1 1/0) 5e-16)) #t) (test (equivalent? (complex 1 1/0) (- (complex 1 1/0) 1/1428571428571429)) #t) (test (equivalent? (complex 1 1/0) (+ (complex 1 1/0) 0+5e-16i)) #t) (test (equivalent? (complex 1 1/0) (+ (complex 1 1/0) 0-1/1428571428571429i)) #t) (test (equivalent? (complex 1 1/0) 0) #f) (test (equivalent? (complex 1 1/0) 1) #f) (test (equivalent? (complex 1 1/0) 1e-300) #f) (test (equivalent? (complex 1 1/0) 0+1e-300i) #f) (test (equivalent? (complex 1 1/0) 1/0) #f) (test (equivalent? (complex 1 1/0) (real-part (log 0))) #f) (test (equivalent? (complex 1 1/0) (- (real-part (log 0)))) #f) (test (equivalent? (complex 1 1/0) (- 0/0)) #f) (test (equivalent? (complex 1 1/0) (log 0)) #f) (test (equivalent? (complex 1 1/0) (complex 1/0 1)) #f) (test (equivalent? (complex 1 1/0) (complex 1 1/0)) #t) (test (equivalent? (complex 1 1/0) (complex 1/0 1/0)) #f) (test (equivalent? (complex 1 1/0) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (complex 1 1/0) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (complex 1 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (complex 1 1/0) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (complex 1 1/0) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 1/0) (+ (complex 1/0 1/0) 5e-16)) #t) (test (equivalent? (complex 1/0 1/0) (- (complex 1/0 1/0) 1/1428571428571429)) #t) (test (equivalent? (complex 1/0 1/0) (+ (complex 1/0 1/0) 0+5e-16i)) #t) (test (equivalent? (complex 1/0 1/0) (+ (complex 1/0 1/0) 0-1/1428571428571429i)) #t) (test (equivalent? (complex 1/0 1/0) 0) #f) (test (equivalent? (complex 1/0 1/0) 1/0) #f) (test (equivalent? (complex 1/0 1/0) (real-part (log 0))) #f) (test (equivalent? (complex 1/0 1/0) (- (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 1/0) (- 0/0)) #f) (test (equivalent? (complex 1/0 1/0) (log 0)) #f) (test (equivalent? (complex 1/0 1/0) (complex 1/0 1)) #f) (test (equivalent? (complex 1/0 1/0) (complex 1 1/0)) #f) (test (equivalent? (complex 1/0 1/0) (complex 1/0 1/0)) #t) (test (equivalent? (complex 1/0 1/0) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (complex 1/0 1/0) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 1/0) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (complex 1/0 1/0) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 5e-16)) #t) (test (equivalent? (complex (real-part (log 0)) 1/0) (- (complex (real-part (log 0)) 1/0) 1/1428571428571429)) #t) (test (equivalent? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 0+5e-16i)) #t) (test (equivalent? (complex (real-part (log 0)) 1/0) (+ (complex (real-part (log 0)) 1/0) 0-1/1428571428571429i)) #t) (test (equivalent? (complex (real-part (log 0)) 1/0) 0) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) 1) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) 1000) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) 1/1000) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) 0.0) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) 1.0) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) 1e-16) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) 1e4) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) 1/0) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (real-part (log 0))) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (- (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (- 0/0)) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (log 0)) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1/0 1)) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1 1/0)) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1/0 1/0)) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) 1/0)) #t) (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (complex (real-part (log 0)) 1/0) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 5e-16)) #t) (test (equivalent? (complex 1/0 (real-part (log 0))) (- (complex 1/0 (real-part (log 0))) 1/1428571428571429)) #t) (test (equivalent? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 0+5e-16i)) #t) (test (equivalent? (complex 1/0 (real-part (log 0))) (+ (complex 1/0 (real-part (log 0))) 0-1/1428571428571429i)) #t) (test (equivalent? (complex 1/0 (real-part (log 0))) (real-part (log 0))) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (- (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (- 0/0)) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (log 0)) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1/0 1)) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1 1/0)) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1/0 1/0)) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #t) (test (equivalent? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (complex 1/0 (real-part (log 0))) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 5e-16)) #t) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (- (complex (real-part (log 0)) (real-part (log 0))) 1/1428571428571429)) #t) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 0+5e-16i)) #t) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (+ (complex (real-part (log 0)) (real-part (log 0))) 0-1/1428571428571429i)) #t) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) 0) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) 1/0) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (real-part (log 0))) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (- (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (- 0/0)) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (log 0)) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 1)) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1 1/0)) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 1/0)) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #t) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (complex (real-part (log 0)) (real-part (log 0))) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 5e-16)) #t) (test (equivalent? (complex (real-part (log 0)) 1) (- (complex (real-part (log 0)) 1) 1/1428571428571429)) #t) (test (equivalent? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 0+5e-16i)) #t) (test (equivalent? (complex (real-part (log 0)) 1) (+ (complex (real-part (log 0)) 1) 0-1/1428571428571429i)) #t) (test (equivalent? (complex (real-part (log 0)) 1) 0) #f) (test (equivalent? (complex (real-part (log 0)) 1) 1) #f) (test (equivalent? (complex (real-part (log 0)) 1) 0+1e-300i) #f) (test (equivalent? (complex (real-part (log 0)) 1) 1/0) #f) (test (equivalent? (complex (real-part (log 0)) 1) (real-part (log 0))) #f) (test (equivalent? (complex (real-part (log 0)) 1) (- (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) 1) (- 0/0)) #f) (test (equivalent? (complex (real-part (log 0)) 1) (log 0)) #f) (test (equivalent? (complex (real-part (log 0)) 1) (complex 1/0 1)) #f) (test (equivalent? (complex (real-part (log 0)) 1) (complex 1 1/0)) #f) (test (equivalent? (complex (real-part (log 0)) 1) (complex 1/0 1/0)) #f) (test (equivalent? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (complex (real-part (log 0)) 1) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (complex (real-part (log 0)) 1) (complex (real-part (log 0)) 1)) #t) (test (equivalent? (complex (real-part (log 0)) 1) (complex 1 (real-part (log 0)))) #f) (test (equivalent? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 5e-16)) #t) (test (equivalent? (complex 1 (real-part (log 0))) (- (complex 1 (real-part (log 0))) 1/1428571428571429)) #t) (test (equivalent? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 0+5e-16i)) #t) (test (equivalent? (complex 1 (real-part (log 0))) (+ (complex 1 (real-part (log 0))) 0-1/1428571428571429i)) #t) (test (equivalent? (complex 1 (real-part (log 0))) (real-part (log 0))) #f) (test (equivalent? (complex 1 (real-part (log 0))) (- (real-part (log 0)))) #f) (test (equivalent? (complex 1 (real-part (log 0))) (- 0/0)) #f) (test (equivalent? (complex 1 (real-part (log 0))) (log 0)) #f) (test (equivalent? (complex 1 (real-part (log 0))) (complex 1/0 1)) #f) (test (equivalent? (complex 1 (real-part (log 0))) (complex 1 1/0)) #f) (test (equivalent? (complex 1 (real-part (log 0))) (complex 1/0 1/0)) #f) (test (equivalent? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) 1/0)) #f) (test (equivalent? (complex 1 (real-part (log 0))) (complex 1/0 (real-part (log 0)))) #f) (test (equivalent? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) (real-part (log 0)))) #f) (test (equivalent? (complex 1 (real-part (log 0))) (complex (real-part (log 0)) 1)) #f) (test (equivalent? (complex 1 (real-part (log 0))) (complex 1 (real-part (log 0)))) #t)) ; end with-bignums (test (equivalent? 1.0e10 (+ 1.0e10 1.0e-6)) #f) (test (equivalent? (open-input-file "s7test.scm") (open-input-file "s7test.scm")) #t) (test (equivalent? (make-iterator (hash-table 'a 1)) (make-iterator (hash-table 'a 1))) #t) (let ((i1 (make-iterator (hash-table 'a 1 'b 2))) (i2 (make-iterator (hash-table 'a 1 'b 2)))) (i1) (i2) (test (equivalent? i1 i2) #t)) (let ((i1 (make-iterator (hash-table 'a 1 'b 2))) (i2 (make-iterator (hash-table 'a 1 'b 2)))) (i1) (test (equivalent? i1 i2) #f)) (test (equivalent? (make-iterator (inlet 'a 1)) (make-iterator (inlet 'a 1))) #t) (let ((i1 (make-iterator (inlet 'a 1 'b 2))) (i2 (make-iterator (inlet 'a 1 'b 2)))) (test (equivalent? i1 i2) #t) (i1) (test (equivalent? i1 i2) #f) (i2) (test (equivalent? i1 i2) #t) (i2) (test (equivalent? i1 i2) #f)) (test (equivalent? (make-iterator (list unless 1+i 0/0+i #u())) (make-iterator (list unless 1+i 0/0+i #u()))) #t) (let ((i1 (make-iterator (list +nan.0 +inf.0))) (i2 (make-iterator (list +nan.0 +inf.0)))) (test (equivalent? i1 i2) #t) (i1) (test (equivalent? i1 i2) #f)) (when with-block (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-6)) (test (equivalent? (make-iterator (block (/ pi 2))) (make-iterator (block 1.570796326794897))) #t))) (when with-bignums (test (equivalent? (bignum +nan.0) 0/0+0/0i) #f) (test (equivalent? (bignum 0) 0+0/0i) #f) (test (equivalent? +nan.0 (bignum 0/0+0/0i)) #f) (test (equivalent? 0 (bignum 0+0/0i)) #f) (test (equivalent? 1/2 (bignum 1/2+0/0i)) #f) (test (equivalent? (bignum 1/2) 1/2+0/0i) #f) (test (equivalent? (bignum 1/2+0/0i) 1/2+0/0i) #t) (test (equivalent? (vector 1) (vector (bignum 1))) #t) (test (equivalent? (list 1.0) (list (bignum 1.0))) #t) (test (equivalent? (hash-table 'a 1/2) (hash-table 'a (bignum 1/2))) #t) (test (equivalent? (inlet 'a 1+i) (inlet 'a (bignum 1+i))) #t)) (let ((h1 (make-hash-table 8 equivalent?))) (set! (h1 (complex 0.0 +inf.0)) 1) (test (h1 (complex 0.0 +inf.0)) 1) (let ((h2 (make-hash-table 8 equivalent?))) (set! (h2 (complex 0.0 +inf.0)) 1) (test (equivalent? h1 h2) #t) (let ((h3 (copy h1))) (test (equivalent? h1 h3) #t) (set! (h3 (complex +nan.0 +inf.0)) 2) (set! (h1 (complex +nan.0 +inf.0)) 2) (test (equivalent? h1 h3) #t) (set! (h2 (complex +nan.0 0.0)) 2) (test (equivalent? h1 h2) #f) ))) (test (equivalent? (let ((h (make-hash-table 8 equivalent?))) (set! (h #_abs) (log 0)) h) (eval-string (object->string (let ((h (make-hash-table 8 equivalent?))) (set! (h #_abs) (log 0)) h) :readable))) #t) ;;; ---------------- ;;; try a bunch of combinations (define-expansion (format-with-line port str . args) `(format ,port ,str ,(port-line-number) ,@args)) (let ((lst1 ()) (lst2 ())) (if (not (eq? lst1 lst2)) (format-with-line #t ";~A: nils are not eq?~%")) (if (not (eqv? lst1 lst2)) (format-with-line #t ";~A: nils are not eqv?~%")) (if (not (equal? lst1 lst2)) (format-with-line #t ";~A: nils are not equal?~%")) (let ((v1 (make-vector 100 #f)) (v2 (make-vector 100 #f))) (if (not (equal? v1 v2)) (format-with-line #t ";~A: base vectors are not equal?~%")) (let ((h1 (make-hash-table)) (h2 (make-hash-table))) (if (not (equal? h1 h2)) (format-with-line #t ";~A: base hash-tables are not equal?~%")) (let ((e1 (sublet (curlet))) (e2 (sublet (curlet)))) (if (not (equal? e1 e2)) (format-with-line #t ";~A: base environments are not equal?~%")) (let ((ctr 0)) (for-each (lambda (arg1 arg2) ;; make sure the args are eq? to themselves ;; if equal? and equal to copy place in lst1, place copy in lst2, check that they are still equal ;; similarly for vector, hash-table, envs (let ((a1 arg1) (a2 arg2)) (if (not (eq? a1 arg1)) (format-with-line #t ";~A: ~A is not eq? to itself? ~A~%" arg1 a1)) (if (and (eq? a1 a2) (not (eqv? a1 a2))) (format-with-line #t ";~A: ~A is eq? but not eqv? ~A~%" a1 a2)) (if (equal? a1 a2) (begin (if (and (eq? a1 a2) (not (eqv? a1 a2))) (format-with-line #t ";~A: ~A is eq? and equal? but not eqv?? ~A~%" a1 a2)) (if (not (equivalent? a1 a2)) (format-with-line #t ";~A: ~A is equal? but not equivalent? ~A~%" a1 a2)) (set! lst1 (cons a1 lst1)) (set! lst2 (cons a2 lst2)) (set! (v1 ctr) a1) (set! (v2 ctr) a2) (let* ((sym1 (symbol "symbol-" (number->string ctr))) (sym2 (copy sym1))) (set! (h1 sym1) a1) (set! (h2 sym2) a2) (varlet e1 (cons sym1 a1)) (varlet e2 (cons sym2 a2)) (if (not (equal? lst1 lst2)) (begin (format-with-line #t ";~A: add ~A to lists, now not equal?~%" a1) (set! lst1 (cdr lst1)) (set! lst2 (cdr lst2)))) (if (not (equal? v1 v2)) (begin (format-with-line #t ";~A: add ~A to vectors, now not equal?~%" a1) (set! (v1 ctr) #f) (set! (v2 ctr) #f))) (if (not (equal? h1 h2)) (begin (format-with-line #t ";~A: add ~A to hash-tables, now not equal?~%" a1) (set! (h1 sym1) #f) (set! (h2 sym2) #f))) (if (not (equal? e1 e2)) (begin (format-with-line #t ";~A: add ~A to environments, now not equal?~% ~A~% ~A~%" a1 e1 e2) (eval `(set! ,sym1 #f) e1) (eval `(set! ,sym2 #f) e2))) )) (begin (if (eq? a1 arg1) (format-with-line #t ";~A: ~A is eq? but not equal? ~A~%" a1 a2)) (if (eqv? a1 arg1) (format-with-line #t ";~A: ~A is eqv? but not equal? ~A~%" a1 a2)) (format-with-line #t ";~A: ~A is not equal to ~A~%" a1 a2))) (set! ctr (+ ctr 1)))) (list "hi" "" (integer->char 65) #\space #\newline #\null 1 3/4 ;; 1.0 1+i pi (real-part (log 0)) 1e18 most-negative-fixnum most-positive-fixnum 'a-symbol (make-vector 3 #f) #() #2d((1 2) (3 4)) abs quasiquote macroexpand (log 0) (hash-table 'a 1 'b 2) (hash-table) (sublet (curlet) 'a 1) (rootlet) #f #t :hi # # # (cons 1 2) () '(1) (list (cons 1 2)) '(1 2 . 3) (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) ) (list (string #\h #\i) (string) #\A #\space #\newline (integer->char 0) (- 2 1) (/ 3 4) ;; 1.0 1+i pi (real-part (log 0)) 1e18 -9223372036854775808 9223372036854775807 (string->symbol "a-symbol") (vector #f #f #f) (vector) #2d((1 2) (3 4)) abs quasiquote macroexpand (log 0) (let ((h (make-hash-table 31))) (set! (h 'a) 1) (set! (h 'b) 2) h) (make-hash-table 123) (sublet (curlet) '(a . 1)) (rootlet) #f #t :hi # # (if #f #f) '(1 . 2) (list) (list 1) (list (cons 1 2)) '(1 2 . 3) (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) )) (set! (v1 ctr) lst1) (set! (v2 ctr) lst2) (set! ctr (+ ctr 1)) (if (not (equal? v1 v2)) (format-with-line #t ";~A: add lists to vectors, now vectors not equal?~%") (begin (set! lst1 (cons v1 lst1)) (set! lst2 (cons v2 lst2)) (if (not (equal? lst1 lst2)) (begin (format-with-line #t ";~A: add vectors to lists, now lists not equal?~%") (set! (h1 'lst1) lst1) (set! (h2 'lst2) lst2) (if (not (equal? h1 h2)) (format-with-line #t ";~A: add lists to hash-tables, not hash-tables not equal?~%") (begin (set! (v1 ctr) v1) (set! (v2 ctr) v2) (set! ctr (+ ctr 1)) (if (not (equal? v1 v2)) (format-with-line #t ";~A: add vectors to themselves, now vectors not equal?~%")) (if (not (equal? lst1 lst2)) (format-with-line #t ";~A: add vectors to themselves, now lists not equal?~%")) (set! (h1 'h1) h1) (set! (h2 'h2) h2) (if (not (equal? h1 h2)) (format-with-line #t ";~A: add hash-tables to themselves, not hash-tables not equal?~%")) ))))))))))) (define old-readers *#readers*) (set! *#readers* (cons (cons #\u (lambda (str) (string->number (substring str 1)))) ())) (test (eval (with-input-from-string "(+ 10 #u12)" read)) 22) (test (eval (with-input-from-string "(+ 10 #u87)" read)) 97) (set! *#readers* (list (cons #\[ (lambda (str) (let ((h (make-hash-table))) (do ((c (read) (read))) ((eq? c ']#) h) (set! (h (car c)) (cdr c)))))))) (eval-string "(let ((table #[(a . 1) (b . #[(c . 3)]#)]#)) (test (hash-table? table) #t) (test (table 'a) 1) (test (hash-table? (table 'b)) #t) (test ((table 'b) 'c) 3))" (curlet)) (set! *#readers* old-readers) (when with-block (let ((b (make-block 4))) (test (equivalent? b b) #t) (let ((b1 (make-block 4))) (test (equivalent? b b1) #t) (set! (b 1) 1.0) (test (equivalent? b b1) #f)))) (test (let ((p (c-pointer 0))) (equivalent? p (copy p))) #t) ;;; -------------------------------------------------------------------------------- ;;; some clm opt coverage tests ;;; move these! (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (quotient i 3)))) (num-test (fc) (quotient 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash 3 3)))) (num-test (fc) (ash 3 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash 3 i)))) (num-test (fc) (ash 3 9))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash 3 (+ i 1))))) (num-test (fc) (ash 3 10))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash i (+ i 1))))) (num-test (fc) (ash 9 10))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash (+ i 1) (- i 1))))) (num-test (fc) (ash 10 8))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (quotient i j)))) (num-test (fc) (quotient 9 3))) (let () (define (fc) (do ((count 0.0) (i 7.0 (+ 1.0 i))) ((>= i 10.0) count) (set! count (quotient i 3.0)))) (num-test (fc) (quotient 9.0 3.0))) ; fx_add_ft (let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (quotient i 3.0)))) (num-test (fc) (quotient 9.0 3.0))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (remainder i 3)))) (test (fc) (remainder 9 3))) (let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (remainder i 3.0)))) (test (fc) (remainder 9.0 3.0))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (remainder i j)))) (test (fc) (remainder 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (modulo i 3)))) (test (fc) (modulo 9 3))) (let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (modulo i 3.0)))) (test (fc) (modulo 9.0 3.0))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (modulo i j)))) (test (fc) (modulo 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (max i 3)))) (test (fc) (max 9 3))) (let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (max i 3.0)))) (test (fc) (max 9.0 3.0))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (max i j)))) (test (fc) (max 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (min i 3)))) (test (fc) (min 9 3))) (let () (define (fc) (do ((count 0.0) (i 7.0 (+ i 1.0))) ((>= i 10.0) count) (set! count (min i 3.0)))) (test (fc) (min 9.0 3.0))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (min i j)))) (test (fc) (min 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (logior i 3)))) (test (fc) (logior 9 3))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (logior i j)))) (test (fc) (logior 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (logand i 3)))) (test (fc) (logand 9 3))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (logand i j)))) (test (fc) (logand 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (logxor i 3)))) (test (fc) (logxor 9 3))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (logxor i j)))) (test (fc) (logxor 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (lognot i)))) (test (fc) (lognot 9))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash i 3)))) (test (fc) (ash 9 3))) (let () (define (fc) (do ((count 0) (j 3) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash i j)))) (test (fc) (ash 9 3))) (let () (define (fc) (do ((count 0) (i 7 (+ i 1))) ((= i 10) count) (set! count (ash i -3)))) (test (fc) (ash 9 -3))) (let ((lt (inlet 'a 10))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) (let-ref lt 'a)) (let-set! lt 'a i))) (test (fc) 0)) (let ((lt (inlet 'a 10)) (sym 'a)) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) (let-ref lt 'a)) (let-set! lt sym i))) (test (fc) 0)) (let ((dfn (vector #f))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (defined? 'abs) (vector-set! dfn 0 #t)))) (test (fc) #(#t))) (let ((dfn (vector #f))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (defined? 'abs (curlet)) (vector-set! dfn 0 #t)))) (test (fc) #(#t))) (let ((dfn (vector ""))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (number->string i)))) (test (fc) (vector (number->string 0)))) (let ((dfn (vector ""))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (number->string i 8)))) (test (fc) (vector (number->string 0 8)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (magnitude i)))) (test (fc) (float-vector (magnitude 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (angle i)))) (test (fc) (float-vector (angle 0.0)))) (let ((dfn (vector 0.0))) (define (fc) (do ((i 0 (+ i 1))) ((>= i 1) dfn) (vector-set! dfn 0 (complex i i)))) (test (fc) (vector 0))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (sin i)))) (test (fc) (float-vector (sin 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (cos i)))) (test (fc) (float-vector (cos 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (tan i)))) (test (fc) (float-vector (tan 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (atan i i)))) (test (fc) (float-vector (atan 0.0 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (sinh i)))) (test (fc) (float-vector (sinh 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (cosh i)))) (test (fc) (float-vector (cosh 0.0)))) (let ((dfn (float-vector 0.0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (tanh i)))) (test (fc) (float-vector (tanh 0.0)))) (let ((dfn (float-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (floor i)))) (test (fc) (float-vector (floor 0.0)))) (let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (floor (sqrt i))))) (test (fc) (int-vector (sqrt 0)))) (let ((dfn (float-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (ceiling i)))) (test (fc) (float-vector (ceiling 0.0)))) (let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (ceiling (sqrt i))))) (test (fc) (int-vector (ceiling (sqrt 0.0))))) (let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (ceiling i)))) (test (fc) (int-vector (ceiling 0)))) (let ((dfn (int-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (int-vector-set! dfn 0 (ceiling i)))) (test (fc) (int-vector (ceiling 0.0)))) (let ((dfn (float-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (float-vector-set! dfn 0 (round i)))) (test (fc) (float-vector (round 0.0)))) (let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (round (sqrt i))))) (test (fc) (int-vector (round (sqrt 0))))) (let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (round i)))) (test (fc) (int-vector (round 0)))) (let ((dfn (int-vector 0))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (int-vector-set! dfn 0 (round i)))) (test (fc) (int-vector (round 0.0)))) (let ((dfn (int-vector 0))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (int-vector-set! dfn 0 (truncate i)))) (test (fc) (int-vector (truncate 0)))) (let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (= i count)))) (test (fc) #(#t))) ;equal_p_ii (let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (= i 0.0)))) (test (fc) #(#t))) ;equal_p_dd (let ((dfn #f)) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (= i 0)))) (test (fc) #t)) ;equal_p_pp (let ((dfn #f)) (define (fc) (do ((count '(0)) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (= (car count) 0)))) (test (fc) #t)) ;equal_p_pi (let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (>= i count)))) (test (fc) #(#t))) (let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (>= i 0.0)))) (test (fc) #(#t))) (let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (<= i count)))) (test (fc) #(#t))) (let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (<= i 0.0)))) (test (fc) #(#t))) (let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (> i count)))) (test (fc) #(#f))) (let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (> i 0.0)))) (test (fc) #(#f))) (let ((dfn (vector #f))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (vector-set! dfn 0 (< i count)))) (test (fc) #(#f))) (let ((dfn (vector #f))) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (vector-set! dfn 0 (< i 0.0)))) (test (fc) #(#f))) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (<= i (sqrt count)) (set! dfn #t)))) (test (fc) #t)) ;leq_b_pp (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (>= i (sqrt count)) (set! dfn #t)))) (test (fc) #t)) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (> i (sqrt count)) (set! dfn #t)))) (test (fc) #f)) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (< i (sqrt count)) (set! dfn #t)))) (test (fc) #f)) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (>= i count) (set! dfn #t)))) (test (fc) #t)) (let ((dfn #f)) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (>= i 0.0) (set! dfn #t)))) (test (fc) #t)) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (<= i count) (set! dfn #t)))) (test (fc) #t)) (let ((dfn #f)) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (<= i 0.0) (set! dfn #t)))) (test (fc) #t)) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (> i count) (set! dfn #t)))) (test (fc) #f)) (let ((dfn #f)) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (> i 0.0) (set! dfn #t)))) (test (fc) #f)) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (< i count) (set! dfn #t)))) (test (fc) #f)) (let ((dfn #f)) (define (fc) (do ((i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (< i 0.0) (set! dfn #t)))) (test (fc) #f)) (let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char=? #\b c) (set! d #t)))) (test (fc) #t)) ;char_eq_b_direct (let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t)) ;char_eq_b (let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char<=? #\b c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char<=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char>=? #\b c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char>=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char? #\b c) (set! d #t)))) (test (fc) #f)) (let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char>? (string-ref e 0) c) (set! d #t)))) (test (fc) #f)) (let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci=? #\b c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci<=? #\b c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci<=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci>=? #\b c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci>=? (string-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci? #\b c) (set! d #t)))) (test (fc) #f)) (let ((d #f) (e "b")) (define (fc) (do ((c #\b) (i 0 (+ i 1))) ((= i 1) d) (if (char-ci>? (string-ref e 0) c) (set! d #t)))) (test (fc) #f)) (let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string=? "b" c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string<=? "b" c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string<=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string>=? "b" c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string>=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string? "b" c) (set! d #t)))) (test (fc) #f)) (let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string>? (vector-ref e 0) c) (set! d #t)))) (test (fc) #f)) (let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci=? "b" c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci<=? "b" c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci<=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci>=? "b" c) (set! d #t)))) (test (fc) #t)) (let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci>=? (vector-ref e 0) c) (set! d #t)))) (test (fc) #t)) (let ((d #f)) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci? "b" c) (set! d #t)))) (test (fc) #f)) (let ((d #f) (e #("b"))) (define (fc) (do ((c "b") (i 0 (+ i 1))) ((= i 1) d) (if (string-ci>? (vector-ref e 0) c) (set! d #t)))) (test (fc) #f)) (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (+ i)))) (test (fc) 2.0)) ;add_d_d (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (+ i 1.0))))) (test (fc) 3.0)) ;add_p_dd (let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 3) count) (set! count (- i)))) (test (fc) -2)) ;subtract_i_i (let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 3) count) (set! count (- i i i)))) (test (fc) -2)) ;subtract_i_iii (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (- i)))) (test (fc) -2.0)) ;subtract_d_d (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (- i i)))) (test (fc) 0.0)) ;subtract_d_dd (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (- i i i)))) (test (fc) -2.0)) ;subtract_d_ddd (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (- i i i i)))) (test (fc) -4.0)) ;subtract_d_dddd (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (- i 1.0))))) (test (fc) 1.0)) ;sub_p_dd (let ((fv #r(1.0))) (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (- i (* 0.5 (float-vector-ref fv 0))))))) (test (fc) 1.5)) ;subtract_p_pp (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (* i)))) (test (fc) 2.0)) ;multiply_d_d (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (* i i)))) (test (fc) 4.0)) ;multiply_d_dd (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (* i i i)))) (test (fc) 8.0)) ;multiply_d_ddd (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (* i i i i)))) (test (fc) 16.0)) ;multiply_d_dddd (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (* i 1.0))))) (test (fc) 2.0)) ;mul_p_dd (let ((fv #r(1.0))) (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (magnitude (* i (* 0.5 (float-vector-ref fv 0))))))) (test (fc) 1.0)) ;multiply_p_pp (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i)))) (test (fc) 0.5)) ;divide_d_d (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i)))) (test (fc) 1.0)) ;divide_d_dd (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i i)))) (test (fc) 0.5)) ;divide_d_ddd (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (/ i i i i)))) (test (fc) 0.25)) ;divide_d_dddd (let () (define (fc) (do ((count 0) (i 1 (+ i 1))) ((= i 3) count) (set! count (magnitude (/ i i))))) (test (fc) 1)) (let () (define (fc) (do ((count 0) (i 1 (+ i 1))) ((= i 3) count) (set! count (abs (/ i i))))) (test (fc) 1)) (let () (define (fc) (do ((count 0.0) (i 1 (+ i 1))) ((= i 3) count) (set! count (magnitude (/ i i))))) (test (equivalent? (fc) 1.0) #t)) (let () (define (fc) (do ((count 0.0) (i 1 (+ i 1))) ((= i 3) count) (set! count (abs (/ i i))))) (test (equivalent? (fc) 1.0) #t)) (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (<= i (sqrt count))))) (test (fc) #t)) ;leq_p_pp (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (<= (sqrt count) 1)))) (test (fc) #t)) ;leq_p_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (< (sqrt count) 1)))) (test (fc) #t)) ;lt_p_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (>= (sqrt count) 1)))) (test (fc) #f)) ;geq_p_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (set! dfn (> (sqrt count) 1)))) (test (fc) #f)) ;gt_p_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (<= (sqrt count) 1) (set! dfn #t)))) (test (fc) #t)) ;leq_b_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (< (sqrt count) 1) (set! dfn #t)))) (test (fc) #t)) ;lt_b_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (>= (sqrt count) 1) (set! dfn #t)))) (test (fc) #f)) ;geq_b_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (> (sqrt count) 1) (set! dfn #t)))) (test (fc) #f)) ;gt_b_pi (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (imag-part (complex i i))))) (test (fc) 2.0)) ;imag_part_d_p (let () (define (fc) (do ((count 0.0) (i 1.0 (+ i 1.0))) ((>= i 3.0) count) (set! count (real-part (complex i i))))) (test (fc) 2.0)) ;real_part_d_p (let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (numerator (/ i 2))))) (test (fc) 0)) ;numerator_i (let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (denominator (/ i 2))))) (test (fc) 1)) ;denominator_i (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (nan? i) (set! dfn #t)))) (test (fc) #f)) ;is_nan_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (infinite? i) (set! dfn #t)))) (test (fc) #f)) ;is_infinite_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (even? i) (set! dfn #t)))) (test (fc) #t)) ;is_even_i (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (odd? i) (set! dfn #t)))) (test (fc) #f)) ;is_odd_i (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (even? (magnitude i)) (set! dfn #t)))) (test (fc) #t)) ;is_even_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (odd? (magnitude i)) (set! dfn #t)))) (test (fc) #f)) ;is_odd_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (zero? i) (set! dfn #t)))) (test (fc) #t)) ;is_zero_i (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (zero? (magnitude i)) (set! dfn #t)))) (test (fc) #t)) ;is_zero_d (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (zero? (sqrt i)) (set! dfn #t)))) (test (fc) #t)) ;is_zero_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (negative? i) (set! dfn #t)))) (test (fc) #f)) ;is_negative_i (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (negative? (magnitude i)) (set! dfn #t)))) (test (fc) #f)) ;is_negative_d (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (negative? (sqrt i)) (set! dfn #t)))) (test (fc) #f)) ;is_negative_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (positive? i) (set! dfn #t)))) (test (fc) #f)) ;is_positive_i (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (positive? (magnitude i)) (set! dfn #t)))) (test (fc) #f)) ;is_positive_d (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (positive? (sqrt i)) (set! dfn #t)))) (test (fc) #f)) ;is_positive_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (exact? (sqrt i)) (set! dfn #t)))) (test (fc) #t)) ;is_exact_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (inexact? (sqrt i)) (set! dfn #t)))) (test (fc) #f)) ;is_inexact_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (integer-length i)))) (test (fc) 0)) ;integer_length_i_i (let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (random i)))) (test (fc) 0)) ;random_i_i (let () (define (fc) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) count) (set! count (random i)))) (test (fc) 0.0)) ;random_d_d (let () (define (fc) (do ((count (complex 1 1)) (i 0 (+ i 1))) ((= i 1) count) (set! count (random (complex i i))))) (test (fc) 0)) ;random_p_p (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (random-state? i) (set! dfn #t)))) (test (fc) #f)) ;is_random_state_b (let ((str "123qasde")) (define (fc) (do ((i 0 (+ i 1))) ((= i 1)) (char-position #\a str 0))) (test (fc) #t)) ;char_position_p_ppi (let ((str "123qasde")) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (string-length str)))) (test (fc) 8)) ;string_length_i (let ((str #("123qasde"))) (define (fc) (catch #t (lambda () (do ((count #\a) (i 0 (+ i 1))) ((= i 1) count) (set! count (string-ref str i)))) (lambda args 'error))) (test (fc) 'error)) ;string_ref_p_pi (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (macro? i) (set! dfn #t)))) (test (fc) #f)) ;is_macro_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (float? i) (set! dfn #t)))) (test (fc) #f)) ;is_float_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (port-closed? *stdout*) (set! dfn #t)))) (test (fc) #f)) ;is_port_closed_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (directory? "s7test.scm") (set! dfn #t)))) (test (fc) #f)) ;is_directory_b (let ((dfn #f)) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (sequence? i) (set! dfn #t)))) (test (fc) #f)) ;is_sequence_b (let ((p '(1 2 (3 4)))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (tree-leaves p)))) (test (fc) 4)) ; tree_leaves_i (let () (define (fc) (do ((i 0 (+ i 1))) ((= i 1)) (newline))) (let-temporarily (((current-output-port) #f)) (test (fc) #t))) (let () (define (fc) (do ((i 0 (+ i 1))) ((= i 1)) (newline #f))) (test (fc) #t)) (let () (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1)) (set! count (port-line-number (current-input-port))))) (test (fc) #t)) ; port_line_number_i_p (let ((dfn #f)) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (provided? 'asdf) (set! dfn #t)))) (test (fc) #f)) ; is_provided_b (let ((str #u(1 2 3))) (define (fc) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (byte-vector-ref str i)))) (test (fc) 1)) ; byte_vector_ref_i (let ((str #u(1 2 3))) (define (fc) (do ((i 0 (+ i 1))) ((= i 1) (str 0)) (byte-vector-set! str i 4))) (test (fc) 4)) ; byte_vector_set_i (let () (define (f1) (let ((dfn #f)) (do ((count 0) (i 0 (+ i 1))) ((= i 1) dfn) (if (logbit? i count) (set! dfn #t))))) (test (f1) #f)) ; opt_b_ii_ss (let () (define (f2) (let ((dfn #f)) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (logbit? i 0) (set! dfn #t))))) (test (f2) #f)) ; opt_b_ii_sc_bit (let () (define (f3) (let ((dfn #f)) (do ((count 0.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (> i count) (set! dfn #t))))) (test (f3) #f)) ; opt_b_dd_ss_gt (let () (define (f4) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (< i count) (set! dfn #t))))) (test (f4) #t)) ; opt_b_dd_ss_lt (let () (define (f5) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (< i 1.0) (set! dfn #t))))) (test (f5) #t)) ; opt_b_dd_sc_lt (let () (define (f6) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (>= i 0.0) (set! dfn #t))))) (test (f6) #t)) ; opt_b_dd_sc_geq (let () (define (f7) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((= i 1.0) dfn) (if (<= i 1.0) (set! dfn #t))))) (test (f7) #t)) ; opt_b_dd_sc (let () (define (f8) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (= i 1.0) (set! dfn #t))))) (test (f8) #f)) ; opt_b_dd_sc_eq (let () (define (f9) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (= i (+ count 1.0)) (set! dfn #t))))) (test (f9) #f)) ; opt_b_dd_sf (let () (define (f10) (let ((dfn #f)) (do ((count 1.0) (i 0.0 (+ i 1.0))) ((>= i 1.0) dfn) (if (= (+ i 1.0) (+ count 1.0)) (set! dfn #t))))) (test (f10) #f)) ; opt_b_dd_ff (let () (define (f11) (do ((x 1.0) (i 0 (+ i 1))) ((= i 1)) (if (negative? (+ x 1.0)) (* x 2) (- x 3)))) (test (f11) #t)) ; opt_b_d_f (let () (define (f12) (let ((dfn #\c)) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (char=? dfn #\a) (set! dfn #\b))))) (test (f12) #\c)) ; opt_b_7pp_sc (let () (define (f13) (let ((dfn #\c)) (do ((i 0 (+ i 1))) ((= i 1) dfn) (if (eq? dfn #\a) (set! dfn #\b))))) (test (f13) #\c)) ; opt_b_pp_sc (let () (define (f14) (let ((dfn #f)) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (random 1))))) (test (f14) 0)) ; opt_i_7i_c (let () (define (f15) (let ((dfn #f)) (do ((count 0) (i 0 (+ i 1))) ((= i 1) count) (set! count (ash (+ i 1) 3))))) (test (f15) 8)) ; opt_i_7ii_fc ;;; coverage for op_let_a_fx_old -- why does it have to be at top level? (define (___f fv) (let ((fv-copy (copy fv))) (reverse! fv) (reverse! fv))) (___f (int-vector 1 2 3)) (test (___f (int-vector 1 2 3)) #i(1 2 3)) ;;; fx coverage (define _gfx_ 3) (define _vfx_ (vector (vector 0))) (define _vfxi_ (vector 0)) (let () ; fx_* coverage (define (f1 x) (and (pair? (cddr x)) (symbol? (cadr x)))) (test (f1 (list 1 2 3)) #f) (test (f1 (list 1 'a 3)) #t) (test (f1 (list 1 'a)) #f) (define (f2 x) (and (not (null? x)) (pair? (car x)))) (test (f2 (list 1 2)) #f) (test (f2 (list (list 1) 2)) #t) (test (f2 (list)) #f) (define (f3 x y) (or (< x y) (<= x y))) (test (f3 3 2) #f) (test (f3 3 3) #t) (test (f3 1 2) #t) (define (f4 x y) (or (>= x y) (> x _gfx_))) (test (f4 4 5) #t) (test (f4 3 3) #t) (test (f4 2 3) #f) (define (f5 fv z) (let ((x (vector-ref fv 0))) (when (< x z) (vector-set! fv 0 (+ x 1)) (f5 fv z)))) (test (f5 (vector 0) 2) #) (define (f6 fv z) (let ((x (length fv))) (when (eqv? x z) (f6 (cons x fv) z)))) (test (f6 (list 0) 2) #) (define (f7 x y) (let ((z x)) (if (zero? z) (f7 (- x 1) (cons z y))))) (test (f7 2 ()) #) (define (f8 x y z) (or (proper-list? z) (hash-table? x) (integer? z))) (test (f8 0 0 (list 1)) #t) (test (f8 0 0 1) #t) (test (f8 0 0 (vector 1)) #f) (define (f9 x y) (or (vector? x) (not x) (vector? y))) (test (f9 #f 0) #t) (test (f9 #(0) 0) #t) (test (f9 () ()) #f) (define (f10 x) (or (= x _gfx_) (eqv? x _gfx_))) (test (f10 1) #f) (test (f10 _gfx_) #t) (define (f11 x y z) (or (not (eq? (car z) 'a)) (null? (cddr z)) (eqv? x y))) (test (f11 1 2 (list 1 2)) #t) (test (f11 1 1 (list 'a 2)) #t) (define (f12 x y) (if (not (> y x)) (not (eqv? y x)))) (test (f12 1 2) #) (test (f12 1 1) #f) (define (f13 x y q r) (if (zero? (- (* q r) (* r q))) 32 12) (if (< (- q r) (- r q)) 32 12)) (test (f13 1 2 3 4) 32) (define (f14 x y) (let ((z (+ x y))) (cond ((= z 0) pi) ((< z 0) 'oops) (else (f14 (- x 1) (- y 1)))))) (test (f14 1 2) 'oops) (define (f15 lst) (let loop ((p lst) (sum 0)) (if (null? p) sum (loop (cdr p) (+ sum (car p)))))) (test (f15 (list 0 1 2)) 3) (define (f16 x y z) (+ (* 3.0 x) (- 3.0 x) (- z 3.0))) (test (f16 3 4 5) 11.0) (define (f17 x y z) (let ((v (vector 'a))) (if (eq? z (vector-ref v x)) 0 1))) (test (f17 0 0 'a) 0) (define (f18 x y z) (let ((v (vector 0))) (if (>= z (vector-ref v x)) 0 1))) (test (f18 0 0 0) 0) (define (f19 x y z) (let ((v (vector 0))) (if (> (vector-ref v x) z) 0 1))) (test (f19 0 0 0) 1) (define (f20 x y z) (let ((v (vector 0))) (+ (* z (vector-ref v x)) (- z (vector-ref v y))))) (test (f20 0 0 0) 0) (define (f21 x y z) (let ((v (vector 0))) (if (> (+ z (vector-ref v x)) 1) 0 1))) (test (f21 0 0 0) 1) (define (len=2? x) (and (pair? x) (pair? (cdr x)) (null? (cddr x)))) (define (f22 x) (and (list? x) (len=2? x))) (test (f22 (list 1 2)) #t) (define (len>2? x) (and (pair? x) (pair? (cdr x)) (pair? (cddr x)))) (define (f23 x) (and (list? x) (len>2? x))) (test (f23 (list 1 2 3)) #t) (define (f24 x) (let ((h (hash-table))) (hash-table-set! h x (+ (or (hash-table-ref h x) 0) 1)))) (test (f24 'a) 1) (define (f25 x) (if (or (not (symbol? x)) (keyword? x)) 1 0)) (test (f25 'a) 0) (test (f25 :a) 1) (test (f25 #f) 1) (define (f26 x) (if (> (+ _gfx_ (* x 2) 32) 0) 1 0)) (test (f26 3) 1) (define (f27 x) (let ((y 3)) (if (zero? (remainder x y)) 0 1))) (test (f27 4) 1) (test (f27 6) 0) (define (f28 x y) (if (= (remainder (car y) x) 0) 0 (f28 (- x 1) y))) (test (f28 2 '(3)) 0) (test (f28 3 '(3)) 0) (define (f29) (let ((v (vector 1 2)) (i 0) (j 1)) (if (zero? (- (vector-ref v i) (vector-ref v j))) 0 1))) (test (f29) 1) (define (f30 x) (if (eq? (string-ref (symbol->string (car x)) 0) #\a) 0 1)) (test (f30 '(abc)) 0) (test (f30 '(bcd)) 1) (define (f31 x) (do ((y 3 (+ y 1))) ((or (zero? x) (>= y x)) 0))) (test (f31 4) 0) (test (f31 0) 0) (define (f32 x y z) (if (vector-ref x (+ y z)) 1 0)) (test (f32 (vector #f #t) 1 0) 1) (define (f33 x y) (if (string? (number->string (+ 1 (car x) (car x)) y)) 1 0)) (test (f33 '(0) 10) 1) (define (f34 x y q r) (eqv? (vector-ref (vector-ref q r) y) 0)) (test (f34 0 0 (vector (vector 1)) 0) #f) (test (f34 0 0 (vector (vector 0)) 0) #t) (define (f35 x y q r) (eqv? (vector-ref (vector-ref x y) q) 0)) (test (f35 (vector (vector 1)) 0 0 0) #f) (test (f35 (vector (vector 0)) 0 0 0) #t) (define (f36 x y) (eqv? (vector-ref (vector-ref _vfx_ y) x) 0)) (test (f36 0 0) #t) (test (f36 0 1) 'error) (define (f37 x) (eqv? (vector-ref _vfx_ (vector-ref _vfxi_ x)) 0)) (test (f37 0) #f) (define (f38 x y) (eqv? (+ (* x x) (* y y)) 1)) (test (f38 1 2) #f) (test (f38 1 0) #t) (define (f39 x y z) (eqv? (vector-ref (vector-ref x y) z) 0)) (test (f39 (vector (vector 0)) 0 0) #t) (test (f39 (vector (vector 1)) 0 0) #f) (define (f40 items sequence) (cond ((not (pair? sequence)) sequence) ((memq (car sequence) items) (f40 items (cdr sequence))) (else (cons (car sequence) (f40 items (cdr sequence)))))) (test (f40 '(a b c) '(a d f e b c)) '(d f e)) (define (f41 row dist placed) (or (null? placed) (and (not (= (car placed) (+ row dist))) (not (= (car placed) (- row dist))) (f41 row (+ dist 1) (cdr placed))))) (test (f41 0 0 '(0 1 2)) #f) (test (f41 0 1 '(0 1 2)) #t) (define (f42 v i j y) (if (and (or (> (vector-ref v i) y) (>= y (vector-ref v j))) (or (> (vector-ref v j) y) (>= y (vector-ref v i)))) 0 1)) (test (f42 (vector 1 2 3 4) 1 2 3) 0) (test (f42 (vector 1 2 3 4) 1 2 2) 1) (define-constant (f43 x) (and (pair? x) (pair? (cdr x)))) (define (g) (let ((x (list 1 2))) (if (f43 x) 0 1))) (test (g) 0) (define (f44 fv z) (let ((x (vector-ref fv 0))) (when (< x 30) (vector-set! fv 0 z) (f44 fv (+ z 1))))) (test (f44 (vector 0) 0) #) (define (f45 x y z q) (zero? (* x (hash-table-ref y (vector-ref z q))))) (test (f45 2.0 (hash-table 'a 3.0) (vector 'a) 0) #f) (define (f46 x y z) (zero? (- (string->number (vector-ref x y)) z))) (test (f46 (vector "3.0") 0 1.0) #f) (define (f47 x y) (if (number? y) (or (positive? y) (/ 3.5 y)) (cddr y))) (test (f47 0 1) #t) (test (f47 0 -1) -3.5) (test (f47 -1 (list 1 2)) ()) (let () ; tshoot (define (palindrome? string) (or (< (string-length string) 2) (and (char=? (string-ref string 0) (string-ref string (- (string-length string) 1))) (palindrome? (substring string 1 (- (string-length string) 1)))))) (define (pal-test) (test (palindrome? "abcdefgfedcba") #t)) (pal-test)) (let () ; primes.scm benchmark (define (iotar m n) (if (> m n) () (cons m (iotar (+ 1 m) n)))) (define (erat l) (letrec ((only-p (lambda (n l) (if (null? l) () (if (= (remainder (car l) n) 0) (only-p n (cdr l)) (cons (car l) (only-p n (cdr l)))))))) (if (null? l) () (cons (car l) (erat (only-p (car l) (cdr l))))))) (define (f49) (erat (iotar 2 20))) (test (f49) '(2 3 5 7 11 13 17 19))) ) (let () ;; unknown_g (define (f3 f x) (f x)) (define (f2 x) (+ x 1)) (define (f4 x) (list x) (+ x 2)) (define (f5 x) (call-with-exit (lambda (return) (return (+ x 1))))) (define f6 (vector 1 2 3)) (define f7 "123") (test (f3 f2 1) 2) (test (f3 f4 1) 3) (test (f3 f5 1) 2) (test (f3 f6 1) 2) (test (f3 f7 1) #\2) (define (f8 g x) (g x)) (test (f8 f2 1) 2) (test (f8 (lambda (x) (+ x 1)) 1) 2) (test (f8 abs -1) 1) (test (f8 + 1) 1) (test (f8 (list 1 2 3) 1) 2) ;; unknown_ss (define (f9 g x y) (g x y)) (define (f10 x y) (+ x y)) (define (f11 x y) (list x y) (+ x y)) (define (f12 x y) (call-with-exit (lambda (return) (return (+ x y))))) (define f13 #2r((1 2 3 4 5 6 7) (8 9 10 11 12 13 14))) (define-macro (f14 x y) `(+ ,x ,y)) (test (f9 f10 1 2) 3) (test (f9 f11 3 4) 7) (test (f9 f12 3 4) 7) (test (f9 f13 1 2) 10.0) (test (f9 f14 7 8) 15) ;; unknown_a (define (f13 f x) (f (* x 3))) (define (f12 x) (+ x 1)) (define (f14 x) (list x) (+ x 2)) (define (f15 x) (call-with-exit (lambda (return) (return (+ x 1))))) (define f16 (vector 1 2 3 4 5 6)) (define f17 "123456") (test (f13 f12 1) 4) (test (f13 f14 1) 5) (test (f13 f15 1) 4) (test (f13 f16 1) 4) (test (f13 f17 1) #\4) (define (f18 g x) (g (* 3 x))) (test (f18 f12 1) 4) (test (f18 (lambda (x) (+ x 1)) 1) 4) (test (f18 abs -1) 3) (test (f18 + 1) 3) (test (f18 (list 1 2 3 4 5 6) 1) 4)) ;; -------- unknown: (test (let ((e-1 (lambda (x) (x)))) (e-1 +)) 0) (test (let ((e-1 (lambda (x) (x)))) (e-1 (lambda () 3))) 3) (test (let ((e-1 (lambda (x) (x)))) (e-1 (lambda* ((d 32)) d))) 32) (test (let ((e-1 (lambda (x) (x)))) (call-with-exit (lambda (return) (e-1 return) 123))) ()) (test (let ((e-1 (lambda (x) (x)))) (e-1 (macro () `(+ 1 2)))) 3) (test (let ((e-1 (lambda (x) (x)))) (e-1 (macro* ((d 32)) `(+ 1 ,d)))) 33) (test (let ((e-1 (lambda (x) (x)))) (let ((iter (make-iterator '(1 2 3)))) (e-1 iter))) 1) ;; -------- unknown_g: (test (let ((f-1 (lambda (x a) (x a)))) (f-1 abs 2)) 2) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 / 2)) 1/2) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 #(0 1 2 3) 2)) 2) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 #r(1 2 3 4) 2)) 3.0) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (lambda (b) (+ b 1)) 2)) 3) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (lambda* (b (d 3)) (+ b d)) 2)) 5) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (macro (x) `(+ ,x 10)) 2)) 12) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (macro* (x (d 10)) `(+ ,x ,d)) 2)) 12) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (list 1 2 3 4) 2)) 3) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (hash-table 1 2 2 4) 2)) 4) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 "asdf" 2)) #\d) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (block 1 2 3 4) 2)) 3.0) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (bacro (x) `(+ ,x 10)) 2)) 12) ; no fixup [-> op_s_s in this case] (test (let ((f-1 (lambda (x a) (x a)))) (f-1 abs 2)) 2) ; op_s_s (test (let ((f-1 (lambda (x a) (x a)))) (call-with-exit (lambda (return) (f-1 return 32) 2))) 32) (test (let ((f-1 (lambda (x a) (x a)))) (call/cc (lambda (return) (f-1 return 32) 2))) 32) (test (let ((f-1 (lambda (x a) (x a)))) (f-1 (inlet 'a 1 'b 2) 'b)) 2) ;;; -------- unknown_gg: (test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 + 2 3)) 5) (test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 / 2 3)) 2/3) (test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 #2d((0 1 2 3) (4 5 6 7)) 1 2)) 6) (test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 (lambda (b c) (+ b c)) 2 3)) 5) (test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 (lambda* (b (d 3)) (+ b d)) 2 1)) 3) (test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 (macro (x y) `(+ ,x ,y)) 2 3)) 5) (test (let ((g-1 (lambda (x a b) (x a b)))) (g-1 (macro* (x (d 10)) `(+ ,x ,d)) 2 1)) 3) ;; -------- unknown_a: (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 abs 2)) 3) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 / 2)) 1/3) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 #(0 1 2 3) 2)) 3) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 #r(1 2 3 4) 2)) 4.0) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (lambda (b) (+ b 1)) 2)) 4) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (lambda* (b (d 3)) (+ b d)) 2)) 6) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (macro (x) `(+ ,x 10)) 2)) 13) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (macro* (x (d 10)) `(+ ,x ,d)) 2)) 13) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (list 1 2 3 4) 2)) 4) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (hash-table 1 2 3 4) 2)) 4) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 "asdf" 2)) #\f) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (block 1 2 3 4) 2)) 4.0) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 (bacro (x) `(+ ,x 10)) 2)) 13) ; no fixup [-> op_s_s in this case] (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (f-1 abs 2)) 3) ; op_s_s (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (call-with-exit (lambda (return) (f-1 return 32) 2))) 33) (test (let ((f-1 (lambda (x a) (x (+ a 1))))) (call/cc (lambda (return) (f-1 return 32) 2))) 33) (test (let ((f-1 (lambda (x a) (x (car '(a)))))) (f-1 (inlet 'a 1 'b 2) 'b)) 1) ;;; -------- unknown_aa: (test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 + 2 3)) 5) (test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 / 2 3)) 3/2) (test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 #2d((0 1 2 3) (4 5 6 7)) 0 3)) 6) (test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 (lambda (b c) (+ b c)) 2 3)) 5) (test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 (lambda* (b (d 3)) (+ b d)) 2 1)) 3) (test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 (macro (x y) `(+ ,x ,y)) 2 3)) 5) (test (let ((g-1 (lambda (x a b) (x (+ a 1) (- b 1))))) (g-1 (macro* (x (d 10)) `(+ ,x ,d)) 2 1)) 3) ;;; -------- unknown_all_s: (test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 + 2 3 -1)) 4) (test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 / 2 3 2)) 1/3) (test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 (lambda (b c d) (+ b c d)) 2 3 1)) 6) (test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 (lambda* (b (d 3) (e 0)) (+ b d e)) 2 1 3)) 6) (test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 (macro (x y z) `(+ ,x ,y ,z)) 2 3 4)) 9) (test (let ((g-1 (lambda (x a b c) (x a b c)))) (g-1 (macro* (x (d 10) (e 0)) `(+ ,x ,d ,e)) 2 1 3)) 6) ;;; -------- unknown_all_a: (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 + 2 3 5)) 15) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 / 2 3 4)) 3/16) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 (lambda (b c d) (+ b c d)) 2 3 5)) 15) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 (lambda* (b (d 3) (e 0)) (+ b d e)) 2 1 3)) 9) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 (macro (x y z) `(+ ,x ,y ,z)) 2 3 5)) 15) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (* c 2))))) (g-1 (macro* (x (d 10) (e 0)) `(+ ,x ,d ,e)) 2 1 3)) 9) ;;; -------- unknown_all_fp: (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 + 2 3 5)) 12) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 / 2 3 4)) 3/16) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 (lambda (b c d e) (+ b c d e)) 2 3 5)) 12) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) (values c 2))))) (g-1 (lambda* (b c (d 3) (e 0)) (+ b c d e)) 2 3 5)) 12) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) 2 (values c 2))))) (g-1 (macro (x y z w) `(+ ,x ,y ,z ,w)) 2 3 5)) 14) (test (let ((g-1 (lambda (x a b c) (x (+ a 1) (- b 1) 2 (values c 2))))) (g-1 (macro* (x c (d 10) (e 0)) `(+ ,x ,c ,d ,e)) 2 1 3)) 10) (test (let (([] 3)) (+ [] 1)) 4) ;;; -------------------------------------------------------------------------------- ;;; c-object? ;;; c-object-type ;;; c-pointer ;;; c-pointer? ;;; c-pointer->list ;;; c-pointer-info ;;; c-pointer-type ;;; c-pointer-weak1|2 (when with-block (test (c-object? (block)) #t) (test (integer? (c-object-type (block))) #t) (test ((*s7* 'c-types) (c-object-type (block))) "")) ; perhaps return block? instead? (test (c-pointer? 0) #f) (test (c-pointer? _null_) #t) (test (c-pointer->list (c-pointer 0 1 2)) '(0 1 2)) (if with-block (test (c-object? _c_obj_) #t) (test (c-pointer? _c_obj_) #t)) (for-each (lambda (arg) (test (c-pointer? arg) #f) (test (c-object? arg) #f) (test (c-object-type arg) 'error) (test (c-pointer arg) 'error) (test (c-pointer-info arg) 'error) (test (c-pointer-type arg) 'error) (test (c-pointer->list arg) 'error)) (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ _undef_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (c-pointer?) 'error) (test (c-object?) 'error) (test (c-pointer? _c_obj_ 2 3) 'error) (test (c-object? _c_obj_ 2) 'error) (test (c-pointer 1 2 3 4 5 6) 'error) (test (c-pointer? (openlet (inlet 'c-pointer? (lambda (p) #t)))) #t) (test (c-pointer? (c-pointer 2 'integer?) 'integer?) #t) (test (c-pointer? (c-pointer 2 'integer?) 'symbol?) #f) (test (c-pointer->list (c-pointer 0)) '(0 #f #f)) (test (c-pointer->list (c-pointer 123 'null?)) '(123 null? #f)) (test (c-pointer-info (copy (c-pointer 1 2 3 4 5))) 3) (test (c-pointer-weak1 (copy (c-pointer 1 2 3 4 5))) 4) (test (c-pointer-weak2 (copy (c-pointer 1 2 3 4 5))) 5) (test (equal? (c-pointer 1) 1) #f) (test (equal? (c-pointer 1) (c-pointer 1)) #t) (test (equal? (c-pointer 1) (c-pointer 0)) #f) (test (equal? (c-pointer 1 (vector)) (c-pointer 1 (vector))) #t) (test (equal? (c-pointer 1 (vector)) (c-pointer 1 (vector 0))) #f) (test (equal? (c-pointer 1 vector? (vector)) (c-pointer 1 vector? (vector))) #t) (test (equal? (c-pointer 1 vector? (vector)) (c-pointer 1 vector? (vector 0))) #f) (test (equal? (c-pointer 1 +nan.0) (c-pointer 1 +nan.0)) #t) ; nan's are eq? (test (equivalent? (c-pointer 1) 1) #f) (test (equivalent? (c-pointer 1) (c-pointer 1)) #t) (test (equivalent? (c-pointer 1) (c-pointer 0)) #f) (test (equivalent? (c-pointer 1 (vector)) (c-pointer 1 (vector))) #t) (test (equivalent? (c-pointer 1 (vector)) (c-pointer 1 (vector 0))) #f) (test (equivalent? (c-pointer 1 vector? (vector)) (c-pointer 1 vector? (vector))) #t) (test (equivalent? (c-pointer 1 vector? (vector)) (c-pointer 1 vector? (vector 0))) #f) (test (equivalent? (c-pointer 1 +nan.0) (c-pointer 1 +nan.0)) #t) (test (equivalent? (c-pointer 1 +nan.0) (c-pointer 1 +inf.0)) #f) (test (equal? (copy (c-pointer 0 vector?)) (c-pointer 0 vector?)) #t) (test (object->string (c-pointer 1 (vector)) :readable) "(c-pointer 1 #() #f)") (test (object->string (c-pointer 1 (vector))) "#") ; ?? (test (object->string (copy (c-pointer 1 2 3 4 5)) :readable) "(c-pointer 1 2 3)") ; see s7.html, same for equal? and equivalent? (test (c-pointer-info) 'error) (test (c-pointer-info #f) 'error) (test (c-pointer-info (c-pointer 0)) #f) (test (c-pointer-info (c-pointer 0) #f) 'error) (test (c-pointer-info (c-pointer 0)) #f) (test (c-pointer-info (c-pointer 0 1 2)) 2) (test (c-pointer-type) 'error) (test (c-pointer-type #f) 'error) (test (c-pointer-type (c-pointer 0)) #f) (test (c-pointer-type (c-pointer 0) #f) 'error) (test (c-pointer-type (c-pointer 0)) #f) (test (c-pointer-type (c-pointer 0 1 2)) 1) (test (object->string (c-pointer 123123123 (symbol (make-string 130 #\a)))) "#") (test (type-of (c-pointer-weak1 (c-pointer 1))) 'boolean?) (test (c-pointer-weak1 (copy (let ((<1> #f) (<2> (list #f (hash-table 'a 1 'c 3 'b 2) #f))) (set! <1> (c-pointer 1 <2> #f)) (set-car! <2> <1>) <1>))) #f) (when with-bignums (test (c-pointer? (c-pointer (bignum "12341234"))) #t) (test (c-pointer (bignum "1.4")) 'error)) (let ((ptr (c-pointer 1 'abc (inlet 'object->string (lambda (obj . args) (let ((lt (object->let obj))) (format #f "I am pointer ~A of type '~A!" (lt 'pointer) (lt 'c-type)))))))) (openlet ptr) (test (object->string ptr) "I am pointer 1 of type 'abc!")) (test (openlet (c-pointer #b101 (setter car) (rootlet))) 'error) (test (abs (openlet (c-pointer 3 'asdf (inlet 'abs (lambda (val) 12))))) 12) (test (with-let (c-pointer 3 'asdf (openlet (inlet 'abs (lambda (val) 12)))) (abs 32)) 12) (test (with-let (c-pointer 3 'asdf (openlet (sublet (inlet) 'let-ref-fallback (lambda (lt sym) 12)))) asdf) 12) ;;; -------------------------------------------------------------------------------- ;;; type-of (test (type-of) 'error) (test (type-of 1 2) 'error) (test (type-of #f) 'boolean?) (test (type-of ()) 'null?) (test (type-of (list 1)) 'pair?) (test (type-of 1) 'integer?) (test (type-of 1/2) 'rational?) (test (type-of 1.0) 'float?) (test (type-of 1+i) 'complex?) (test (type-of #) 'unspecified?) (test (type-of (values)) 'unspecified?) (test (type-of #) 'undefined?) (test (type-of _undef_) 'undefined?) (test (type-of #) 'eof-object?) (test (type-of (hash-table)) 'hash-table?) (test (type-of (weak-hash-table)) 'hash-table?) (test (type-of #(1)) 'vector?) (test (type-of #r(1.0)) 'float-vector?) (test (type-of #c(1.0+i)) 'complex-vector?) (test (type-of #i(1)) 'int-vector?) (test (type-of (byte-vector 1 2)) 'byte-vector?) (test (type-of "") 'string?) (test (type-of #\a) 'char?) (test (type-of 'a) 'symbol?) (test (type-of :a) 'symbol?) (test (type-of (gensym)) 'symbol?) (test (type-of (inlet 'a 1)) 'let?) (test (type-of *stderr*) 'output-port?) (test (type-of *stdin*) 'input-port?) (test (type-of abs) 'procedure?) (test (type-of +) 'procedure?) (test (type-of (lambda () 1)) 'procedure?) (test (type-of (lambda* ((a 1)) a)) 'procedure?) (test (type-of quasiquote) 'macro?) (test (type-of (define-bacro (_b_ x) `(+ ,x 1))) 'macro?) ; bacro? undefined (test (type-of (c-pointer 0)) 'c-pointer?) (test (type-of (random-state 123)) 'random-state?) (test (type-of lambda) 'syntax?) (test (type-of (call-with-exit (lambda (g) g))) 'goto?) (test (type-of (call/cc (lambda (g) g))) 'continuation?) (test (type-of (make-iterator '(1 2))) 'iterator?) (when with-block (test (type-of (block)) 'c-object?)) (let () (define (remove obj seq) ; remove-all? (case (type-of seq) ((pair?) (if (proper-list? seq) (let loop ((lst seq) (res ())) (if (null? lst) (reverse! res) (loop (cdr lst) (if (equal? obj (car lst)) res (cons (car lst) res))))) seq)) ((string? vector? float-vector? int-vector? byte-vector? complex-vector?) (let ((len (length seq))) (if (zero? len) seq (do ((v (copy seq)) (j -1) (i 0 (+ i 1))) ((= i len) (if (string? seq) (copy v (make-string (+ j 1))) (if (byte-vector? seq) (copy v (make-byte-vector (+ j 1))) (subvector v 0 (+ j 1))))) (if (not (equal? obj (seq i))) (set! (v (set! j (+ j 1))) (seq i))))))) ((hash-table?) (let ((ht (copy seq))) (hash-table-set! ht obj #f) ht)) ((let?) (let ((lt (copy seq))) (if (and (openlet? lt) (let-ref lt 'remove)) ((let-ref lt 'remove) obj lt) (cutlet lt obj)) lt)) (else seq))) (test (remove #\a "abcdabcd") "bcdbcd") (test (remove 1 (vector 0 1 2 1 1)) #(0 2)) (test (remove 1 (vector 1)) #()) (test (remove 1 (byte-vector 0 1 2 1 1)) #u(0 2)) (test (remove 1 (int-vector 1 2 1 3 4 1 5)) #i(2 3 4 5)) (test (remove 1.0 (float-vector 1.0 3.0 1.0)) #r(3.0)) (test (remove 1+i (complex-vector 1-i 1+i 1+i)) #c(1-i)) (test (remove 1 '(1 2 3 4 1)) '(2 3 4)) (test (remove 'a (hash-table 'a 1 'b 2)) (hash-table 'b 2)) (test (remove 'a (inlet 'a 1 'b 2)) (inlet 'b 2)) (let ((lt1 (remove 'a (openlet (inlet 'a 1 'b 2 'remove (lambda (obj lt) (set! (lt 'b) 3) (cutlet lt obj))))))) (test (lt1 'b) 3)) (test (remove 1 (vector)) #()) (define (hi) (let ((v (byte-vector 1 2 3)) (sv (make-vector 3))) (do ((i 0 (+ i 1))) ((= i 3) sv) (set! (sv i) (v i))))) (test (hi) #(1 2 3)) (define (hi) (let ((v (byte-vector 1 2 3)) (sv (make-byte-vector 3))) (do ((i 0 (+ i 1))) ((= i 3) sv) (set! (sv i) (v i))))) (test (hi) #u(1 2 3))) (let () (define (the type expr) (if (eq? type (symbol->value (type-of expr))) expr (error 'bad-type "~S is ~S but should be ~S in (the ~S ~S)" expr (type-of expr) type type expr))) (test (+ 1 (the integer? 3)) 4) (test (+ 1 (the integer? 3.0)) 'error)) ;;; -------------------------------------------------------------------------------- ;;; boolean? (test (boolean? #f) #t) (test (boolean? #t) #t) (test (boolean? 0) #f) (test (boolean? 1) #f) (test (boolean? "") #f) (test (boolean? #\0) #f) (test (boolean? ()) #f) (test (boolean? #()) #f) (test (boolean? 't) #f) (test (boolean? (list)) #f) (test ( boolean? #t) #t) (test (boolean? boolean?) #f) (test (boolean? or) #f) (test ( ; a comment boolean? ;;; and another #t ) #t) (for-each (lambda (arg) (if (boolean? arg) (format #t ";(boolean? ~A) -> #t?~%" arg))) (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) # #)) (test (recompose 12 boolean? #f) #t) (test (boolean?) 'error) (test (boolean? #f #t) 'error) (test (boolean #f) 'error) (test (boolean? (lambda (x) #f)) #f) (test (boolean? and) #f) (test (boolean? if) #f) (test (boolean? (values)) #f) ;(test (boolean? else) #f) ; this could also be an error -> unbound variable, like (symbol? else) ;;; -------------------------------------------------------------------------------- ;;; not (test (not #f) #t) (test (not #t) #f) (test (not (not #t)) #t) (test (not 0) #f) (test (not 1) #f) (test (not ()) #f) (test (not 't) #f) (test (not (list)) #f) (test (not (list 3)) #f) (test (not 'nil) #f) (test (not not) #f) (test (not "") #f) (test (not lambda) #f) (test (not quote) #f) (for-each (lambda (arg) (if (not arg) (format #t ";(not ~A) -> #t?~%" arg))) (list "hi" (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi # # (if #f #f))) (test (recompose 12 not #f) #f) (test (not) 'error) (test (not #f #t) 'error) (test (not and) #f) (test (not case) #f) (let () ; check some optimizer branches (define (f1 sym) (not (symbol? sym))) (test (f1 'hi) #f) (test (f1 "hi") #t) (define (f2 sym) (not (integer? sym))) (test (f2 2) #f) (test (f2 'hi) #t) (define (f3 sym) (not (char? sym))) (test (f3 2) #t) (test (f3 #\a) #f) (define (f4 sym) (not (list? sym))) (test (f4 2) #t) (test (f4 '(1 2 3)) #f) (define (f5 sym) (not (boolean? sym))) (test (f5 2) #t) (test (f5 #f) #f) (define (f6 sym) (not (eof-object? sym))) (test (f6 2) #t) (test (f6 #) #f) (define (f7 sym) (not (pair? (car sym)))) (test (f7 '(hi)) #t) (test (f7 '((1))) #f) (define (f8 sym) (not (eq? sym 'q))) (test (f8 'a) #t) (test (f8 'q) #f) (define (f9 sym) (pair? (cadr sym))) (test (f9 '(1 2 3)) #f) (test (f9 '(1 (2 3) 4)) #t) (define (f10 lst val) (eq? (car lst) val)) (test (f10 '(#f) #f) #t) (test (f10 '(a) 32) #f) (define (f11 lst) (eq? (caar lst) 'q)) (test (f11 '((a))) #f) (test (f11 '((q))) #t) (define (f12 lst) (= (length lst) 2)) (test (f12 '(1 2)) #t) (test (f12 '(1 2 3)) #f) (define (f13 lst) (< (length lst) 2)) (test (f13 '(1 2)) #f) (test (f13 '(1)) #t) (define (f14 lst) (negative? (length lst))) (test (f14 '(1 2)) #f) (test (f14 '(1 . 3)) #t) (define (f15 lst) (memq (car lst) '(a b c))) (test (f15 '(a)) '(a b c)) (test (f15 '(d)) #f) (define (f16 a b) (if a (begin (+ b a) (format #f "~A" a) (+ a a)))) (test (f16 1 2) 2) (define (f17 a) (aritable? a 1)) (test (f17 abs) #t) (define (f22) (begin (display ":") (display (object->string 2)) (display ":"))) (test (with-output-to-string (lambda () (f22))) ":2:") (define (f23 a b) (list a b)) (define (f24 x y) (f23 (car x) (car y))) (define (f25 x y) (f23 (cdr x) (cdr y))) (test (f24 '(1 2) '(3 4)) '(1 3)) (test (f25 '(1 2) '(3 4)) '((2) (4))) (define (f24a s1 s2 s3) (+ (* s1 s2) (* (- 1.0 s1) s3))) (test (f24a 2.0 3.0 4.0) 2.0) (let () (define (a b) (define c 1) (+ b c)) (define (tst) (a 2)) (tst) (test (tst) 3)) (define (f25) (let ((x 0.0) (y 1.0)) (call-with-exit (lambda (return) (do ((i y (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((>= i 7)) (set! x (+ x i)) (if (> x 123.0) (return x)))))) x)) (test (f25) 85.0) ) (let () (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (ho 2))) (hi)) 7) (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (ho 1) (values 3 4))) (hi)) 10) (test (let () (define (ho a) (+ a 2)) (define (hi) (+ (values 3 4) (ho 1))) (hi)) 10) (test (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) 10) (test (let () (define (ho a) (values a 1)) (define (hi) (- (ho 2))) (hi)) 1) (test (let () (define (ho1) (*s7* 'version)) (define (ho2) (ho1)) (string? (ho2))) #t) (test (let () (define (hi) (vector 0)) (define (ho) (hi)) (ho)) #(0))) (let () (define (make-it . names) (apply vector names)) (define (hi) (make-it pi pi pi pi)) (test (hi) (vector pi pi pi pi))) (test (let () (define (hi a b c d) (+ a (* (- b c) d))) (define (ho) (hi 1 2 3 4)) (ho)) -3) (test (let () (define (hi a b c d) (+ a (* d (- b c)))) (define (ho) (hi 1 2 3 4)) (ho)) -3) (test (let () (define (hi) (let ((x (values 1 2))) (if x (list x)))) (define (ho) (hi)) (catch #t (lambda () (ho)) (lambda args #f)) (ho)) 'error) ; let_one_p_new (test (let () (define (hi) (let ((x (values 1 2))) (display x) (if x (list x)))) (define (ho) (hi)) (catch #t (lambda () (ho)) (lambda args #f)) (ho)) 'error) ; let_one_new (test (let () (define (hi a b) (- (+ a (abs b)))) (define (ho) (hi 1 -2)) (ho)) -3) (let () (define (e1) (((lambda () list)) 'a 'b 'c)) (define (e2) (e1)) (e2) (test (e2) '(a b c))) (let () (define (c1 s i) (case (string-ref s i) ((#\a) 1) (else 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2)) (let () (define (c1 s i) (case (string-ref s i) ((#\a) 1) ((#\i) 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2)) (let () (define (c1 s i) (case (string-ref s i) ((#\a #\h) 1) ((#\i #\o) 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2)) (let () (define (c1 s i) (case (string-ref s i) ((#\a #\h) 1) (else 2))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) 2)) (let () (define (d1) (do ((lst () (cons i lst)) (i 0 (+ i 1))) ((> i 6) (reverse lst)))) (define (d2) (d1)) (d2) (test (d2) '(0 1 2 3 4 5 6))) (let () (define (d3) ((define (hi a) (+ a 1)) 2)) (define (d4) (d3)) (d4) (test (d4) 3)) (let () (define (fif) (if (< 2 3) (quote . -1))) (catch #t fif (lambda args 'error)) (test (catch #t fif (lambda args 'error)) 'error)) ;(let () (define (fcond) (cond ((< 2 3) ((lambda (x) x 1 . 5) 2)))) (catch #t fcond (lambda args 'error)) (test (fcond) 'error)) ;(let () (define (fcond1) (cond ((< 2 3) ((lambda* (x) x . 5) 2)))) (catch #t fcond1 (lambda args 'error)) (test (fcond1) 'error)) ; those aren't what they appear to be: the catch does the stray dot check/error, then a call simply does what it can (let () (define (incsaa k i) (let ((sum 1)) (set! sum (+ sum (expt k i) (expt (- k) i))) sum)) (define (f1) (incsaa 3 2)) (test (f1) 19)) (let () (define (unks v1 i) (let ((x 0)) (set! x (v1 i)) x)) (define (f1) (unks (vector 1 2 3) 2)) (test (f1) 3)) (test (let () (define (func) (catch #t (lambda () (when (not abs cond) #f)) (lambda args 'err))) (define (hi) (func) (func)) (hi) (hi)) 'err) ; set_if_opts ;;; -------------------------------------------------------------------------------- ;;; symbol? (test (symbol? 't) #t) (test (symbol? "t") #f) (test (symbol? '(t)) #f) (test (symbol? #t) #f) (test (symbol? 4) #f) (test (symbol? 'foo) #t) (test (symbol? (car '(a b))) #t) (test (symbol? 'nil) #t) (test (symbol? ()) #f) (test (symbol? #()) #f) (test (symbol? #f) #f) (test (symbol? 'car) #t) (test (symbol? car) #f) (test (symbol? '#f) #f) (test (symbol? #()) #f) (test (symbol? :hi) #t) (test (symbol? hi:) #t) (test (symbol? :hi:) #t) (test (symbol? '::) #t) (test (symbol? ':) #t) (test (symbol? '|) #t) (test (symbol? '|') #t) (test (symbol? '@) #t) ;(test (symbol? '#:) #t) ; confusable given guile-style keywords (test (symbol? #b1) #f) (test (symbol? 'sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789) #t) ;M Gran (test (symbol? (vector-ref #(1 a 34) 1)) #t) (test (if (symbol? '1+) (symbol? '0e) #t) #t) (test (symbol? 'begin) #t) (test (symbol? 'if) #t) (test (symbol? (keyword->symbol :if)) #t) (test (symbol? (string->symbol "if")) #t) (test (symbol? if) #f) (test (symbol? quote) #f) (test (symbol? '(AB\c () xyz)) #f) (test (symbol? '.i) #t) (test (symbol? '1e400x) #t) (test (let ((1e400x 1)) (+ 1e400x 1)) 2) ; from bug-guile (test (symbol? '1+-i) #t) (test (let ((+-. 3) (1+-3e1i 4)) (+ +-. 1+-3e1i)) 7) (test (symbol? '1-+2i) #t) (test (string->number "1e2+-3i") #f) (test (symbol? '20:20) #t) (test (symbol? '2-1) #t) (for-each (lambda (arg) (if (symbol? arg) (format #t ";(symbol? ~A) -> #t?~%" arg))) (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) # #)) (test (symbol?) 'error) (test (symbol? 'hi 'ho) 'error) (test (symbol? 'hi 3) 'error) (test (symbol? 3 3) 'error) (test (symbol? 3 'hi) 'error) (test (symbol 'hi) 'error) ; symbol takes a string ;;; "Returns #t if obj is a symbol, otherwise returns #f" (r5|6rs.html) (test (symbol? begin) #f) ; this is an error in Guile, it was #t in s7 (test (symbol? expt) #f) (test (symbol? if) #f) (test (symbol? and) #f) (test (symbol? lambda) #f) (test (symbol? 'let) #t) (test (symbol? call/cc) #f) (test (symbol? '1.2.3) #t) (test (symbol? '1.2) #f) (test (symbol? ''1.2) #f) (test (symbol? '"hi") #f) (test (let ((sym000000000000000000000 3)) (let ((sym000000000000000000001 4)) (+ sym000000000000000000000 sym000000000000000000001))) 7) (test (let ((11-1 10) (2012-4-19 21) (1+the-road 18) (-1+2 1) (1e. 2) (0+i' 3) (0.. 4)) (+ 11-1 2012-4-19 1+the-road -1+2 1e. 0+i' 0..)) 59) (test (let ((name "hiho")) (string-set! name 2 #\null) (symbol? (string->symbol name))) #t) ;;; syntax? (test (syntax? 'lambda) #f) (test (syntax? lambda) #t) (test (syntax? if) #t) (test (syntax? macroexpand) #t) (test (syntax? 1) #f) (for-each (lambda (arg) (if (syntax? arg) (format #t ";(syntax? ~A) -> #t?~%" arg))) (list "hi" (integer->char 65) (list 1 2) '#t '3 (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) # #)) (test (syntax?) 'error) (test (syntax? 'hi 'ho) 'error) (test (syntax? 'hi 3) 'error) (test (syntax? 3 3) 'error) (test (syntax? 3 'hi) 'error) (test (syntax? 'else) #f) (test (syntax? '=>) #f) (test (syntax? else) #f) (let () (define (syntactic x) (if x (case x ((1) 1) (else 2)))) (syntactic 1) (let ((source (procedure-source syntactic))) (test (syntax? (car source)) #f))) ; 'lambda from (lambda (x) (if x (case x ((1) 1) (else 2)))) (for-each (lambda (x) (test (syntax? x) #t)) (list define with-baffle define-bacro letrec* unless define-macro* let-temporarily lambda define-macro define* let* macroexpand when bacro macro lambda* cond bacro* macro* set! letrec with-let if define-constant do or case define-expansion* define-expansion define-bacro* let begin quote and)) (for-each (lambda (x) (test (syntax? x) #f)) '(define with-baffle define-bacro letrec* unless define-macro* let-temporarily lambda define-macro define* let* macroexpand when bacro macro lambda* cond bacro* macro* set! letrec with-let if define-constant do or case define-expansion* define-expansion define-bacro* let begin quote and)) ;;; -------------------------------------------------------------------------------- ;;; procedure? (test (procedure? car) #t) (test (procedure? procedure?) #t) (test (procedure? 'car) #f) (test (procedure? (lambda (x) x)) #t) (test (procedure? '(lambda (x) x)) #f) (test (call/cc procedure?) #t) (test (let ((a (lambda (x) x))) (procedure? a)) #t) (test (letrec ((a (lambda () (procedure? a)))) (a)) #t) (test (let ((a 1)) (let ((a (lambda () (procedure? a)))) (a))) #f) (test (let () (define (hi) 1) (procedure? hi)) #t) (test (let () (define-macro (hi a) `(+ ,a 1)) (procedure? hi)) #f) (test (procedure? begin) #f) (test (procedure? lambda) #f) (test (procedure? (lambda* ((a 1)) a)) #t) (test (procedure? and) #f) (test (procedure? 'let) #f) (test (procedure? (dilambda (lambda () 1) (lambda (x) x))) #t) (if with-bignums (test (procedure? (bignum "1e100")) #f)) (test (procedure? quasiquote) #f) (let () (define-macro (hi a) `(+ ,a 1)) (test (procedure? hi) #f)) (test (procedure? (random-state 1234)) #f) (test (procedure? pi) #f) (test (procedure? cond) #f) (test (procedure? do) #f) (test (procedure? set!) #f) (for-each (lambda (arg) (if (procedure? arg) (format #t ";(procedure? ~A) -> #t?~%" arg))) (list "hi" _ht_ _undef_ _null_ :hi (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f))) (test (procedure?) 'error) (test (procedure? abs car) 'error) (test (procedure abs) 'error) ;; these are questionable -- an applicable object is a procedure(?) (test (procedure? "hi") #f) (test (procedure? '(1 2)) #f) (test (procedure? #(1 2)) #f) (when with-block (test (procedure? (block)) #t)) ;;; -------------------------------------------------------------------------------- ;;; CHARACTERS ;;; -------------------------------------------------------------------------------- (test (eqv? '#\ #\space) #t) (test (eqv? #\newline '#\newline) #t) ;;; -------------------------------------------------------------------------------- ;;; char? (test (char? #\a) #t) (test (char? #\() #t) (test (char? #\space) #t) (test (char? '#\newline) #t) (test (char? #\1) #t) (test (char? #\$) #t) (test (char? #\.) #t) (test (char? #\\) #t) (test (char? #\)) #t) (test (char? #\%) #t) (test (char? '#\space) #t) (test (char? '#\ ) #t) (test (char? '#\newline) #t) (test (char? '#\a) #t) (test (char? '#\8) #t) (test (char? #\-) #t) (test (char? #\n) #t) (test (char? #\() #t) (test (char? #\#) #t) (test (char? #\x) #t) (test (char? #\o) #t) (test (char? #\b) #t) (test (char? #b101) #f) (test (char? #o73) #f) (test (char? #x73) #f) (test (char? 'a) #f) (test (char? 97) #f) (test (char? "a") #f) (test (char? (string-ref "hi" 0)) #t) (test (char? (string-ref (make-string 1) 0)) #t) (test (char? #\") #t) (test (char? #\') #t) (test (char? #\`) #t) (test (char? #\@) #t) (test (char? #) #f) (test (char? '1e311) #f) (for-each (lambda (arg) (if (char? arg) (format #t ";(char? ~A) -> #t?~%" arg))) (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t (if #f #f) :hi (lambda (a) (+ a 1)))) (test (char? begin) #f) (do ((i 0 (+ i 1))) ((= i 256)) (if (not (char? (integer->char i))) (format #t ";(char? (integer->char ~A)) -> #f?~%" i))) (test (char?) 'error) (test (char? #\a #\b) 'error) (test (char #\a) 'error) (test (char? #\x65) #t) (test (char? #\x000000000065) #t) (test (char? #\x0) #t) (test (char=? #\x000 #\null) #t) (test (char=? #\x08 #\x8) #t) (test (char=? #\x0e #\xe) #t) ; Guile thinks both of these names are bogus (test (char=? #\x00e #\xe) #t) (test (char=? #\x0000e #\xe) #t) (test (char=? #\x00000000e #\xe) #t) ; hmmm -- surely this is a bug (test (char? #\xff) #t) ;; any larger number is a reader error ;(test (eval-string "(char? #\xbdca2cbec)") 'error) ; needs 2 \\ (test (eval-string "(char? #\\xbdca2cbec)") #f) (test (eval-string "(char? #\\100)") #f) (test (eval-string "(char? #\\x-65)") #f) (test (eval-string "(char? #\\x6.5)") #f) (test (eval-string "(char? #\\x6/5)") #f) (test (eval-string "(char? #\\x6/3)") #f) (test (eval-string "(char? #\\x6+i)") #f) (test (eval-string "(char? #\\x6asd)") #f) (test (eval-string "(char? #\\x6#)") #f) (test (eval-string "(char? #\\x#b0)") #f) (test (eval-string "(char? #\\x#b0") 'error) ; missing ) (test (eval-string "(char? #\\x-0)") #f) (test (eval-string "(char? #\\x1.4)") #f) (test (eval-string "(char? #\\x#b0)") #f) (test (eval-string "(char? #\\x-0)") #f) (test (eval-string "(char? #\\x1.4)") #f) (test (char=? #\x6a #\j) #t) (test (char? #\return) #t) (test (char? #\null) #t) (test (char? #\nul) #t) (test (char? #\linefeed) #t) (test (char? #\tab) #t) (test (char? #\space) #t) (test (char=? #\null #\nul) #t) (test (char=? #\newline #\linefeed) #t) (test (char=? #\return #\xd) #t) (test (char=? #\nul #\x0) #t) ;(test (char? #\ÿ) #t) ; this seems to involve unwanted translations in emacs? (test (eval-string (string-append "(char? " (format #f "#\\~C" (integer->char 255)) ")")) #t) (test (eval-string (string-append "(char? " (format #f "#\\~C" (integer->char 127)) ")")) #t) (test (apply char? (list (integer->char 255))) #t) (test (char? #\escape) #t) (test (char? #\alarm) #t) (test (char? #\backspace) #t) (test (char? #\delete) #t) (test (char=? #\delete #\backspace) #f) (num-test (let ((str (make-string 258 #\space))) (do ((i 1 (+ i 1))) ((= i 256)) (string-set! str i (integer->char i))) (string-set! str 257 (integer->char 0)) (string-length str)) 258) (let ((a-to-z (list #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\x #\y #\z)) (cap-a-to-z (list #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\X #\Y #\Z)) (mixed-a-to-z (list #\a #\B #\c #\D #\e #\F #\g #\H #\I #\j #\K #\L #\m #\n #\O #\p #\Q #\R #\s #\t #\U #\v #\X #\y #\Z)) (digits (list #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) ;;; -------------------------------------------------------------------------------- ;;; char-upper-case? (test (char-upper-case? #\a) #f) (test (char-upper-case? #\A) #t) (for-each (lambda (arg) (if (not (char-upper-case? arg)) (format #t ";(char-upper-case? ~A) -> #f?~%" arg))) cap-a-to-z) (for-each (lambda (arg) (if (char-upper-case? arg) (format #t ";(char-upper-case? ~A) -> #t?~%" arg))) a-to-z) (test (char-upper-case? (integer->char 192)) #t) ; 192..208 for unicode ;; non-alpha chars are "unspecified" here (test (char-upper-case? 1) 'error) (test (char-upper-case?) 'error) (test (char-upper-case? 1) 'error) (test (char-upper-case?) 'error) (test (char-upper-case? #\a #\b) 'error) (test (char-upper-case #\a) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-lower-case? (test (char-lower-case? #\A) #f) (test (char-lower-case? #\a) #t) (for-each (lambda (arg) (if (not (char-lower-case? arg)) (format #t ";(char-lower-case? ~A) -> #f?~%" arg))) a-to-z) (for-each (lambda (arg) (if (char-lower-case? arg) (format #t ";(char-lower-case? ~A) -> #t?~%" arg))) cap-a-to-z) (test (char-lower-case? 1) 'error) (test (char-lower-case?) 'error) (test (char-lower-case? 1) 'error) (test (char-lower-case?) 'error) (test (char-lower-case? #\a #\b) 'error) (test (char-lower-case #\a) 'error) ;; (test (char-lower-case? #\xb5) #t) ; what is this? in Snd it's #t, in ex1 it's #f -- is this a locale choice? (test (char-lower-case? #\xb6) #f) (for-each (lambda (c) (test (and (not (char-upper-case? c)) (not (char-lower-case? c))) #t)) (map integer->char (list 0 1 2 3 32 33 34 170 182 247))) ;;; -------------------------------------------------------------------------------- ;;; char-upcase (test (char-upcase #\A) #\A) (test (char-upcase #\a) #\A) (test (char-upcase #\?) #\?) (test (char-upcase #\$) #\$) (test (char-upcase #\.) #\.) (test (char-upcase #\\) #\\) (test (char-upcase #\5) #\5) (test (char-upcase #\)) #\)) (test (char-upcase #\%) #\%) (test (char-upcase #\0) #\0) (test (char-upcase #\_) #\_) (test (char-upcase #\?) #\?) (test (char-upcase #\space) #\space) (test (char-upcase #\newline) #\newline) (test (char-upcase #\null) #\null) (test (char-upper-case? (char-upcase #\?)) #f) ; ! (test (char-lower-case? (char-downcase #\?)) #f) (test (char-upper-case? (char-upcase #\_)) #f) (test (or (char-upper-case? #\?) (char-lower-case? #\?)) #f) (for-each (lambda (arg1 arg2) (if (not (char=? (char-upcase arg1) arg2)) (format #t ";(char-upcase ~A) != ~A?~%" arg1 arg2))) a-to-z cap-a-to-z) (do ((i 1 (+ i 1))) ((= i 256)) (if (and (not (char=? (integer->char i) (char-upcase (integer->char i)))) (not (char-alphabetic? (integer->char i)))) (format #t ";(char-upcase ~A) -> ~A but not alphabetic?~%" (integer->char i) (char-upcase (integer->char i))))) (test (recompose 12 char-upcase #\a) #\A) (test (reinvert 12 char-upcase char-downcase #\a) #\a) (test (char-upcase) 'error) (test (char-upcase #\a #\b) 'error) (test (char-upcase #) 'error) (test (char-upcase #f) 'error) (test (char-upcase (list)) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-downcase (test (char-downcase #\A) #\a) (test (char-downcase #\a) #\a) (test (char-downcase #\?) #\?) (test (char-downcase #\$) #\$) (test (char-downcase #\.) #\.) (test (char-downcase #\_) #\_) (test (char-downcase #\\) #\\) (test (char-downcase #\5) #\5) (test (char-downcase #\)) #\)) (test (char-downcase #\%) #\%) (test (char-downcase #\0) #\0) (test (char-downcase #\space) #\space) (for-each (lambda (arg1 arg2) (if (not (char=? (char-downcase arg1) arg2)) (format #t ";(char-downcase ~A) != ~A?~%" arg1 arg2))) cap-a-to-z a-to-z) (test (recompose 12 char-downcase #\A) #\a) (test (char-downcase) 'error) (test (char-downcase #\a #\b) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-numeric? (test (char-numeric? #\a) #f) (test (char-numeric? #\5) #t) (test (char-numeric? #\A) #f) (test (char-numeric? #\z) #f) (test (char-numeric? #\Z) #f) (test (char-numeric? #\0) #t) (test (char-numeric? #\9) #t) (test (char-numeric? #\space) #f) (test (char-numeric? #\;) #f) (test (char-numeric? #\.) #f) (test (char-numeric? #\-) #f) (test (char-numeric? (integer->char 200)) #f) (test (char-numeric? (integer->char 128)) #f) (test (char-numeric? (integer->char 216)) #f) ; 0 slash (test (char-numeric? (integer->char 189)) #f) ; 1/2 (for-each (lambda (arg) (if (char-numeric? arg) (format #t ";(char-numeric? ~A) -> #t?~%" arg))) cap-a-to-z) (for-each (lambda (arg) (if (char-numeric? arg) (format #t ";(char-numeric? ~A) -> #t?~%" arg))) a-to-z) (test (char-numeric?) 'error) (test (char-numeric? #\a #\b) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-whitespace? (test (char-whitespace? #\a) #f) (test (char-whitespace? #\A) #f) (test (char-whitespace? #\z) #f) (test (char-whitespace? #\Z) #f) (test (char-whitespace? #\0) #f) (test (char-whitespace? #\9) #f) (test (char-whitespace? #\space) #t) (test (char-whitespace? #\tab) #t) (test (char-whitespace? #\newline) #t) (test (char-whitespace? #\return) #t) (test (char-whitespace? #\linefeed) #t) (test (char-whitespace? #\null) #f) (test (char-whitespace? #\;) #f) (test (char-whitespace? #\xb) #t) (test (char-whitespace? #\x0b) #t) (test (char-whitespace? #\xc) #t) (test (char-whitespace? #\xd) #t) ; #\return (test (char-whitespace? #\xe) #f) ;; unicode whitespace apparently: (test (char-whitespace? (integer->char 9)) #t) (test (char-whitespace? (integer->char 10)) #t) (test (char-whitespace? (integer->char 11)) #t) (test (char-whitespace? (integer->char 12)) #t) (test (char-whitespace? (integer->char 13)) #t) (test (char-whitespace? (integer->char 32)) #t) (test (char-whitespace? (integer->char 133)) #t) (test (char-whitespace? (integer->char 160)) #t) (for-each (lambda (arg) (if (char-whitespace? arg) (format #t ";(char-whitespace? ~A) -> #t?~%" arg))) mixed-a-to-z) (for-each (lambda (arg) (if (char-whitespace? arg) (format #t ";(char-whitespace? ~A) -> #t?~%" arg))) digits) (test (char-whitespace?) 'error) (test (char-whitespace? #\a #\b) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-alphabetic? (test (char-alphabetic? #\a) #t) (test (char-alphabetic? #\$) #f) (test (char-alphabetic? #\A) #t) (test (char-alphabetic? #\z) #t) (test (char-alphabetic? #\Z) #t) (test (char-alphabetic? #\0) #f) (test (char-alphabetic? #\9) #f) (test (char-alphabetic? #\space) #f) (test (char-alphabetic? #\;) #f) (test (char-alphabetic? #\.) #f) (test (char-alphabetic? #\-) #f) (test (char-alphabetic? #\_) #f) (test (char-alphabetic? #\^) #f) (test (char-alphabetic? #\[) #f) ;(test (char-alphabetic? (integer->char 200)) #t) ; ?? (test (char-alphabetic? (integer->char 127)) #f) ; backspace (for-each (lambda (arg) (if (char-alphabetic? arg) (format #t ";(char-alphabetic? ~A) -> #t?~%" arg))) digits) (for-each (lambda (arg) (if (not (char-alphabetic? arg)) (format #t ";(char-alphabetic? ~A) -> #f?~%" arg))) mixed-a-to-z) (test (char-alphabetic?) 'error) (test (char-alphabetic? #\a #\b) 'error) (for-each (lambda (op) (for-each (lambda (arg) (test (op arg) 'error)) (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list char-upper-case? char-lower-case? char-upcase char-downcase char-numeric? char-whitespace? char-alphabetic?)) (test (let ((unhappy ())) (do ((i 0 (+ i 1))) ((= i 256)) (let* ((ch (integer->char i)) (chu (char-upcase ch)) (chd (char-downcase ch))) (if (and (not (char=? ch chu)) (not (char-upper-case? chu))) (format #t ";(char-upper-case? (char-upcase ~C)) is #f~%" ch)) (if (and (not (char=? ch chd)) (not (char-lower-case? chd))) (format #t ";(char-lower-case? (char-downcase ~C)) is #f~%" ch)) (if (or (and (not (char=? ch chu)) (not (char=? ch (char-downcase chu)))) (and (not (char=? ch chd)) (not (char=? ch (char-upcase chd)))) (and (not (char=? ch chd)) (not (char=? ch chu))) (not (char-ci=? chu chd)) (not (char-ci=? ch chu)) (and (char-alphabetic? ch) (or (not (char-alphabetic? chd)) (not (char-alphabetic? chu)))) (and (char-numeric? ch) (or (not (char-numeric? chd)) (not (char-numeric? chu)))) (and (char-whitespace? ch) (or (not (char-whitespace? chd)) (not (char-whitespace? chu)))) (and (char-alphabetic? ch) (char-whitespace? ch)) (and (char-numeric? ch) (char-whitespace? ch)) (and (char-alphabetic? ch) (char-numeric? ch))) ;; there are characters that are alphabetic but the result of char-upcase is not an upper-case character ;; 223 for example, or 186 for lower case (set! unhappy (cons (format #f "~C: ~C ~C (~D)~%" ch chu chd i) unhappy))))) unhappy) ()) (for-each (lambda (op) (for-each (lambda (arg) (test (op #\a arg) 'error)) (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list char=? char? char>=? char-ci=? char-ci? char-ci>=?)) (for-each (lambda (op) (for-each (lambda (arg) (test (op arg #\a) 'error)) (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list char=? char? char>=? char-ci=? char-ci? char-ci>=?)) (let () ; check direct opts (define (fc str) (let ((len (length str)) (count 0)) (do ((i 0 (+ i 1))) ((= i len) count) (if (char-whitespace? (string-ref str i)) (set! count (+ count 1))) (if (char-alphabetic? (string-ref str i)) (set! count (+ count 1))) (if (char-numeric? (string-ref str i)) (set! count (+ count 1))) (if (char-lower-case? (string-ref str i)) (set! count (+ count 1))) (if (char-upper-case? (string-ref str i)) (set! count (+ count 1)))))) (test (fc "123 4Ab.2") 10)) ;;; -------------------------------------------------------------------------------- ;;; char=? (test (char=? #\d #\d) #t) (test (char=? #\A #\a) #f) (test (char=? #\d #\x) #f) (test (char=? #\d #\D) #f) (test (char=? #\a #\a) #t) (test (char=? #\A #\B) #f) (test (char=? #\a #\b) #f) (test (char=? #\9 #\0) #f) (test (char=? #\A #\A) #t) (test (char=? #\ #\space) #t) (let ((i (char->integer #\space))) (test (char=? (integer->char i) #\space) #t)) (test (char=? (integer->char (char->integer #\")) #\") #t) (test (char=? #\x65 #\e) #t) (test (char=? #\d #\d #\d #\d) #t) (test (char=? #\d #\d #\x #\d) #f) (test (char=? #\d #\y #\x #\c) #f) (test (apply char=? cap-a-to-z) #f) (test (apply char=? mixed-a-to-z) #f) (test (apply char=? digits) #f) (test (char=? #\d #\c #\d) #f) (test (char=? #\a) 'error) (test (char=?) 'error) (test (char=? #\a 0) 'error) (test (char=? #\a #\b 0) 'error) (test (char=? 90 (integer->char 90)) 'error) (test (char=? 90 #\Z) 'error) (test (char=? #\Z 90) 'error) (test (char=? 1 1) 'error) ;;; -------------------------------------------------------------------------------- ;;; charchar #xf0) (integer->char #x70)) #f) (test (charchar 0) (integer->char 255)) #t) (test (charchar 90)) 'error) (test (charchar 90)) 'error) (test (char<=? 90 #\Z) 'error) (test (char<=? #\Z 90) 'error) ;;; -------------------------------------------------------------------------------- ;;; char>? (test (char>? #\e #\d) #t) (test (char>? #\z #\a) #t) (test (char>? #\A #\B) #f) (test (char>? #\a #\b) #f) (test (char>? #\9 #\0) #t) (test (char>? #\A #\A) #f) (test (char>? #\space #\space) #f) (test (char>? #\d #\c #\b #\a) #t) (test (char>? #\d #\d #\c #\a) #f) (test (char>? #\e #\d #\b #\c #\a) #f) (test (apply char>? a-to-z) #f) (test (apply char>? cap-a-to-z) #f) (test (apply char>? mixed-a-to-z) #f) (test (apply char>? digits) #f) (test (apply char>? (reverse a-to-z)) #t) (test (apply char>? (reverse cap-a-to-z)) #t) (test (apply char>? (reverse mixed-a-to-z)) #f) (test (apply char>? (reverse digits)) #t) (test (char>? #\d #\c #\a) #t) (test (char>? #\d #\c #\c) #f) (test (char>? #\B #\B #\C) #f) (test (char>? #\b #\c #\e) #f) (test (char>? (integer->char #xf0) (integer->char #x70)) #t) (test (char>? #\a #\b "hi") 'error) (test (char>? #\a #\b 0) 'error) (test (char>?) 'error) (test (char>? 90 (integer->char 90)) 'error) (test (char>? 90 #\Z) 'error) (test (char>? #\Z 90) 'error) ;;; -------------------------------------------------------------------------------- ;;; char>=? (test (char>=? #\e #\d) #t) (test (char>=? #\A #\B) #f) (test (char>=? #\a #\b) #f) (test (char>=? #\9 #\0) #t) (test (char>=? #\A #\A) #t) (test (char>=? #\space #\space) #t) (test (char>=? #\d #\c #\b #\a) #t) (test (char>=? #\d #\d #\c #\a) #t) (test (char>=? #\e #\d #\b #\c #\a) #f) (test (apply char>=? a-to-z) #f) (test (apply char>=? cap-a-to-z) #f) (test (apply char>=? mixed-a-to-z) #f) (test (apply char>=? digits) #f) (test (apply char>=? (reverse a-to-z)) #t) (test (apply char>=? (reverse cap-a-to-z)) #t) (test (apply char>=? (reverse mixed-a-to-z)) #f) (test (apply char>=? (reverse digits)) #t) (test (char>=? #\d #\c #\a) #t) (test (char>=? #\d #\c #\c) #t) (test (char>=? #\B #\B #\C) #f) (test (char>=? #\b #\c #\e) #f) (test (char>=? #\a #\b "hi") 'error) (test (char>=? #\a #\b 0) 'error) (test (char>=?) 'error) (test (char>=? 90 (integer->char 90)) 'error) (test (char>=? 90 #\Z) 'error) (test (char>=? #\Z 90) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-ci=? (test (char-ci=? #\A #\B) #f) (test (char-ci=? #\a #\B) #f) (test (char-ci=? #\A #\b) #f) (test (char-ci=? #\a #\b) #f) (test (char-ci=? #\9 #\0) #f) (test (char-ci=? #\A #\A) #t) (test (char-ci=? #\A #\a) #t) (test (char-ci=? #\a #\A) #t) (test (char-ci=? #\space #\space) #t) (test (char-ci=? #\d #\D #\d #\d) #t) (test (char-ci=? #\d #\d #\X #\d) #f) (test (char-ci=? #\d #\Y #\x #\c) #f) (test (apply char-ci=? cap-a-to-z) #f) (test (apply char-ci=? mixed-a-to-z) #f) (test (apply char-ci=? digits) #f) (test (char-ci=? #\d #\c #\d) #f) (test (char-ci=?) 'error) (test (char-ci=? #\a #\b 0) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-ci? (integer->char #xf0) (integer->char #x70)) #t) #| ;; this tries them all: (do ((i 0 (+ i 1))) ((= i 256)) (do ((k 0 (+ k 1))) ((= k 256)) (let ((c1 (integer->char i)) (c2 (integer->char k))) (for-each (lambda (op1 op2) (if (not (eq? (op1 c1 c2) (op2 (string c1) (string c2)))) (format #t ";(~A|~A ~A ~A) -> ~A|~A~%" op1 op2 c1 c2 (op1 c1 c2) (op2 (string c1) (string c2))))) (list char=? char? char>=? char-ci=? char-ci? char-ci>=?) (list string=? string? string>=? string-ci=? string-ci? string-ci>=?))))) |# (test (char-ci? #\a #\b "hi") 'error) (test (char-ci>? #\a #\b 0) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-ci>? (test (char-ci>? #\A #\B) #f) (test (char-ci>? #\a #\B) #f) (test (char-ci>? #\A #\b) #f) (test (char-ci>? #\a #\b) #f) (test (char-ci>? #\9 #\0) #t) (test (char-ci>? #\A #\A) #f) (test (char-ci>? #\A #\a) #f) (test (char-ci>? #\^ #\a) #t) (test (char-ci>? #\_ #\e) #t) (test (char-ci>? #\[ #\S) #t) (test (char-ci>? #\\ #\l) #t) (test (char-ci>? #\t #\_) #f) (test (char-ci>? #\a #\]) #f) (test (char-ci>? #\z #\^) #f) (test (char-ci>? #\] #\X) #t) (test (char-ci>? #\d #\D #\d #\d) #f) (test (char-ci>? #\d #\d #\X #\d) #f) (test (char-ci>? #\d #\Y #\x #\c) #f) (test (apply char-ci>? cap-a-to-z) #f) (test (apply char-ci>? mixed-a-to-z) #f) (test (apply char-ci>? (reverse mixed-a-to-z)) #t) (test (apply char-ci>? digits) #f) (test (char-ci>? #\d #\c #\d) #f) (test (char-ci>? #\b #\c #\a) #f) (test (char-ci>? #\d #\C #\a) #t) ;;; -------------------------------------------------------------------------------- ;;; char-ci<=? (test (char-ci<=? #\A #\B) #t) (test (char-ci<=? #\a #\B) #t) (test (char-ci<=? #\A #\b) #t) (test (char-ci<=? #\a #\b) #t) (test (char-ci<=? #\9 #\0) #f) (test (char-ci<=? #\A #\A) #t) (test (char-ci<=? #\A #\a) #t) (test (char-ci<=? #\` #\H) #f) (test (char-ci<=? #\[ #\m) #f) (test (char-ci<=? #\j #\`) #t) (test (char-ci<=? #\\ #\E) #f) (test (char-ci<=? #\t #\_) #t) (test (char-ci<=? #\a #\]) #t) (test (char-ci<=? #\z #\^) #t) (test (char-ci<=? #\d #\D #\d #\d) #t) (test (char-ci<=? #\d #\d #\X #\d) #f) (test (char-ci<=? #\d #\Y #\x #\c) #f) (test (apply char-ci<=? cap-a-to-z) #t) (test (apply char-ci<=? mixed-a-to-z) #t) (test (apply char-ci<=? digits) #t) (test (char-ci<=? #\d #\c #\d) #f) (test (char-ci<=? #\b #\c #\a) #f) (test (char-ci<=? #\b #\c #\C) #t) (test (char-ci<=? #\b #\C #\e) #t) (test (char-ci<=? #\b #\a "hi") 'error) (test (char-ci<=? #\b #\a 0) 'error) ;;; -------------------------------------------------------------------------------- ;;; char-ci>=? (test (char-ci>=? #\A #\B) #f) (test (char-ci>=? #\a #\B) #f) (test (char-ci>=? #\A #\b) #f) (test (char-ci>=? #\a #\b) #f) (test (char-ci>=? #\9 #\0) #t) (test (char-ci>=? #\A #\A) #t) (test (char-ci>=? #\A #\a) #t) (test (char-ci>=? #\Y #\_) #f) (test (char-ci>=? #\` #\S) #t) (test (char-ci>=? #\[ #\Y) #t) (test (char-ci>=? #\t #\_) #f) (test (char-ci>=? #\a #\]) #f) (test (char-ci>=? #\z #\^) #f) (test (char-ci>=? #\d #\D #\d #\d) #t) (test (char-ci>=? #\d #\d #\X #\d) #f) (test (char-ci>=? #\d #\Y #\x #\c) #f) (test (apply char-ci>=? cap-a-to-z) #f) (test (apply char-ci>=? mixed-a-to-z) #f) (test (apply char-ci>=? (reverse mixed-a-to-z)) #t) (test (apply char-ci>=? digits) #f) (test (char-ci>=? #\d #\c #\d) #f) (test (char-ci>=? #\b #\c #\a) #f) (test (char-ci>=? #\d #\D #\a) #t) (test (char-ci>=? #\\ #\J #\+) #t) (test (char-ci>=? #\a #\b "hi") 'error) (test (char-ci>=? #\a #\b 0) 'error) ) ; end let with a-to-z ;;; -------------------------------------------------------------------------------- ;;; integer->char ;;; char->integer (test (integer->char (char->integer #\.)) #\.) (test (integer->char (char->integer #\A)) #\A) (test (integer->char (char->integer #\a)) #\a) (test (integer->char (char->integer #\space)) #\space) (test (char->integer (integer->char #xf0)) #xf0) (do ((i 0 (+ i 1))) ((= i 256)) (if (not (= (char->integer (integer->char i)) i)) (format #t ";char->integer ~D ~A != ~A~%" i (integer->char i) (char->integer (integer->char i))))) (test (reinvert 12 integer->char char->integer 60) 60) (test (char->integer 33) 'error) (test (char->integer) 'error) (test (integer->char) 'error) (test (integer->char (expt 2 31)) 'error) (test (integer->char (expt 2 32)) 'error) (test (integer->char 12 14) 'error) (test (char->integer #\a #\b) 'error) ;(test (char->integer #\ÿ) 255) ; emacs confusion? (test (eval-string (string-append "(char->integer " (format #f "#\\~C" (integer->char 255)) ")")) 255) (for-each (lambda (arg) (test (char->integer arg) 'error)) (list -1 1 0 123456789 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (integer->char arg) 'error)) (list -1 257 123456789 -123456789 #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi most-positive-fixnum 1/0 (if #f #f) (lambda (a) (+ a 1)))) (test (#\a) 'error) (test (#\newline 1) 'error) ;;; -------------------------------------------------------------------------------- ;;; STRINGS ;;; -------------------------------------------------------------------------------- ;;; -------------------------------------------------------------------------------- ;;; string? (test (string? "abc") #t) (test (string? ':+*/-) #f) (test (string? "das ist einer der teststrings") #t) (test (string? '(das ist natuerlich falsch)) #f) (test (string? "aaaaaa") #t) (test (string? #\a) #f) (test (string? "\"\\\"") #t) (test (string? lambda) #f) (test (string? format) #f) (for-each (lambda (arg) (test (string? arg) #f)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (string?) 'error) (test (string? "hi" "ho") 'error) (test (string? #\null) #f) ;;; -------------------------------------------------------------------------------- ;;; string=? (test (string=? "foo" "foo") #t) (test (string=? "foo" "FOO") #f) (test (string=? "foo" "bar") #f) (test (string=? "FOO" "FOO") #t) (test (string=? "A" "B") #f) (test (string=? "a" "b") #f) (test (string=? "9" "0") #f) (test (string=? "A" "A") #t) (test (string=? "" "") #t) (test (string=? (string #\newline) (string #\newline)) #t) (test (string=? "A" "B" "a") #f) (test (string=? "A" "A" "a") #f) (test (string=? "A" "A" "A") #t) (test (string=? "foo" "foo" "foo") #t) (test (string=? "foo" "foo" "") #f) (test (string=? "foo" "foo" "fOo") #f) (test (string=? "foo" "FOO" 1.0) 'error) (let ((str "01234567")) (test (length str) 8) (set! str (reverse! str)) (test (string=? "76543210" str) #t) ; checking the bswap case in s7 (set! str "012345670123456701234567012345670123456701234567") (test (length str) 48) (set! str (reverse! str)) (string=? str "765432107654321076543210765432107654321076543210") (set! str "0123456") (set! str (reverse! str)) (test (string=? "6543210" str) #t)) (test (let ((str (string #\" #\1 #\\ #\2 #\"))) (string=? str "\"1\\2\"")) #t) (test (let ((str (string #\\ #\\ #\\))) (string=? str "\\\\\\")) #t) (test (let ((str (string #\"))) (string=? str "\"")) #t) (test (let ((str (string #\\ #\"))) (string=? str "\\\"")) #t) (test (let ((str (string #\space #\? #\)))) (string=? str " ?)")) #t) (test (let ((str (string #\# #\\ #\t))) (string=? str "#\\t")) #t) (test (string=? (string #\x (integer->char #xf0) #\x) (string #\x (integer->char #x70) #\x)) #f) (test (string=? (string #\x (integer->char #xf0) #\x) (string #\x (integer->char #xf0) #\x)) #t) (test (string=? "\x65;\x65;" "ee") #t) (test (string=? "\"\\\n\t\r\/\b\f\x65;\"" "\x22;\x5c;\xa;\x09;\xd;\x2f;\x8;\xc;e\x22;") #t) (test (string=? (string) "") #t) (test (string=? (string) (make-string 0)) #t) (test (string=? (string-copy (string)) (make-string 0)) #t) (test (string=? "" (make-string 0)) #t) (test (string=? "" (string-append)) #t) (test (string=? (string #\space #\newline) " \n") #t) (test (string=? "......" "...\ ...") #t) (test (string=? "\n" (string #\newline)) #t) (test (string=? "\ \ \ \ " "") #t) (test (string=? "" (string #\null)) #f) (test (string=? (string #\null #\null) (string #\null)) #f) (test (string=? "" "asd") #f) (test (string=? "asd" "") #f) (test (string=? "xx" (make-string 2 #\x) (string #\x #\x) (list->string (list #\x #\x)) (substring "axxb" 1 3) (string-append "x" "x")) #t) (test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #f) (test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #t) (test (let ((s1 "1234") (s2 "124")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #f) (test (string=? (make-string 3 #\space) (let ((s (make-string 4 #\space))) (set! (s 3) #\null) s)) #f) (test "\x3012;" "0\x12;") ; \x30 = 48 = #\0 (for-each (lambda (arg) (test (string=? "hi" arg) 'error) (test (string=? arg "hi") 'error)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;; this strikes me as highly dubious (test (call-with-input-string "1\n2" (lambda (p) (read p))) 1) (test (call-with-input-string "1\\ \n2" (lambda (p) (read p))) (symbol "1\\")) (test (eval (with-input-from-string "(symbol \"(\\\")\")" read)) (symbol "(\")")) (test (call-with-input-string "1\ 2" (lambda (p) (read p))) 12) ;; do we guarantee that read takes place in the current environment? no... (test (call-with-input-string "fl\ oor" read) 'floor) (test (call-with-input-string "p\ i" (lambda (p) (eval (read p)))) pi) (test (call-with-input-string "(+ 1;\ this is presumably a comment 1)" (lambda (p) (eval (read p)))) 2) (test (call-with-input-string "(+ 1;\ this is presumably a comment;\ and more commentary 1)" (lambda (p) (eval (read p)))) 2) (test (string=? (string #\1) (byte-vector 2)) 'error) ; changed 18-June-18 (let () (define (func) (let ((x #f) (i 0)) (if (not x) (string=? (immutable! "asdf") :frequency)))) (test (func) 'error)) ;;; -------------------------------------------------------------------------------- ;;; stringchar #xf0)) (string (integer->char #x70))) #f) (for-each (lambda (arg) (test (string? (test (string>? "aaab" "aaaa") #t) (test (string>? "aaaaa" "aaaa") #t) (test (string>? "" "abcdefgh") #f) (test (string>? "a" "abcdefgh") #f) (test (string>? "abc" "abcdefgh") #f) (test (string>? "cabc" "abcdefgh") #t) (test (string>? "abcdefgh" "abcdefgh") #f) (test (string>? "xyzabc" "abcdefgh") #t) (test (string>? "abc" "xyzabcdefgh") #f) (test (string>? "abcdefgh" "") #t) (test (string>? "abcdefgh" "a") #t) (test (string>? "abcdefgh" "abc") #t) (test (string>? "abcdefgh" "cabc") #f) (test (string>? "abcdefgh" "xyzabc") #f) (test (string>? "xyzabcdefgh" "abc") #t) (test (string>? "abcde" "bc") #f) (test (string>? "bcdef" "abcde") #t) (test (string>? "bcdef" "abcdef") #t) (test (string>? "" "") #f) (test (string>? "A" "B") #f) (test (string>? "a" "b") #f) (test (string>? "9" "0") #t) (test (string>? "A" "A") #f) (test (string>? "A" "B" "a") #f) (test (string>? "C" "B" "A") #t) (test (string>? "A" "A" "A") #f) (test (string>? "B" "B" "A") #f) (test (string>? "foo" "foo" "foo") #f) (test (string>? "foo" "foo" "") #f) (test (string>? "foo" "foo" "fOo") #f) (test (string>? "foo" "fooo" 1.0) 'error) (test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>? s1 s2)) #f) (test (let ((s1 "1234") (s2 "123")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>? s1 s2)) #t) (test (let ((s1 "123") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>? s1 s2)) #f) (test (string>? (string (integer->char #xf0)) (string (integer->char #x70))) #t) ; ?? (for-each (lambda (arg) (test (string>? "hi" arg) 'error) (test (string>? arg "hi") 'error)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;;; -------------------------------------------------------------------------------- ;;; string<=? (test (string<=? "aaa" "aaaa") #t) (test (string<=? "aaaaa" "aaaa") #f) (test (string<=? "a" "abcdefgh") #t) (test (string<=? "abc" "abcdefgh") #t) (test (string<=? "aaabce" "aaabcdefgh") #f) (test (string<=? "cabc" "abcdefgh") #f) (test (string<=? "abcdefgh" "abcdefgh") #t) (test (string<=? "xyzabc" "abcdefgh") #f) (test (string<=? "abc" "xyzabcdefgh") #t) (test (string<=? "abcdefgh" "") #f) (test (string<=? "abcdefgh" "a") #f) (test (string<=? "abcdefgh" "abc") #f) (test (string<=? "abcdefgh" "cabc") #t) (test (string<=? "abcdefgh" "xyzabc") #t) (test (string<=? "xyzabcdefgh" "abc") #f) (test (string<=? "abcdef" "bcdefgh") #t) (test (string<=? "" "") #t) (test (string<=? "A" "B") #t) (test (string<=? "a" "b") #t) (test (string<=? "9" "0") #f) (test (string<=? "A" "A") #t) (test (string<=? "A" "B" "C") #t) (test (string<=? "C" "B" "A") #f) (test (string<=? "A" "B" "B") #t) (test (string<=? "A" "A" "A") #t) (test (string<=? "B" "B" "A") #f) (test (string<=? "foo" "foo" "foo") #t) (test (string<=? "foo" "foo" "") #f) (test (string<=? "foo" "foo" "fooo") #t) (test (string<=? "foo" "fo" 1.0) 'error) (test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<=? s1 s2)) #t) (test (let ((s1 "1234") (s2 "123")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<=? s1 s2)) #f) (test (let ((s1 "123") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<=? s1 s2)) #t) (test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<=? s1 s2)) #t) (for-each (lambda (arg) (test (string<=? "hi" arg) 'error) (test (string<=? arg "hi") 'error)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;;; -------------------------------------------------------------------------------- ;;; string>=? (test (string>=? "aaaaa" "aaaa") #t) (test (string>=? "aaaa" "aaaa") #t) (test (string>=? "aaa" "aaaa") #f) (test (string>=? "" "abcdefgh") #f) (test (string>=? "a" "abcdefgh") #f) (test (string>=? "abc" "abcdefgh") #f) (test (string>=? "cabc" "abcdefgh") #t) (test (string>=? "abcdefgh" "abcdefgh") #t) (test (string>=? "xyzabc" "abcdefgh") #t) (test (string>=? "abc" "xyzabcdefgh") #f) (test (string>=? "abcdefgh" "") #t) (test (string>=? "abcdefgh" "a") #t) (test (string>=? "abcdefgh" "abc") #t) (test (string>=? "abcdefgh" "cabc") #f) (test (string>=? "abcdefgh" "xyzabc") #f) (test (string>=? "xyzabcdefgh" "abc") #t) (test (string>=? "bcdef" "abcdef") #t) (test (string>=? "A" "B") #f) (test (string>=? "a" "b") #f) (test (string>=? "9" "0") #t) (test (string>=? "A" "A") #t) (test (string>=? "" "") #t) (test (string>=? "A" "B" "C") #f) (test (string>=? "C" "B" "A") #t) (test (string>=? "C" "B" "B") #t) (test (string>=? "A" "B" "B") #f) (test (string>=? "A" "A" "A") #t) (test (string>=? "B" "B" "A") #t) (test (string>=? "B" "B" "C") #f) (test (string>=? "foo" "foo" "foo") #t) (test (string>=? "foo" "foo" "") #t) (test (string>=? "foo" "foo" "fo") #t) (test (string>=? "fo" "foo" 1.0) 'error) (test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>=? s1 s2)) #f) (test (let ((s1 "1234") (s2 "123")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>=? s1 s2)) #t) (test (let ((s1 "123") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>=? s1 s2)) #f) (test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string>=? s1 s2)) #t) (for-each (lambda (arg) (test (string>=? "hi" arg) 'error) (test (string>=? arg "hi") 'error)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;;; -------------------------------------------------------------------------------- ;;; string-ci=? (test (string-ci=? "A" "B") #f) (test (string-ci=? "a" "B") #f) (test (string-ci=? "A" "b") #f) (test (string-ci=? "a" "b") #f) (test (string-ci=? "9" "0") #f) (test (string-ci=? "A" "A") #t) (test (string-ci=? "A" "a") #t) (test (string-ci=? "" "") #t) (test (string-ci=? "aaaa" "AAAA") #t) (test (string-ci=? "aaaa" "Aaaa") #t) (test (string-ci=? "A" "B" "a") #f) (test (string-ci=? "A" "A" "a") #t) (test (string-ci=? "A" "A" "a") #t) (test (string-ci=? "foo" "foo" "foo") #t) (test (string-ci=? "foo" "foo" "") #f) (test (string-ci=? "foo" "Foo" "fOo") #t) (test (string-ci=? "foo" "GOO" 1.0) 'error) (test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #f) (test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #t) (test (let ((s1 "1234") (s2 "124")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #f) (test (let ((s1 "abcd") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #t) (test (let ((s1 "abcd") (s2 "ABCE")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #f) (test (let ((s1 "abcd") (s2 "ABC")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci=? s1 s2)) #f) (for-each (lambda (arg) (test (string-ci=? "hi" arg) 'error) (test (string-ci=? arg "hi") 'error)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (when full-s7test (let ((size 15) (tries 10000)) (let ((str1 (make-string size)) (str2 (make-string size))) (do ((i 0 (+ i 1))) ((= i tries)) (do ((k 0 (+ k 1))) ((= k size)) (set! (str1 k) (integer->char (random 128))) (if (> (random 10) 4) (set! (str2 k) (char-upcase (str1 k))) (set! (str2 k) (char-downcase (str1 k))))) (if (not (string-ci=? str1 str2)) (format #t "not =: ~S ~S~%" str1 str2)) (if (and (string-ci=? str1 str2)) (format #t "< : ~S ~S~%" str1 str2)) (if (and (string-ci>? str1 str2) (string-ci<=? str1 str2)) (format #t "> : ~S ~S~%" str1 str2)))))) ;;; -------------------------------------------------------------------------------- ;;; string-ciP" "DMhk3Bg") #f) (test (string-cichar #xf0) (integer->char #x70)) (test (string-cichar #xf0)) (string (integer->char #x70))) #t)) (test (string-ci=? "test" "tes") #t) (test (string-ci>? "test" "tes") #t) (test (string-ci<=? "tes" "test") #t) (test (string-ci=? "tes" "test") #f) (test (string-ci>? "tes" "test") #f) ;;; -------------------------------------------------------------------------------- ;;; string-ci>? (test (string-ci>? "Aaa" "AA") #t) (test (string-ci>? "A" "B") #f) (test (string-ci>? "a" "B") #f) (test (string-ci>? "A" "b") #f) (test (string-ci>? "a" "b") #f) (test (string-ci>? "9" "0") #t) (test (string-ci>? "A" "A") #f) (test (string-ci>? "A" "a") #f) (test (string-ci>? "" "") #f) (test (string-ci>? "Z" "DjNTl0") #t) (test (string-ci>? "2399dt7BVN[,A" "^KHboHV") #f) (test (string-ci>? "t" "_") #f) (test (string-ci>? "a" "]") #f) (test (string-ci>? "z" "^") #f) (test (string-ci>? "R*95oG.k;?" "`2?J6LBbLG^alB[fMD") #f) (test (string-ci>? "]" "X") #t) (test (string-ci>? "A" "B" "a") #f) (test (string-ci>? "C" "b" "A") #t) (test (string-ci>? "a" "A" "A") #f) (test (string-ci>? "B" "B" "A") #f) (test (string-ci>? "foo" "foo" "foo") #f) (test (string-ci>? "foo" "foo" "") #f) (test (string-ci>? "foo" "foo" "fOo") #f) (test (string-ci>? "ZNiuEa@/V" "KGbKliYMY" "9=69q3ica" ":]") #f) (test (string-ci>? "^" "aN@di;iEO" "7*9q6uPmX9)PaY,6J" "15vH") #t) (test (string-ci>? "foo" "fooo" 1.0) 'error) (test (let ((s1 "abcd") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>? s1 s2)) #f) (test (let ((s1 "abcd") (s2 "ABCE")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>? s1 s2)) #f) (test (let ((s1 "abcd") (s2 "ABC")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>? s1 s2)) #t) (test (let ((s1 "abc") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>? s1 s2)) #f) (for-each (lambda (arg) (test (string-ci>? "hi" arg) 'error) (test (string-ci>? arg "hi") 'error)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;;; -------------------------------------------------------------------------------- ;;; string-ci<=? (test (string-ci<=? "A" "B") #t) (test (string-ci<=? "a" "B") #t) (test (string-ci<=? "A" "b") #t) (test (string-ci<=? "a" "b") #t) (test (string-ci<=? "9" "0") #f) (test (string-ci<=? "A" "A") #t) (test (string-ci<=? "A" "a") #t) (test (string-ci<=? "" "") #t) (test (string-ci<=? ":LPC`" ",O0>affA?(") #f) (test (string-ci<=? "t" "_") #t) (test (string-ci<=? "a" "]") #t) (test (string-ci<=? "z" "^") #t) (test (string-ci<=? "G888E>beF)*mwCNnagP" "`2uTd?h") #t) (test (string-ci<=? "A" "b" "C") #t) (test (string-ci<=? "c" "B" "A") #f) (test (string-ci<=? "A" "B" "B") #t) (test (string-ci<=? "a" "A" "A") #t) (test (string-ci<=? "B" "b" "A") #f) (test (string-ci<=? "foo" "foo" "foo") #t) (test (string-ci<=? "foo" "foo" "") #f) (test (string-ci<=? "FOO" "fOo" "fooo") #t) (test (string-ci<=? "78mdL82*" "EFaCrIdm@_D+" "eMu\\@dSSY") #t) (test (string-ci<=? "`5pNuFc3PM=? (test (string-ci>=? "A" "B") #f) (test (string-ci>=? "a" "B") #f) (test (string-ci>=? "A" "b") #f) (test (string-ci>=? "a" "b") #f) (test (string-ci>=? "9" "0") #t) (test (string-ci>=? "A" "A") #t) (test (string-ci>=? "A" "a") #t) (test (string-ci>=? "" "") #t) (test (string-ci>=? "5d7?[o[:hop=ktv;9)" "p^r9;TAXO=^") #f) (test (string-ci>=? "t" "_") #f) (test (string-ci>=? "a" "]") #f) (test (string-ci>=? "z" "^") #f) (test (string-ci>=? "jBS" "`<+s[[:`l") #f) (test (string-ci>=? "A" "b" "C") #f) (test (string-ci>=? "C" "B" "A") #t) (test (string-ci>=? "C" "B" "b") #t) (test (string-ci>=? "a" "B" "B") #f) (test (string-ci>=? "A" "A" "A") #t) (test (string-ci>=? "B" "B" "A") #t) (test (string-ci>=? "B" "b" "C") #f) (test (string-ci>=? "foo" "foo" "foo") #t) (test (string-ci>=? "foo" "foo" "") #t) (test (string-ci>=? "foo" "foo" "fo") #t) (test (string-ci>=? "tF?8`Sa" "NIkMd7" "f`" "1td-Z?teE" "-ik1SK)hh)Nq].>") #t) (test (string-ci>=? "Z6a8P" "^/VpmWwt):?o[a9\\_N" "8[^h)=? "fo" "foo" 1.0) 'error) (test (let ((s1 "abcd") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>=? s1 s2)) #t) (test (let ((s1 "abcd") (s2 "ABCE")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>=? s1 s2)) #f) (test (let ((s1 "abcd") (s2 "ABC")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>=? s1 s2)) #t) (test (let ((s1 "abc") (s2 "ABCD")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string-ci>=? s1 s2)) #f) (for-each (lambda (arg) (test (string-ci>=? "hi" arg) 'error) (test (string-ci>=? arg "hi") 'error)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;;; -------------------------------------------------------------------------------- ;;; string-length (test (string-length "abc") 3) (test (string-length "") 0) (test (string-length (string)) 0) (test (string-length "\"\\\"") 3) (test (string-length (string #\newline)) 1) (test (string-length "hi there") 8) (test (string-length "\"") 1) (test (string-length "\\") 1) (test (string-length "\n") 1) (test (string-length (make-string 100 #\a)) 100) (test (string-length "1\\2") 3) (test (string-length "1\\") 2) (test (string-length "hi\\") 3) (test (string-length "\\\\\\\"") 4) (test (string-length "A ; comment") 11) (test (string-length "#| comment |#") 13) (test (string-length "'123") 4) (test (string-length '"'123") 4) (test (let ((str (string #\# #\\ #\t))) (string-length str)) 3) (test (string-length "#\\(") 3) (test (string-length ")()") 3) (test (string-length "(()") 3) (test (string-length "(string #\\( #\\+ #\\space #\\1 #\\space #\\3 #\\))") 44) (test (string-length) 'error) (test (string-length "hi" "ho") 'error) (test (string-length (string #\null)) 1) ; ? (test (string-length (string #\null #\null)) 2) ; ? (test (string-length (string #\null #\newline)) 2) ; ? (test (string-length ``"hi") 2) ; ?? and in s7 ,"hi" is "hi" as with numbers (test (string-length ";~S ~S") 6) (test (string-length "\n;~S ~S") 7) (test (string-length "\n\t") 2) (test (string-length "#\newline") 8) (test (string-length "#\tab") 4) (test (string-length "a\x00;b") 3) (test (string-length "123\ 456") 6) (test (string-length"123\n 456") 8) (test (string-length"123\n\ 456") 7) (for-each (lambda (arg) (test (string-length arg) 'error)) (list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (string? "[a-zA-Z_\x7f-\xff][a-zA-Z0-9_\x7f-\xff]*") #t) (test (format #f "\x7f;~a" 1) (string #\delete #\1)) (test (format #f "\x00;~a\xff;" 1) (string #\null #\1 #\xff)) (test (format #f "\x44;") "D") (test (format #f "\x44") "D") (test (format #f "\x44;o") "Do") (test (format #f "\x9") (string #\tab)) (test (string? "\x7") #t) (test (string? "\x7f") #t) (test (string? "\x7ff") #t) (test (string? "\x7fff") #t) (test (string? "\x7fff") #t) ;(test (string? "\xH") 'error) ;(string? "\x7H") ; an error in Guile (test (string? "\x7fH") #t) (test (string? "\x7ffH") #t) (test (string? "\x7fffH") #t) (test (string? "\x7fffH") #t) ;;; what is correct here? r7rs seems to say the semicolon is needed if we're in a string constant?? ;;; tests changed to include semicolon 1-Mar-22 ;;; -------------------------------------------------------------------------------- ;;; string (for-each (lambda (arg) (test (string #\a arg) 'error) (test (string #\a #\null arg) 'error) (test (string arg) 'error)) (list () (list 1) '(1 . 2) "a" #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (string) "") (test (string #\a #\b #\c) "abc") (test (string #\a) "a") (test (map string '(#\a #\b)) '("a" "b")) (test (map string '(#\a #\b) '(#\c #\d)) '("ac" "bd")) (test (map string '(#\a #\b #\c) '(#\d #\e #\f) '(#\g #\h #\i)) '("adg" "beh" "cfi")) (test (map string "abc" "def" "ghi") '("adg" "beh" "cfi")) (test (string #\" #\# #\") "\"#\"") (test (string #\\ #\\ #\# #\\ #\# #\#) "\\\\#\\##") (test (string #\' #\' #\` #\") '"''`\"") ;;; some schemes accept \' and other such sequences in a string, but the spec only mentions \\ and \" (test (string ()) 'error) (test (string "j" #\a) 'error) (test (string (values #\a #\b #\c)) "abc") ;;; -------------------------------------------------------------------------------- ;;; make-string (test (make-string 0) "") (test (make-string 3 #\a) "aaa") (test (make-string 0 #\a) "") (test (make-string 3 #\space) " ") (test (let ((hi (make-string 3 #\newline))) (string-length hi)) 3) (test (make-string (* 8796093022208 8796093022208)) 'error) (test (make-string 8796093022208) 'error) (test (make-string -1) 'error) (test (make-string -0) "") (test (make-string 2 #\a #\b) 'error) (test (make-string) 'error) (test (make-string most-positive-fixnum) 'error) (test (make-string most-negative-fixnum) 'error) (let () (define (hi size) (make-string size (integer->char (+ 1 (random 255))))) (string? (hi 3))) (for-each (lambda (arg) (test (make-string 3 arg) 'error)) (list "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (make-string arg #\a) 'error)) (list #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (make-string arg) 'error)) (list #\a "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (make-string 0 #f) 'error) (let ((strs (vector "a"))) ; make_string_p_i from tbig (define (string-sorter) (do ((i 0 (+ i 1))) ((= i 1) strs) (copy (vector-ref strs i) (make-string 1)) (copy (vector-ref strs i) (make-string 0)))) (string-sorter)) ;;; -------------------------------------------------------------------------------- ;;; string-ref (test (string-ref "abcdef-dg1ndh" 0) #\a) (test (string-ref "abcdef-dg1ndh" 1) #\b) (test (string-ref "abcdef-dg1ndh" 6) #\-) (test (string-ref "\"\\\"" 1) #\\) (test (string-ref "\"\\\"" 2) #\") (test (let ((str (make-string 3 #\x))) (set! (string-ref str 1) #\a) str) "xax") (test (string-ref "abcdef-dg1ndh" 20) 'error) (test (string-ref "abcdef-dg1ndh") 'error) (test (string-ref "abcdef-dg1ndh" -3) 'error) (test (string-ref) 'error) (test (string-ref 2) 'error) (test (string-ref "\"\\\"" 3) 'error) (test (string-ref "" 0) 'error) (test (string-ref "" 1) 'error) (test (string-ref "hiho" (expt 2 32)) 'error) (test (char=? (string-ref (string #\null) 0) #\null) #t) (test (char=? (string-ref (string #\1 #\null #\2) 1) #\null) #t) (test (char=? ("1\x002;" 1) #\null) #t) (test (char=? (string-ref (string #\newline) 0) #\newline) #t) (test (char=? (string-ref (string #\space) 0) #\space) #t) (for-each (lambda (arg) (test (string-ref arg 0) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (string-ref "hiho" arg) 'error)) (list #\a -1 123 4 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test ("hi" 1) #\i) (test (("hi" 1) 0) 'error) (test ("hi" 1 2) 'error) (test ("" 0) 'error) (test (set! ("" 0) #\a) 'error) (test (set! ("hi" 1 2) #\a) 'error) (test (set! ("hi" 1) #\a #\b) 'error) (test ("hi") 'error) (test ("") 'error) (test ((let () "hi")) 'error) (test ((let () "hi") 0) #\h) (test ("abs" most-negative-fixnum) 'error) (test (string-ref "abs" most-negative-fixnum) 'error) (test ("abs" (+ 1 most-negative-fixnum)) 'error) (test ("abs" most-positive-fixnum) 'error) (test (catch #t (lambda () ("hi" 1 2)) (lambda (t i) (apply format #f i))) "string ref: too many indices: (\"hi\" 1 2)") (let ((strs (vector "abc")) ; string_ref_p_pi (str #f)) (define (string-sorter) (do ((i 0 (+ i 1))) ((= i 1) str) (set! str (string (string-ref strs i))))) (test (string-sorter) 'error)) ;;; -------------------------------------------------------------------------------- ;;; string-copy (test (let ((hi (string-copy "hi"))) (string-set! hi 0 #\H) hi) "Hi") (test (let ((hi (string-copy "hi"))) (string-set! hi 1 #\H) hi) "hH") (test (let ((hi (string-copy "\"\\\""))) (string-set! hi 0 #\a) hi) "a\\\"") (test (let ((hi (string-copy "\"\\\""))) (string-set! hi 1 #\a) hi) "\"a\"") (test (let ((hi (string #\a #\newline #\b))) (string-set! hi 1 #\c) hi) "acb") (test (string-copy "ab") "ab") (test (string-copy "") "") (test (string-copy "\"\\\"") "\"\\\"") (test (let ((hi "abc")) (eq? hi (string-copy hi))) #f) (test (let ((hi (string-copy (make-string 8 (integer->char 0))))) (string-fill! hi #\a) hi) "aaaaaaaa") (test (string-copy (string-copy (string-copy "a"))) "a") (test (string-copy (string-copy (string-copy ""))) "") (test (string-copy "a\x00;b") "a\x00;b") ; prints normally as "a" however (test (string-copy (string #\1 #\null #\2)) (string #\1 #\null #\2)) (test (string-copy) 'error) (test (string-copy "hi" (immutable! "ho")) 'error) (test (string-copy "hi" (make-string 4 #\.) 0) "hi..") (test (string-copy "hi" (make-string 4 #\.) 1) ".hi.") (test (string-copy "hi" (make-string 4 #\.) 2) "..hi") (test (string-copy "hi" (make-string 4 #\.) 3) "...h") (test (string-copy "hi" (make-string 4 #\.) 4) "....") (test (string-copy "hi" (make-string 4 #\.) 1 1) "....") (test (string-copy "hi" (make-string 4 #\.) 1 2) ".h..") (test (string-copy "hi" (make-string 4 #\.) 1 3) ".hi.") (test (string-copy "hi" (make-string 4 #\.) 1 4) ".hi.") (test (string-copy "hi" "asdf") "hidf") (test (string-copy "" (make-string 4 #\.)) "....") (test (string-copy "ho" "") "") (test (string-copy "ho" ".") "h") (test (let () (define (func) (string-copy "abc" (substring "0123" 1))) (func)) "abc") ; string_substring_chooser incorrectly from string_copy (for-each (lambda (arg) (test (string-copy arg) 'error) (test (string-copy "hi" arg) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (length (string-copy (string #\null))) 1) (test (string-copy "hi" (make-string 4 #\.) "ho") 'error) (test (string-copy "hi" (make-string 4 #\.) 1 "ho") 'error) ;;; -------------------------------------------------------------------------------- ;;; string-set! (let ((str (make-string 10 #\x))) (string-set! str 3 (integer->char 0)) (test (string=? str "xxx") #f) (test (char=? (string-ref str 4) #\x) #t) (string-set! str 4 #\a) (test (string=? str "xxx") #f) (test (char=? (string-ref str 4) #\a) #t) (string-set! str 3 #\x) (test (string=? str "xxxxaxxxxx") #t)) (test (string-set! "hiho" 1 #\c) #\c) (test (set! ("hi" 1 2) #\i) 'error) (test (set! ("hi" 1) "ho") 'error) (test (set! ("hi") #\i) 'error) (test (let ((x "hi") (y 'x)) (string-set! y 0 #\x) x) 'error) (test (let ((str "ABS")) (set! (str 0) #\a)) #\a) (test (let ((str "ABS")) (string-set! str 0 #\a)) #\a) (test (let ((str "ABS")) (set! (string-ref str 0) #\a)) #\a) (test (let ((hi (make-string 3 #\a))) (string-set! hi 1 (let ((ho (make-string 4 #\x))) (string-set! ho 1 #\b) (string-ref ho 0))) hi) "axa") (test (string-set! "hiho" (expt 2 32) #\a) 'error) (test (let ((hi (string-copy "hi"))) (string-set! hi 2 #\H) hi) 'error) (test (let ((hi (string-copy "hi"))) (string-set! hi -1 #\H) hi) 'error) (test (let ((g (lambda () "***"))) (string-set! (g) 0 #\?)) #\?) (test (string-set! "" 0 #\a) 'error) (test (string-set! "" 1 #\a) 'error) (test (string-set! (string) 0 #\a) 'error) (test (string-set! (symbol->string 'lambda) 0 #\a) #\a) (test (let ((ho (make-string 0 #\x))) (string-set! ho 0 #\a) ho) 'error) (test (let ((str "hi")) (string-set! (let () str) 1 #\a) str) "ha") ; (also in Guile) (test (let ((x 2) (str "hi")) (string-set! (let () (set! x 3) str) 1 #\a) (list x str)) '(3 "ha")) (test (let ((str "hi")) (set! ((let () str) 1) #\b) str) "hb") (test (let ((str "hi")) (string-set! (let () (string-set! (let () str) 0 #\x) str) 1 #\x) str) "xx") (test (let ((str "hi")) (string-set! (let () (set! str "hiho") str) 3 #\x) str) "hihx") ; ! (this works in Guile also) (for-each (lambda (arg) (test (string-set! arg 0 #\a) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (string-set! "hiho" arg #\a) 'error)) (list #\a -1 123 4 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (string-set! "hiho" 0 arg) 'error)) (list 1 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (equal? (let ((str "hiho")) (string-set! str 2 #\null) str) "hi") #f) (test (string=? (let ((str "hiho")) (string-set! str 2 #\null) str) "hi") #f) (test (let* ((s1 "hi") (s2 s1)) (string-set! s2 1 #\x) s1) "hx") (test (let* ((s1 "hi") (s2 (copy s1))) (string-set! s2 1 #\x) s1) "hi") (test (eq? (car (catch #t (lambda () (set! ("hi") #\a)) (lambda args args))) 'wrong-number-of-args) #t) (test (eq? (car (catch #t (lambda () (set! ("hi" 0 0) #\a)) (lambda args args))) 'wrong-number-of-args) #t) ; (vector-set! 1 ...) (test (eq? (car (catch #t (lambda () (set! (("hi" 0) 0) #\a)) (lambda args args))) 'no-setter) #t) ; (set! (1 ...)) (test (let ((s "012345")) (set! (apply s 2) #\a) s) 'error) (test (string-set! #u(0 1 0) 0 -9223372036854775808) 'error) (let () (define (hi) (let ((str "123")) (set! (str 0) (values #\a #\b)) str)) (test (begin (hi) (hi)) 'error)) (let () (define (hi) (let ((str "123")) (set! (str 0) (values #\a #\b)) str)) (test (begin (catch #t hi (lambda a a)) (hi)) 'error)) (test (let ((str "asdf")) (define (func) (set! (str) "asdf")) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v "asdf")) (define (func) (set! (v) "asdf" #\a)) (catch #t func (lambda args #f)) (func)) 'error) ;; similar tests for other types (test (let ((v (vector 1 2))) (define (func) (set! (v) 1)) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (vector 1 2))) (define (func) (set! (v) #(0) 1)) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (int-vector 1 2))) (define (func) (set! (v) #(0) 1)) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (int-vector 1 2))) (define (func) (set! (v) #(0))) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (float-vector 1 2))) (define (func) (set! (v) #(0) 1)) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (float-vector 1 2))) (define (func) (set! (v) #(0))) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (hash-table 'a 1))) (define (func) (set! (v) 'a 1)) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (hash-table 'a 1))) (define (func) (set! (v) 1)) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (hash-table 'a 1))) (define (func) (set! (v) (hash-table 'b 1) 1)) (catch #t func (lambda args #f)) (func)) 'error) (when with-block (test (let ((v (block 1))) (define (func) (set! (v) (block 1))) (catch #t func (lambda args #f)) (func)) 'error)) (when with-block (test (let ((v (block 1))) (define (func) (set! (v) (block 1) 1)) (catch #t func (lambda args #f)) (func)) 'error)) (test (let ((v (inlet 'a 1))) (define (func) (set! (v) (inlet 'b 2))) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (inlet 'a 1))) (define (func) (set! (v) (inlet 'b 2) 2)) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (list 1 2))) (define (func) (set! (v) (list 1))) (catch #t func (lambda args #f)) (func)) 'error) (test (let ((v (hash-table 'a 1))) (define (func) (set! (v) (hash-table 'b 1))) (catch #t func (lambda args #f)) (func)) 'error) (when with-block (let ((B (block 1 2 3))) ; c_obj_to_list (define (f2) (format #f "~{~S ~}" B)) (test (f2) "1.0 2.0 3.0 ")) (let ((B (make-c-tag1))) ; s7_copy_1 if obj has 'copy method in method list, but not built-in copy (define (f3) (copy B (vector 0 0 0))) (test (f3) 123)) (let ((B (make-simple-block 3))) ; s7_copy_1 if obj has no methods or built-in copy -> c_object_getter (will need ref/set funcs) (define (f4) (copy B (vector 0 0 0))) (test (f4) #(0.0 0.0 0.0)))) ;;; -------------------------------------------------------------------------------- ;;; string-fill! (test (string-fill! "hiho" #\c) #\c) (test (string-fill! "" #\a) #\a) (test (string-fill! "hiho" #\a) #\a) (test (let ((g (lambda () "***"))) (string-fill! (g) #\?)) #\?) (test (string-fill!) 'error) (test (string-fill! "hiho" #\a #\b) 'error) (test (let ((hi (string-copy "hi"))) (string-fill! hi #\s) hi) "ss") (test (let ((hi (string-copy ""))) (string-fill! hi #\x) hi) "") (test (let ((str (make-string 0))) (string-fill! str #\a) str) "") (test (let ((hi (make-string 8 (integer->char 0)))) (string-fill! hi #\a) hi) "aaaaaaaa") ; is this result widely accepted? (test (recompose 12 string-copy "xax") "xax") (test (let ((hi (make-string 3 #\x))) (recompose 12 (lambda (a) (string-fill! a #\a) a) hi)) "aaa") (test (let ((hi (make-string 3 #\x))) (recompose 12 (lambda (a) (string-fill! hi a)) #\a) hi) "aaa") (test (let ((str (string #\null #\null))) (fill! str #\x) str) "xx") (for-each (lambda (arg) (test (let ((hiho "hiho")) (string-fill! hiho arg) hiho) 'error)) (list 1 "hi" () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (string-fill! arg #\a) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (let ((str "1234567890")) (string-fill! str #\a 0) str) "aaaaaaaaaa") (test (let ((str "1234567890")) (string-fill! str #\a 0 10) str) "aaaaaaaaaa") (test (let ((str "1234567890")) (string-fill! str #\a 0 0) str) "1234567890") (test (let ((str "1234567890")) (string-fill! str #\a 4 4) str) "1234567890") (test (let ((str "1234567890")) (string-fill! str #\a 10 10) str) "1234567890") (test (let ((str "1234567890")) (string-fill! str #\a 0 4) str) "aaaa567890") (test (let ((str "1234567890")) (string-fill! str #\a 3 4) str) "123a567890") (test (let ((str "1234567890")) (string-fill! str #\a 1 9) str) "1aaaaaaaa0") (test (let ((str "1234567890")) (string-fill! str #\a 8) str) "12345678aa") (test (let ((str "1234567890")) (string-fill! str #\a 1 9 0) str) 'error) (test (let ((str "1234567890")) (string-fill! str #\a 1 0) str) 'error) (test (let ((str "1234567890")) (string-fill! str #\a 11) str) 'error) (test (let ((str "1234567890")) (string-fill! str #\a 9 11) str) 'error) (test (string-fill! "" 0 "hi") 'error) (test (string-fill! "" 0 -1 3) 'error) (test (string-fill! "" 0 1) 'error) (test (string-fill! "" 0 0 4/3) 'error) (test (string-fill! "aaa" #\b #f) 'error) (test (string-fill! "aaa" #\b 1 #f) 'error) (test (string-fill! "aaa" #\b #f 1) 'error) ;;; -------------------------------------------------------------------------------- ;;; string-upcase ;;; string-downcase (test (string-downcase "") "") (test (string-downcase "a") "a") (test (string-downcase "A") "a") (test (string-downcase "AbC") "abc") (test (string-downcase "\"\\\"") "\"\\\"") (test (let ((hi "abc")) (eq? hi (string-downcase hi))) #f) (test (string-downcase (string-upcase (string-downcase "a"))) "a") (test (string-downcase "a\x00;b") "a\x00;b") (test (string-downcase (string #\1 #\null #\2)) (string #\1 #\null #\2)) (test (string-downcase) 'error) (test (string-downcase "hi" "ho") 'error) (test (string-upcase "") "") (test (string-upcase "a") "A") (test (string-upcase "A") "A") (test (string-upcase "AbC") "ABC") (test (string-upcase "\"\\\"") "\"\\\"") (test (let ((hi "ABC")) (eq? hi (string-upcase hi))) #f) (test (string-upcase (string-downcase (string-upcase "a"))) "A") (test (string-upcase "a\x00;b") "A\x00;B") (test (string-upcase (string #\1 #\null #\2)) (string #\1 #\null #\2)) (test (string-upcase) 'error) (test (string-upcase "hi" "ho") 'error) (for-each (lambda (arg) (test (string-downcase arg) 'error) (test (string-upcase arg) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (string-upcase (make-string 132 #\a)) (make-string 132 #\A)) ; loop limit in g_string_upcase (test (string-downcase (make-string 132 #\A)) (make-string 132 #\a)) ; loop limit in g_string_downcase ;;; for r7rs, these need to be unicode-aware ;;; -------------------------------------------------------------------------------- ;;; substring ;;; substring-uncopied (test (substring "ab") "ab") (test (substring "ab" 0 0) "") (test (substring "ab" 1 1) "") (test (substring "ab" 2 2) "") (test (substring "ab" 0 1) "a") (test (substring "ab" 1 2) "b") (test (substring "ab" 0 2) "ab") (test (substring "hi there" 3 6) "the") (test (substring "hi there" 0 (string-length "hi there")) "hi there") (test (substring "" 0 0) "") (let ((str "012345")) (let ((str1 (substring str 2 4))) (string-set! str1 1 #\x) (test (string=? str "012345") #t) (let ((str2 (substring str1 1))) (set! (str2 0) #\z) (test (string=? str "012345") #t) (test (string=? str1 "2x") #t) (test (string=? str2 "z") #t)))) (test (substring (substring "hiho" 0 2) 1) "i") (test (substring (substring "hiho" 0 2) 2) "") (test (substring (substring "hiho" 0 2) 0 1) "h") (test (substring "hi\nho" 3 5) "ho") (test (substring (substring "hi\nho" 1 4) 2) "h") (test (substring (substring "hi\nho" 3 5) 1 2) "o") (test (substring "hi\"ho" 3 5) "ho") (test (substring (substring "hi\"ho" 1 4) 2) "h") (test (substring (substring "hi\"ho" 3 5) 1 2) "o") (test (let* ((s1 "0123456789") (s2 (substring s1 1 3))) (string-set! s2 1 #\x) s1) "0123456789") (test (substring (substring "" 0 0) 0 0) "") (test (substring (format #f "") 0 0) "") (test (string=? (substring (substring (substring "01234567" 1) 1) 1) "34567") #t) (let () (define (hi) (string=? (substring (substring (substring "01234567" 1) 1) 1) "34567")) (define (ho) (hi)) (ho) (test (ho) #t)) (test (substring "012" 3) "") (test (substring "012" 10) 'error) (test (substring "012" most-positive-fixnum) 'error) (test (substring "012" -1) 'error) (test (substring "012" 3 3) "") (test (substring "012" 3 4) 'error) (test (substring "012" 3 2) 'error) (test (substring "012" 3 -2) 'error) (test (substring "012" 3 0) 'error) (test (substring "012" 0) "012") (test (substring "012" 2) "2") (test (substring "" 0) "") (test (recompose 12 (lambda (a) (substring a 0 3)) "12345") "123") (test (reinvert 12 (lambda (a) (substring a 0 3)) (lambda (a) (string-append a "45")) "12345") "12345") (test (substring "ab" 0 3) 'error) (test (substring "ab" 3 3) 'error) (test (substring "ab" 2 3) 'error) (test (substring "" 0 1) 'error) (test (substring "" -1 0) 'error) (test (substring "abc" -1 0) 'error) (test (substring "hiho" (expt 2 32) (+ 2 (expt 2 32))) 'error) (test (substring) 'error) (test (substring "hiho" 0 1 2) 'error) (test (substring "1234" -1 -1) 'error) (test (substring "1234" 1 0) 'error) (test (substring "" most-positive-fixnum 1) 'error) (let ((str "0123456789")) (string-set! str 5 #\null) (test (substring str 6) "6789") (test (substring str 5 5) "") (test (substring str 4 5) "4") (test (substring str 5 6) "\x00;") (test (substring str 5 7) "\x00;6") (test (substring str 4 7) "4\x00;6")) (for-each (lambda (arg) (test (substring "hiho" arg 0) 'error)) (list "hi" #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (substring "0123" arg) 'error) (test (substring "hiho" 1 arg) 'error)) (list "hi" #\a -1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (substring arg 1 2) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (define (substring? pattern target) ; taken from net somewhere (umich?) with changes for s7 (which now has string-position, so this is unneeded) (define (build-shift-vector pattern) (let* ((pat-len (length pattern)) (shift-vec (make-vector 256 (+ pat-len 1))) (max-pat-index (- pat-len 1))) (let loop ((index 0)) (set! (shift-vec (char->integer (pattern index))) (- pat-len index)) (if (< index max-pat-index) (loop (+ index 1)) shift-vec)))) (if (or (not (string? pattern)) (not (string? target))) (error 'wrong-type-arg "substring? args should be strings: ~S ~S" pattern target) (let ((pat-len (length pattern))) (if (zero? pat-len) 0 (let ((shift-vec (build-shift-vector pattern))) (let* ((tar-len (length target)) (max-tar-index (- tar-len 1)) (max-pat-index (- pat-len 1))) (let outer ((start-index 0)) (and (<= (+ pat-len start-index) tar-len) (let inner ((p-ind 0) (t-ind start-index)) (cond ((> p-ind max-pat-index) #f) ; nothing left to check ((char=? (pattern p-ind) (target t-ind)) (if (= p-ind max-pat-index) start-index ; success -- return start index of match (inner (+ p-ind 1) (+ t-ind 1)))) ; keep checking ((> (+ pat-len start-index) max-tar-index) #f) ; fail (else (outer (+ start-index (shift-vec (char->integer (target (+ start-index pat-len))))))))))))))))) (test (substring? "hiho" "test hiho test") 5) (test (substring? "hiho" "test hihptest") #f) (test (substring? "hiho" "test hih") #f) (test (substring? "hiho" "") #f) (test (substring? "hiho" "hiho") 0) (test (substring? "" "hiho") 0) (test (substring? "abc" 'abc) 'error) (test (substring "123345" (ash 1 32)) 'error) (test (substring "123345" 0 (ash 1 32)) 'error) (test (substring "123345" 8796093022208) 'error) (let ((str (string #\a #\b #\c))) (test (substring-uncopied str) str) (test (substring-uncopied str 1) "bc") (let ((str1 (substring-uncopied str 1))) (test str1 "bc") (test (set! (str1 0) #\d) 'error))) ; wrap_string wrappers are immutable ;;; -------------------------------------------------------------------------------- ;;; string-append (test (string-append "hi" "ho") "hiho") (test (string-append "hi") "hi") (test (string-append "hi" "") "hi") (test (string-append "hi" "" "ho") "hiho") (test (string-append "" "hi") "hi") (test (string-append) "") (test (string-append "a" (string-append (string-append "b" "c") "d") "e") "abcde") (test (string-append "a" "b" "c" "d" "e") "abcde") (test (string-append (string-append) (string-append (string-append))) "") (test (let ((hi "hi")) (let ((ho (string-append hi))) (eq? hi ho))) #f) (test (let ((hi "hi")) (let ((ho (string-append hi))) (string-set! ho 0 #\a) hi)) "hi") (test (let ((hi "hi")) (set! hi (string-append hi hi hi hi)) hi) "hihihihi") (test (string-append ()) 'error) (test (string=? (string-append "012" (string #\null) "456") (let ((str "0123456")) (string-set! str 3 #\null) str)) #t) (test (string=? (string-append "012" (string #\null) "356") (let ((str "0123456")) (string-set! str 3 #\null) str)) #f) (test (string-append """hi""ho""") "hiho") (test (let* ((s1 "hi") (s2 (string-append s1 s1))) (string-set! s2 1 #\x) s1) "hi") (test (let* ((s1 "hi") (s2 (string-append s1))) (string-set! s2 1 #\x) s1) "hi") (test (length (string-append (string #\x #\y (integer->char 127) #\z) (string #\a (integer->char 0) #\b #\c))) 8) (test (length (string-append "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc" "abc")) 915) (test (length (string-append (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c) (string #\a #\b #\c))) 915) (num-test (letrec ((hi (lambda (str n) (if (= n 0) str (hi (string-append str "a") (- n 1)))))) (string-length (hi "" 100))) 100) (test (let* ((str "hiho") (str1 "ha") (str2 (string-append str1 str))) (string-set! str2 1 #\x) (string-set! str2 4 #\x) (and (string=? str "hiho") (string=? str1 "ha") (string=? str2 "hxhixo"))) #t) (test (let* ((str (string-copy "hiho")) (str1 (string-copy "ha")) (str2 (string-append str1 str))) (string-set! str1 1 #\x) (string-set! str 2 #\x) (and (string=? str "hixo") (string=? str1 "hx") (string=? str2 "hahiho"))) #t) (let ((s1 (string #\x #\null #\y)) (s2 (string #\z #\null))) (test (string=? (string-append s1 s2) (string #\x #\null #\y #\z #\null)) #t) (test (string=? (string-append s2 s1) (string #\z #\null #\x #\null #\y)) #t)) (test (recompose 12 string-append "x") "x") (test (recompose 12 (lambda (a) (string-append a "x")) "a") "axxxxxxxxxxxx") (test (recompose 12 (lambda (a) (string-append "x" a)) "a") "xxxxxxxxxxxxa") (test (length (string-append "\\?" "hi")) 4) (test (string-append "hi" 1) 'error) (test (eval-string "(string-append \"\\?\")") 'error) ; guile mailing list (test (eval-string "(string-append \"\\?\" \"hi\")") 'error) ; guile mailing list (for-each (lambda (arg) (test (string-append "hiho" arg) 'error) (test (string-append arg "hi") 'error) (test (string-append "a" "b" arg) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (let () (define (f) (string-append (string-append (string)))) (test (byte-vector? (f)) #f) (test (byte-vector? (f)) #f)) (let () (define (f) (string-append (string-append (string #\a #\b)))) (test (byte-vector? (f)) #f) (test (byte-vector? (f)) #f)) (test (append #u(0 1 2 3) #u(4 5 6)) #u(0 1 2 3 4 5 6)) ;;; -------------------------------- (test (let ((str (make-string 4 #\x)) (ctr 0)) (for-each (lambda (c) (string-set! str ctr c) (set! ctr (+ ctr 1))) "1234") str) "1234") (test (let ((str (make-string 8 #\x)) (ctr 0)) (for-each (lambda (c1 c2) (string-set! str ctr c1) (string-set! str (+ ctr 1) c2) (set! ctr (+ ctr 2))) "1234" "hiho") str) "1h2i3h4o") #| (let ((size 1024)) (let ((str (make-string size))) (do ((i 0 (+ i 1))) ((= i size)) (set! (str i) (integer->char (+ 1 (modulo i 255))))) (let ((str1 (string-copy str))) (test (string? str1) #t) (test (string-length str1) 1024) (test (string-ref str1 556) (string-ref str 556)) (test (string=? str str1) #t) (test (string<=? str str1) #t) (test (string>=? str str1) #t) (test (string-ci=? str str1) #t) (test (string-ci<=? str str1) #t) (test (string-ci>=? str str1) #t) (test (string? str str1) #f) (test (string-ci? str str1) #f) (test (substring str 123 321) (substring str1 123 321)) (string-set! str1 1000 #\space) (test (string=? str str1) #f) (test (string<=? str str1) #f) (test (string>=? str str1) #t) (test (string-ci=? str str1) #f) (test (string-ci<=? str str1) #f) (test (string-ci>=? str str1) #t) (test (string? str str1) #t) (test (string-ci? str str1) #t) (test (string-length (string-append str str1)) 2048) )))) |# ;;; -------------------------------------------------------------------------------- ;;; string->list ;;; list->string (test (string->list "abc") (list #\a #\b #\c)) (test (string->list "") ()) (test (string->list (make-string 0)) ()) (test (string->list (string #\null)) '(#\null)) (test (string->list (string)) ()) (test (string->list (substring "hi" 0 0)) ()) (test (string->list (list->string (list #\a #\b #\c))) (list #\a #\b #\c)) (test (string->list (list->string ())) ()) (test (list->string (string->list "abc")) "abc") (test (list->string (string->list "hi there")) "hi there") (test (list->string (string->list "&*#%^@%$)~@")) "&*#%^@%$)~@") (test (list->string (string->list "")) "") (test (let* ((str "abc") (lst (string->list str))) (and (string=? str "abc") (equal? lst (list #\a #\b #\c)))) #t) (test (list->string ()) "") (test (list->string (list #\a #\b #\c)) "abc") (test (list->string (list)) "") (test (list->string (list #\" #\# #\")) "\"#\"") (test (list->string (list #\\ #\\ #\# #\\ #\# #\#)) "\\\\#\\##") (test (list->string (list #\' #\' #\` #\")) '"''`\"") (test (reinvert 12 string->list list->string "12345") "12345") (test (string->list) 'error) (test (list->string) 'error) (test (string->list "hi" "ho") 'error) (test (list->string () '(1 2)) 'error) (test (apply list->string '(#\a . #\b)) 'error) (test (list->string #\a . #\b) 'error) (test (let ((lst (cons #\a #\b))) (list->string lst)) 'error) (test (string->list " hi ") '(#\space #\h #\i #\space)) (test (string->list (string (integer->char #xf0) (integer->char #x70))) (list (integer->char #xf0) (integer->char #x70))) (for-each (lambda (arg) (test (string->list arg) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->string x)) 'error) (test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (list->string lst)) 'error) (test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (apply string lst)) 'error) (for-each (lambda (arg) (test (list->string arg) 'error)) (list "hi" #\a 1 ''foo '(1 . 2) (cons #\a #\b) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (let ((str (list->string '(#\x #\space #\null #\x)))) (test (length str) 4) (test (str 1) #\space) (test (str 2) #\null) (test (str 3) #\x) (test (object->string str) "\"x \\x00;x\"") (let ((lst (string->list str))) (test lst '(#\x #\space #\null #\x)))) (let ((strlen 8)) (let ((str (make-string strlen))) (do ((i 0 (+ i 1))) ((= i 10)) (do ((k 0 (+ k 1))) ((= k strlen)) (set! (str k) (integer->char (random 256)))) (let ((lst (string->list str))) (let ((newstr (list->string lst))) (let ((lstlen (length lst)) (newstrlen (length newstr))) (if (or (not (= lstlen strlen newstrlen)) (not (string=? newstr str))) (format #t ";string->list->string: ~S -> ~A -> ~S~%" str lst newstr)))))))) (when full-s7test (let () (define (all-strs len file) (let* ((funny-chars (list #\` #\# #\, #\@ #\' #\" #\. #\( #\) #\\)) (num-chars (length funny-chars))) (let ((ctrs (make-vector len 0))) (do ((i 0 (+ i 1))) ((= i (expt num-chars len))) (let ((carry #t)) (do ((k 0 (+ k 1))) ((or (= k len) (not carry))) (vector-set! ctrs k (+ 1 (vector-ref ctrs k))) (if (= (vector-ref ctrs k) num-chars) (vector-set! ctrs k 0) (set! carry #f))) (let ((strlst ())) (do ((k 0 (+ k 1))) ((= k len)) (let ((c (list-ref funny-chars (vector-ref ctrs k)))) (set! strlst (cons c strlst)))) (let ((str (list->string strlst))) (format file "(test (and (string=? ~S (string ~{#\\~C~^ ~})) (equal? '~A (string->list ~S))) #t)~%" str strlst strlst str)))))))) (call-with-output-file "strtst.scm" (lambda (p) (do ((len 3 (+ len 1))) ((= len 5)) (all-strs len p)))) (load "strtst.scm"))) (test (and (string=? "\"" (string #\")) (equal? '(#\") (string->list "\""))) #t) (test (and (string=? "#\\" (string #\# #\\)) (equal? '(#\# #\\) (string->list "#\\"))) #t) (test (and (string=? "#(" (string #\# #\()) (equal? '(#\# #\() (string->list "#("))) #t) (test (and (string=? "\"@" (string #\" #\@)) (equal? '(#\" #\@) (string->list "\"@"))) #t) (test (and (string=? "\";" (string #\" #\;)) (equal? '(#\" #\;) (string->list "\";"))) #t) (test (and (string=? ")(" (string #\) #\()) (equal? '(#\) #\() (string->list ")("))) #t) (test (and (string=? "`)#" (string #\` #\) #\#)) (equal? '(#\` #\) #\#) (string->list "`)#"))) #t) (test (and (string=? "##\\" (string #\# #\# #\\)) (equal? '(#\# #\# #\\) (string->list "##\\"))) #t) (test (and (string=? "#\"(" (string #\# #\" #\()) (equal? '(#\# #\" #\() (string->list "#\"("))) #t) (test (and (string=? "#.@" (string #\# #\. #\@)) (equal? '(#\# #\. #\@) (string->list "#.@"))) #t) (test (and (string=? ",`@" (string #\, #\` #\@)) (equal? '(#\, #\` #\@) (string->list ",`@"))) #t) (test (and (string=? "',@" (string #\' #\, #\@)) (equal? '(#\' #\, #\@) (string->list "',@"))) #t) (test (and (string=? "\"#@" (string #\" #\# #\@)) (equal? '(#\" #\# #\@) (string->list "\"#@"))) #t) (test (and (string=? "\")\"" (string #\" #\) #\")) (equal? '(#\" #\) #\") (string->list "\")\""))) #t) (test (and (string=? ")#(" (string #\) #\# #\()) (equal? '(#\) #\# #\() (string->list ")#("))) #t) (test (and (string=? "`(,@" (string #\` #\( #\, #\@)) (equal? '(#\` #\( #\, #\@) (string->list "`(,@"))) #t) (test (and (string=? "`)#\"" (string #\` #\) #\# #\")) (equal? '(#\` #\) #\# #\") (string->list "`)#\""))) #t) (test (and (string=? "#\"'#" (string #\# #\" #\' #\#)) (equal? '(#\# #\" #\' #\#) (string->list "#\"'#"))) #t) (test (and (string=? "#(@\\" (string #\# #\( #\@ #\\)) (equal? '(#\# #\( #\@ #\\) (string->list "#(@\\"))) #t) (test (and (string=? "#(\\\\" (string #\# #\( #\\ #\\)) (equal? '(#\# #\( #\\ #\\) (string->list "#(\\\\"))) #t) (test (and (string=? ",,.@" (string #\, #\, #\. #\@)) (equal? '(#\, #\, #\. #\@) (string->list ",,.@"))) #t) (test (and (string=? ",@`\"" (string #\, #\@ #\` #\")) (equal? '(#\, #\@ #\` #\") (string->list ",@`\""))) #t) (test (and (string=? "\"'\")" (string #\" #\' #\" #\))) (equal? '(#\" #\' #\" #\)) (string->list "\"'\")"))) #t) (test (and (string=? "\")#\"" (string #\" #\) #\# #\")) (equal? '(#\" #\) #\# #\") (string->list "\")#\""))) #t) (test (and (string=? "(\\`)" (string #\( #\\ #\` #\))) (equal? '(#\( #\\ #\` #\)) (string->list "(\\`)"))) #t) (test (and (string=? "))\"'" (string #\) #\) #\" #\')) (equal? '(#\) #\) #\" #\') (string->list "))\"'"))) #t) (test (and (string=? "\\,\\\"" (string #\\ #\, #\\ #\")) (equal? '(#\\ #\, #\\ #\") (string->list "\\,\\\""))) #t) (test (and (string=? "\\\"`\"" (string #\\ #\" #\` #\")) (equal? '(#\\ #\" #\` #\") (string->list "\\\"`\""))) #t) (test (and (string=? "\\\\#\"" (string #\\ #\\ #\# #\")) (equal? '(#\\ #\\ #\# #\") (string->list "\\\\#\""))) #t) (test (string->list "" 0 10) 'error) (test (string->list "1" 0 2) 'error) (test (string->list "" 0 0) ()) (test (string->list "1" 1) ()) (test (string->list "1" 0) '(#\1)) (test (string->list "" #\null) 'error) (test (string->list "" 0 #\null) 'error) (test (string->list "" -1) 'error) (test (string->list "1" -1) 'error) (test (string->list "1" 0 -1) 'error) (test (string->list "1" -2 -1) 'error) (test (string->list "1" most-negative-fixnum) 'error) (test (string->list "1" 2) 'error) (for-each (lambda (arg) (test (string->list "012345" arg) 'error) (test (string->list "012345" 1 arg) 'error)) (list #\a "hi" () (list 1) '(1 . 2) 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (string->list "12345" 0) '(#\1 #\2 #\3 #\4 #\5)) (test (string->list "12345" 0 5) '(#\1 #\2 #\3 #\4 #\5)) (test (string->list "12345" 5 5) ()) (test (string->list "12345" 4 5) '(#\5)) (test (string->list "12345" 2 4) '(#\3 #\4)) (test (string->list "12345" 2 1) 'error) (test (string->list "12345" 2 3 4) 'error) (test (string->list (make-string 3 #\null) 2 3) '(#\null)) (unless pure-s7 (test (catch #t (lambda () (let-temporarily (((*s7* 'max-list-length) 3)) (string->list "12345"))) (lambda (type info) (apply format #f info))) "string->list length 5, (- 5 0), is greater than (*s7* 'max-list-length), 3")) ;;; -------------------------------------------------------------------------------- ;;; char-position ;;; string-position (test (char-position) 'error) (test (char-position #\a) 'error) (test (char-position #\a "abc" #\0) 'error) (test (char-position #\a "abc" 0 1) 'error) (test (string-position) 'error) (test (string-position #\a) 'error) (test (string-position "a" "abc" #\0) 'error) (test (string-position "a" "abc" 0 1) 'error) (for-each (lambda (arg) (test (string-position arg "abc") 'error) (test (char-position arg "abc") 'error) (test (string-position "a" arg) 'error) (test (char-position #\a arg) 'error) (test (string-position "a" "abc" arg) 'error) (test (char-position #\a "abc" arg) 'error)) (list () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 -1 most-negative-fixnum 1.0+1.0i :hi (if #f #f) (lambda (a) (+ a 1)))) (test (char-position #\a "abc" most-positive-fixnum) #f) (test (char-position "a" "abc" most-positive-fixnum) #f) (test (string-position "a" "abc" most-positive-fixnum) #f) (test (char-position #\b "abc") 1) (test (char-position #\b "abc" 0) 1) (test (char-position #\b "abc" 1) 1) (test (char-position "b" "abc") 1) (test (char-position "b" "abc" 1) 1) (test (char-position "c" "abc") 2) (test (string-position "b" "abc") 1) (test (string-position "b" "abc" 1) 1) (test (string-position "b" "abc" 2) #f) (test (string-position "b" "abc" 3) #f) (test (char-position "b" "abc" 2) #f) (test (char-position "b" "abc" 3) #f) (test (char-position #\b "abc" 2) #f) (test (char-position #\b "abc" 3) #f) (test (char-position "ab" "abcd") 0) (test (char-position "ab" "ffbcd") 2) (test (char-position "ab" "ffacd") 2) (test (string-position "ab" "ffacd") #f) (test (string-position "ab" "ffabd") 2) (test (string-position "ab" "ffabab" 2) 2) (test (string-position "ab" "ffabab" 3) 4) (test (string-position "ab" "ffabab" 4) 4) (test (string-position "ab" "ffabab" 5) #f) (test (string-position "abc" "ab") #f) (test (string-position "abc" "") #f) (test (string-position "" "") #f) (test (char-position "\"" "a") #f) (test (char-position "\"" "a\"b") 1) (test (char-position #\" "a\"b") 1) (test (string-position "\"hiho\"" "hiho") #f) (test (string-position "\"hiho\"" "\"\"hiho\"") 1) (test (string-position "" "a") #f) ; this is a deliberate choice in s7.c (test (char-position "" "a") #f) (test (char-position #\null "a") 1) ; ?? (test (char-position #\null "") #f) ; ?? (test (string-position (string #\null) "a") 0) ; ?? (test (string-position (string #\null) "") #f) ; ?? (test (char-position #\null (string #\null)) 0) ; ?? (test (char-position #\null (string #\a #\null #\n)) 1) (test (char-position "" (string #\a #\null #\n)) #f) ;(test (char-position #\n (string #\a #\null #\n)) 2) ; ?? returns #f due to assumption of C-style strings ;(test (char-position "n" (string #\a #\null #\n)) 1) ; oops! ;(test (string-position "n" (string #\a #\null #\n)) 2) ; oops! (test (char-position "" (string #\a #\n)) #f) (test (char-position #(1) "asdasd" 63) 'error) (test (let ((i 0)) (sort! (vector 3 2 4 5 1) (lambda (a b) (+ (char-position #\xff abs (+ i 1))) (> a b)))) 'error) ;; if "" as string-pos first, -> #f so same for char-pos, even if string contains a null (let () ;; actually more of a string-append/temp substring test (define (fixit str) (let ((pos (char-position #\& str))) (if (not pos) str (string-append (substring str 0 pos) (let ((epos (char-position #\; str pos))) (let ((substr (substring str (+ pos 1) epos))) (let ((replacement (cond ((string=? substr "gt") ">") ((string=? substr "lt") "<") ((string=? substr "mdash") "-") (else (format #t "unknown: ~A~%" substr))))) (string-append replacement (fixit (substring str (+ epos 1))))))))))) (test (fixit "(let ((f (hz->radians 100)) (g (hz->radians 200))) (< f g))") "(let ((f (hz->radians 100)) (g (hz->radians 200))) (< f g))")) ;;; opt bug (test (apply char-position '(#\a #u() #f)) 'error) (test (let () (define (f1) (do ((i 0 (+ i 1))) ((= i 1) (char-position #\a #u() #f)) (char-position #\a #u() #f))) (f1)) 'error) ;;; -------------------------------------------------------------------------------- ;;; symbol->string ;;; string->symbol ;;; symbol (test (symbol->string 'hi) "hi") (test (string->symbol (symbol->string 'hi)) 'hi) (test (eq? (string->symbol "hi") 'hi) #t) (test (eq? (string->symbol "hi") (string->symbol "hi")) #t) (test (string->symbol "hi") 'hi) (test (let ((str (symbol->string 'hi))) (catch #t (lambda () (string-set! str 1 #\x)) (lambda args 'error)) ; can be disallowed (symbol->string 'hi)) "hi") (test (symbol->string 'sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789) "sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789") (test (string->symbol "sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789") 'sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789) (test (let ((sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 32)) (+ sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 1)) 33) (test (symbol->string (string->symbol "hi there")) "hi there") (test (symbol->string (string->symbol "Hi There")) "Hi There") (test (symbol->string (string->symbol "HI THERE")) "HI THERE") (test (symbol->string (string->symbol "")) 'error) ; this fluctuates (test (symbol? (string->symbol "(weird name for a symbol!)")) #t) (test (symbol->string (string->symbol "()")) "()") (test (symbol->string (string->symbol (string #\"))) "\"") (test (symbol->string 'quote) "quote") (test (symbol->string if) 'error) (test (symbol->string quote) 'error) (test (symbol? (string->symbol "0")) #t) (test (symbol? (symbol "0")) #t) (test (symbol? (symbol ".")) #t) ; hmmm (test (let () (define |.| 1) (+ |.| 2)) 3) (test (string->symbol "0e") '0e) (test (string->symbol "1+") '1+) (test (symbol? (string->symbol "1+i")) #t) (test (string->symbol ":0") ':0) (test (symbol? (string->symbol " hi")) #t) (test (symbol? (string->symbol "hi ")) #t) (test (keyword? (string->symbol ":asdf")) #t) (test (symbol->string 'a'b) "a'b") (test (string->symbol "a\"b") (symbol "a\"b")) (test (symbol->string (symbol "a\"b")) "a\"b") (test (symbol->string (symbol "a" (string #\") "b")) "a\"b") ; r7rs spec says no escapes -- how is it a legal string? (test (string->symbol (string #\a #\" #\b)) (symbol "a\"b")) (test (reinvert 12 string->symbol symbol->string "hiho") "hiho") (test (symbol->string) 'error) (test (string->symbol) 'error) (test (symbol->string 'hi 'ho) 'error) (test (string->symbol "hi" "ho") 'error) (test (symbol? (string->symbol (string #\x (integer->char 255) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 8) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 128) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 200) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 255) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 20) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 2) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 7) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 17) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 170) #\x))) #t) (test (symbol? (string->symbol (string #\x (integer->char 0) #\x))) #t) ; but the symbol's name here is "x" ;(test (eq? (string->symbol (string #\x (integer->char 0) #\x)) 'x) #t) ; hmmm... (test (symbol? (string->symbol (string #\x #\y (integer->char 127) #\z))) #t) ; xy(backspace)z (test (let ((abc 12)) (symbol->value (symbol "abc"))) 12) (test (symbol "abc" ()) 'error) (test (symbol () "abc") 'error) (test (symbol "a" #(#\a)) 'error) (test (symbol "a" "" "b") 'ab) (test (symbol "" ()) 'error) (test (symbol? (string->symbol (string #\; #\" #\)))) #t) (test (let (((symbol ";")) 3) (symbol ";")) 'error) (test ((lambda () (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) 3) (let (((symbol ";")) 3) (symbol ";"))))) 'error) (test (symbol "") 'error) (test (symbol "" "") 'error) (test (symbol "" "" "") 'error) (test (symbol (string #\null) "ho") (symbol "\x00;ho")) (test (let () (define (func) (symbol (string #\null) "ho")) (define (hi) (func) (func)) (hi) (hi)) (symbol "\x00;ho")) (test (symbol "a" (string #\null) "b") (symbol "a\x00;b")) (test (object->string (symbol "(ab)")) "(symbol \"(ab)\")") (test (object->string (symbol "(ab")) "(symbol \"(ab\")") (test (object->string (symbol "()")) "(symbol \"()\")") (test (object->string (symbol (string #\return))) "(symbol \"\\r\")") (test (object->string (symbol (string #\return #\a #\tab))) "(symbol \"\\ra\\t\")") (test (object->string (symbol (string #\return #\tab))) "(symbol \"\\r\\t\")") (test (object->string (symbol (string #\a #\b #\return #\tab))) "(symbol \"ab\\r\\t\")") (test (object->string (symbol (string #\return #\tab #\a #\b))) "(symbol \"\\r\\tab\")") (test (object->string (symbol (string #\return #\tab #\a #\null))) "(symbol \"\\r\\ta\\x00;\")") (test (symbol->string (openlet (inlet 'symbol->string (lambda (s) "a symbol")))) "a symbol") (test (let () (apply define (list (symbol "#g")) (list 1)) (eval (list (symbol "#g")))) 1) (let () (apply define (list (symbol "[#]") 0)) (test (symbol->value (symbol "[#]")) 0) (set! (symbol "[#]") 32) (test (symbol->value (symbol "[#]")) 32) (apply define (list (symbol "a" "b" "c") 12)) (set! (symbol "a" "b" "c") -1) (test (symbol->value (symbol "a" "b" "c")) -1) (apply set! (list (symbol "[#]") -2)) (test (symbol->value (symbol "[#]")) -2) (let-temporarily (((symbol "[#]") 101)) (test (symbol->value (symbol "[#]")) 101)) (test (symbol->value (symbol "[#]")) -2) (test (let-temporarily (((symbol ":asdf") 32)) :asdf) 'error)) (let ((s1 "as") (s2 "df")) (apply define (list (symbol s1 s2) 0)) (set! (symbol s1 s2) 123) (test (symbol->value (symbol s1 s2)) 123) (test asdf 123)) (for-each (lambda (arg) (test (symbol->string arg) 'error)) (list #\a 1 "hi" () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (string->symbol arg) 'error) (test (symbol arg) 'error) (test (symbol "a" arg) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (symbol? (string->symbol (string arg))) #t) (test (symbol? (symbol (string arg))) #t)) (list #\; #\, #\. #\) #\( #\" #\' #\` #\x33 #\xff #\x7f #\# #\])) (test (symbol) 'error) (test (symbol "hi" "ho") 'hiho) (let () (define-macro (string-case selector . clauses) `(case (symbol ,selector) ,@(map (lambda (clause) (if (pair? (car clause)) `(,(map symbol (car clause)) ,@(cdr clause)) clause)) clauses))) (test (let ((str "hi")) (string-case str (("hi" "ho") 1 2 3) (("hiho") 2) (else 4))) 3)) (let () (apply define (list (symbol "(#)") 3)) (test (eval (symbol "(#)") (curlet)) 3)) (let () (define (immutabl obj) (string->symbol (object->string obj :readable))) (define (symbol->object sym) (eval-string (symbol->string sym))) (test (symbol->object (immutabl (list 1 2 3))) (list 1 2 3)) (test (symbol->object (immutabl "hi")) "hi")) ;;; -------------------------------------------------------------------------------- ;;; symbol->value ;;; symbol->dynamic-value ;;; symbol-initial-value (let ((sym 0)) (test (symbol->value 'sym) 0) (test (symbol->dynamic-value 'sym) 0) (for-each (lambda (arg) (set! sym arg) (test (symbol->value 'sym) arg) (test (symbol->dynamic-value 'sym) arg)) (list #\a 1 () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) # (lambda (a) (+ a 1))))) (for-each (lambda (arg) (test (symbol->value arg) 'error) (test (symbol->value 'abs arg) 'error) (test (symbol->dynamic-value arg) 'error) (test (symbol->dynamic-value 'abs arg) 'error)) (list #\a 1 () (list 1) "hi" '(1 . 2) #f (make-vector 3) _ht_ _undef_ 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) #)) (test (symbol->value) 'error) (test (symbol->value 'hi 'ho) 'error) (test (symbol->dynamic-value) 'error) (test (symbol->dynamic-value 'hi 'ho) 'error) (test (symbol->value 'abs (unlet)) abs) (test (symbol->value 'abs (rootlet)) abs) (test (symbol->value 'lambda) lambda) (test (symbol->value 'do) do) (test (symbol->value do) 'error) (test (symbol->value 'macroexpand) macroexpand) (test (symbol->value 'quasiquote) quasiquote) (test (symbol->value 'else) else) (test (symbol->value :hi) :hi) (test (symbol->value hi:) hi:) (test (symbol->value :hi 123) 'error) (test (symbol->value :hi abs) :hi) (test (symbol->value :readable (lambda a (copy a))) :readable) (test (symbol->dynamic-value 'lambda) lambda) (test (symbol->dynamic-value 'do) do) (test (symbol->dynamic-value do) 'error) (test (symbol->dynamic-value 'macroexpand) macroexpand) (test (symbol->dynamic-value 'quasiquote) quasiquote) (test (symbol->dynamic-value 'else) else) (test (symbol->dynamic-value :hi) :hi) (test (symbol->dynamic-value hi:) hi:) (test (symbol->value '#) 'error) ; because it's not a symbol: (test (symbol? '#) #f) (test (let ((a1 32)) (let () (symbol->value 'a1 (curlet)))) 32) (test (let ((a1 32)) (let ((a1 0)) (symbol->value 'a1 (curlet)))) 0) (test (let ((a1 32)) (let ((a1 0)) (symbol->value 'b1 (curlet)))) #) (test (symbol->value 'abs ()) 'error) (test (let ((a1 (let ((b1 32)) (lambda () b1)))) (symbol->value 'b1 (funclet a1))) 32) (test (let ((x #f)) (set! x (let ((a1 (let ((b1 32)) (lambda () b1)))) a1)) (symbol->value 'b1 (funclet x))) 32) (test (symbol->value 'if) if) (test (symbol->value if) 'error) (test ((define (hi a) (+ a 1)) 2) 3) (test ((define-macro (hi a) `(+ ,a 1)) 2) 3) (test (let ((mac (define-macro (hi a) `(+ ,a 1)))) (mac 3)) 4) (test (eq? #_abs (symbol->value 'abs (unlet))) #t) (test (eq? #_lambda (symbol->value 'lambda (unlet))) #t) (test (eq? #_case case) #t) (test (eq? #_cond #_if) #f) (test (let ((b 2)) (let ((e (curlet))) (let ((a 1)) (symbol->value 'a e)))) #) (test (let ((a 2)) (let ((e (curlet))) (let ((a 1)) (symbol->value 'a e)))) 2) (test (let ((a 2)) (let ((e (curlet))) (let ((a 1)) (symbol->value 'a)))) 1) (test (let ((asdf 32)) (symbol->value 'asdf (rootlet))) #) (test (let ((asdf 32)) (symbol->value 'asdf (unlet))) #) (test (let ((asdf 32)) (symbol->value 'asdf)) 32) (let () (define *ds* 0) (define (get-ds) (list *ds* (symbol->dynamic-value '*ds*))) (test (get-ds) '(0 0)) (let ((*ds* 32)) (test (values (get-ds)) '(0 32))) (let ((*ds* 3)) (define (gds) (list *ds* (symbol->dynamic-value '*ds*))) (test (list (get-ds) (gds)) '((0 3) (3 3))) (let ((*ds* 123)) (test (list (get-ds) (gds)) '((0 123) (3 123))))) (let ((*ds* 3)) (define (gds) (list *ds* (symbol->dynamic-value '*ds*))) (let ((*ds* 123)) (set! *ds* 321) (test (list (get-ds) (gds)) '((0 321) (3 321)))))) (test (symbol->dynamic-value 'asdasfasdasfg) #) (let ((x 32)) (define (gx) (symbol->dynamic-value 'x)) (let ((x 12)) (test (values (gx)) 12))) (let ((x "hi") (y 0) (z '(1 2 3))) (define (gx) (+ (symbol->dynamic-value 'x) (symbol->dynamic-value 'z))) (let ((x 32) (z (+ 123 (car z)))) (test (values (gx)) 156))) (let ((x 32)) (define (gx) (symbol->dynamic-value 'x)) (let ((x 100)) (let ((x 12)) (test (values (gx)) 12)))) (let ((x 32)) (define (gx) ; return both bindings of 'x (list x (symbol->value 'x) (symbol->dynamic-value 'x))) (let ((x 100)) (let ((x 12)) (test (values (gx)) '(32 32 12))))) (test (let () (define (func) (int-vector-set! (subvector #i2d((1 2) (3 4)) 0 4) 1 2 (arity (symbol->dynamic-value (gensym "g_123"))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (list (string-append) 42 (integer->char 255) (symbol->dynamic-value (gensym)))) (define (hi) (func)) (hi)) (list "" 42 #\xff #)) (let ((bindings ())) ;; taken from the MIT_Scheme documentation (changing fluid-let to let) (define (write-line v) (set! bindings (cons v bindings))) (define (complicated-dynamic-binding) (let ((variable 1) (inside-continuation #f)) (write-line variable) (call-with-current-continuation (lambda (outside-continuation) (let ((variable 2)) (write-line variable) (set! variable 3) (call-with-current-continuation (lambda (k) (set! inside-continuation k) (outside-continuation #t))) (write-line variable) (set! inside-continuation #f)))) (write-line variable) (if inside-continuation (begin (set! variable 4) (inside-continuation #f))))) (complicated-dynamic-binding) (test (reverse bindings) '(1 2 1 3 4))) ;;; (define (func x) (call-with-output-file "/dev/null" (symbol->dynamic-value (*function* (curlet))))) ;;; gets either stack overflow or error: open-output-file: Too many open files "/dev/null" ;;; because (symbol->dynamic-value (*function* (curlet))) is the calling function (func) so we have ;;; an infinite recursion. (when with-block (test (defined? 'subsequence (block) #t) #t) (test ((block) 'subsequence) subblock) (test (let-ref (block) 'subsequence) subblock) (test (with-let (block) subsequence) subblock) (test (symbol->value 'subsequence (block)) subblock) (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence abs abs abs))))) (test (func) 'error)) (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence 0-i abs abs))))) (test (func) 'error)) (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence abs 0-i abs))))) (test (func) 'error)) (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence abs abs 0-i))))) (test (func) 'error)) (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence 0-i 0-i 0-i))))) (test (func) 'error)) (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence 0-i 0-i abs))))) (test (func) 'error)) (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence 0-i abs 0-i))))) (test (func) 'error)) (let () (define (func) (do () (#t (with-let (block 1.0 2.0 3.0) (subsequence abs 0-i 0-i))))) (test (func) 'error)) (let () (define-constant imb12 (immutable! (block 0.0 1.0 2.0))) (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (set! var (symbol->value :allow-other-keys imb12)))) (test (func) :allow-other-keys))) ;;; symbol-initial-value (test (eq? (symbol-initial-value 'abs) #_abs) #t) (test (eq? (symbol-initial-value 'abs) abs) #t) ; (if global=initial) (test (set! (symbol-initial-value 'abs) 321) 'error) ; error: can't set! (symbol-initial-value 'abs); it is immutable (define (__init_f_ x) (+ x 1)) (test (symbol-initial-value '__init_f_) #) (test (set! (symbol-initial-value '__init_f_) __init_f_) __init_f_) (test (symbol-initial-value '__init_f_) __init_f_) (test (set! (symbol-initial-value '__init_f_) abs) 'error) (test (set! (symbol-initial-value :hi) abs) abs) (test (#_:hi -1) 1) ; yow (test (hi -1) 'error) (test (:hi -1) 'error) (test (symbol-initial-value :hi) abs) ; ??? (let ((g (gensym))) (test (symbol-initial-value g) #) (test (set! (symbol-initial-value g) abs) abs) (test (symbol-initial-value g) abs)) (for-each (lambda (arg) (test (symbol-initial-value arg) 'error) (test (set! (symbol-initial-value arg) 123) 'error)) (list "hi" '(1 2) (integer->char 65) 1 (make-vector 3) _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) (if #f #f) # #)) (test (symbol-initial-value 'quasiquote) #_quasiquote) (let () (define (f23 y) (+ y 1)) ; first f23 (define-macro (m1 x) `(f23 ,x)) ; picks up f23 from whatever the local env is where m1 is expanded (test (m1 3) 4) (let ((f23 (lambda (y) (+ y 2)))) ; second f23 (test (m1 3) 5) (set! (symbol-initial-value :f23) f23)) ; remember the second f23 as #_:f23 or (symbol-initial-value :f23) (define-macro (m2 x) `(,f23 ,x)) ; picks up f23 from curlet (m2's definition env) (define e1 #f) (let ((f23 (lambda (y) (+ y 3)))) ; third f23 (set! e1 (curlet)) ; save environment holding the third f23 (set! (symbol-initial-value 'e1) e1) (test (m2 3) 4)) ; y + 1 because at this point the definition env f23 is the first (set! (symbol-initial-value 'f23) f23) ; #_f23 now refers to the first f23 (set! f23 (lambda (y) (+ y 4))) ; fourth f23 (define-macro (m3 x) `((#_symbol-initial-value 'f23) ,x)) (define-macro (m4 x) `(#_f23 ,x)) (define-macro (m5 x) `((#_symbol-initial-value :f23) ,x)) ; reference to the second f23 (define-macro (m6 x) `(((#_symbol-initial-value 'e1) 'f23) ,x)) ; use e1 to get the third f23 (define-macro (m7 x) `((,e1 'f23) ,x)) ; deftime e1? (let ((f23 (lambda (y) (+ y 5)))) ; fifth f23 (test (m1 3) 8) ; = 3 + 5 from local (fifth) f23 (test (m2 3) 7) ; = 3 + 4 from definition env (the fourth f23) (test (m3 3) 4) ; = 3 + 1 from the first f23 (before its value was set) (test (catch #t (lambda () (m4 3)) (lambda (type info) (apply format #f info))) "attempt to apply an undefined object #_f23 in (#_f23 3)?") (test (m5 3) 5) ; = 3 + 2 from second f23 (test (m6 3) 6) ; = 3 + 3 from third f23 (let ((e1 32)) (test (m7 3) 6)))) ;; now look at capturing the other way (let () (define-macro (cap . body) `(let ((x 2)) ,@body)) ;; (macroexpand (cap (+ x 1))): (let ((x 2)) (+ x 1)) (test (let ((x 0)) (cap (+ x 1))) 3) ; captured (define-macro (cap1 . body) (let ((x (gensym))) `(let ((,x 2)) ,@body))) ;; (macroexpand (cap1 (+ x 1))): (let (({gensym}-0 2)) (+ x 1)) (test (let ((x 0)) (cap1 (+ x 1))) 1) ; not captured but gensym? (define-macro (cap2 . body) `(let ((e (curlet))) (let ((x 2)) (with-let e ,@body)))) ;; (macroexpand (cap2 (+ x 1))): (let ((e (curlet))) (let ((x 2)) (with-let e (+ x 1)))) (test (let ((x 0)) (cap2 (+ x 1))) 1) ; but "e"? (define-macro (cap3 . body) (#_let ((e (#_gensym))) `(#_let ((,e (#_curlet))) (#_let ((x 2)) (#_with-let ,e ,@body))))) ;; (macroexpand (cap3 (+ x 1))): (let (({gensym}-2 (curlet))) (let ((x 2)) (with-let {gensym}-2 (+ x 1)))) (test (let ((x 0)) (cap3 (+ x 1))) 1) ; ok but still a gensym (define-macro (cap4 . body) (#_let ((e (#_gensym))) `(#_let ((,e (#_curlet))) (#_set! (#_symbol-initial-value ',e) ,e) (#_let ((x 2)) (#_with-let (#_symbol-initial-value ',e) ,@body))))) ;; (macroexpand (cap4 (+ x 1))): ;; (#_let (({gensym}-4 (curlet))) (#_set! (symbol-initial-value '{gensym}-4) {gensym}-4) (#_let ((x 2)) (#_with-let (symbol-initial-value '{gensym}-4) (+ x 1)))) (test (let ((x 0)) (cap4 (+ x 1))) 1) ; ok?? ) ;;; -------------------------------------------------------------------------------- ;;; BYTE-VECTORS ;;; -------------------------------------------------------------------------------- (let ((bv #u(1 0 3))) (test bv #u(1 0 3)) (test (object->string bv) "#u(1 0 3)") (test (equal? bv #u(1 0 3)) #t) (test (eq? bv bv) #t) (test (eqv? bv bv) #t) (test (equal? (byte-vector 1 0 3) #u(1 0 3)) #t) (test (byte-vector? bv) #t) (test (equal? (make-byte-vector 3 0) #u(0 0 0)) #t) (test (string-ref #u(64 65 66) 1) 'error) (test (byte-vector-ref #u(64 65 66) 1) 65) (test (let ((nbv (copy bv))) (equal? nbv bv)) #t) (test (let ((rbv (reverse bv))) (equal? rbv #u(3 0 1))) #t) (test (length bv) 3) ) (test (eval-string "#u(-1)") 'error) (test (eval-string "#u(1.0)") 'error) (test (eval-string "#u(3/2)") 'error) (test (eval-string "#u(1+i)") 'error) (test (eval-string "#u((32))") 'error) (test (eval-string "#u(#\\a)") 'error) (test (eval-string "#u(256)") 'error) (test (eval-string "#u(1/0)") 'error) (test (eval-string "#u(9223372036854775807)") 'error) (test (eval-string "#u(-9223372036854775808)") 'error) (test #u(#b11 #x8) #u(3 8)) (test (eval-string "#u(1 2 . 3)") 'error) (test #u(255) (byte-vector 255)) (test (byte-vector 256) 'error) (test (byte-vector -1) 'error) (test (object->string #u()) "#u()") (test (object->string #u(255)) "#u(255)") (test (object->string #u(255 255)) "#u(255 255)") (test (object->string #u(128)) "#u(128)") (test (object->string #u(128 128)) "#u(128 128)") (test (length #u(0)) 1) (test (length #u(0 0)) 2) (test (length #u()) 0) (test (length (byte-vector)) 0) (test (byte-vector? #u()) #t) (test (equal? (let ((bv #u(1 0 3))) (set! (bv 2) 64) bv) #u(1 0 64)) #t) (test (let ((bv #u(1 0 3))) (map values bv)) '(1 0 3)) (test (let ((bv #u(1 0 3)) (lst ())) (for-each (lambda (x) (set! lst (cons x lst))) bv) lst) '(3 0 1)) (test (let ((bv #u(1 2 3))) (bv 1)) 2) (test (let ((bv #u(1 2 3))) (reverse bv)) #u(3 2 1)) (test (let ((bv #u(1 2 3))) (object->string (reverse bv))) "#u(3 2 1)") (test (let ((bv #u(1 2 3))) (copy bv)) #u(1 2 3)) (test (#u(1 2 3) 2) 3) (test (let ((v #u(0 1 2))) (let ((v1 (reverse! v))) (eq? v v1))) #t) (test (let ((v #u(0 1 2))) (reverse! v)) #u(2 1 0)) ;; should (vector? #u(1 2)) be #t? (test (format #f "~{~A ~}" (byte-vector 255 0)) "255 0 ") ;;; string->byte-vector -- why is this needed? -- why not use copy instead? (test (byte-vector? (string->byte-vector (string #\0))) #t) (test (byte-vector? (string->byte-vector "")) #t) (test (byte-vector? (string->byte-vector "1230")) #t) (test (byte-vector? (string->byte-vector (string->byte-vector (string #\0)))) 'error) (test (byte-vector? (string->byte-vector (string))) #t) (test (byte-vector? (string->byte-vector #u(1 2))) 'error) (test (byte-vector? (string->byte-vector #u())) 'error) (test (byte-vector? (string->byte-vector #(1 2))) 'error) (for-each (lambda (arg) (test (string->byte-vector arg) 'error) (test (byte-vector? arg) #f)) (list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) # (lambda (a) (+ a 1)))) (test (string->byte-vector #x010203) 'error) (test (string->byte-vector (immutable! "123")) #u(49 50 51)) (let ((str (immutable! "123"))) (string->byte-vector str) (test str "123") (test (immutable? str) #t)) (test (let ((str "123")) (string->byte-vector str) (byte-vector? str)) #f) (test (let ((str (string #\a))) (string->byte-vector str) (byte-vector? str)) #f) (test (let () (define (func) (string->byte-vector "ho")) (define (hi) (func) (func)) (hi) (hi)) #u(104 111)) (test (let () (define (func) (byte-vector->string #u(65))) (define (hi) (func) (func)) (hi) (hi)) "A") ;;; byte-vector->string (test (string? (byte-vector->string #u(0))) #t) (test (string? (byte-vector->string #u())) #t) (test (string? (byte-vector->string #u(1 2 3))) #t) (test (string? (byte-vector->string (string->byte-vector (string #\0)))) #t) (test (string? (byte-vector->string (byte-vector))) #t) (test (string? (byte-vector->string "asd")) 'error) (test (string? (byte-vector->string "")) 'error) (test (string? (byte-vector->string #(1 2))) 'error) (for-each (lambda (arg) (test (byte-vector->string arg) 'error)) (list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) # (lambda (a) (+ a 1)))) (test (byte-vector->string #x010203) 'error) (test (byte-vector->string (immutable! #u(49 50 51))) "123") (let ((bv (immutable! #u(49 50 51)))) (byte-vector->string bv) (test bv #u(49 50 51)) (test (immutable? bv) #t)) ;;; make-byte-vector (test (equal? (make-byte-vector 0) #u()) #t) (test (equal? (make-byte-vector 0 32) #u()) #t) (test (equal? (make-byte-vector 1 32) #u(32)) #t) (test (make-byte-vector 0 -32) 'error) (test (make-byte-vector 1 -32) 'error) (test (make-byte-vector 1 256) 'error) (test (make-byte-vector 1 3.0) 'error) (test (make-byte-vector 2) #u(0 0)) ; make sure it's init is 0 -- g_make_byte_vector bug (test (make-byte-vector 1) #u(0)) (for-each (lambda (arg) (if (not (eq? 'error (catch #t (lambda () (make-byte-vector arg)) (lambda args 'error)))) (format *stderr* ";(make-byte-vector ~S) returns a byte-vector?\n" arg)) (if (not (eq? 'error (catch #t (lambda () (make-byte-vector 1 arg)) (lambda args 'error)))) (format *stderr* ";(make-byte-vector 1 ~S) returns a byte-vector?\n" arg))) (list #\a () '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) # (lambda (a) (+ a 1)))) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (make-byte-vector most-positive-fixnum 0))) (f)) 'error) ;;; byte-vector (test (byte-vector) #u()) (test (byte-vector 32) (make-byte-vector 1 32)) (test (byte-vector 0 256) 'error) (test (byte-vector -1) 'error) (for-each (lambda (arg) (test (byte-vector arg) 'error)) (list #\a () (list 1) '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) # (lambda (a) (+ a 1)))) (test (map append #u(0 1 2)) '(0 1 2)) (test (format #f "~{#x~X~| ~}" #u(49 50 51)) "#x31 #x32 #x33") (test (format #f "~{~D~| ~}" (string->byte-vector "abcd")) "97 98 99 100") (test (let ((lst ())) (for-each (lambda (c) (set! lst (cons c lst))) #u(90 91 92)) (reverse lst)) '(90 91 92)) (test (integer? (#u(1 2 3) 0)) #t) (test (integer? ((string->byte-vector "abc") 1)) #t) (test ((vector (byte-vector 1)) 0 0) 1) ; i.e. not a character (test (let () (define (f) (or (#_byte-vector 1) (#_documentation cons))) (f)) #u(1)) ; optimizer bug #| (test (byte-vector 0 (openlet (inlet 'byte-vector (lambda args (append #u(1) (apply #_byte-vector (cdr args)))))) 2) #u(0 1 2)) |# (let ((bv (byte-vector 0 1 2 3))) (fill! bv 4) (test bv #u(4 4 4 4)) (fill! bv 1 1 3) (test bv #u(4 1 1 4)) (let ((bv1 (copy bv))) (test bv1 #u(4 1 1 4)) (fill! bv 1) (copy bv bv1) (test bv1 #u(1 1 1 1)) (fill! bv 255) (copy bv bv1 1 3) (test bv1 #u(255 255 1 1)))) ; copy and fill do not interpret their indices in the same way (one is source, the other destination) (test (equal? (byte-vector (char->integer #\a)) (string #\a)) #f) (test (equivalent? (byte-vector (char->integer #\a)) (string #\a)) #f) (test (byte-vector? (copy "12")) #f) (test (byte-vector? (copy #u(0))) #t) (test (byte-vector? (reverse (byte-vector 0 1))) #t) (test (let ((v (byte-vector 0))) (fill! v #\a)) 'error) (test (let ((v (byte-vector 0))) (fill! v 1) v) #u(1)) (test (byte-vector? (append #u(0 1) (byte-vector 2 3))) #t) ;;; should string->byte-vector insist on string (not bv) arg? similarly for string-ref et al? ;;; byte-vector-ref ;;; byte-vector-set! (test (let ((str "123")) (byte-vector-ref str 0)) 'error) (test (let ((str "123")) (byte-vector-set! str 0 1)) 'error) (test (let ((str "123")) (byte-vector-set! str 0 #\1)) 'error) (test (let ((str (byte-vector 0 1 2))) (byte-vector-ref str 0)) 0) (test (let ((str (byte-vector 0 1 2))) (char? (byte-vector-ref str 0))) #f) (test (let ((str (byte-vector 0 1 2))) (byte-vector-set! str 0 1)) 1) (test (let ((str (byte-vector 0 1 2))) (byte-vector-set! str 0 #\1)) 'error) (test (byte-vector-ref #u(0 1 2)) 'error) (test (byte-vector-ref) 'error) (test (byte-vector-ref #u(0 1 2) 1 1) 'error) (test (byte-vector-ref #u(0 1 2) -1) 'error) (test (byte-vector-set! #u(0 1 2)) 'error) (test (byte-vector-set! #u(0 1 2) 0) 'error) (test (byte-vector-set!) 'error) (test (byte-vector-set! #u(0 1 2) 1 1 2) 'error) (test (byte-vector-set! #u(0 1 2) -1 1) 'error) (test (let ((iv #i2d((0 1) (2 3)))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (byte-vector-set! iv 1 0)))) (func)) 'error) (for-each (lambda (arg) (test (byte-vector-ref arg 0) 'error) (test (byte-vector-set! arg 0 0) 'error) (test (byte-vector-ref #u(0 1 2) arg) 'error) (test (byte-vector-set! #u(0 1 2) arg 0) 'error) (test (byte-vector-set! #u(0 1 2) 0 arg) 'error) (test (let ((v #u(0 1 2))) (v arg)) 'error) (test (let ((v #u(0 1 2))) (set! (v arg) 0)) 'error)) (list #\a () (list 1) "str" "" '(1 . 2) #f (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (if #f #f) # (lambda (a) (+ a 1)))) (test (let ((v #u(0 1 2))) (v 1)) 1) (test (let ((v (byte-vector 0 1 2))) (set! (v 1) 3) v) #u(0 3 2)) (test (let ((bv (byte-vector #\1))) bv) 'error) (test (let ((bv (string 1))) bv) 'error) (let ((bv #u(0 1))) (test (string->byte-vector (byte-vector->string bv)) bv)) (test (let ((bv (byte-vector 1))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (byte-vector-set! bv 0 #\1))) (f)) 'error) (test (let ((bc #u(0 1))) (set! (bc 0) #\1)) 'error) (test (let ((bc #u(0 1))) (byte-vector-set! bc 0 #\1)) 'error) (test (let ((bc #u(0 1))) (string-set! bc 0 #\1)) 'error) (test (let ((bc "123")) (set! (bc 0) 1)) 'error) (test (let ((bc "123")) (string-set! bc 0 1)) 'error) (test (let ((bc "123")) (byte-vector-set! bc 0 1)) 'error) (test (let ((bv (byte-vector 1))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! (bv 0) #\1))) (f)) 'error) (test (let ((bv (string #\1))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! (bv 0) 1))) (f)) 'error) (test (let ((bv (string #\1))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (string-set! bv 0 1))) (f)) 'error) (test (let () (define (hi) (do ((i 0 (+ i 1))) ((= i 1)) (char-alphabetic? (string-ref #u(0 1) 1)))) (hi)) 'error) (let ((fv (byte-vector 0 1))) (test (byte-vector-ref fv 0 0) 'error) (test (vector-ref fv 0 0) 'error) (test (fv 0 0) 'error)) (let ((fv #i2d((1 2) (3 4)))) (test (byte-vector-ref fv 0 0 0) 'error) (test (byte-vector-ref fv 0 0 0 0) 'error) (test (vector-ref fv 0 0 0) 'error) (test (fv 0 0 0) 'error)) (let ((bv (byte-vector 0 1 2))) (test (byte-vector-ref bv bv) 'error) (test (bv bv) 'error) (test (call-with-input-file (apply bv bv (list))) 'error)) (let ((bv (make-byte-vector '(2 3)))) (test (vector-length bv) 6) (test (length bv) 6) (test (vector-dimensions bv) '(2 3)) (byte-vector-set! bv 0 0 32) (test (byte-vector-ref bv 0 0) 32) (set! (bv 0 1) 33) (test (bv 0 1) 33) (fill! bv 1) (test bv (make-byte-vector '(2 3) 1)) (test (bv 0) #u(1 1 1)) (set! (bv 0 0) 2) (test (copy bv (make-byte-vector 4)) #u(2 1 1 1))) (let ((bv #u(1 2 3))) (test (fill! bv #\a) 'error) (test (vector-fill! bv #\a) 'error) (test (fill! bv -1) 'error) (test (vector-fill! bv 256) 'error) (test (bv 3) 'error) (test (vector-ref bv 3) 'error) (test (vector-ref bv 0) 1) (vector-set! bv 1 32) (test (bv 1) 32) (test (copy #i(1 2 321) (make-byte-vector 3)) 'error)) (test (copy #i(31 32 321) (make-string 3)) 'error) (test (copy #(31 32 321) (make-byte-vector 3)) 'error) (test (copy '(31 32 321) (make-byte-vector 3)) 'error) (test (copy #(31 32 321) (make-string 3)) 'error) (test (copy '(31 32 321) (make-string 3)) 'error) (let ((bv (make-byte-vector '(2 3) 95))) (test (byte-vector->string bv) "______") (test (vector->list bv) '(95 95 95 95 95 95))) (let ((bv #u(0 1 2 3 4 5))) (test (subvector bv 0 2) #u(0 1)) (test (subvector bv 2 4) #u(2 3)) (test (subvector bv 0 4 '(2 2)) (let ((b (make-byte-vector '(2 2)))) (copy bv b) b)) (test (vector-append bv #i(6 7)) #u(0 1 2 3 4 5 6 7)) (test (append bv #i(6 7)) #u(0 1 2 3 4 5 6 7))) (test ((make-byte-vector '(2 3) 1) 1) #u(1 1 1)) (test ((make-byte-vector '(2 4) 1) 1) #u(1 1 1 1)) (test ((make-byte-vector '(2 3) 1) 0) #u(1 1 1)) (test ((make-byte-vector '(2 4) 12) 0) #u(12 12 12 12)) (test ((make-byte-vector '(3 2) 12) 1) #u(12 12)) (test ((make-byte-vector '(3 2) 12) 2) #u(12 12)) (test (byte-vector-ref (make-byte-vector '(3 2) 12) 2) #u(12 12)) (test (let ((bv (make-byte-vector '(2 3) 0))) (copy #u(1 2 3 4 5 6) bv) (subvector bv 2 6)) #u(3 4 5 6)) (test (object->string #u2d((1 2) (3 4))) "#u2d((1 2) (3 4))") (test (object->string #u8(1 2)) "#u(1 2)") (let ((x #u2d((1 2) (3 4))) (lst ())) (test (do ((iter (make-iterator x)) (lst ())) ((iterator-at-end? iter) (reverse lst)) (set! lst (cons (iter) lst))) '(1 2 3 4 #))) (test (equal? #i(1) #u(1)) #t) (test (equivalent? #i(1) #u(1)) #t) (test (equal? #u(1) #i(1)) #t) (test (equivalent? #u(1) #i(1)) #t) (test (equal? #u(1 2 3 4) #u2d((1 2) (3 4))) #f) (test (equal? #i(1 2 3 4) #i2d((1 2) (3 4))) #f) (test (equivalent? #u(1 2 3 4) #u2d((1 2) (3 4))) #f) (test (subvector #u(1 2 3 4) 0 3) #u(1 2 3)) (test (equivalent? #u2d((1 2) (3 4)) #i2d((1 2) (3 4))) #t) ;;; -------------------------------------------------------------------------------- ;;; LISTS ;;; -------------------------------------------------------------------------------- ;;; -------------------------------------------------------------------------------- ;;; cons (test (cons 'a ()) '(a)) (test (cons '(a) '(b c d)) '((a) b c d)) (test (cons "a" '(b c)) '("a" b c)) (test (cons 'a 3) '(a . 3)) (test (cons '(a b) 'c) '((a b) . c)) (test (cons () ()) '(())) (test (cons () 1) '(() . 1)) (test (cons 1 2) '(1 . 2)) (test (cons 1 ()) '(1)) (test (cons () 2) '(() . 2)) (test (cons 1 (cons 2 (cons 3 (cons 4 ())))) '(1 2 3 4)) (test (cons 'a 'b) '(a . b)) (test (cons 'a (cons 'b (cons 'c ()))) '(a b c)) (test (cons 'a (list 'b 'c 'd)) '(a b c d)) (test (cons 'a (cons 'b (cons 'c 'd))) '(a b c . d)) (test '(a b c d e) '(a . (b . (c . (d . (e . ())))))) (test (cons (cons 1 2) (cons 3 4)) '((1 . 2) 3 . 4)) (test (list (cons 1 2) (cons 3 4)) '((1 . 2) (3 . 4))) (test (cons (cons 1 (cons 2 3)) 4) '((1 . (2 . 3)) . 4)) (test (cons (cons 1 (cons 2 ())) (cons 1 2)) '((1 2) . (1 . 2))) (test (let ((lst (list 1 2))) (list (apply cons lst) lst)) '((1 . 2) (1 2))) (test (let ((lst (list 1 2))) (list lst (apply cons lst))) '((1 2) (1 . 2))) (test (cdadr (let ((lst (list 1 2))) (list (apply cons lst) lst))) '(2)) (test (cons '+ '=) '(+ . =)) (test (cons .(cadddr 10)) (cons cadddr 10)) (test (#_cons 1 2) '(1 . 2)) (test (cons 1 ()) '( 1 )) ;;; -------------------------------------------------------------------------------- ;;; car (test (car (list 1 2 3)) 1) (test (car (cons 1 2)) 1) (test (car (list 1)) 1) (test (car '(1 2 3)) 1) (test (car '(1)) 1) (test (car '(1 . 2)) 1) (test (car '((1 2) 3)) '(1 2)) (test (car '(((1 . 2) . 3) 4)) '((1 . 2) . 3)) (test (car (list (list) (list 1 2))) ()) (test (car '(a b c)) 'a) (test (car '((a) b c d)) '(a)) (test (car (reverse (list 1 2 3 4))) 4) (test (car (list 'a 'b 'c 'd 'e 'f 'g)) 'a) (test (car '(a b c d e f g)) 'a) (test (car '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((((1 2 3) 4) 5) (6 7))) (test (car '(a)) 'a) (test (car '(1 ^ 2)) 1) (test (car '(1 .. 2)) 1) (test (car ''foo) #_quote) (test (car '(1 2 . 3)) 1) (test (car (cons 1 ())) 1) (test (car (if #f #f)) 'error) (test (car ()) 'error) (test (car #(1 2)) 'error) (let ((L (list 1 2 3))) (set! (car L) 32) (test L '(32 2 3))) (let ((L (list 1 2 3))) (set! (#_car L) 12) (test L '(12 2 3))) (for-each (lambda (arg) (if (not (equal? (car (cons arg ())) arg)) (format #t ";(car '(~A)) returned ~A?~%" arg (car (cons arg ())))) (test (car arg) 'error)) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (reinvert 12 car (lambda (a) (cons a ())) '(1)) '(1)) ;;; -------------------------------------------------------------------------------- ;;; cdr (test (cdr (list 1 2 3)) '(2 3)) (test (cdr (cons 1 2)) 2) (test (cdr (list 1)) ()) (test (cdr '(1 2 3)) '(2 3)) (test (cdr '(1)) ()) (test (cdr '(1 . 2)) 2) (test (cdr '((1 2) 3)) '(3)) (test (cdr '(((1 . 2) . 3) 4)) '(4)) (test (cdr (list (list) (list 1 2))) '((1 2))) (test (cdr '(a b c)) '(b c)) (test (cdr '((a) b c d)) '(b c d)) (test (equal? (cdr (reverse (list 1 2 3 4))) 4) #f) (test (equal? (cdr (list 'a 'b 'c 'd 'e 'f 'g)) 'a) #f) (test (cdr '((((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f) g)) '(g)) (test (cdr '(a)) ()) (test (cdr '(a b c d e f g)) '(b c d e f g)) (test (cdr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((((u v w) x) y) ((q w e) r) (a b c) e f g)) (test (cdr ''foo) '(foo)) (test (cdr (cons (cons 1 2) (cons 3 4))) '(3 . 4)) (test (cdr '(1 2 . 3)) '(2 . 3)) (test (cdr (if #f #f)) 'error) (test (cdr ()) 'error) (for-each (lambda (arg) (if (not (equal? (cdr (cons () arg)) arg)) (format #t ";(cdr '(() ~A) -> ~A?~%" arg (cdr (cons () arg)))) (test (cdr arg) 'error)) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (let* ((a (list 1 2 3)) (b a)) (set! (car a) (cadr a)) (set! (cdr a) (cddr a)) (test a (list 2 3)) (test b a)) (define (cons-r a b n) (if (= 0 n) (cons a b) (cons (cons-r (+ a 1) (+ b 1) (- n 1)) (cons-r (- a 1) (- b 1) (- n 1))))) (define (list-r a b n) (if (= 0 n) (list a b) (list (list-r (+ a 1) (+ b 1) (- n 1)) (list-r (- a 1) (- b 1) (- n 1))))) (define lists (list (list 1 2 3) (cons 1 2) (list 1) (list) (list (list 1 2) (list 3 4)) (list (list 1 2) 3) '(1 . 2) '(a b c) '((a) b (c)) '((1 2) (3 4)) '((1 2 3) (4 5 6) (7 8 9)) '(((1) (2) (3)) ((4) (5) (6)) ((7) (8) (9))) '((((1 123) (2 124) (3 125) (4 126)) ((5) (6) (7) (8)) ((9) (10) (11) (12)) ((13) (14) (15) (16))) (((21 127) (22 128) (23 129) (24 130)) ((25) (26) (27) (28)) ((29) (30) (31) (32)) ((33) (34) (35) (36))) (((41 131) (42 132) (43 133) (44 134)) ((45) (46) (47) (48)) ((49) (50) (51) (52)) ((53) (54) (55) (56))) (((61 135) (62 136) (63 137) (64 138)) ((65) (66) (67) (68)) ((69) (70) (71) (72)) ((73) (74) (75) (76))) 321) (cons 1 (cons 2 (cons 3 4))) (cons (cons 2 (cons 3 4)) 5) (cons () 1) (cons 1 ()) (cons () ()) (list 1 2 (cons 3 4) 5 (list (list 6) 7)) (cons-r 0 0 4) (cons-r 0 0 5) (cons-r 0 0 10) (list-r 0 0 3) (list-r 0 0 7) (list-r 0 0 11) ''a )) ;;; -------------------------------------------------------------------------------- ;;; cxr (define (caar-1 x) (car (car x))) (define (cadr-1 x) (car (cdr x))) (define (cdar-1 x) (cdr (car x))) (define (cddr-1 x) (cdr (cdr x))) (define (caaar-1 x) (car (car (car x)))) (define (caadr-1 x) (car (car (cdr x)))) (define (cadar-1 x) (car (cdr (car x)))) (define (caddr-1 x) (car (cdr (cdr x)))) (define (cdaar-1 x) (cdr (car (car x)))) (define (cdadr-1 x) (cdr (car (cdr x)))) (define (cddar-1 x) (cdr (cdr (car x)))) (define (cdddr-1 x) (cdr (cdr (cdr x)))) (define (caaaar-1 x) (car (car (car (car x))))) (define (caaadr-1 x) (car (car (car (cdr x))))) (define (caadar-1 x) (car (car (cdr (car x))))) (define (caaddr-1 x) (car (car (cdr (cdr x))))) (define (cadaar-1 x) (car (cdr (car (car x))))) (define (cadadr-1 x) (car (cdr (car (cdr x))))) (define (caddar-1 x) (car (cdr (cdr (car x))))) (define (cadddr-1 x) (car (cdr (cdr (cdr x))))) (define (cdaaar-1 x) (cdr (car (car (car x))))) (define (cdaadr-1 x) (cdr (car (car (cdr x))))) (define (cdadar-1 x) (cdr (car (cdr (car x))))) (define (cdaddr-1 x) (cdr (car (cdr (cdr x))))) (define (cddaar-1 x) (cdr (cdr (car (car x))))) (define (cddadr-1 x) (cdr (cdr (car (cdr x))))) (define (cdddar-1 x) (cdr (cdr (cdr (car x))))) (define (cddddr-1 x) (cdr (cdr (cdr (cdr x))))) (for-each (lambda (name op1 op2) (for-each (lambda (lst) (let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error))) (val2 (catch #t (lambda () (op2 lst)) (lambda args 'error)))) (if (not (equal? val1 val2)) (format #t ";(~A ~S) -> ~S, (~A-1): ~S?~%" name lst val1 name val2)))) lists)) (list 'caar 'cadr 'cdar 'cddr 'caaar 'caadr 'cadar 'cdaar 'caddr 'cdddr 'cdadr 'cddar 'caaaar 'caaadr 'caadar 'cadaar 'caaddr 'cadddr 'cadadr 'caddar 'cdaaar 'cdaadr 'cdadar 'cddaar 'cdaddr 'cddddr 'cddadr 'cdddar) (list caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar) (list caar-1 cadr-1 cdar-1 cddr-1 caaar-1 caadr-1 cadar-1 cdaar-1 caddr-1 cdddr-1 cdadr-1 cddar-1 caaaar-1 caaadr-1 caadar-1 cadaar-1 caaddr-1 cadddr-1 cadadr-1 caddar-1 cdaaar-1 cdaadr-1 cdadar-1 cddaar-1 cdaddr-1 cddddr-1 cddadr-1 cdddar-1)) (test (equal? (cadr (list 'a 'b 'c 'd 'e 'f 'g)) 'b) #t) (test (equal? (cddr (list 'a 'b 'c 'd 'e 'f 'g)) '(c d e f g)) #t) (test (equal? (caddr (list 'a 'b 'c 'd 'e 'f 'g)) 'c) #t) (test (equal? (cdddr (list 'a 'b 'c 'd 'e 'f 'g)) '(d e f g)) #t) (test (equal? (cadddr (list 'a 'b 'c 'd 'e 'f 'g)) 'd) #t) (test (equal? (cddddr (list 'a 'b 'c 'd 'e 'f 'g)) '(e f g)) #t) (test (equal? (caadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '((u v w) x)) #t) (test (equal? (cadar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(6 7)) #t) (test (equal? (cdaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(5)) #t) (test (equal? (cdadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(y)) #t) (test (equal? (cddar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) ()) #t) (test (equal? (caaaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(1 2 3)) #t) (test (equal? (caadar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 6) #t) (test (equal? (caaddr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(q w e)) #t) (test (equal? (cadaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 5) #t) (test (equal? (cadadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 'y) #t) (test (equal? (caddar (list (list (list (list (list 1 2 3) 4) 5) 1 6 (list 5 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) 6) #t) (test (equal? (cadddr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(a b c)) #t) (test (equal? (cdaaar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(4)) #t) (test (equal? (cdaadr (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(x)) #t) (test (equal? (cdadar (list (list (list (list (list 1 2 3) 4) 5) (list 6 7)) (list (list (list 'u 'v 'w) 'x) 'y) (list (list 'q 'w 'e) 'r) (list 'a 'b 'c) 'e 'f 'g)) '(7)) #t) (test (caar '((a) b c d e f g)) 'a) (test (cadr '(a b c d e f g)) 'b) (test (cdar '((a b) c d e f g)) '(b)) (test (cddr '(a b c d e f g)) '(c d e f g)) (test (caaar '(((a)) b c d e f g)) 'a) (test (caadr '(a (b) c d e f g)) 'b) (test (cadar '((a b) c d e f g)) 'b) (test (caddr '(a b c d e f g)) 'c) (test (cdaar '(((a b)) c d e f g)) '(b)) (test (cdadr '(a (b c) d e f g)) '(c)) (test (cddar '((a b c) d e f g)) '(c)) (test (cdddr '(a b c d e f g)) '(d e f g)) (test (caaaar '((((a))) b c d e f g)) 'a) (test (caaadr '(a ((b)) c d e f g)) 'b) (test (caadar '((a (b)) c d e f g)) 'b) (test (caaddr '(a b (c) d e f g)) 'c) (test (cadaar '(((a b)) c d e f g)) 'b) (test (cadadr '(a (b c) d e f g)) 'c) (test (caddar '((a b c) d e f g)) 'c) (test (cadddr '(a b c d e f g)) 'd) (test (cdaaar '((((a b))) c d e f g)) '(b)) (test (cdaadr '(a ((b c)) d e f g)) '(c)) (test (cdadar '((a (b c)) d e f g)) '(c)) (test (cdaddr '(a b (c d) e f g)) '(d)) (test (cddaar '(((a b c)) d e f g)) '(c)) (test (cddadr '(a (b c d) e f g)) '(d)) (test (cdddar '((a b c d) e f g)) '(d)) (test (cddddr '(a b c d e f g)) '(e f g)) (test (cadr '(1 2 . 3)) 2) (test (cddr '(1 2 . 3)) 3) (test (cadadr '''1) 1) (test (cdadr '''1) '(1)) ;; sacla (test (caar '((a) b c)) 'a) (test (cadr '(a b c)) 'b) (test (cdar '((a . aa) b c)) 'aa) (test (cddr '(a b . c)) 'c) (test (caaar '(((a)) b c)) 'a) (test (caadr '(a (b) c)) 'b) (test (cadar '((a aa) b c)) 'aa) (test (caddr '(a b c)) 'c) (test (cdaar '(((a . aa)) b c)) 'aa) (test (cdadr '(a (b . bb) c)) 'bb) (test (cddar '((a aa . aaa) b c)) 'aaa) (test (cdddr '(a b c . d)) 'd) (test (caaaar '((((a))) b c)) 'a) (test (caaadr '(a ((b)) c)) 'b) (test (caadar '((a (aa)) b c)) 'aa) (test (caaddr '(a b (c))) 'c) (test (cadaar '(((a aa)) b c)) 'aa) (test (cadadr '(a (b bb) c)) 'bb) (test (caddar '((a aa aaa) b c)) 'aaa) (test (cadddr '(a b c d)) 'd) (test (cdaaar '((((a . aa))) b c)) 'aa) (test (cdaadr '(a ((b . bb)) c)) 'bb) (test (cdadar '((a (aa . aaa)) b c)) 'aaa) (test (cdaddr '(a b (c . cc))) 'cc) (test (cddaar '(((a aa . aaa)) b c)) 'aaa) (test (cddadr '(a (b bb . bbb) c)) 'bbb) (test (cdddar '((a aa aaa . aaaa) b c)) 'aaaa) (test (cddddr '(a b c d . e)) 'e) (test (caar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(((1 2 3) 4) 5)) (test (cadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(((u v w) x) y)) (test (cdar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((6 7))) (test (cddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(((q w e) r) (a b c) e f g)) (test (caaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((1 2 3) 4)) (test (caadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((u v w) x)) (test (cadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(6 7)) (test (caddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((q w e) r)) (test (cdaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(5)) (test (cdadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(y)) (test (cddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ()) (test (cdddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '((a b c) e f g)) (test (caaaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(1 2 3)) (test (caaadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(u v w)) (test (caadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 6) (test (caaddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(q w e)) (test (cadaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 5) (test (cadadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'y) (test (cadddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(a b c)) (test (cdaaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(4)) (test (cdaadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(x)) (test (cdadar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(7)) (test (cdaddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(r)) (test (cddaar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ()) (test (cddadr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) ()) (test (cddddr '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) '(e f g)) (test (caar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '((a . b) c . d)) (test (caar '(((a . b) c . d) (e . f) g . h)) '(a . b)) (test (caar '((a . b) c . d)) 'a) (test (cadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '((i . j) k . l)) (test (cadr '(((a . b) c . d) (e . f) g . h)) '(e . f)) (test (cadr '((a . b) c . d)) 'c) (test (cdar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '((e . f) g . h)) (test (cdar '(((a . b) c . d) (e . f) g . h)) '(c . d)) (test (cdar '((a . b) c . d)) 'b) (test (cddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '((m . n) o . p)) (test (cddr '(((a . b) c . d) (e . f) g . h)) '(g . h)) (test (cddr '((a . b) c . d)) 'd) (test (caaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '(a . b)) (test (caaar '(((a . b) c . d) (e . f) g . h)) 'a) (test (caadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '(i . j)) (test (caadr '(((a . b) c . d) (e . f) g . h)) 'e) (test (cddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '(g . h)) (test (cddar '(((a . b) c . d) (e . f) g . h)) 'd) (test (cdddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) '(o . p)) (test (cdddr '(((a . b) c . d) (e . f) g . h)) 'h) (test (caaaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'a) (test (caaadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'i) (test (caddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'g) (test (cadddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'o) (test (cdaaar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'b) (test (cdaadr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'j) (test (cdddar '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'h) (test (cddddr '((((a . b) c . d) (e . f) g . h) ((i . j) k . l) (m . n) o . p)) 'p) (test (cadr ''foo) 'foo) (let ((lst '((((A . B) C . D) (E . F) G . H) ((I . J) K . L) (M . N) O . P))) ; from comp.lang.lisp I think (test (car lst) '(((A . B) C . D) (E . F) G . H)) (test (cdr lst) '(((I . J) K . L) (M . N) O . P)) (test (caar lst) '((A . B) C . D)) (test (cadr lst) '((I . J) K . L)) (test (cdar lst) '((E . F) G . H)) (test (cddr lst) '((M . N) O . P)) (test (caaar lst) '(A . B)) (test (caadr lst) '(I . J)) (test (cadar lst) '(E . F)) (test (caddr lst) '(M . N)) (test (cdaar lst) '(C . D)) (test (cdadr lst) '(K . L)) (test (cddar lst) '(G . H)) (test (cdddr lst) '(O . P)) (test (caaaar lst) 'A) (test (caaadr lst) 'I) (test (caadar lst) 'E) (test (caaddr lst) 'M) (test (cadaar lst) 'C) (test (cadadr lst) 'K) (test (caddar lst) 'G) (test (cadddr lst) 'O) (test (cdaaar lst) 'B) (test (cdaadr lst) 'J) (test (cdadar lst) 'F) (test (cdaddr lst) 'N) (test (cddaar lst) 'D) (test (cddadr lst) 'L) (test (cdddar lst) 'H) (test (cddddr lst) 'P)) (test (recompose 10 cdr '(1 2 3 4 5 6 7 8 9 10 11 12)) '(11 12)) (test (recompose 10 car '(((((((((((1 2 3)))))))))))) '(1 2 3)) (test (cons 1 . 2) 'error) (test (eval-string "(1 . 2 . 3)") 'error) (test (car (list)) 'error) (test (cdr (list)) 'error) (test (caddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error) (test (cdddar '(((((1 2 3) 4) 5) (6 7)) (((u v w) x) y) ((q w e) r) (a b c) e f g)) 'error) (test (caar '(a b c d e f g)) 'error) (test (cdar '(a b c d e f g)) 'error) (test (caaar '(a b c d e f g)) 'error) (test (caadr '(a b c d e f g)) 'error) (test (cadar '(a b c d e f g)) 'error) (test (cdaar '(a b c d e f g)) 'error) (test (cdadr '(a b c d e f g)) 'error) (test (cddar '(a b c d e f g)) 'error) (test (caaaar '(a b c d e f g)) 'error) (test (caaadr '(a b c d e f g)) 'error) (test (caadar '(a b c d e f g)) 'error) (test (caaddr '(a b c d e f g)) 'error) (test (cadaar '(a b c d e f g)) 'error) (test (cadadr '(a b c d e f g)) 'error) (test (caddar '(a b c d e f g)) 'error) (test (cdaaar '(a b c d e f g)) 'error) (test (cdaadr '(a b c d e f g)) 'error) (test (cdadar '(a b c d e f g)) 'error) (test (cdaddr '(a b c d e f g)) 'error) (test (cddaar '(a b c d e f g)) 'error) (test (cddadr '(a b c d e f g)) 'error) (test (cdddar '(a b c d e f g)) 'error) (test (caar 'a) 'error) (test (caar '(a)) 'error) (test (cadr 'a) 'error) (test (cadr '(a . b)) 'error) (test (cdar 'a) 'error) (test (cdar '(a . b)) 'error) (test (cddr 'a) 'error) (test (cddr '(a . b)) 'error) (test (caaar 'a) 'error) (test (caaar '(a)) 'error) (test (caaar '((a))) 'error) (test (caadr 'a) 'error) (test (caadr '(a . b)) 'error) (test (caadr '(a b)) 'error) (test (cadar 'a) 'error) (test (cadar '(a . b)) 'error) (test (cadar '((a . c) . b)) 'error) (test (caddr 'a) 'error) (test (caddr '(a . b)) 'error) (test (caddr '(a c . b)) 'error) (test (cdaar 'a) 'error) (test (cdaar '(a)) 'error) (test (cdaar '((a . b))) 'error) (test (cdadr 'a) 'error) (test (cdadr '(a . b)) 'error) (test (cdadr '(a b . c)) 'error) (test (cddar 'a) 'error) (test (cddar '(a . b)) 'error) (test (cddar '((a . b) . b)) 'error) (test (cdddr 'a) 'error) (test (cdddr '(a . b)) 'error) (test (cdddr '(a c . b)) 'error) (test (caaaar 'a) 'error) (test (caaaar '(a)) 'error) (test (caaaar '((a))) 'error) (test (caaaar '(((a)))) 'error) (test (caaadr 'a) 'error) (test (caaadr '(a . b)) 'error) (test (caaadr '(a b)) 'error) (test (caaadr '(a (b))) 'error) (test (caadar 'a) 'error) (test (caadar '(a . b)) 'error) (test (caadar '((a . c) . b)) 'error) (test (caadar '((a c) . b)) 'error) (test (caaddr 'a) 'error) (test (caaddr '(a . b)) 'error) (test (caaddr '(a c . b)) 'error) (test (caaddr '(a c b)) 'error) (test (cadaar 'a) 'error) (test (cadaar '(a)) 'error) (test (cadaar '((a . b))) 'error) (test (cadaar '((a b))) 'error) (test (cadadr 'a) 'error) (test (cadadr '(a . b)) 'error) (test (cadadr '(a b . c)) 'error) (test (cadadr '(a (b . e) . c)) 'error) (test (caddar 'a) 'error) (test (caddar '(a . b)) 'error) (test (caddar '((a . b) . b)) 'error) (test (caddar '((a b . c) . b)) 'error) (test (cadddr 'a) 'error) (test (cadddr '(a . b)) 'error) (test (cadddr '(a c . b)) 'error) (test (cadddr '(a c e . b)) 'error) (test (cdaaar 'a) 'error) (test (cdaaar '(a)) 'error) (test (cdaaar '((a))) 'error) (test (cdaaar '(((a . b)))) 'error) (test (cdaadr 'a) 'error) (test (cdaadr '(a . b)) 'error) (test (cdaadr '(a b)) 'error) (test (cdaadr '(a (b . c))) 'error) (test (cdadar 'a) 'error) (test (cdadar '(a . b)) 'error) (test (cdadar '((a . c) . b)) 'error) (test (cdadar '((a c . d) . b)) 'error) (test (cdaddr 'a) 'error) (test (cdaddr '(a . b)) 'error) (test (cdaddr '(a c . b)) 'error) (test (cdaddr '(a c b . d)) 'error) (test (cddaar 'a) 'error) (test (cddaar '(a)) 'error) (test (cddaar '((a . b))) 'error) (test (cddaar '((a b))) 'error) (test (cddadr 'a) 'error) (test (cddadr '(a . b)) 'error) (test (cddadr '(a b . c)) 'error) (test (cddadr '(a (b . e) . c)) 'error) (test (cdddar 'a) 'error) (test (cdddar '(a . b)) 'error) (test (cdddar '((a . b) . b)) 'error) (test (cdddar '((a b . c) . b)) 'error) (test (cddddr 'a) 'error) (test (cddddr '(a . b)) 'error) (test (cddddr '(a c . b)) 'error) (test (cddddr '(a c e . b)) 'error) (test (caar '((1))) 1) (test (cadr '(1 2)) 2) (test (cdar '((1 . 2))) 2) (test (caaar '(((1)))) 1) (test (caadr '(1 (2))) 2) (test (cadar '((1 2))) 2) (test (cdaar '(((1 . 2)))) 2) (test (caddr '(1 2 3)) 3) (test (cdddr '(1 2 3 . 4)) 4) (test (cdadr '(1 (2 . 3))) 3) (test (cddar '((1 2 . 3))) 3) (test (caaaar '((((1))))) 1) (test (caaadr '(1 ((2)))) 2) (test (caadar '((1 (2)))) 2) (test (cadaar '(((1 2)))) 2) (test (caaddr '(1 2 (3))) 3) (test (cadddr '(1 2 3 4)) 4) (test (cadadr '(1 (2 3))) 3) (test (caddar '((1 2 3))) 3) (test (cdaaar '((((1 . 2))))) 2) (test (cdaadr '(1 ((2 . 3)))) 3) (test (cdadar '((1 (2 . 3)))) 3) (test (cddaar '(((1 2 . 3)))) 3) (test (cdaddr '(1 2 (3 . 4))) 4) (test (cddddr '(1 2 3 4 . 5)) 5) (test (cddadr '(1 (2 3 . 4))) 4) (test (cdddar '((1 2 3 . 4))) 4) (let () (define (f1 x) (eq? (car x) 'y)) (let ((z 1)) (test (f1 z) 'error))) (let () (define (f1 x) (eq? (cdr x) 'y)) (let ((z 1)) (test (f1 z) 'error))) (let () (define (f1 x) (eq? (caar x) 'y)) (let ((z (list 1 2))) (test (f1 z) 'error))) (let () (define (f1 x) (eq? (cadr x) 'y)) (let ((z (cons 1 2))) (test (f1 z) 'error))) (let () (define (f1 x) (eq? (cdar x) 'y)) (let ((z (list 1 2))) (test (f1 z) 'error))) (let () (define (f1 x) (eq? (cddr x) 'y)) (let ((z (cons 1 2))) (test (f1 z) 'error))) ;;; -------------------------------------------------------------------------------- ;;; length (test (length (list 'a 'b 'c 'd 'e 'f)) 6) (test (length (list 'a 'b 'c 'd)) 4) (test (length (list 'a (list 'b 'c) 'd)) 3) (test (length ()) 0) (test (length '(this-that)) 1) (test (length '(this - that)) 3) (test (length '(a b)) 2) (test (length '(a b c)) 3) (test (length '(a (b) (c d e))) 3) (test (length (list 1 (cons 1 2))) 2) (test (length (list 1 (cons 1 ()))) 2) (for-each (lambda (arg) (test (length arg) #f)) (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (length 'x) #f) (test (length (cons 1 2)) -1) (let ((x (list 1 2))) (set-cdr! x x) (test (infinite? (length x)) #t)) (test (length '(1 2 . 3)) -2) (test (length) 'error) (test (length '(1 2 3) #(1 2 3)) 'error) (test (integer? (length (funclet cons))) #t) (test (> (length (rootlet)) 200) #t) (test (length '((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 1) (test (let ((f (lambda (a) (values a (+ a 1))))) (define (f1 x) (hash-table-entries (and (< (length x) 100) x))) (f1 f)) 'error) (test (let ((f (lambda (a) (values a (+ a 1))))) (define (f1 x) (hash-table-entries (and (= (length x) 100) x))) (f1 f)) 'error) (test (call-with-input-string "01234" (lambda (p) (length p))) 5) (test (call-with-input-file "s7test.scm" (lambda (p) (> (length p) 5000000))) #t) (unless pure-s7 (test (length (call-with-input-file "s7test.scm" (dilambda (lambda* (a b) a) (lambda* (a b c) c)))) #f)) ; (length ) (test (let ((len 0)) (call-with-output-string (lambda (p) (display "0123" p) (set! len (length p)))) len) 4) ;;; -------------------------------------------------------------------------------- ;;; reverse (test (reverse '(a b c d)) '(d c b a)) (test (reverse '(a b c)) '(c b a)) (test (reverse '(a (b c) d (e (f)))) '((e (f)) d (b c) a)) (test (reverse ()) ()) (test (reverse (list 1 2 3)) '(3 2 1)) (test (reverse (list 1)) '(1)) (test (reverse (list)) (list)) (test (reverse '(1 2 3)) (list 3 2 1)) (test (reverse '(1)) '(1)) (test (reverse '((1 2) 3)) '(3 (1 2))) (test (reverse '(((1 . 2) . 3) 4)) '(4 ((1 . 2) . 3))) (test (reverse (list (list) (list 1 2))) '((1 2) ())) (test (reverse '((a) b c d)) '(d c b (a))) (test (reverse (reverse (list 1 2 3 4))) (list 1 2 3 4)) (test (reverse ''foo) '(foo #_quote)) (test (let ((x (list 1 2 3 4))) (let ((y (reverse x))) (and (equal? x (list 1 2 3 4)) (equal? y (list 4 3 2 1))))) #t) (test (letrec ((hi (lambda (lst n) (if (= n 0) lst (hi (reverse lst) (- n 1)))))) (hi (list 1 2 3) 100)) (list 1 2 3)) (test (let ((var (list 1 2 3))) (reverse (cdr var)) var) (list 1 2 3)) (test (let ((var '(1 2 3))) (reverse (cdr var)) var) '(1 2 3)) (test (let ((var (list 1 (list 2 3)))) (reverse (cdr var)) var) (list 1 (list 2 3))) (test (let ((var '(1 (2 3)))) (reverse (cdr var)) var) '(1 (2 3))) (test (let ((var (list (list 1 2) (list 3 4 5)))) (reverse (car var)) var) '((1 2) (3 4 5))) (test (let ((x '(1 2 3))) (list (reverse x) x)) '((3 2 1) (1 2 3))) (test (reverse '(1 2)) '(2 1)) (test (reverse '(1 2 3)) '(3 2 1)) (test (reverse '(1 2 3 4)) '(4 3 2 1)) (when with-block (test (block? (reverse _c_obj_)) #t) (let ((b (block 1 2 3 4))) (let ((b1 (reverse b))) (test b1 (block 4 3 2 1)) (test b (block 1 2 3 4))))) (for-each (lambda (lst) (if (proper-list? lst) (if (not (equal? lst (reverse (reverse lst)))) (format #t ";(reverse (reverse ~A)) -> ~A?~%" lst (reverse (reverse lst)))))) lists) (for-each (lambda (lst) (if (proper-list? lst) (if (not (equal? lst (reverse (reverse (reverse (reverse lst)))))) (format #t ";(reverse...(4x) ~A) -> ~A?~%" lst (reverse (reverse (reverse (reverse lst)))))))) lists) (test (let ((x (list 1 2 3))) (list (recompose 32 reverse x) x)) '((1 2 3) (1 2 3))) (test (let ((x (list 1 2 3))) (list (recompose 31 reverse x) x)) '((3 2 1) (1 2 3))) (test (reverse (cons 1 2)) '(2 . 1)) (test (reverse '(1 . 2)) '(2 . 1)) (test (reverse '(1 2 . 3)) '(3 2 1)) (test (reverse) 'error) (test (reverse '(1 2 3) '(3 2 1)) 'error) (test (reverse (subvector (make-int-vector '(2 3) 0) 0 6 '(6))) (make-int-vector 6 0)) (test (reverse (make-float-vector 6 0.0)) (make-float-vector 6 0.0)) (for-each (lambda (arg) (test (reverse arg) 'error)) (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (reverse "hi") "ih") (test (reverse "") "") (test (reverse "123") "321") (test (reverse "1234") "4321") (test (reverse "12") "21") (test (reverse "a\x00;b") "b\x00;a") (test (reverse #()) #()) (test (reverse #(1)) #(1)) (test (reverse #(1 2)) #(2 1)) (test (reverse #(1 2 3)) #(3 2 1)) (test (reverse #(1 2 3 4)) #(4 3 2 1)) (test (reverse #2d((1 2) (3 4))) #2d((4 3) (2 1))) (test (reverse (string #\a #\null #\b)) "b\x00;a") (test (reverse abs) 'error) (test (vector->list (reverse (let ((v (make-int-vector 3))) (set! (v 1) 1) (set! (v 2) 2) v))) '(2 1 0)) (test (reverse (int-vector)) #()) (test (reverse (int-vector 1)) (int-vector 1)) (test (reverse (int-vector 1 2)) (int-vector 2 1)) (test (reverse (int-vector 1 2 3)) (int-vector 3 2 1)) (test (reverse (int-vector 1 2 3 4)) (int-vector 4 3 2 1)) (test (reverse (float-vector)) #()) (test (reverse (float-vector 1)) (float-vector 1)) (test (reverse (float-vector 1 2)) (float-vector 2 1)) (test (reverse (float-vector 1 2 3)) (float-vector 3 2 1)) (test (reverse (float-vector 1 2 3 4)) (float-vector 4 3 2 1)) (test (reverse (complex-vector 1+i 1-i)) (complex-vector 1-i 1+i)) (test (let ((v #(1 2 3))) (reverse v) v) #(1 2 3)) (test (reverse #u(1 2 3)) #u(3 2 1)) (test (reverse #u(1 2)) #u(2 1)) (test (reverse #u(1 2 3 4)) #u(4 3 2 1)) (test (vector-typer (reverse (make-vector 3 'a symbol?))) symbol?) ; integer? -> int-vector (let ((V (make-vector 4 'a symbol?))) (test (object->string V :readable) "(let (( (vector 'a 'a 'a 'a))) (set! (vector-typer ) symbol?) )")) (let ((V (make-vector 4 'a symbol?))) (test (object->string (reverse V) :readable) "(let (( (vector 'a 'a 'a 'a))) (set! (vector-typer ) symbol?) )")) (when with-block (let ((b (block 1.0 2.0 3.0))) (set! (b 1) 32.0) (test (b 1) 32.0) (let ((b1 (reverse b))) (test b1 (block 3.0 32.0 1.0))))) ;;; -------------------------------------------------------------------------------- ;;; reverse! (test (reverse! '(1 . 2)) 'error) (test (reverse! (cons 1 2)) 'error) (test (reverse! (cons 1 (cons 2 3))) 'error) (test (reverse!) 'error) (test (reverse! '(1 2 3) '(3 2 1)) 'error) (test (reverse! '(a b c d)) '(d c b a)) (test (reverse! '(a b c)) '(c b a)) (test (reverse! '(a (b c) d (e (f)))) '((e (f)) d (b c) a)) (test (reverse! ()) ()) (test (reverse! (list 1 2 3)) '(3 2 1)) (test (reverse! (list 1)) '(1)) (test (reverse! (list)) (list)) (test (reverse! '(1 2 3)) (list 3 2 1)) (test (reverse! '(1)) '(1)) (test (reverse! '((1 2) 3)) '(3 (1 2))) (test (reverse! '(((1 . 2) . 3) 4)) '(4 ((1 . 2) . 3))) (test (reverse! (list (list) (list 1 2))) '((1 2) ())) (test (reverse! '((a) b c d)) '(d c b (a))) (test (reverse! (reverse! (list 1 2 3 4))) (list 1 2 3 4)) (test (reverse! (reverse! (sort! (list 1 2 3 4) >))) (sort! (list 1 2 3 4) >)) (test (reverse! ''foo) '(foo #_quote)) (test (reverse (reverse! (list 1 2 3))) (list 1 2 3)) (test (reverse (reverse! (reverse! (reverse (list 1 2 3))))) (list 1 2 3)) (test (reverse! "") "") (test (reverse! #()) #()) (test (reverse! #i()) #i()) (test (reverse! #r()) #r()) (test (reverse! #u()) #u()) (test (reverse! (immutable! #(1))) #(1)) (test (reverse! #i(1)) #i(1)) ;; check dumb optimization oversight (when with-block (let ((b (block 0 1 2 3 4 5 6 7))) (set! b (reverse! b)) (test b (block 7 6 5 4 3 2 1 0)))) (test (reverse! #r(0 1 2 3 4 5 6 7)) #r(7 6 5 4 3 2 1 0)) (test (reverse! #i(0 1 2 3 4 5 6 7)) #i(7 6 5 4 3 2 1 0)) (test (reverse! #(0 1 2 3 4 5 6 7)) #(7 6 5 4 3 2 1 0)) (test (reverse! #u(0 1 2 3 4 5 6 7)) #u(7 6 5 4 3 2 1 0)) (test (reverse! "01234567") "76543210") (do ((i 0 (+ i 1))) ((= i 33)) (let ((b (make-vector i)) (s (make-string i))) (do ((j 0 (+ j 1))) ((= i j)) (set! (b j) j) (set! (s j) (integer->char (+ 32 j)))) (set! b (reverse! b)) (set! s (reverse! s)) (do ((j 0 (+ j 1))) ((= i j)) (if (not (= (b j) (- i j 1))) (format *stderr* "~A at ~A ~A~%" b i j)) (if (not (char=? (s j) (integer->char (+ 32 (- i j 1))))) (format *stderr* "~S at ~A ~A~%" s i j))))) (test (let ((x (list 1 2 3))) (recompose 31 reverse! x)) '(3 2 1)) (test (reverse! '(1 2 . 3)) 'error) (let* ((lst1 (list 1 2 3)) (lst2 (apply list '(4 5 6))) (lst3 (sort! (reverse! (append lst1 lst2)) <))) (test lst3 '(1 2 3 4 5 6)) (define (lt . args) args) (set! lst3 (sort! (apply reverse! (lt lst3)) >)) (test lst3 '(6 5 4 3 2 1))) (for-each (lambda (arg) (test (reverse! arg) 'error)) (list (integer->char 65) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t (if #f #f) (lambda (a) (+ a 1)))) (test (let ((str "1234")) (reverse! str) str) "4321") (test (let ((str "123")) (reverse! str) str) "321") (test (let ((str "")) (reverse! str) str) "") (test (let ((v #(1 2 3))) (reverse! v) v) #(3 2 1)) (test (let ((v #(1 2 3 4))) (reverse! v) v) #(4 3 2 1)) (test (let ((v #())) (reverse! v) v) #()) (test (let ((v (float-vector 1.0 2.0 3.0))) (reverse! v) v) (float-vector 3.0 2.0 1.0)) (test (let ((v (float-vector 1.0 2.0 3.0 4.0))) (reverse! v) v) (float-vector 4.0 3.0 2.0 1.0)) (test (let ((v (float-vector))) (reverse! v) v) #()) (test (let ((v (int-vector 1 2 3))) (reverse! v) v) (int-vector 3 2 1)) (test (let ((v (int-vector 1 2 3 4))) (reverse! v) v) (int-vector 4 3 2 1)) (test (let ((v (int-vector))) (reverse! v) v) #()) (when with-block (test (block? (reverse! _c_obj_)) #t) (let ((b (block 1 2 3 4))) (reverse! b) (test b (block 4 3 2 1))) (let ((b (block 1 2 3 4 5 6 7 8 9))) (set! b (reverse! b)) (test b (block 9 8 7 6 5 4 3 2 1)))) (test (let ((v (make-int-vector 3 1))) (set! (v 1) 2) (set! (v 2) 3) (reverse! v) v) (let ((v (make-int-vector 3 3))) (set! (v 1) 2) (set! (v 2) 1) v)) (when full-s7test (let () ;; some sequence tests (define (fv-tst len) (let ((fv (make-float-vector len))) (if (not (= (length fv) len)) (format *stderr* "float-vector length ~A: ~A~%" fv (length fv))) (fill! fv 0.0) (let ((fv-orig (copy fv))) (do ((i 0 (+ i 1))) ((= i len)) (set! (fv i) (- (random 1000.0) 500.0))) (let ((fv-ran (copy fv)) (fv-ran1 (copy fv))) (sort! fv <) (call-with-exit (lambda (quit) (do ((i 1 (+ i 1))) ((= i len)) (when (> (fv (- i 1)) (fv i)) (format *stderr* "float-vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i) (quit))))) (sort! fv-ran (lambda (a b) (< a b))) (if (not (equivalent? fv fv-ran)) (format *stderr* "float-vector closure not equal~%")) (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f)))) (if (not (equivalent? fv fv-ran1)) (format *stderr* "float-vector cond closure not equal~%"))) (let ((fv-copy (copy fv))) (reverse! fv) (if (and (not (equivalent? fv-copy fv)) (equivalent? fv fv-orig)) (format *stderr* "float-vector reverse!: ~A ~A~%" fv fv-orig)) (reverse! fv) (if (not (equivalent? fv-copy fv)) (format *stderr* "float-vector reverse! twice: ~A ~A~%" fv fv-copy)) (let ((fv1 (apply float-vector (make-list len 1.0)))) (if (or (not (= (length fv1) len)) (not (= (fv1 (- len 1)) 1.0))) (format *stderr* "float-vector apply: ~A ~A~%" len (fv (- len 1))))) )))) (define (iv-tst len) (let ((fv (make-int-vector len 0))) (if (not (= (length fv) len)) (format *stderr* "int-vector length ~A: ~A~%" fv (length fv))) (fill! fv 0) (let ((fv-orig (copy fv))) (do ((i 0 (+ i 1))) ((= i len)) (set! (fv i) (- (random 1000000) 500000))) (let ((fv-ran (copy fv)) (fv-ran1 (copy fv))) (sort! fv <) (call-with-exit (lambda (quit) (do ((i 1 (+ i 1))) ((= i len)) (when (> (fv (- i 1)) (fv i)) (format *stderr* "int-vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i) (quit))))) (sort! fv-ran (lambda (a b) (< a b))) (if (not (equivalent? fv fv-ran)) (format *stderr* "int-vector closure not equal~%")) (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f)))) (if (not (equivalent? fv fv-ran1)) (format *stderr* "int-vector cond closure not equal~%"))) (let ((fv-copy (copy fv))) (reverse! fv) (if (and (not (equivalent? fv-copy fv)) (equivalent? fv fv-orig)) (format *stderr* "int-vector reverse!: ~A ~A~%" fv fv-orig)) (reverse! fv) (if (not (equivalent? fv-copy fv)) (format *stderr* "int-vector reverse! twice: ~A ~A~%" fv fv-copy)) )))) (define (v-tst len) (let ((fv (make-vector len))) (if (not (= (length fv) len)) (format *stderr* "vector length ~A: ~A~%" fv (length fv))) (fill! fv 0) (let ((fv-orig (copy fv))) (do ((i 0 (+ i 1))) ((= i len)) (set! (fv i) (- (random 1000000) 500000))) (let ((fv-ran (copy fv)) (fv-ran1 (copy fv))) (sort! fv <) (call-with-exit (lambda (quit) (do ((i 1 (+ i 1))) ((= i len)) (when (> (fv (- i 1)) (fv i)) (format *stderr* "vector: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i) (quit))))) (sort! fv-ran (lambda (a b) (< a b))) (if (not (equivalent? fv fv-ran)) (format *stderr* "vector closure not equal~%")) (sort! fv-ran1 (lambda (a b) (cond ((< a b) #t) (#t #f)))) (if (not (equivalent? fv fv-ran1)) (format *stderr* "vector cond closure not equal~%"))) (let ((fv-copy (copy fv))) (reverse! fv) (if (and (not (equivalent? fv-copy fv)) (equivalent? fv fv-orig)) (format *stderr* "vector reverse!: ~A ~A~%" fv fv-orig)) (reverse! fv) (if (not (equivalent? fv-copy fv)) (format *stderr* "vector reverse! twice: ~A ~A~%" fv fv-copy)) (let ((fv1 (apply vector (make-list len 1)))) (if (or (not (= (length fv1) len)) (not (= (fv1 (- len 1)) 1))) (format *stderr* "vector apply: ~A ~A~%" len (fv (- len 1))))) )))) (define (s-tst len) (let ((fv (make-string len))) (if (not (= (length fv) len)) (format *stderr* "string length ~A: ~A~%" fv (length fv))) (fill! fv #\a) (let ((fv-orig (copy fv))) (do ((i 0 (+ i 1))) ((= i len)) (set! (fv i) (integer->char (+ 20 (random 100))))) (let ((fv-ran (copy fv)) (fv-ran1 (copy fv))) (sort! fv char? (fv (- i 1)) (fv i)) (format *stderr* "string: ~A > ~A at ~D~%" (fv (- i 1)) (fv i) i) (quit))))) (sort! fv-ran (lambda (a b) (char (car p0) (car p1)) (format *stderr* "list: ~A > ~A at ~D~%" (car p0) (car p1) i) (quit))))) (sort! fv-ran (lambda (a b) (< a b))) (if (not (equivalent? fv fv-ran)) (format *stderr* "pair closure not equal~%"))) (let ((fv-copy (copy fv))) (set! fv (reverse! fv)) (if (and (not (equivalent? fv-copy fv)) (equivalent? fv fv-orig)) (format *stderr* "list reverse!: ~A ~A~%" fv fv-orig)) (set! fv (reverse! fv)) (if (not (equivalent? fv-copy fv)) (format *stderr* "list reverse! twice: ~A ~A~%" fv fv-copy)) )))) (for-each (lambda (b p) (do ((k 0 (+ k 1))) ((= k 1000)) (fv-tst b) (iv-tst b) (v-tst b) (s-tst b) (p-tst b)) (do ((i 0 (+ i 1))) ((= i p)) (format *stderr* "~D fv " (expt b i)) (fv-tst (expt b i)) (format *stderr* "iv ") (iv-tst (expt b i)) (format *stderr* "v ") (v-tst (expt b i)) (format *stderr* "s ") (s-tst (expt b i)) (format *stderr* "p ") (p-tst (expt b i)) (newline *stderr*) )) (list 2 3 4 7 10) (list 12 4 3 6 6)) )) (test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 0 3))) (reverse! sv) v)) #(3 2 1 4)) (test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 1 4))) (reverse! sv) v)) #(1 4 3 2)) (test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 1 4))) (fill! sv 5) v)) #(1 5 5 5)) (test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 1 4))) (reverse sv) v)) #(1 2 3 4)) (test (let ((v (vector 1 2 3 4))) (let ((sv (subvector v 1 4))) (sort! sv >) v)) #(1 4 3 2)) (test (let ((v (make-int-vector '(3 3) 1))) (let ((sv (v 1))) (fill! sv 2) v)) (subvector (int-vector 1 1 1 2 2 2 1 1 1) 0 9 '(3 3))) (test (immutable? (subvector (immutable! (vector 1 2 3 4)) 0 4 '(2 2))) #t) (test (let ((v (make-int-vector '(3 3) 1))) (do ((i 0 (+ i 1))) ((= i 3)) (do ((j 0 (+ j 1))) ((= j 3)) (set! (v i j) (+ j (* i 3))))) (let ((sv (v 1))) (fill! sv 2) v)) (subvector (int-vector 0 1 2 2 2 2 6 7 8) 0 9 '(3 3))) (test (let ((v (make-int-vector '(3 3) 1))) (do ((i 0 (+ i 1))) ((= i 3)) (do ((j 0 (+ j 1))) ((= j 3)) (set! (v i j) (+ j (* i 3))))) (let ((sv (v 1))) (sort! sv >) v)) (subvector (int-vector 0 1 2 5 4 3 6 7 8) 0 9 '(3 3))) (test (let ((v (make-int-vector '(3 3) 1))) (do ((i 0 (+ i 1))) ((= i 3)) (do ((j 0 (+ j 1))) ((= j 3)) (set! (v i j) (+ j (* i 3))))) (let ((sv (v 1))) (reverse! sv) v)) (subvector (int-vector 0 1 2 5 4 3 6 7 8) 0 9 '(3 3))) (test (catch #t (lambda () (reverse! (catch #t 1 cons)) (reverse! (catch #t 1 cons))) ; this will clobber sc->wrong_type_arg_info if not caught (lambda args 'error)) 'error) (test (reverse! `((1) . x)) 'error) (if with-block (test (reverse! (immutable! (block 0 0))) 'error)) (when full-s7test (let () (define (revstr size) (let ((str (make-string size))) (do ((i 0 (+ i 1))) ((= i size)) (string-set! str i (integer->char (+ i 20)))) (let ((rstr (reverse! str))) (do ((i 0 (+ i 1)) (j (- size 1) (- j 1))) ((= i size)) (unless (char=? (string-ref str j) (integer->char (+ i 20))) (format *stderr* "revstr ~D: ~A ~A~%" i (string-ref str j) (integer->char (+ i 20)))))))) (do ((i 1 (+ i 1))) ((= i 8)) (revstr (expt 2 i))) (define (revint size) (let ((str (make-int-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (int-vector-set! str i i)) (let ((rstr (reverse! str))) (do ((i 0 (+ i 1)) (j (- size 1) (- j 1))) ((= i size)) (unless (= (int-vector-ref str j) i) (format *stderr* "revint ~D: ~A ~A~%" i (int-vector-ref str j) i)))))) (do ((i 3 (+ i 1))) ((= i 10)) (revint (expt 2 i))) )) ;;; -------------------------------------------------------------------------------- ;;; pair? (test (pair? 'a) #f) (test (pair? '()) #f) (test (pair? ()) #f) (test (pair? '(a b c)) #t) (test (pair? (cons 1 2)) #t) (test (pair? ''()) #t) (test (pair? #f) #f) (test (pair? (make-vector 6)) #f) (test (pair? #t) #f) (test (pair? '(a . b)) #t) (test (pair? #(a b)) #f) (test (pair? (list 1 2)) #t) (test (pair? (list)) #f) (test (pair? ''foo) #t) (test (pair? (list 'a 'b 'c 'd 'e 'f)) #t) (test (pair? '(this-that)) #t) (test (pair? '(this - that)) #t) (let ((x (list 1 2))) (set-cdr! x x) (test (pair? x) #t)) (test (pair? (list 1 (cons 1 2))) #t) (test (pair? (list 1 (cons 1 ()))) #t) (test (pair? (cons 1 ())) #t) (test (pair? (cons () ())) #t) (test (pair? (cons () 1)) #t) (test (pair? (list (list))) #t) (test (pair? '(())) #t) (test (pair? (cons 1 (cons 2 3))) #t) (test (pair?) 'error) (test (pair? `'1) #t) (test (pair? begin) #f) (test (pair? 'begin) #f) (test (pair? ''begin) #t) (test (pair? list) #f) (for-each (lambda (arg) (if (pair? arg) (format #t ";(pair? ~A) -> #t?~%" arg))) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;;; pair-line-number (test (pair-line-number) 'error) (test (pair-line-number () ()) 'error) (for-each (lambda (arg) (test (pair-line-number arg) 'error)) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;; pair-filename (test (pair-filename) 'error) (test (pair-filename () ()) 'error) (for-each (lambda (arg) (test (pair-filename arg) 'error)) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (let () (call-with-output-file "t559.scm" (lambda (p) (format p "~%~%~%(define (pair-fl-test)~% (+ 1 2))~%~%(list (port-line-number) (port-filename))~%~%"))) (let ((loc (load "t559.scm" (curlet)))) (test loc (list 7 "t559.scm"))) (let ((s (procedure-source pair-fl-test))) (if (pair? s) (begin (test (pair-filename (cddr s)) "t559.scm") (test (pair-line-number (cddr s)) 4)) (format *stderr* "t559.scm no source~%")))) ;;; -------------------------------------------------------------------------------- ;;; list? (test (list? 'a) #f) (test (list? ()) #t) (test (list? '(a b c)) #t) (test (list? (cons 1 2)) #t) (test (list? ''()) #t) (test (list? #f) #f) (test (list? (make-vector 6)) #f) (test (list? #t) #f) (test (list? '(a . b)) #t) (test (list? #(a b)) #f) (test (list? (list 1 2)) #t) (test (list? (list)) #t) (test (list? ''foo) #t) (test (list? ''2) #t) (test (list? (list 'a 'b 'c 'd 'e 'f)) #t) (test (list? '(this-that)) #t) (test (list? '(this - that)) #t) (let ((x (list 1 2))) (set-cdr! x x) (test (proper-list? x) #f) (test (list? x) #t)) (test (list? (list 1 (cons 1 2))) #t) (test (list? (list 1 (cons 1 ()))) #t) (test (list? (cons 1 ())) #t) (test (list? (cons () ())) #t) (test (list? (cons () 1)) #t) (test (list? (list (list))) #t) (test (list? '(())) #t) (test (list? '(1 2 . 3)) #t) (test (list? (cons 1 (cons 2 3))) #t) (test (list? '(1 . ())) #t) (test (list? '(1 2) ()) 'error) (test (list?) 'error) (for-each (lambda (arg) (if (list? arg) (format #t ";(list? ~A) -> #t?~%" arg))) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;;; proper-list? (test (proper-list? 'a) #f) (test (proper-list? ()) #t) (test (proper-list? '(a b c)) #t) (test (proper-list? (cons 1 2)) #f) (test (proper-list? ''()) #t) (test (proper-list? #f) #f) (test (proper-list? (make-vector 6)) #f) (test (proper-list? #t) #f) (test (proper-list? '(a . b)) #f) (test (proper-list? #(a b)) #f) (test (proper-list? (list 1 2)) #t) (test (proper-list? (list)) #t) (test (proper-list? ''foo) #t) (test (proper-list? ''2) #t) (test (proper-list? (list 'a 'b 'c 'd 'e 'f)) #t) (test (proper-list? '(this-that)) #t) (test (proper-list? '(this - that)) #t) (let ((x (list 1 2))) (set-cdr! x x) (test (proper-list? x) #f)) (test (proper-list? (list 1 (cons 1 2))) #t) (test (proper-list? (list 1 (cons 1 ()))) #t) (test (proper-list? (cons 1 ())) #t) (test (proper-list? (cons () ())) #t) (test (proper-list? (cons () 1)) #f) (test (proper-list? (list (list))) #t) (test (proper-list? '(())) #t) (test (proper-list? '(1 2 . 3)) #f) (test (proper-list? (cons 1 (cons 2 3))) #f) (test (proper-list? '(1 . ())) #t) (test (proper-list? (let ((lst (list 1))) (set-cdr! lst lst) lst)) #f) (test (proper-list? (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) lst)) #f) (test (proper-list? (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst)) #f) (test (proper-list? (let ((lst (list 1 2 3 4))) (set-cdr! (cdddr lst) lst) lst)) #f) (test (proper-list? (let ((lst (list 1 2 3 4 5))) (set-cdr! (cdr (cdddr lst)) lst) lst)) #f) (test (proper-list? '(1 2) ()) 'error) (test (proper-list?) 'error) (for-each (lambda (arg) (if (proper-list? arg) (format #t ";(list? ~A) -> #t?~%" arg))) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;;; -------------------------------------------------------------------------------- ;;; null? (test (null? 'a) '#f) (test (null? ()) #t) (test (null? ()) #t) (test (null? '(a b c)) #f) (test (null? (cons 1 2)) #f) (test (null? ''()) #f) (test (null? #f) #f) (test (null? (make-vector 6)) #f) (test (null? #t) #f) (test (null? '(a . b)) #f) (test (null? #(a b)) #f) (test (null? (list 1 2)) #f) (test (null? (list)) #t) (test (null? ''foo) #f) (test (null? (list 'a 'b 'c 'd 'e 'f)) #f) (test (null? '(this-that)) #f) (test (null? '(this - that)) #f) (let ((x (list 1 2))) (set-cdr! x x) (test (null? x) #f)) (test (null? (list 1 (cons 1 2))) #f) (test (null? (list 1 (cons 1 ()))) #f) (test (null? (cons 1 ())) #f) (test (null? (cons () ())) #f) (test (null? (cons () 1)) #f) (test (null? (list (list))) #f) (test (null? '(())) #f) (test (null? #()) #f) (test (null? (make-vector '(2 0 3))) #f) (test (null? "") #f) (test (null? lambda) #f) (test (null? cons) #f) (test (null? (begin)) #t) (test (null? (cdr (list 1))) #t) (test (null? (cdr (cons () '(())))) #f) (test (null? () ()) 'error) (test (null?) 'error) (for-each (lambda (arg) (if (null? arg) (format #t ";(null? ~A) -> #t?~%" arg))) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t (if #f #f) :hi # # (values) (lambda (a) (+ a 1)))) ;;; -------------------------------------------------------------------------------- ;;; set-car! (test (let ((x (cons 1 2))) (set-car! x 3) x) (cons 3 2)) (test (let ((x (list 1 2))) (set-car! x 3) x) (list 3 2)) (test (let ((x (list (list 1 2) 3))) (set-car! x 22) x) (list 22 3)) (test (let ((x (cons 1 2))) (set-car! x ()) x) (cons () 2)) (test (let ((x (list 1 (list 2 3 4)))) (set-car! x (list 5 (list 6))) x) (list (list 5 (list 6)) (list 2 3 4))) (test (let ((x '(((1) 2) (3)))) (set-car! x '((2) 1)) x) '(((2) 1) (3))) (test (let ((x ''foo)) (set-car! x "hi") x) (list "hi" 'foo)) (test (let ((x '((1 . 2) . 3))) (set-car! x 4) x) '(4 . 3)) (test (let ((x '(1 . 2))) (set-car! x (cdr x)) x) '(2 . 2)) (test (let ((x '(1 . 2))) (set-car! x x) (proper-list? x)) #f) (test (let ((x (list 1))) (set-car! x ()) x) '(())) (test (let ((x '(((1 2) . 3) 4))) (set-car! x 1) x) '(1 4)) (test (let ((lst (cons 1 (cons 2 3)))) (set-car! (cdr lst) 4) lst) (cons 1 (cons 4 3))) (test (let ((lst (cons 1 (cons 2 3)))) (set-car! lst 4) lst) (cons 4 (cons 2 3))) (test (let ((x (list 1 2))) (set! (car x) 0) x) (list 0 2)) (test (let ((x (cons 1 2))) (set! (cdr x) 0) x) (cons 1 0)) (test (let ((x (list 1 2))) (set-car! x (list 3 4)) x) '((3 4) 2)) (test (let ((x (cons 1 2))) (set-car! x (list 3 4)) x) '((3 4) . 2)) (test (let ((x (cons (list 1 2) 3))) (set-car! (car x) (list 3 4)) x) '(((3 4) 2) . 3)) (test (let ((lst (list 1 2 3))) (set! (car lst) 32) lst) '(32 2 3)) (test (set-car! '() 32) 'error) (test (set-car! () 32) 'error) (test (set-car! (list) 32) 'error) (test (set-car! 'x 32) 'error) (test (set-car! #f 32) 'error) (test (set-car!) 'error) (test (set-car! '(1 2) 1 2) 'error) (test (set-car! '(1 . 2) 3) 3) ; from bug-guile (test (let ((lst (list 1 2))) (set-car! lst (values 2 3)) lst) 'error) (test (let ((lst '(1 2))) (set-car! lst 32)) 32) (test (let ((lst '(1 2))) (set! (car lst) 32)) 32) (test (let ((c (cons 1 2))) (set-car! c #\a) (car c)) #\a) (test (let ((c (cons 1 2))) (set-car! c #()) (car c)) #()) (test (let ((c (cons 1 2))) (set-car! c #f) (car c)) #f) (test (let ((c (cons 1 2))) (set-car! c _ht_) (car c)) _ht_) ;;; these have apparently caused a segfault in guile for more than 10 years (test (let ((xs '(1))) (set-car! xs 0)) 0) (test (let ((xs '(1 2))) (set-car! (cdr xs) 0)) 0) (test (set-car! '(0 . ()) 1) 1) (test (let ((C (cons 1 2))) (set! (car C) 3) C) '(3 . 2)) (test (let ((C (cons 1 2))) (set! (#_car C) 3) C) '(3 . 2)) ;;; -------------------------------------------------------------------------------- ;;; set-cdr! (test (let ((x (cons 1 2))) (set-cdr! x 3) x) (cons 1 3)) (test (let ((x (list 1 2))) (set-cdr! x 3) x) (cons 1 3)) (test (let ((x (list (list 1 2) 3))) (set-cdr! x 22) x) '((1 2) . 22)) (test (let ((x (cons 1 2))) (set-cdr! x '()) x) (list 1)) (test (let ((x (list 1 (list 2 3 4)))) (set-cdr! x (list 5 (list 6))) x) '(1 5 (6))) (test (let ((x '(((1) 2) (3)))) (set-cdr! x '((2) 1)) x) '(((1) 2) (2) 1)) (test (let ((x ''foo)) (set-cdr! x "hi") x) (cons #_quote "hi")) (test (let ((x '((1 . 2) . 3))) (set-cdr! x 4) x) '((1 . 2) . 4)) (test (let ((x '(1 . 2))) (set-cdr! x (cdr x)) x) '(1 . 2)) (test (let ((x '(1 . 2))) (set-cdr! x x) (proper-list? x)) #f) (test (let ((x (list 1))) (set-cdr! x '()) x) (list 1)) (test (let ((x '(1 . (2 . (3 (4 5)))))) (set-cdr! x 4) x) '(1 . 4)) (test (let ((lst (cons 1 (cons 2 3)))) (set-cdr! (cdr lst) 4) lst) (cons 1 (cons 2 4))) (test (let ((x (cons (list 1 2) 3))) (set-cdr! (car x) (list 3 4)) x) '((1 3 4) . 3)) (test (let ((x (list 1 2))) (set-cdr! x (list 4 5)) x) '(1 4 5)) (test (let ((x (cons 1 2))) (set-cdr! x (list 4 5)) x) '(1 4 5)) ;! (test (let ((x (cons 1 2))) (set-cdr! x (cons 4 5)) x) '(1 4 . 5)) (test (let ((lst (list 1 2 3))) (set! (cdr lst) 32) lst) (cons 1 32)) (test (set-cdr! '() 32) 'error) (test (set-cdr! () 32) 'error) (test (set-cdr! (list) 32) 'error) (test (set-cdr! 'x 32) 'error) (test (set-cdr! #f 32) 'error) (test (set-cdr!) 'error) (test (set-cdr! '(1 2) 1 2) 'error) (test (let ((lst '(1 2))) (set-cdr! lst 32)) 32) (test (let ((lst '(1 2))) (set! (cdr lst) 32)) 32) (test (let ((c (cons 1 2))) (set-cdr! c #\a) (cdr c)) #\a) (test (let ((c (cons 1 2))) (set-cdr! c #()) (cdr c)) #()) (test (let ((c (cons 1 2))) (set-cdr! c #f) (cdr c)) #f) (test (let ((c (cons 1 2))) (set-cdr! c _ht_) (cdr c)) _ht_) (test (let ((c (cons 1 2))) (set-cdr! c (list 3)) c) '(1 3)) ;;; -------------------------------------------------------------------------------- ;;; list-ref (test (list-ref (list 1 2) 1) 2) (test (list-ref '(a b c d) 2) 'c) (test (list-ref (cons 1 2) 0) 1) (test (list-ref ''foo 0) #_quote) (test (list-ref '((1 2) (3 4)) 1) '(3 4)) (test (list-ref (list-ref (list (list 1 2) (list 3 4)) 1) 1) 4) (test (let ((x (list 1 2 3))) (list-ref x (list-ref x 1))) 3) (test (list-ref '(1 2 . 3) 1) 2) (test (list-ref '(1 2 . 3) 2) 'error) (test ('(1 2 . 3) 0) 1) (test ('(1 . 2) 0) 1) (test (let ((lst (list 1 2))) (set! (list-ref lst 1) 0) lst) (list 1 0)) (test (((lambda () list)) 'a 'b 'c) '(a b c)) (test (apply ((lambda () list)) (list 'a 'b 'c) (list 'c 'd 'e)) '((a b c) c d e)) (test (((lambda () (values list))) 1 2 3) '(1 2 3)) (test (apply list 'a 'b '(c)) '(a b c)) (for-each (lambda (name op1 op2) (for-each (lambda (lst) (let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error))) (val2 (catch #t (lambda () (op2 lst)) (lambda args 'error)))) (if (not (equal? val1 val2)) (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2)))) lists)) (list 'list-ref:0 'list-ref:1 'list-ref:2 'list-ref:3) (list car cadr caddr cadddr) (list (lambda (l) (list-ref l 0)) (lambda (l) (list-ref l 1)) (lambda (l) (list-ref l 2)) (lambda (l) (list-ref l 3)))) (for-each (lambda (arg) (test (list-ref (list 1 arg) 1) arg)) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 0)) 1) (test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 1)) 1) (test (let ((x '(1 . 2))) (set-cdr! x x) (list-ref x 100)) 1) (test (list-ref '((1 2 3) (4 5 6)) 1) '(4 5 6)) (test (list-ref '((1 2 3) (4 5 6)) 1 2) 6) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1) '((7 8 9) (10 11 12))) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0) '(7 8 9)) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 2) 9) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 3) 'error) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 2 0) 'error) (test ('((1 2 3) (4 5 6)) 1) '(4 5 6)) (test ('((1 2 3) (4 5 6)) 1 2) 6) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1) '((7 8 9) (10 11 12))) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0) '(7 8 9)) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 2) 9) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 3) 'error) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) 1 0 2 0) 'error) (test (let ((L '((1 2 3) (4 5 6)))) (L 1)) '(4 5 6)) (test (let ((L '((1 2 3) (4 5 6)))) (L 1 2)) 6) (test (let ((L '((1 2 3) (4 5 6)))) (L 1 2 3)) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L 1)) '((7 8 9) (10 11 12))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L 1 0)) '(7 8 9)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L 1 0 2)) 9) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L 1 0 2 3)) 'error) (test (let ((L '((1 2 3) (4 5 6)))) ((L 1) 2)) 6) (test (let ((L '((1 2 3) (4 5 6)))) (((L 1) 2) 3)) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L 1) 0)) '(7 8 9)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (((L 1) 0) 2)) 9) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L 1 0) 2)) 9) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L 1) 0 2)) 9) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((((L 1) 0) 2) 3)) 'error) (test (let ((L '((1 2 3) (4 5 6)))) (list-ref (L 1) 2)) 6) (test (let ((L '((1 2 3) (4 5 6)))) (list-ref ((L 1) 2) 3)) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-ref (L 1) 0)) '(7 8 9)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((list-ref (L 1) 0) 2)) 9) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-ref (((L 1) 0) 2) 3)) 'error) (let ((zero 0) (one 1) (two 2) (three 3)) (test (list-ref '((1 2 3) (4 5 6)) one) '(4 5 6)) (test (list-ref '((1 2 3) (4 5 6)) 1 two) 6) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one) '((7 8 9) (10 11 12))) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero) '(7 8 9)) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero two) 9) (test (list-ref '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero three) 'error) (test ('((1 2 3) (4 5 6)) one) '(4 5 6)) (test ('((1 2 3) (4 5 6)) 1 two) 6) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one) '((7 8 9) (10 11 12))) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero) '(7 8 9)) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero two) 9) (test ('(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) one zero three) 'error) (test (let ((L '((1 2 3) (4 5 6)))) (L one)) '(4 5 6)) (test (let ((L '((1 2 3) (4 5 6)))) (L 1 two)) 6) (test (let ((L '((1 2 3) (4 5 6)))) (L 1 2 3)) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L one)) '((7 8 9) (10 11 12))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L one zero)) '(7 8 9)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (L one zero two)) 9) (test (let ((L '((1 2 3) (4 5 6)))) ((L one) two)) 6) (test (let ((L '((1 2 3) (4 5 6)))) (((L one) two) 3)) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L one) zero)) '(7 8 9)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (((L one) zero) two)) 9) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L one zero) two)) 9) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((L one) 0 two)) 9) (test (let ((L '((1 2 3) (4 5 6)))) (list-ref (L one) two)) 6) (test (let ((L '((1 2 3) (4 5 6)))) (list-ref ((L one) two) 3)) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-ref (L one) zero)) '(7 8 9)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((list-ref (L one) zero) two)) 9)) (test (list-ref () 0) 'error) (test (list-ref (list 1 2) 2) 'error) (test (list-ref (list 1 2) -1) 'error) (test (list-ref (list 1 2) 1.3) 'error) (test (list-ref (list 1 2) 1/3) 'error) (test (list-ref (list 1 2) 1+2.0i) 'error) (test (list-ref (cons 1 2) 1) 'error) (test (list-ref (cons 1 2) 2) 'error) (test (list-ref (list 1 2 3) (expt 2 32)) 'error) (test (list-ref '(1 2 3) 1 2) 'error) (test (list-ref) 'error) (test (list-ref '(1 2)) 'error) (test ('(0)) 'error) (test ((0)) 'error) (test (list-ref '((1 2) (3 4)) 1 1) 4) (test ('(1 2 3) 1) 2) (test ((list 1 2 3) 2) 3) (test ((list)) 'error) (test ((list 1) 0 0) 'error) (test ((list 1 (list 2 3)) 1 1) 3) (test ((append '(3) () '(1 2)) 0) 3) (test ((append '(3) () 1) 0) 3) (test ((append '(3) () 1) 1) 'error) ;; this works with 0 because: (test ((cons 1 2) 0) 1) (test (list-ref (cons 1 2) 0) 1) (test (((list (list 1 2 3)) 0) 0) 1) (test (((list (list 1 2 3)) 0) 1) 2) (test (((list (list 1 2 3)) 0 1)) 'error) ; see below (test (let ((lst (list (list 1 2 3)))) (lst 0 1)) 2) (test ((list (list 1 2 3)) 0 1) 2) (test (list-ref (list (list 1 2)) 0 ()) 'error) (test (((list +) 0) 1 2 3) 6) (let ((lst (list 1 2))) (for-each (lambda (arg) (test (list-ref (list 1 2) arg) 'error) (test ((list 1 2) arg) 'error) (test (lst arg) 'error)) (list "hi" (integer->char 65) #f '(1 2) () 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))) ;;; -------------------------------------------------------------------------------- ;;; list-set! (test (let ((x (list 1))) (list-set! x 0 2) x) (list 2)) (test (let ((x (cons 1 2))) (list-set! x 0 3) x) '(3 . 2)) (test (let ((x (cons 1 2))) (list-set! x 1 3) x) 'error) (test (let ((x '((1) 2))) (list-set! x 0 1) x) '(1 2)) (test (let ((x '(1 2))) (list-set! x 1 (list 3 4)) x) '(1 (3 4))) (test (let ((x ''foo)) (list-set! x 0 "hi") x ) '("hi" foo)) (test (let ((x (list 1 2))) (list-set! x 0 x) (list? x)) #t) (test (let ((x (list 1 2))) (list-set! x 1 x) (list? x)) #t) (test (let ((x 2) (lst '(1 2))) (list-set! (let () (set! x 3) lst) 1 23) (list x lst)) '(3 (1 23))) (test (apply list-set! '((1 2) (3 2)) 1 '(1 2)) 2) (test (list-set! '(1 2 3) 1 4) 4) (test (set-car! '(1 2) 4) 4) (test (set-cdr! '(1 2) 4) 4) (test (fill! (list 1 2) 4) 4) (test (fill! () 1) 1) (test (list-set! '(1 2 . 3) 1 23) 23) (test (list-set! '(1 2 . 3) 2 23) 'error) (test (set! ('(1 2 . 3) 1) 23) 23) (test (let ((lst '(1 2 3))) (list-set! lst 0 32)) 32) (test (let ((lst '(1 2 3))) (set! (lst 0) 32)) 32) (test (let ((lst '(1 2 3))) (set! (list-ref lst 0) 32)) 32) (for-each (lambda (arg) (test (let ((x (list 1 2))) (list-set! x 0 arg) (list-ref x 0)) arg)) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 32) L) '((1 2 3) 32)) (test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 0 32) L) '((1 2 3) (32 5 6))) (test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 0 2 32) L) 'error) (test (let ((L '((1 2 3) (4 5 6)))) (list-set! L 1 3 32) L) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 32) L) '(((1 2 3) (4 5 6)) 32)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 0 32) L) '(((1 2 3) (4 5 6)) (32 (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 0 2 32) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 0 2 1 32) L) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L 1 4 2 32) L) 'error) (test (let ((L '((1 2 3) (4 5 6)))) (set! (L 1) 32) L) '((1 2 3) 32)) (test (let ((L '((1 2 3) (4 5 6)))) (set! (L 1 0) 32) L) '((1 2 3) (32 5 6))) (test (let ((L '((1 2 3) (4 5 6)))) (set! (L 1 0 2) 32) L) 'error) (test (let ((L '((1 2 3) (4 5 6)))) (set! (L 1 3) 32) L) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1) 32) L) '(((1 2 3) (4 5 6)) 32)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 0) 32) L) '(((1 2 3) (4 5 6)) (32 (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 0 2) 32) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 0 2 1) 32) L) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L 1 4 2) 32) L) 'error) (test (let ((L '((1 2 3) (4 5 6)))) (set! ((L 1) 0) 32) L) '((1 2 3) (32 5 6))) (test (let ((L '((1 2 3) (4 5 6)))) (set! (((L 1) 0) 2) 32) L) 'error) (test (let ((L '((1 2 3) (4 5 6)))) (set! ((L 1) 3) 32) L) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((L 1) 0) 32) L) '(((1 2 3) (4 5 6)) (32 (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((L 1) 0) 2) 32) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((((L 1) 0) 2) 1) 32) L) 'error) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((L 1) 4) 2) 32) L) 'error) (test (let ((L '(((1 2 3))))) (set! ((L 0) 0 1) 32) L) '(((1 32 3)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((L 1 0) 2) 32) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (L 0 0 1) 32) L) '((((1 2 3) 32) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L 0) 0 1 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L 0 0) 1 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L 0 0 1) 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (((L 0) 0) 1 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (((L 0 0) 1) 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((((L 0) 0) 1) 2) 32) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '(1 2 3))) (let ((L1 (list L))) (set! ((car L1) 1) 32) L)) '(1 32 3)) (let ((zero 0) (one 1) (two 2) (three 3) (thirty-two 32)) (test (let ((L '((1 2 3) (4 5 6)))) (list-set! L one thirty-two) L) '((1 2 3) 32)) (test (let ((L '((1 2 3) (4 5 6)))) (list-set! L one zero thirty-two) L) '((1 2 3) (32 5 6))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L one thirty-two) L) '(((1 2 3) (4 5 6)) 32)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L one zero thirty-two) L) '(((1 2 3) (4 5 6)) (32 (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (list-set! L one zero two thirty-two) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))) (test (let ((L '((1 2 3) (4 5 6)))) (set! (L one) thirty-two) L) '((1 2 3) 32)) (test (let ((L '((1 2 3) (4 5 6)))) (set! (L one zero) thirty-two) L) '((1 2 3) (32 5 6))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L one) thirty-two) L) '(((1 2 3) (4 5 6)) 32)) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L one zero) thirty-two) L) '(((1 2 3) (4 5 6)) (32 (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (L one zero two) thirty-two) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))) (test (let ((L '((1 2 3) (4 5 6)))) (set! ((L one) zero) thirty-two) L) '((1 2 3) (32 5 6))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((L one) zero) thirty-two) L) '(((1 2 3) (4 5 6)) (32 (10 11 12)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((L one) zero) two) thirty-two) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))) (test (let ((L '(((1 2 3))))) (set! ((L zero) zero one) thirty-two) L) '(((1 32 3)))) (test (let ((L '(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! ((L one zero) two) thirty-two) L) '(((1 2 3) (4 5 6)) ((7 8 32) (10 11 12)))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (L zero zero one) thirty-two) L) '((((1 2 3) 32) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L zero) zero one two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L zero zero) one two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((L zero 0 one) two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (((L zero) zero) one two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! (((L zero zero) one) two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '((((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))) (13 14 15)))) (set! ((((L zero) zero) one) two) thirty-two) L) '((((1 2 3) (4 5 32)) ((7 8 9) (10 11 12))) (13 14 15))) (test (let ((L '(1 2 3))) (let ((L1 (list L))) (set! ((car L1) one) thirty-two) L)) '(1 32 3))) (test (let ((x '(1)) (y '(2))) (set! ((if #t x y) 0) 32) (list x y)) '((32) (2))) (test (list-set! () 0 1) 'error) (test (list-set! () -1 1) 'error) (test (list-set! '(1) 1 2) 'error) (test (list-set! '(1 2 3) -1 2) 'error) (test (list-set! '(1) 1.5 2) 'error) (test (list-set! '(1) 3/2 2) 'error) (test (list-set! '(1) 1+3i 2) 'error) (test (list-set! '(1 2 3) 1 2 3) 'error) (test (list-set! (list 1 2 3) (expt 2 32) 0) 'error) (test (list-set! (list 1 2) () 1) 'error) (for-each (lambda (arg) (test (list-set! (list 1 2) arg arg) 'error) (test (list-set! arg 1 2) 'error) (test (list-set! (list 1 2) arg 1) 'error)) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (catch #t (lambda () (let ((L1 (list 1))) (list-set! L1 3 0))) (lambda (type info) (apply format #f info))) "list-set! second argument, 3, is out of range (it is too large)") ;;; -------------------------------------------------------------------------------- ;;; list (test (let ((tree1 (list 1 (list 1 2) (list (list 1 2 3)) (list (list (list 1 2 3 4)))))) tree1) '(1 (1 2) ((1 2 3)) (((1 2 3 4))))) (test (let ((tree2 (list "one" (list "one" "two") (list (list "one" "two" "three"))))) tree2) '("one" ("one" "two") (("one" "two" "three")))) (test (let ((tree1 (list 1 (list 1 2) (list 1 2 3) (list 1 2 3 4)))) tree1) '(1 (1 2) (1 2 3) (1 2 3 4))) (test (let ((tree1 (list 1 (list 1 2))) (tree2 (list 1 (list 1 2)))) tree2) '(1 (1 2))) (test (let ((tree1 (list 1 (list 1 2))) (tree2 (list 1 (list 1 2)))) (eqv? tree1 tree2)) #f) (test (let ((tree1 (list ''a (list ''b ''c))) (tree2 (list ''a (list ''b ''c)))) tree2) '('a ('b 'c))) (test (let ((lst (list 1 (list 2 3)))) lst) '(1 (2 3))) (test (let* ((lst (list 1 (list 2 3))) (slst lst)) slst) '(1 (2 3))) (test (list 1) '(1)) (test (let ((a 1)) (list a 2)) '(1 2)) (test (let ((a 1)) (list 'a '2)) '(a 2)) (test (let ((a 1)) (list 'a 2)) '(a 2)) (test (list) ()) (test (let ((a (list 1 2))) a) '(1 2)) (test (let ((a (list 1 2))) (list 3 4 'a (car (cons 'b 'c)) (+ 6 -2))) '(3 4 a b 4)) (test (list) ()) (test (length (list quote do map call/cc lambda define if begin set! let let* cond and or for-each)) 15) (test (list 1(list 2)) '(1(2))) (test (list 1 2 . 3) 'error) ;(test (list 1 2 , 3) 'error) ; ,3 -> 3 in the reader now (test (list 1 2 ,@ 3) 'error) ;;; -------------------------------------------------------------------------------- ;;; list-tail (test (list-tail '(1 2 3) 0) '(1 2 3)) (test (list-tail '(1 2 3) 2) '(3)) (test (list-tail '(1 2 3) 3) ()) (test (list-tail '(1 2 3 . 4) 2) '(3 . 4)) (test (list-tail '(1 2 3 . 4) 3) 4) (test (let ((x (list 1 2 3))) (eq? (list-tail x 2) (cddr x))) #t) (test (list-tail () 0) ()) (test (list-tail () 1) 'error) (test (list-tail '(1 2 3) 4) 'error) (test (list-tail () -1) 'error) (test (list-tail (list 1 2) 2) ()) (test (list-tail (cons 1 2) 0) '(1 . 2)) (test (list-tail (cons 1 2) 1) 2) (test (list-tail (cons 1 2) 2) 'error) (test (list-tail (cons 1 2) -1) 'error) (test (list-tail ''foo 1) '(foo)) (test (list-tail '((1 2) (3 4)) 1) '((3 4))) (test (list-tail (list-tail '(1 2 3) 1) 1) '(3)) (test (list-tail (list-tail (list-tail '(1 2 3 4) 1) 1) 1) '(4)) (test (list-tail '(1 2) (list-tail '(0 . 1) 1)) '(2)) (let ((x '(1 . 2))) (set-cdr! x x) (test (list-tail x 0) x)) (let ((x '(1 . 2))) (set-cdr! x x) (test (list-tail x 1) (cdr x))) (let ((x '(1 . 2))) (set-cdr! x x) (test (list-tail x 100) x)) (let ((x (list 1 2 3))) (let ((y (list-tail x 1))) (set! (y 1) 32) (test (equal? y '(2 32)) #t) (test (equal? x '(1 2 32)) #t))) ; list-tail is not like substring (for-each (lambda (name op1 op2) (for-each (lambda (lst) (let ((val1 (catch #t (lambda () (op1 lst)) (lambda args 'error))) (val2 (catch #t (lambda () (op2 lst)) (lambda args 'error)))) (if (not (equal? val1 val2)) (format #t ";(~A ~A) -> ~A ~A?~%" name lst val1 val2)))) lists)) (list 'list-tail:0 'list-tail:1 'list-tail:2 'list-tail:3 'list-tail:4) (list (lambda (l) l) cdr cddr cdddr cddddr) (list (lambda (l) (list-tail l 0)) (lambda (l) (list-tail l 1)) (lambda (l) (list-tail l 2)) (lambda (l) (list-tail l 3)) (lambda (l) (list-tail l 4)))) (test (list-tail (list 1 2) 3) 'error) (test (list-tail (list 1 2) -1) 'error) (test (list-tail (list 1 2) 1.3) 'error) (test (list-tail (list 1 2) 1/3) 'error) (test (list-tail (list 1 2) 1+2.0i) 'error) (test (list-tail '(1 2 . 3)) 'error) (test (list-tail '(1 2 . 3) 1) '(2 . 3)) (test (list-tail '(1 2 . 3) 0) '(1 2 . 3)) (test (list-tail (list 1 2 3) (+ 1 (expt 2 32))) 'error) (test (list-tail) 'error) (test (list-tail '(1)) 'error) (test (list-tail '(1) 1 2) 'error) (test (set! (list-tail (list 1 2 3)) '(32)) 'error) ; should this work? (for-each (lambda (arg) (test (list-tail (list 1 2) arg) 'error) (test (list-tail arg 0) 'error)) (list "hi" -1 3 most-negative-fixnum most-positive-fixnum (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t (if #f #f) # #() #(1 2 3) (lambda (a) (+ a 1)))) ;;; -------------------------------------------------------------------------------- ;;; make-list (test (make-list 0) ()) (test (make-list 0 123) ()) (test (make-list 1) '(#f)) (test (make-list 1 123) '(123)) (test (make-list 1 ()) '(())) (test (make-list 2) '(#f #f)) (test (make-list 2 1) '(1 1)) (test (make-list 2/1 1) '(1 1)) (test (make-list 2 (make-list 1 1)) '((1) (1))) (test (make-list -1) 'error) (test (make-list -0) ()) (test (make-list most-negative-fixnum) 'error) (test (make-list most-positive-fixnum) 'error) (test (make-list (* 8796093022208 8796093022208)) 'error) (test (make-list 8796093022208) 'error) (test (make-list 0 #\a) ()) (test (make-list 1 #\a) '(#\a)) (test (let-temporarily (((*s7* 'max-list-length 32))) (make-list 64)) 'error) (for-each (lambda (arg) (test (make-list arg) 'error)) (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i 0.0 1.0 () #t 'hi #(()) (list 1 2 3) '(1 . 2) "hi" (- (real-part (log 0.0))))) (for-each (lambda (arg) (test ((make-list 1 arg) 0) arg)) (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi")) (test (make-list) 'error) (test (make-list 1 2 3) 'error) (test (let ((lst (make-list 2 (make-list 1 0)))) (eq? (lst 0) (lst 1))) #t) ;;; -------------------------------------------------------------------------------- ;;; assq (let ((e '((a 1) (b 2) (c 3)))) (test (assq 'a e) '(a 1)) (test (assq 'b e) '(b 2)) (test (assq 'd e) #f)) (test (assq (list 'a) '(((a)) ((b)) ((c)))) #f) (let ((xcons (cons 1 2)) (xvect (vector 1 2)) (xlambda (lambda () 1)) (xstr "abs")) (let ((e (list (list #t 1) (list #f 2) (list 'a 3) (list xcons 4) (list xvect 5) (list xlambda 6) (list xstr 7) (list car 8)))) (test (assq #t e) (list #t 1)) (test (assq #f e) (list #f 2)) (test (assq 'a e) (list 'a 3)) (test (assq xcons e) (list xcons 4)) (test (assq xvect e) (list xvect 5)) (test (assq xlambda e) (list xlambda 6)) (test (assq xstr e) (list xstr 7)) (test (assq car e) (list car 8)))) (let ((e '((1+i 1) (3.0 2) (5/3 3)))) (test (assq 1+i e) #f) (test (assq 3.0 e) #f) (test (assq 5/3 e) #f)) (test (assq 'x (cdr (assq 'a '((b . 32) (a . ((a . 12) (b . 32) (x . 1))) (c . 1))))) '(x . 1)) (test (assq #f '(#f 2 . 3)) #f) (test (assq #f '((#f 2) . 3)) '(#f 2)) (test (assq () '((() 1) (#f 2))) '(() 1)) (test (assq () '((1) (#f 2))) #f) (test (assq #() '((#f 1) (() 2) (#() 3))) #f) ; (eq? #() #()) -> #f (test (assq 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2)) (test (assq 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3)) (test (assq 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2)) (test (assq 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3)) (test (assq 'b (list '(a . 1) '(b . 2) () '(c . 3) #f)) '(b . 2)) (test (assq 'asdf (list '(a . 1) '(b . 2) () '(c . 3) #f)) #f) (test (assq "" (list '("a" . 1) '("" . 2) '(#() . 3))) '("" . 2)) ; was #f (test (assq 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified? (test (assq 'a '((b . 1) (a . 2) (a . 3))) '(a . 2)) ;; check the even/odd cases (let ((odd '((3 . 1) (a . 2) (3.0 . 3) (b . 4) (3/4 . 5) (c . 6) (#(1) . 7) (d . 8))) (even '((e . 1) (3 . 2) (a . 3) (3.0 . 4) (b . 5) (3/4 . 6) (c . 7) (#(1) . 8) (d . 9)))) (test (assq 'a odd) '(a . 2)) (test (assq 'a even) '(a . 3)) (test (assq 3/4 odd) #f) (test (assq 3/4 even) #f) (test (assq 3.0 odd) #f) (test (assq 3.0 even) #f) (test (assq #(1) odd) #f) (test (assq #(1) even) #f)) ;;; -------------------------------------------------------------------------------- ;;; assv (test (assv 1 '(1 2 . 3)) #f) (test (assv 1 '((1 2) . 3)) '(1 2)) (let ((e '((a 1) (b 2) (c 3)))) (test (assv 'a e) '(a 1)) (test (assv 'b e) '(b 2)) (test (assv 'd e) #f)) (test (assv (list 'a) '(((a)) ((b)) ((c)))) #f) (let ((xcons (cons 1 2)) (xvect (vector 1 2)) (xlambda (lambda () 1)) (xstr "abs")) (let ((e (list (list #t 1) (list #f 2) (list 'a 3) (list xcons 4) (list xvect 5) (list xlambda 6) (list xstr 7) (list car 8)))) (test (assv #t e) (list #t 1)) (test (assv #f e) (list #f 2)) (test (assv 'a e) (list 'a 3)) (test (assv xcons e) (list xcons 4)) (test (assv xvect e) (list xvect 5)) (test (assv xlambda e) (list xlambda 6)) (test (assv xstr e) (list xstr 7)) (test (assv car e) (list car 8)))) (let ((e '((1+i 1) (3.0 2) (5/3 3) (#\a 4) ("hiho" 5)))) (test (assv 1+i e) '(1+i 1)) (test (assv 3.0 e) '(3.0 2)) (test (assv 5/3 e) '(5/3 3)) (test (assv #\a e) '(#\a 4)) (test (assv "hiho" e) #f)) (let ((e '(((a) 1) (#(a) 2) ("c" 3)))) (test (assv '(a) e) #f) (test (assv #(a) e) #f) (test (assv (string #\c) e) #f)) (let ((lst '((2 . a) (3 . b)))) (set-cdr! (assv 3 lst) 'c) (test lst '((2 . a) (3 . c)))) (test (assv () '((() 1) (#f 2))) '(() 1)) (test (assv () '((1) (#f 2))) #f) (test (assv #() '((#f 1) (() 2) (#() 3))) #f) ; (eqv? #() #()) -> #f ?? (test (assv 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2)) (test (assv 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3)) (test (assv 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2)) (test (assv 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3)) (test (assv 'asdf '((a . 1) (b . 2) () (c . 3) . 4)) #f) (test (assv 'd '((a . 1) (b . 2) () (c . 3) (d . 5))) '(d . 5)) (test (assv 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified? (test (assv 'a '((b . 1) (a . 2) (a . 3))) '(a . 2)) (let ((odd '((3 . 1) (a . 2) (3.0 . 3) (b . 4) (3/4 . 5) (c . 6) (#(1) . 7) (d . 8))) (even '((e . 1) (3 . 2) (a . 3) (3.0 . 4) (b . 5) (3/4 . 6) (c . 7) (#(1) . 8) (d . 9)))) (test (assv 'a odd) '(a . 2)) (test (assv 'a even) '(a . 3)) (test (assv 3 odd) '(3 . 1)) (test (assv 3 even) '(3 . 2)) (test (assv 3/4 odd) '(3/4 . 5)) (test (assv 3/4 even) '(3/4 . 6)) (test (assv 3.0 odd) '(3.0 . 3)) (test (assv 3.0 even) '(3.0 . 4)) (test (assv #(1) odd) #f) (test (assv #(1) even) #f)) (test (assv 1/0 '((1/0 . 1) (1.0 . 3))) #f) (test (pair? (assv (real-part (log 0)) (list (cons 1/0 1) (cons (real-part (log 0)) 2) (cons -1 3)))) #t) (test (pair? (assv (- (real-part (log 0))) (list (cons 1/0 1) (cons (real-part (log 0)) 2) (cons -1 3)))) #f) ;;; -------------------------------------------------------------------------------- ;;; assoc (let ((e '((a 1) (b 2) (c 3)))) (test (assoc 'a e) '(a 1)) (test (assoc 'b e) '(b 2)) (test (assoc 'd e) #f)) (test (assoc (list 'a) '(((a)) ((b)) ((c)))) '((a))) (let ((xcons (cons 1 2)) (xvect (vector 1 2)) (xlambda (lambda () 1)) (xstr "abs")) (let ((e (list (list #t 1) (list #f 2) (list 'a 3) (list xcons 4) (list xvect 5) (list xlambda 6) (list xstr 7) (list car 8)))) (test (assoc #t e) (list #t 1)) (test (assoc #f e) (list #f 2)) (test (assoc 'a e) (list 'a 3)) (test (assoc xcons e) (list xcons 4)) (test (assoc xvect e) (list xvect 5)) (test (assoc xlambda e) (list xlambda 6)) (test (assoc xstr e) (list xstr 7)) (test (assoc car e) (list car 8)))) (let ((e '((1+i 1) (3.0 2) (5/3 3) (#\a 4) ("hiho" 5)))) (test (assoc 1+i e) '(1+i 1)) (test (assoc 3.0 e) '(3.0 2)) (test (assoc 5/3 e) '(5/3 3)) (test (assoc #\a e) '(#\a 4)) (test (assoc "hiho" e) '("hiho" 5))) (let ((e '(((a) 1) (#(a) 2) ("c" 3)))) (test (assoc '(a) e) '((a) 1)) (test (assoc #(a) e) '(#(a) 2)) (test (assoc (string #\c) e) '("c" 3))) (test (assoc 'a '((b c) (a u) (a i))) '(a u)) (test (assoc 'a '((b c) ((a) u) (a i))) '(a i)) (test (assoc (list 'a) '(((a)) ((b)) ((c)))) '((a))) (test (assoc 5 '((2 3) (5 7) (11 13))) '(5 7)) (test (assoc 'key ()) #f) (test (assoc 'key '(() ())) 'error) (test (assoc () ()) #f) (test (assoc 1 '((1 (2)) (((3) 4)))) '(1 (2))) (test (assoc #f () 1/9223372036854775807) 'error) (test (assoc () 1) 'error) (test (assoc (cons 1 2) 1) 'error) (test (assoc (let ((x (cons 1 2))) (set-cdr! x x)) 1) 'error) (test (assoc '((1 2) .3) 1) 'error) (test (assoc ''foo quote) 'error) (test (assoc 3 '((a . 3)) abs =) 'error) (test (assoc 1 '(1 2 . 3)) 'error) (test (assoc 1 '((1 2) . 3)) '(1 2)) (test (assoc 1 '((1) (1 3) (1 . 2))) '(1)) (test (assoc 1 '((1 2 . 3) (1 . 2))) '(1 2 . 3)) (test (assoc '(((1 2))) '((1 2) ((1 2) 3) (((1 2) 3) 4) ((((1 2) 3) 4) 5))) #f) (test (assoc '(((1 2))) '((1 2) ((1 2)) (((1 2))) ((((1 2)))))) '((((1 2))))) (test (assoc 'a '((a . 1) (a . 2) (a . 3))) '(a . 1)) ; is this specified? (test (assoc 'a '((b . 1) (a . 2) (a . 3))) '(a . 2)) (test (assoc () '((() 1) (#f 2))) '(() 1)) (test (assoc () '((1) (#f 2))) #f) (test (assoc #() '((#f 1) (() 2) (#() 3))) '(#() 3)) (test (assoc # (list (cons (apply values ()) #f))) '(# . #f)) (test (assoc # '((1 2) (# 3))) '(# 3)) (test (assoc #<...> '((1 x) (#<...> 4)) equivalent?) '(#<...> 4)) (test (assoc #<> '((1 2) (#<> 3))) '(#<> 3)) (test (assoc # '((1 2) (# 3))) #f) (test (assoc # '((# 3))) '(# 3)) (test (assoc # '((1 2) (# 3))) '(# 3)) (for-each (lambda (arg) (test (assoc arg (list (list 1 2) (list arg 3))) (list arg 3))) (list "hi" (integer->char 65) #f 'a-symbol #() abs 3/4 #\f #t (if #f #f))) (test (assoc 'b '((a . 1) (b . 2) () (c . 3) #f)) '(b . 2)) (test (assoc 'c '((a . 1) (b . 2) () (c . 3) #f)) '(c . 3)) (test (assoc 'b '((a . 1) (b . 2) () (c . 3) . 4)) '(b . 2)) (test (assoc 'c '((a . 1) (b . 2) () (c . 3) . 4)) '(c . 3)) (test (assoc 'c '((a . 1) (b . 2) () (c . 3) (c . 4) . 4)) '(c . 3)) (test (assoc 'asdf '((a . 1) (b . 2) () (c . 3) (c . 4) . 4)) #f) (test (assoc "" (list '("a" . 1) '("" . 2) '(#() . 3))) '("" . 2)) (test (assoc assoc (list (cons abs 1) (cons assoc 2) (cons + 3))) (cons assoc 2)) (let ((odd '((3 . 1) (a . 2) (3.0 . 3) (b . 4) (3/4 . 5) (c . 6) (#(1) . 7) (d . 8))) (even '((e . 1) (3 . 2) (a . 3) (3.0 . 4) (b . 5) (3/4 . 6) (c . 7) (#(1) . 8) (d . 9)))) (test (assoc 'a odd) '(a . 2)) (test (assoc 'a even) '(a . 3)) (test (assoc 3 odd) '(3 . 1)) (test (assoc 3 even) '(3 . 2)) (test (assoc 3/4 odd) '(3/4 . 5)) (test (assoc 3/4 even) '(3/4 . 6)) (test (assoc 3.0 odd =) '(3 . 1)) (test (assoc 3.0 odd) '(3.0 . 3)) (test (assoc 3.0 even) '(3.0 . 4)) (test (assoc #(1) odd) '(#(1) . 7)) (test (assoc #(1) even) '(#(1) . 8))) (test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) =) '(3 . c)) (test (assoc 3 '((1 . a) (2 . b) (31 . c) (4 . d)) =) #f) (test (assoc 3 () =) #f) (test (assoc 3.0 '((1 . a) (2 . b) (3 . c) (4 . d)) =) '(3 . c)) (test (assoc #\a '((#\A . 1) (#\b . 2)) char=?) #f) (test (assoc #\a '((#\A . 1) (#\b . 2)) char-ci=?) '(#\A . 1)) (test (assoc #\a '((#\A . 1) (#\b . 2)) (lambda (a b) (char-ci=? a b))) '(#\A . 1)) (test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) #(1)) 'error) (test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) abs) 'error) (test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) quasiquote) 'error) (test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b c) (= a b))) 'error) (test (assoc 3.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda* (a b c) (= a b))) '(3 . c)) (test (assoc 3 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a) (= a 1))) 'error) (test (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (dilambda = =)) '(4 . d)) (test (catch #t (lambda () (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b) (error 'assoc a)))) (lambda args (car args))) 'assoc) (test (call-with-exit (lambda (go) (assoc 4.0 '((1 . a) (2 . b) (3 . c) (4 . d)) (lambda (a b) (go 'assoc))))) 'assoc) (test (assoc 3 '((#\a . 3) (#() . 2) (3.0 . 1) ("3" . 0))) #f) (test (assoc 3 '((#\a . 3) (#() . 2) (3.0 . 1) ("3" . 0)) (lambda (a b) (= a b))) 'error) (test (assoc 3 '((#\a . 3) (#() . 2) (3.0 . 1) ("3" . 0)) (lambda (a b) (and (number? b) (= a b)))) '(3.0 . 1)) ; is this order specified? (test (let ((lst (list (cons 1 2) (cons 3 4) (cons 5 6)))) (set! (cdr (cdr lst)) lst) (assoc 3 lst)) '(3 . 4)) (test (let ((lst '((1 . 2) (3 . 4) . 5))) (assoc 3 lst)) '(3 . 4)) (test (let ((lst '((1 . 2) (3 . 4) . 5))) (assoc 5 lst)) #f) (test (let ((lst '((1 . 2) (3 . 4) . 5))) (assoc 3 lst =)) '(3 . 4)) (test (let ((lst '((1 . 2) (3 . 4) . 5))) (assoc 5 lst =)) #f) (test (assoc 3 '((1 . 2) . 3)) #f) (test (assoc 1 '((1 . 2) . 3)) '(1 . 2)) (test (assoc 3 '((1 . 2) . 3) =) #f) (test (assoc 1 '((1 . 2) . 3) =) '(1 . 2)) (test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (and (assoc 2 lst =) lst)) '((1 . 2) (2 . 3) (3 . 4))) (test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr lst)) lst) (assoc 2 lst)) '(2 . 3)) (test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr lst)) lst) (assoc 2 lst =)) '(2 . 3)) (test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr lst)) lst) (assoc 4 lst)) #f) (test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr lst)) lst) (assoc 4 lst =)) #f) (test (let ((lst (list (cons 1 2) (cons 2 3) (cons 3 4)))) (set! (cdr (cdr (cdr lst))) lst) (assoc 3 lst =)) '(3 . 4)) (test (assoc '(1 2) '((a . 3) ((1 2) . 4))) '((1 2) . 4)) (test (assoc '(1 2) '((a . 3) ((1 2) . (3 4)))) '((1 2) 3 4)) (test (assoc '(1 2) '((a . 3) ((1 2) . (3 . 4)))) '((1 2) 3 . 4)) (test (cdr (assoc '(1 2) '((a . 3) ((1 2) . (3 . 4))))) (cons 3 4)) (test (assoc #t (list 1 2) #()) 'error) (test (assoc #t (list 1 2) (integer->char 127)) 'error) (test (assoc #t (list 1 2) (lambda (x y) (+ x 1))) 'error) ; (+ #t 1) (test (assoc #t (list 1 2) abs) 'error) (test (assoc #t (list 1 2) (lambda args args)) 'error) (test (assoc 1 '((3 . 2) 3) =) 'error) (test (assoc 1 '((1 . 2) 3) =) '(1 . 2)) ; this is like other trailing error unchecked cases -- should we check? (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a) (eq? a b))) 'error) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b) (eq? a b))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b c) (eq? a b))) 'error) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b c . d) (eq? a b))) 'error) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a b . c) (eq? a b))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda a (apply eq? a))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda (a . b) (eq? a (car b)))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a) (eq? a b))) 'error) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b) (eq? a b))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b c) (eq? a b))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b c . d) (eq? a b))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a b . c) (eq? a b))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* a (apply eq? a))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a . b) (eq? a (car b)))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a :rest b) (eq? a (car b)))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (a :rest b :rest c) (eq? a (car b)))) '(a 1)) (test (assoc 'a '((c 3) (a 1) (b 2)) (lambda* (:rest a) (apply eq? a))) '(a 1)) (test (assoc 'a '((a 1) (b 2) (c 3)) (define-macro (_m_ a b) `(eq? ',a ',b))) '(a 1)) (test (assoc 'c '((a 1) (b 2) (c 3)) (define-macro (_m_ a b) `(eq? ',a ',b))) '(c 3)) (when with-bignums (test (assoc 1 (list (list (bignum 1) 2))) '(1 2)) (test (assoc 1 (list (list (bignum 1) 2)) =) '(1 2)) (test (assoc 1 (list (list (bignum 1) 2)) eqv?) '(1 2)) (test (assoc 1 (list (list (bignum 1) 2)) equivalent?) '(1 2)) (test (assv 1 (list (list (bignum 1) 2))) '(1 2)) (test (assv (bignum 1) (list (list 1 3))) '(1 3))) (let () (define (atest a b) (eq? a b)) (atest 1 1) (let ((lst (list (cons 'a 1) (cons 'b 2)))) (test (assoc 'b lst atest) '(b . 2)))) (for-each (lambda (arg lst) (test (assoc arg lst eq?) (assq arg lst)) (test (assoc arg lst eqv?) (assv arg lst)) (test (assoc arg lst equal?) (assoc arg lst))) (list 'a #f (list 'a) 'a 1 3/4 #(1) "hi") (list '((a . 1) (b . 2) (c . 3)) '((1 . 1) ("hi" . 2) (#t . 4) (#f . 5) (2 . 3)) '((b . 1) ((a) . 2) (c . 3)) '((d . 1) (a . 2) (b . 4) . (c . 3)) '((1 . 1) (3/4 . 2) (23 . 3)) '((a . 1) (1 . 2) (#(1) . 4) (23 . 3)) '((1 . 1) ("hi" . 2) (23 . 3)))) (test (catch #t (lambda () (assoc 1 (list (list 3 2) (list 2)) (lambda (a b) (catch #t 1 cons)))) (lambda args 'error)) 'error) (test (catch #t (lambda () (member 1 (list 3 2) (lambda (a b) (catch #t 1 cons)))) (lambda args 'error)) 'error) ;;; -------------------------------------------------------------------------------- ;;; memq (test (memq 'a '(a b c)) '(a b c)) (test (memq 'a (list 'a 'b 'c)) '(a b c)) (test (memq 'b '(a b c)) '(b c)) (test (memq 'a '(b c d)) #f) (test (memq (list 'a) '(b (a) c)) #f) (test (memq 'a '(b a c a d a)) '(a c a d a)) (let ((v (vector 'a))) (test (memq v (list 'a 1.2 v "hi")) (list v "hi"))) (test (memq #f '(1 a #t "hi" #f 2)) '(#f 2)) (test (memq eq? (list 2 eqv? 1 eq?)) (list eq?)) (test (memq eq? (list 2 eqv? 2)) #f) (test (memq 6 (memq 5 (memq 4 (memq 3 (memq 2 (memq 1 '(1 2 3 4 5 6))))))) '(6)) (test (memq 1/2 (list (/ 2.0) .5 1/2)) #f) (test (memq 'a (cons 'a 'b)) '(a . b)) (test (memq) 'error) (test (memq 'a) 'error) (test (memq 'a 'b) 'error) (test (memq 'a '(a b . c)) '(a b . c)) (test (memq 'b '(a b . c)) '(b . c)) (test (memq 'c '(a b . c)) #f) ; or should it be 'c? (test (memq () '(1 () 3)) '(() 3)) (test (memq () '(1 2)) #f) (test (memq 'a '(c d a b c)) '(a b c)) (test (memq 'a '(c d f b c)) #f) (test (memq 'a ()) #f) (test (memq 'a '(c d a b . c)) '(a b . c)) (test (memq 'a '(c d f b . c)) #f) (test (memq #f '(1 "hi" #t)) #f) (test (memq () ()) #f) (test (memq () (list)) #f) (test (memq () (list ())) '(())) (test (let ((x (cons 1 2))) (memq x (list x (cons 3 4)))) '((1 . 2) (3 . 4))) (test (pair? (let ((x (lambda () 1))) (memq x (list 1 2 x 3)))) #t) (test (memq memq (list abs + memq car)) (list memq car)) (test (memq 'a '(a a a)) '(a a a)) ;? (test (memq 'a '(b a a)) '(a a)) (test (memq "hi" '(1 "hi" 2)) #f) (test (let ((str "hi")) (memq str (list 1 str 2))) '("hi" 2)) (test (memq #\a '(1 #f #\a 2)) '(#\a 2)) (test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (memq x lst)) '(#(1 2 3) #(1 2))) (test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (memq x lst)) #f) (let ((odd '(3 a 3.0 b 3/4 c #(1) d)) (even '(e 3 a 3.0 b 3/4 c #(1) d))) (test (memq 'a odd) '(a 3.0 b 3/4 c #(1) d)) (test (memq 'a even) '(a 3.0 b 3/4 c #(1) d)) (test (memq 3/4 odd) #f) (test (memq 3/4 even) #f) (test (memq 3.0 odd) #f) (test (memq 3.0 even) #f) (test (memq #(1) odd) #f) (test (memq #(1) even) #f)) ;;; but (memq pi (list 1 pi 2)) -> '(3.1415926535898 2) (test (memq (values #\a '(#\A 97 a))) #f) (test (memq (values #\a '(#\A 97 #\a))) '(#\a)) (test (memq #\a (values #\a '(#\A 97 #\a))) 'error) (test (memq #\a (values '(#\A 97 #\a))) '(#\a)) (test (memq #\a '(1 2) (values)) 'error) ; hmmm (test ((values memq (values #\a '(#\A 97 #\a)))) '(#\a)) ;;; -------------------------------------------------------------------------------- ;;; memv (test (memv 101 '(100 101 102)) '(101 102)) (test (memv 101 (list 100 101 102)) '(101 102)) (test (memv 3.4 '(1.2 2.3 3.4 4.5)) '(3.4 4.5)) (test (memv 3.4 '(1.3 2.5 3.7 4.9)) #f) (test (memv 1/2 (list (/ 2.0) .5 1/2)) '(1/2)) (test (memv 1.0 '(1 2 3)) #f) (test (memv 1/0 '(1/0 1.0 3)) #f) (test (pair? (memv (real-part (log 0)) (list 1/0 (real-part (log 0)) -1))) #t) (test (pair? (memv (- (real-part (log 0))) (list 1/0 (real-part (log 0)) -1))) #f) (let ((ls (list 'a 'b 'c))) (set-car! (memv 'b ls) 'z) (test ls '(a z c))) (test (memv 1 (cons 1 2)) '(1 . 2)) (test (memv 'a (list 'a 'b . 'c)) 'error) (test (memv 'a '(a b . c)) '(a b . c)) (test (memv 'asdf '(a b . c)) #f) (test (memv) 'error) (test (memv 'a) 'error) (test (memv 'a 'b) 'error) (test (memv 'c '(a b c)) '(c)) (test (memv 'c '(a b . c)) #f) (test (memv ''a '('a b c)) #f) (test (let ((x (cons 1 2))) (memv x (list (cons 1 2) (cons 3 4)))) #f) (test (let ((x (cons 1 2))) (memv x (list x (cons 3 4)))) '((1 . 2) (3 . 4))) (test (memv 'a '(a a a)) '(a a a)) ;? (test (memv 'a '(b a a)) '(a a)) (test (memv "hi" '(1 "hi" 2)) #f) (test (memv #\a '(1 #f #\a 2)) '(#\a 2)) (test (memv cons (list car cdr cons +)) (list cons +)) (test (memv (apply values ()) (list #)) (list #)) (let ((odd '(3 a 3.0 b 3/4 c #(1) d)) (even '(e 3 a 3.0 b 3/4 c #(1) d))) (test (memv 'a odd) '(a 3.0 b 3/4 c #(1) d)) (test (memv 'a even) '(a 3.0 b 3/4 c #(1) d)) (test (memv 3/4 odd) '(3/4 c #(1) d)) (test (memv 3/4 even) '(3/4 c #(1) d)) (test (memv 3.0 odd) '(3.0 b 3/4 c #(1) d)) (test (memv 3.0 even) '(3.0 b 3/4 c #(1) d)) (test (memv #(1) odd) #f) (test (memv #(1) even) #f)) (test (memv #(1) '(1 #(1) 2)) #f) (test (memv () '(1 () 2)) '(() 2)) (test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (memv x lst)) '(#(1 2 3) #(1 2))) (test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (memv x lst)) #f) ;;; -------------------------------------------------------------------------------- ;;; member (test (member (list 'a) '(b (a) c)) '((a) c)) (test (member "b" '("a" "c" "b")) '("b")) (test (member 1 '(3 2 1 4)) '(1 4)) (test (member 1 (list 3 2 1 4)) '(1 4)) (test (member car (list abs car modulo)) (list car modulo)) (test (member do (list quote map do)) (list do)) (test (member 5/2 (list 1/3 2/4 5/2)) '(5/2)) (test (member 'a '(a b c d)) '(a b c d)) (test (member 'b '(a b c d)) '(b c d)) (test (member 'c '(a b c d)) '(c d)) (test (member 'd '(a b c d)) '(d)) (test (member 'e '(a b c d)) #f) (test (member 1 (cons 1 2)) '(1 . 2)) (test (member 1 '(1 2 . 3)) '(1 2 . 3)) (test (member 2 '(1 2 . 3)) '(2 . 3)) (test (member 3 '(1 2 . 3)) #f) (test (member 4 '(1 2 . 3)) #f) (test (member 1/2 (list (/ 2.0) .5 1/2)) '(1/2)) (test (member) 'error) (test (member 'a) 'error) (test (member 'a 'b) 'error) (test (member () '(1 2 3)) #f) (test (member () '(1 2 ())) '(())) (test (member #() '(1 () 2 #() 3)) '(#() 3)) (test (member #2d((1 2) (3 4)) '(1 #() #2d((1 2) (1 2)))) #f) (test (member #2d((1 2) (3 4)) '(1 #() #2d((1 2) (3 4)))) '(#2d((1 2) (3 4)))) (test (let ((x (cons 1 2))) (member x (list (cons 1 2) (cons 3 4)))) '((1 . 2) (3 . 4))) (test (let ((x (list 1 2))) (member x (list (cons 1 2) (list 1 2)))) '((1 2))) (test (member ''a '('a b c)) '('a b c)) (test (member 'a '(a a a)) '(a a a)) ;? (test (member 'a '(b a a)) '(a a)) (test (member (member 3 '(1 2 3 4)) '((1 2) (2 3) (3 4) (4 5))) '((3 4) (4 5))) (test (member "hi" '(1 "hi" 2)) '("hi" 2)) (test (member #\a '(1 #f #\a 2)) '(#\a 2)) (test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" x (vector 1 2)))) (member x lst)) '(#(1 2 3) #(1 2))) (test (let* ((x (vector 1 2 3)) (lst (list 1 "hi" (vector 1 2 3)))) (member x lst)) '(#(1 2 3))) (test (member # '(1 2 # 3)) '(# 3)) (test (member #<...> '(1 x #<...> 4 5) equivalent?) '(#<...> 4 5)) (test (member #<> '(1 2 #<>)) '(#<>)) (test (member # '(1 # 2)) #f) (test (member # '(1 # 3)) '(# 3)) (test (member # '(1 # 3)) '(# 3)) (test (member # '(1 # 3)) '(# 3)) (for-each (lambda (arg) (test (member arg (list 1 2 arg 3)) (list arg 3))) (list "hi" (integer->char 65) #f 'a-symbol abs 3/4 #\f #t (if #f #f) '(1 2 (3 (4))) most-positive-fixnum)) (test (member 3 . (1 '(2 3))) 'error) (test (member 3 '(1 2 3) = =) 'error) (test (member 3 . ('(1 2 3))) '(3)) (test (member 3 . ('(1 2 3 . 4))) '(3 . 4)) (test (member . (3 '(1 2 3))) '(3)) (test (member '(1 2) '(1 2)) #f) (test (member '(1 2) '((1 2))) '((1 2))) (test (member . '(quote . ((quote)))) #f) (test (member . '(quote . ((quote) .()))) #f) (test (member '(((1))) '((((1).()).()).())) '((((1))))) (test (member '((1)) '(1 (1) ((1)) (((1))))) '(((1)) (((1))))) (test (member member (list abs car memq member +)) (list member +)) (test (member () () "") 'error) (let ((odd '(3 a 3.0 b 3/4 c #(1) d)) (even '(e 3 a 3.0 b 3/4 c #(1) d))) (test (member 'a odd) '(a 3.0 b 3/4 c #(1) d)) (test (member 'a even) '(a 3.0 b 3/4 c #(1) d)) (test (member 3/4 odd) '(3/4 c #(1) d)) (test (member 3/4 even) '(3/4 c #(1) d)) (test (member 3.0 odd) '(3.0 b 3/4 c #(1) d)) (test (member 3.0 even) '(3.0 b 3/4 c #(1) d)) (test (member #(1) odd) '(#(1) d)) (test (member #(1) even) '(#(1) d))) (test (member 3 '(1 2 3 4) =) '(3 4)) (test (member 3 () =) #f) (test (member 3 '(1 2 4 5) =) #f) (test (member 4.0 '(1 2 4 5) =) '(4 5)) (test (member #\a '(#\b #\A #\c) char=?) #f) (test (member #\a '(#\b #\A #\c) char-ci=?) '(#\A #\c)) (test (member #\a '(#\b #\A #\c) (lambda (a b) (char-ci=? a b))) '(#\A #\c)) (test (char=? (car (member #\a '(#\b #\a))) #\a) #t) (test (char=? (car (member #\a '(#\b #\a) (lambda (a b) (char=? a b)))) #\a) #t) (test (member 3 '(1 2 3 4) <) '(4)) (test (member 3 '((1 2) (3 4)) member) '((3 4))) (test (member 3 '(((1 . 2) (4 . 5)) ((3 . 4))) assoc) '(((3 . 4)))) (test (member '(#f #f #t) '(0 1 2) list-ref) '(2)) (test (let ((v (vector 1 2 3))) (member v (list 0 v) vector-fill!)) '(0 #(0 0 0))) (test (member 3 '(1 2 3) abs) 'error) (test (member 3 '(1 2 3) quasiquote) 'error) (test (member 3 '(1 2 3) (lambda (a b c) (= a b))) 'error) (test (member 3 '(1 2 3) (lambda* (a b c) (= a b))) '(3)) (test (member 3 '(1 2 3 4) (dilambda = =)) '(3 4)) (test (catch #t (lambda () (member 3 '(1 2 3) (lambda (a b) (error 'member a)))) (lambda args (car args))) 'member) (test (call-with-exit (lambda (go) (member 3 '(1 2 3) (lambda (a b) (go 'member))))) 'member) (test (member 'a '(a a a) eq?) '(a a a)) (test (member 'a '(b a a) eqv?) '(a a)) (test (member 3.0 '(1 #\a (3 . 3) abs #() 3+i)) #f) (test (member 3.0 '(1 #\a (3 . 3) abs #() 3+i) (lambda (a b) (= (real-part a) b))) 'error) (test (member 3.0 '(1 #\a (3 . 3) abs #() 3+i) (lambda (a b) (and (number? b) (= (real-part b) a)))) '(3+i)) ;; is it guaranteed that in the comparison function the value is first and the list member 2nd? (test (member 4 '((1 2 3) (4 5 6) (7 8 9)) member) '((4 5 6) (7 8 9))) (test (member 4 '(1 2 3) member) 'error) (test (member 4 '((1 2) (3 5) 7) (lambda (a b) (member a (map (lambda (c) (+ c 1)) b)))) '((3 5) 7)) (test (member 4 '((1 2) (3 5) 7) (lambda (a b) (assoc a (map (lambda (c) (cons (+ c 1) c)) b)))) '((3 5) 7)) (test (let ((f #f)) (member 'a '(a b c) (lambda (a b) (if (eq? b 'a) (set! f (lambda () b))) (eq? a 123))) (f)) 'a) (test (let ((i 0) (f (make-vector 3))) (member 'a '(a b c) (lambda (a b) (vector-set! f i b) (set! i (+ i 1)) (eq? a 123))) f) #(a b c)) (test (member 1 '(0 1 2) (lambda (a b . c) (= a b))) '(1 2)) (test (member 1 '(0 1 2) (lambda* (a b c) (= a b))) '(1 2)) (test (member 1 '(0 1 2) (lambda (a) (= a b))) 'error) (test (member 1 '(0 1 2) (lambda a (= (car a) (cadr a)))) '(1 2)) (test (member 'a '(c 3 a 1 b 2) (lambda (a) (eq? a b))) 'error) (test (member 'a '(c 3 a 1 b 2) (lambda (a b) (eq? a b))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda (a b c) (eq? a b))) 'error) (test (member 'a '(c 3 a 1 b 2) (lambda (a b c . d) (eq? a b))) 'error) (test (member 'a '(c 3 a 1 b 2) (lambda (a b . c) (eq? a b))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda a (apply eq? a))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda (a . b) (eq? a (car b)))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* (a) (eq? a b))) 'error) (test (member 'a '(c 3 a 1 b 2) (lambda* (a b) (eq? a b))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* (a b c) (eq? a b))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* (a b c . d) (eq? a b))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* (a b . c) (eq? a b))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* a (apply eq? a))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* (a . b) (eq? a (car b)))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* (a :rest b) (eq? a (car b)))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* (a :rest b :rest c) (eq? a (car b)))) '(a 1 b 2)) (test (member 'a '(c 3 a 1 b 2) (lambda* (:rest a) (apply eq? a))) '(a 1 b 2)) (test (member 'a '(a b c) (define-macro (_m_ a b) `(eq? ',a ',b))) '(a b c)) (test (member 'c '(a b c) (define-macro (_m_ a b) `(eq? ',a ',b))) '(c)) (test (member 4 '(1 2 3 4 . 5)) '(4 . 5)) (test (member 4 '(1 2 3 4 . 5) =) '(4 . 5)) (test (member 4 '(1 2 3 . 4)) #f) (test (member 4 '(1 2 3 . 4) =) #f) (test (let ((lst (list 1 2 3))) (and (member 2 lst =) lst)) '(1 2 3)) (test (pair? (let ((lst (list 1 2 3))) (set! (cdr (cdr lst)) lst) (member 2 lst))) #t) (test (pair? (let ((lst (list 1 2 3))) (set! (cdr (cdr lst)) lst) (member 2 lst =))) #t) (test (let ((lst (list 1 2 3))) (set! (cdr (cdr lst)) lst) (member 4 lst)) #f) (test (let ((lst (list 1 2 3))) (set! (cdr (cdr lst)) lst) (member 4 lst =)) #f) (test (pair? (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) (member 3 lst =))) #t) (test (pair? (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr lst))) (cdr (cdr lst))) (member 3 lst =))) #t) (test (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr lst))) (cdr (cdr lst))) (member 5 lst =)) #f) (test (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr lst))) (cdr lst)) (member 4 lst =)) #f) (test (let ((lst '(1 2 3 5 6 9 10))) (member 3 lst (let ((last (car lst))) (lambda (a b) (let ((result (= (- b last) a))) (set! last b) result))))) '(9 10)) (test (let ((lst '(1 2 3 5 6 9 10))) (member 2 lst (let ((last (car lst))) (lambda (a b) (let ((result (= (- b last) a))) (set! last b) result))))) '(5 6 9 10)) (test (member 1 () =) #f) (test (member 1 #(1) =) 'error) (test (member 3 '(5 4 3 2 1) >) '(2 1)) (test (member 3 '(5 4 3 2 1) >=) '(3 2 1)) (test (member '(1 2) '((1) (1 . 2) (1 2 . 3) (1 2 3) (1 2) 1 . 2)) '((1 2) 1 . 2)) (test (member '(1 2 . 3) '((1) (1 . 2) (1 2 . 3) (1 2 3) (1 2) 1 . 2)) '((1 2 . 3) (1 2 3) (1 2) 1 . 2)) (when with-bignums (test (memv 1 (list (bignum 1))) '(1)) (test (memv (bignum 1) (list 1)) '(1)) (test (member 1 (list (bignum 1)) eqv?) '(1)) (test (member 1 (list (bignum 1)) =) '(1)) (test (member 1 (list (bignum 1))) '(1)) (test (member 1 (list (bignum 1)) equivalent?) '(1)) (test (member 1 (list (bignum 1)) equal?) '(1)) (test (member 1.0 (list (bignum 1)) equivalent?) '(1)) (test (member (+ 1.0 1e-15) (list (bignum 1)) equivalent?) #f) (test (assoc 1 (list (list (bignum 1) 'ok))) '(1 ok)) (test (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-6)) (member (+ 1 1e-10) (list (bignum 1)) equivalent?)) '(1)) (test (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-6)) (member (+ 1 1e-10) (list (bignum 1)) =)) #f)) (when with-block (test (member 1 (list 2 3) (lambda (a b) (float-vector? (block)))) '(2 3))) (let () (define (sfind obj lst) (member obj lst (lambda (a b) (catch #t (lambda () (and (equal? a b) (member obj lst (lambda (a b) (catch #t (lambda () (error 'oops)) (lambda args (equal? a b))))))) (lambda args 'oops))))) (test (sfind 'a '(b c a d)) '(a d))) (let* ((records (list ; from Woody Douglass (inlet :person "oscar meyer") (inlet :person "howard johnson") (inlet :person "betty crocker"))) (match-record (lambda (name record) (display name #f) ;(format (current-error-port) "COMPARE '~A' '~A'~%" name (record 'person)) (let ((vname (record 'person))) (equal? name (substring vname 0 (min (length name) (length vname))))))) (find-record (lambda (name) (display name #f) ;(format (current-error-port) "FINDING ~A~%" name) (let* ((found (member name records match-record))) (if found (car found) #f))))) (test (find-record "betty") (inlet :person "betty crocker"))) (let () (define-macro (do-list lst . body) `(member #t ,(cadr lst) (lambda (a b) (let ((,(car lst) b)) ,@body #f)))) (let ((sum 0)) (do-list (x '(1 2 3)) (set! sum (+ sum x))) (test (= sum 6) #t))) (let () (define (tree-member a lst) (member a lst (lambda (c d) (if (pair? d) (tree-member c d) (equal? c d))))) (test (tree-member 1 '(2 3 (4 1) 5)) '((4 1) 5)) (test (tree-member -1 '(2 3 (4 1) 5)) #f) (test (tree-member 1 '(2 3 ((4 (1) 5)))) '(((4 (1) 5))))) (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) (test (member 2 lst) (member 2 lst equal?))) (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) (test (member 4 lst) (member 4 lst equal?))) (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr (cdr lst)))) lst) (test (member 4 lst) (member 4 lst equal?))) (let ((lst (list 1 2 3 4))) (set! (cdr (cdr (cdr (cdr lst)))) (cdr lst)) (test (member 4 lst) (member 4 lst equal?))) (for-each (lambda (arg lst) (test (member arg lst eq?) (memq arg lst)) (test (member arg lst eqv?) (memv arg lst)) (test (member arg lst equal?) (member arg lst))) (list 'a #f (list 'a) 'a 1 3/4 #(1) "hi") (list '(a b c) '(1 "hi" #t #f 2) '(b (a) c) '(d a b . c) '(1 3/4 23) '(1 3/4 23) '(a 1 #(1) 23) '(1 "hi" 23))) (for-each (lambda (op) (test (op) 'error) (for-each (lambda (arg) (let ((result (catch #t (lambda () (op arg)) (lambda args 'error)))) (if (not (eq? result 'error)) (format #t ";(~A ~A) returned ~A?~%" op arg result)) (test (op arg () arg) 'error) (test (op arg) 'error))) (list () "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar assq assv memq memv list-ref list-tail)) (for-each (lambda (op) (test (op '(1) '(2)) 'error)) (list reverse car cdr caar cadr cdar cddr caaar caadr cadar cdaar caddr cdddr cdadr cddar caaaar caaadr caadar cadaar caaddr cadddr cadadr caddar cdaaar cdaadr cdadar cddaar cdaddr cddddr cddadr cdddar list-ref list-tail list-set!)) (for-each (lambda (op) (for-each (lambda (arg) (let ((result (catch #t (lambda () (op #f arg)) (lambda args 'error)))) (if (not (eq? result 'error)) (format #t ";(~A #f ~A) returned ~A?~%" op arg result)))) (list "hi" (integer->char 65) #f 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list assq assv assoc memq memv member)) ;; t_simple_p checks [except for member/assoc, only case uses is_simple] (test (equal? (inlet 'a 1 'b 2) (inlet 'a 1 'b 2)) #t) (test (member (inlet 'a 1 'b 2) (list (inlet 'a 1 'b 2))) (list (inlet 'a 1 'b 2))) (test (assoc (inlet 'a 1 'b 2) (list (cons (inlet 'a 1 'b 2) 1))) (cons (inlet 'a 1 'b 2) 1)) (let () (define (fequal? a b) (equal? a b)) (define (f1) (equal? (inlet 'a 1 'b 2) (inlet 'a 1 'b 2))) (f1) (test (f1) #t) (define (f2) (member (inlet 'a 1 'b 2) (list (inlet 'a 1 'b 2)))) (f2) (test (f2) (list (inlet 'a 1 'b 2))) (define (f3) (member (inlet 'a 1 'b 2) (list (inlet 'a 1 'b 2)) fequal?)) (f3) (test (f3) (list (inlet 'a 1 'b 2))) (define (f4) (assoc (inlet 'a 1 'b 2) (list (cons (inlet 'a 1 'b 2) 1)))) (f4) (test (f4) (cons (inlet 'a 1 'b 2) 1))) (let ((ip1 (open-input-string "asdf")) (ip2 (open-input-string "asdf"))) (test (equal? ip1 ip2) #f) (test (member ip1 (list ip2)) #f) (test (assoc ip1 (list (cons ip2 1))) #f) (close-input-port ip1) (close-input-port ip2)) (let ((ip1 #) (ip2 #)) (test (equal? ip1 ip2) #t) (test (member ip1 (list ip2)) (list ip2)) (test (assoc ip1 (list (cons ip2 1))) (cons ip2 1))) (let ((lt1 (inlet 'a 1))) (test (apply case lt1 (list (list lt1) 1) (list (list 'else 2))) 1)) (let () (define* (f a b) (eqv? a b)) (test (member 3 '(1 2 3) f) '(3))) ;;; these need to be here because we methodize 'string? below! (let () ; opt_b_7p_s_iter_at_end (define (find-if-d1 iter) (do ((i 0 (+ i 1))) ((= i 1) (not (iterator-at-end? iter))) (do () ((or (string? (iterate iter)) (iterator-at-end? iter)))))) (test (find-if-d1 (make-iterator (list 1 2))) #f)) (let () ; iterator_is_at_end_b_7p (define (find-if-d2 iter) (do ((i 0 (+ i 1))) ((= i 1) (not (iterator-at-end? iter))) (do () ((or (string? (iterate iter)) (iterator-at-end? (car (list iter)))))))) (test (find-if-d2 (make-iterator (list 1 2))) #f)) ;;; -------------------------------------------------------------------------------- ;;; append (test (append '(a b c) ()) '(a b c)) (test (append () '(a b c)) '(a b c)) (test (append '(a b) '(c d)) '(a b c d)) (test (append '(a b) 'c) '(a b . c)) (test (equal? (append (list 'a 'b 'c) (list 'd 'e 'f) () '(g)) '(a b c d e f g)) #t) (test (append (list 'a 'b 'c) (list 'd 'e 'f) () (list 'g)) '(a b c d e f g)) (test (append (list 'a 'b 'c) 'd) '(a b c . d)) (test (append () ()) ()) (test (append () (list 'a 'b 'c)) '(a b c)) (test (append) ()) (test (append () 1) 1) (test (append 'a) 'a) (test (append '(x) '(y)) '(x y)) (test (append '(a) '(b c d)) '(a b c d)) (test (append '(a (b)) '((c))) '(a (b) (c))) (test (append '(a b) '(c . d)) '(a b c . d)) (test (append () 'a) 'a) (test (append '(a b) (append (append '(c)) '(e) 'f)) '(a b c e . f)) (test (append ''foo 'foo) (cons #_quote (cons 'foo 'foo))) (test (append () (cons 1 2)) '(1 . 2)) (test (append () () ()) ()) (test (append (cons 1 2)) '(1 . 2)) (test (append (list 1) 2) '(1 . 2)) (test (append #f) #f) (test (append () #f) #f) (test (append '(1 2) #f) '(1 2 . #f)) (test (append () () #f) #f) (test (append () '(1 2) #f) '(1 2 . #f)) (test (append '(1 2) () #f) '(1 2 . #f)) (test (append '(1 2) '(3 4) #f) '(1 2 3 4 . #f)) (test (append () () () #f) #f) (test (append '(1 2) '(3 4) '(5 6) #f) '(1 2 3 4 5 6 . #f)) (test (append () () #()) #()) (test (append () ((lambda () #f))) #f) (test (append (begin) do) do) (test (append if) if) (test (append quote) quote) (test (append 0) 0) ; is this correct? (test (append () 0) 0) (test (append () () 0) 0) (test (let* ((x '(1 2 3)) (y (append x ()))) (eq? x y)) #f) ; check that append returns a new list (test (let* ((x '(1 2 3)) (y (append x ()))) (equal? x y)) #t) (test (let* ((x (list 1 2 3)) (y (append x (list)))) (eq? x y)) #f) (test (append '(1) 2) '(1 . 2)) (let ((x (list 1 2 3))) (let ((y (append x ()))) (set-car! x 0) (test (= (car y) 1) #t))) (let ((x (list 1 2 3))) (let ((y (append x ()))) (set-cdr! x 0) (test (and (= (car y) 1) (= (cadr y) 2) (= (caddr y) 3)) #t))) (test (let ((xx (list 1 2))) (recompose 12 (lambda (x) (append (list (car x)) (cdr x))) xx)) '(1 2)) (test (append 'a 'b) 'error) (test (append 'a ()) 'error) (test (append (cons 1 2) ()) 'error) (test (append '(1) 2 '(3)) 'error) (test (append '(1) 2 3) 'error) (test (let ((lst (list 1 2 3))) (append lst lst)) '(1 2 3 1 2 3)) (test (append ''1 ''1) (list #_quote 1 #_quote 1)) (test (append '(1 2 . 3) '(4)) 'error) (test (append '(1 2 . 3)) '(1 2 . 3)) (test (append '(4) '(1 2 . 3)) '(4 1 2 . 3)) (test (append () 12 . ()) 12) (test (append '(1) 12) '(1 . 12)) (test (append '(1) 12 . ()) '(1 . 12)) (test (append () () '(1) 12) '(1 . 12)) (test (append '(1) '(2) '(3) 12) '(1 2 3 . 12)) (test (append '(((1))) '(((2)))) '(((1)) ((2)))) (test (append () . (2)) 2) (test (append . (2)) 2) (test (append ''() ()) ''()) (test (let ((i 1)) (logior 123 (append i))) 123) ; ! (test (let ((x "hi")) (eq? (append x "") x)) #f) (test (let ((x #(1 2 3))) (eq? (append x #()) x)) #f) (test (let ((x '(1 2 3))) (eq? (append x ()) x)) #f) (test (let ((x '(1 2 3))) (eq? (append x) x)) #t) (test (append (rootlet) #f) 'error) ; "append first argument, (rootlet), is a let but should be a sequence other than the rootlet" (test (append () (make-hash-table) (byte-vector)) #u()) (test (append (append () (make-hash-table)) (byte-vector)) (hash-table)) (for-each (lambda (arg) (test (append arg) arg) (test (append () arg) arg) (test (append () () () arg) arg)) (list "hi" #\a #f 'a-symbol _ht_ _undef_ _null_ (make-vector 3) abs 1 3.14 3/4 1.0+1.0i #t # # () #() (list 1 2) (cons 1 2) #(0) (lambda (a) (+ a 1)))) (test (append not) not) (test (let ((l0 (list 0)) (l1 (list 0))) (let ((m0 (append '(2) l0)) (m1 (append '(2) l1 '()))) (and (equal? l0 l1) (equal? m0 m1) (let () (list-set! m0 1 3) (list-set! m1 1 3) (list l0 l1))))) '((3) (0))) ;;; generic append (test (append "asdasd" '("asd")) 'error) (test (append "asdasd" #("asd")) 'error) (test (append (string->byte-vector "asdasd") '("asd")) 'error) (test (append (string->byte-vector "asdasd") #("asd")) 'error) (test (catch #t (lambda () (append #r(1.0 2.0 3.0) #((a . 4)))) (lambda (type info) (apply format #f info))) "append argument, (a . 4), is a pair but should be a real") (test (catch #t (lambda () (append #i(1 2 3) #r(1.0 2.0 3.0))) (lambda (type info) (apply format #f info))) "can't append #r(1.0 2.0 3.0) to an int-vector") (test (append (inlet) (hash-table :readable 123)) 'error) (test (let ((h1 (hash-table 'a 1 'b 2)) (h2 (hash-table 'c 3))) (append h1 h2)) (hash-table 'c 3 'a 1 'b 2)) (test (let ((i1 (inlet 'a 1)) (i2 (inlet 'b 2 'c 3))) (append i1 i2)) (inlet 'a 1 'c 3 'b 2)) (test (let ((s1 "abc") (s2 "def")) (append s1 s2)) "abcdef") (test (let ((v1 #(0 1)) (v2 #(2 3))) (append v1 v2)) #(0 1 2 3)) (test (let ((p1 '(1 2)) (p2 '(3 4))) (append p1 p2)) '(1 2 3 4)) (test (vector? (append #())) #t) (test (float-vector? (append (float-vector))) #t) (test (complex-vector? (append (complex-vector))) #t) (test (int-vector? (append (int-vector))) #t) (test (append "12" '(1 . 2) "3") 'error) (for-each (lambda (arg) (test (append arg) arg) (test (append () arg) arg)) (list "" #u() () #() (int-vector) (float-vector) (inlet) (hash-table) "123" #u(101 102) '(1 2 3) '((e . 5) (f . 6)) #(1 2 3) #((g . 8) (h . 9)) (int-vector 1 2 3) (float-vector 1 2 3) (inlet 'a 1 'b 2) (hash-table 'c 3 'd 4))) (test (append #u() (int-vector 1 2 3)) #u(1 2 3)) (test (append #u() "123") #u(49 50 51)) (test (append "" "123") "123") (test (append #() (hash-table)) #()) (test (append #() #u(101 102)) #(101 102)) (test (append (float-vector) #u(101 102)) (float-vector 101.0 102.0)) (test (append (int-vector) #u(101 102)) (int-vector 101 102)) (test (append (hash-table) '((e . 5) (f . 6))) (hash-table 'e 5 'f 6)) (test (append (inlet) #((g . 8) (h . 9))) (inlet 'g 8 'h 9)) (test (append '(1 2 3) #u()) '(1 2 3)) (test (append '(1 2 3) #u() #(4 5)) '(1 2 3 4 5)) (test (append '(1 2 3) #u(101 102)) '(1 2 3 101 102)) (test (append '(1 2 3) #() (inlet 'a 1 'b 2)) '(1 2 3 (a . 1) (b . 2))) (test (let ((lst (append '((e . 5) (f . 6)) "" (hash-table 'c 3 'd 4)))) (or (equal? lst '((e . 5) (f . 6) (c . 3) (d . 4))) (equal? lst '((e . 5) (f . 6) (d . 4) (c . 3))))) #t) (test (append (list 1) "hi") '(1 #\h #\i)) (test (append #(1 2 3) "123") #(1 2 3 #\1 #\2 #\3)) (test (append (int-vector 1 2 3) #(1 2 3)) (int-vector 1 2 3 1 2 3)) (test (append (int-vector 1 2 3) "123") (int-vector 1 2 3 49 50 51)) (test (append (float-vector 1.0 2.0 3.0) (int-vector 1 2 3)) (float-vector 1.0 2.0 3.0 1.0 2.0 3.0)) (test (append (int-vector 1 2 3) (float-vector 1.0 2.0 3.0)) 'error) ;(int-vector 1 2 3 1 2 3)) (test (append (inlet 'a 1 'b 2) '((e . 5) (f . 6))) (inlet 'b 2 'a 1 'e 5 'f 6)) (test (append (inlet 'a 1 'b 2) (hash-table 'c 3 'd 4)) (inlet 'b 2 'a 1 'c 3 'd 4)) (test (append "" #() #u(101 102)) "ef") (test (append "" #u(101 102) (hash-table)) "ef") (test (append #u() #() #u(101 102)) #u(101 102)) (test (append #u() (inlet) "") #u()) (test (append #u() #u(101 102) "123") #u(101 102 49 50 51)) (test (append () "" (int-vector 1 2 3)) (int-vector 1 2 3)) (test (let ((v (append #() #u() (hash-table 'c 3 'd 4)))) (or (equal? v #((c . 3) (d . 4))) (equal? v #((d . 4) (c . 3))))) #t) (test (append #() #(1 2 3) (inlet)) #(1 2 3)) (test (append #() (float-vector 1.0 2.0 3.0) ()) #(1.0 2.0 3.0)) (test (append (float-vector) "" "123") (float-vector 49.0 50.0 51.0)) (test (append (float-vector) (int-vector 1 2 3) #u(101 102)) (float-vector 1.0 2.0 3.0 101.0 102.0)) (test (append (inlet) #() #((g . 8) (h . 9))) (inlet 'g 8 'h 9)) (test (append (inlet) '((e . 5) (f . 6)) (hash-table 'c 3 'd 4)) (inlet 'e 5 'f 6 'c 3 'd 4)) (test (append (hash-table) "" (inlet 'a 1 'b 2)) (hash-table 'b 2 'a 1)) (test (append (hash-table) '((e . 5) (f . 6)) (inlet 'a 1 'b 2)) (hash-table 'b 2 'e 5 'f 6 'a 1)) (test (append (hash-table) #((g . 8) (h . 9)) '((e . 5) (f . 6))) (hash-table 'e 5 'g 8 'f 6 'h 9)) (test (append "123" #u(101 102) (hash-table)) "123ef") (test (append #u(101 102) #u() #u(101 102)) #u(101 102 101 102)) (test (append #u(101 102) "123" (int-vector 1 2 3)) #u(101 102 49 50 51 1 2 3)) (test (append #u(101 102) '(1 2 3) "") #u(101 102 1 2 3)) (test (append '(1 2 3) #u(101 102) #(1 2 3)) '(1 2 3 101 102 1 2 3)) (test (let ((lst (append '(1 2 3) (hash-table 'c 3 'd 4) ""))) (or (equal? lst '(1 2 3 (c . 3) (d . 4))) (equal? lst '(1 2 3 (d . 4) (c . 3))))) #t) (test (append (int-vector 1 2 3) #u(101 102) (float-vector 1.0 2.0 3.0)) 'error) ; (int-vector 1 2 3 101 102 1 2 3)) (test (append (int-vector 1 2 3) '(1 2 3) #u(101 102)) (int-vector 1 2 3 1 2 3 101 102)) (test (append (hash-table 'c 3 'd 4) (hash-table 'c 3 'd 4) '((e . 5) (f . 6))) (hash-table 'e 5 'f 6 'c 3 'd 4)) (when with-block (test (null? (with-let (block 1.0) (append))) #t) (test (append (block 1 2) (block 3 4)) (block 1 2 3 4)) (test (let () (define (func) (append (list (list (list 1)) (setter car)) (vector-dimensions (block 0.0)))) (define (hi) (func)) (hi)) (list '((1)) set-car! 1)) (test (append #i2d((101 201) (3 4)) (make-block 2)) 'error) ; #i(101 201 3 4 0 0)) (test (let () (define (f1) (do ((i 0 (+ i 1))) ((= i 1)) (values (append "" (block)) 1))) (f1)) #t)) (let ((vvv (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) v))) (test (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (byte-vector 255))))) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (byte-vector 255))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (byte-vector 255))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (int-vector 255))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (vector 255))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 255)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (string #\a))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 #\a)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv (vector 1 2 3))))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 1 2 3)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append vvv vvv)))) (func)) #("asd" #r(4.0 5.0 6.0) (1 2 3) 32 "asd" #r(4.0 5.0 6.0) (1 2 3) 32)) (test (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append (vector 0) vvv (byte-vector 255))))) #(0 "asd" #r(4.0 5.0 6.0) (1 2 3) 32 255)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (append (vector 0) vvv (byte-vector 255))))) (func)) #(0 "asd" #r(4.0 5.0 6.0) (1 2 3) 32 255))) (when with-block (test (char? (append (make-float-vector '(2 3) 1) (immutable! (block 0.0 1.0 2.0)))) #f)) (test (let ((v1 #2d(((b . 2) (:rest . 123))))) (append (inlet :a 32) v1 ())) (inlet 'a 32 'b 2 'rest 123)) ; let_setter keyword check (test (random-state? (cdr (append '(1) (random-state 123)))) #t) (test (append '(1) (random-state 123) ()) 'error) (test (random-state? (append () (random-state 123))) #t) (letrec ((L (openlet (inlet 'value "123" 'append (lambda args (if (eq? (car args) L) (apply #_append (let-ref (car args) 'value) (cdr args)) (apply #_append (car args) (let-ref (cadr args) 'value) (cddr args)))))))) (test (append "asd" #u(90) L "456") "asdZ123456") (test (append "asd" L #u(90) "456") "asd123Z456") (test (append "asd" #u(90) "456" L) "asdZ456123") (test (append L "asd" #u(90) "456") "123asdZ456") (test (append L L "asd" #u(90) "456") "123123asdZ456") (test (append "asd" L #u(90) L "456") "asd123Z123456")) (letrec ((L (openlet (inlet 'value "123" 'string? (lambda (obj) #t) 'string-append (lambda args (if (eq? (car args) L) (apply #_string-append (let-ref (car args) 'value) (cdr args)) (apply #_string-append (car args) (let-ref (cadr args) 'value) (cddr args)))))))) (test (string-append "asd" #u(90) L "456") 'error) (test (string-append "asd" "Z" L "456") "asdZ123456") (test (string-append "asd" L "Z" "456") "asd123Z456") (test (string-append "asd" "Z" "456" L) "asdZ456123") (test (string-append L "asd" "Z" "456") "123asdZ456") (test (string-append L L "asd" "Z" "456") "123123asdZ456") (test (string-append "asd" L "Z" L "456") "asd123Z123456")) (when full-s7test (let ((seqs (list "" #u() () #() (int-vector) (float-vector) (inlet) (hash-table) "123" #u(101 102) '(1 2 3) '((e . 5) (f . 6)) #(1 2 3) #((g . 8) (h . 9)) (int-vector 1 2 3) (float-vector 1 2 3) (inlet 'a 1 'b 2) (hash-table 'c 3 'd 4) 1 #f '(1 . 2) (let ((lst (list 1))) (set-cdr! lst lst))))) (define (test-append) (for-each (lambda (s1) (catch #t (lambda () (append s1) (for-each (lambda (s2) (catch #t (lambda () (append s1 s2) (for-each (lambda (s3) (catch #t (lambda () (append s1 s2 s3) (for-each (lambda (s4) (catch #t (lambda () (append s1 s2 s3 s4) (for-each (lambda (s5) (catch #t (lambda () (append s1 s2 s3 s4 s5)) (lambda args 'error))) seqs)) (lambda args 'error))) seqs)) (lambda args 'error))) seqs)) (lambda args 'error))) seqs)) (lambda args 'error))) seqs)) (test-append))) (test (append (vector 1 2 3) (list 4 5 6)) #(1 2 3 4 5 6)) (test (append (list 1 2 3) (vector 4 5 6)) '(1 2 3 4 5 6)) (test (append (list) (vector 4 5 6)) #(4 5 6)) (test (append (vector 1 2 3) (list)) #(1 2 3)) (test (append (list 1 2 3) (vector)) '(1 2 3)) (test (append (vector #\f) "abc") #(#\f #\a #\b #\c)) (test (append "abc" (vector #\f)) "abcf") (test (append (list #\a) "bc") '(#\a #\b #\c)) (test (append "ab" (list #\c)) "abc") (test (append (hash-table) #(1 2 3)) 'error) (test (append (hash-table 'a 1) #((b . 2))) (hash-table 'a 1 'b 2)) (test (append "" #()) "") (test (append #() "") #()) (test (append #i(1 2 3) "asdf") #i(1 2 3 97 115 100 102)) (test (append "asdf" #i(90 91)) "asdfZ[") (test (append "asdf" ()) "asdf") (test (append "asdf" #()) "asdf") (test (append () "asdf") "asdf") (test (append #r(1.0 2.0 3.0) "asdf") #r(1.0 2.0 3.0 97.0 115.0 100.0 102.0)) (test (append #r(1.0 2.0 3.0) "") #r(1.0 2.0 3.0)) (test (append #r(1.0 2.0 3.0) (hash-table)) #r(1.0 2.0 3.0)) (test (append (hash-table) "asdf") 'error) (test (append () "asdf" #()) '(#\a #\s #\d #\f)) (test (append "asdf" "asdf" #()) "asdfasdf") (test (append (block) #r(1 2 3)) 'error) (test (append #r(1 2 3) (block)) #r(1.0 2.0 3.0)) (test (append (block 1 2 3) #r()) 'error) (test (append (hash-table 'a 1) #((b . 2))) (hash-table 'a 1 'b 2)) (test (append #((a . 1)) (hash-table 'b 2)) #((a . 1) (b . 2))) (test (append #((a . 1)) (hash-table 'b 2) (inlet 'c 3)) #((a . 1) (b . 2) (c . 3))) (test (append (hash-table 'a 1) #((b . 2)) (inlet 'c 3)) (hash-table 'c 3 'a 1 'b 2)) (test (append (inlet 'c 3) (hash-table 'a 1) #((b . 2))) (inlet 'b 2 'a 1 'c 3)) (test (append () (hash-table 'a 1)) (hash-table 'a 1)) (test (append '((b . 2)) (hash-table 'a 1)) '((b . 2) (a . 1))) (test (append (hash-table 'a 1) '((b . 2))) (hash-table 'a 1 'b 2)) (test (append '((a . 1)) (inlet 'b 2)) '((a . 1) (b . 2))) (test (append '(1 2) #i(3 4)) '(1 2 3 4)) (test (append '(1 2) (inlet 'a 1)) '(1 2 (a . 1))) (test (append '(1 2) (hash-table 'a 1)) '(1 2 (a . 1))) (test (append () (hash-table 'a 1)) (hash-table 'a 1)) (test (append (list 1 2) #(3) 4) '(1 2 3 . 4)) (let ((L (list 1))) (set-cdr! L L) (test (append (list 2) L) (cons 2 L))) (test (append "" #() (list #\a) () (inlet) "b" (hash-table) #(#\c)) "abc") (test (append (hash-table 'a 1) (hash-table 'a 2)) (hash-table 'a 2)) (test (append (hash-table 'a 1) (inlet 'a 2)) (hash-table 'a 2)) (test (append "asdf" (list #\a)) "asdfa") ;;; tree-cyclic -------- (test (tree-cyclic? '(1 2)) #f) (test (tree-cyclic? 1) #f) (test (tree-cyclic? (let ((lst (list 1))) (set-cdr! lst lst))) #t) (test (tree-cyclic? (let ((lst (list 1))) (set-car! lst lst))) #t) (test (tree-cyclic? (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 3) 2))) (set-cdr! (car lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 3) 2))) (set-car! (car lst) lst))) #t) (test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-car! (cdr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-cdr! (cdr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-cdr! (cddr lst) lst))) #t) (test (tree-cyclic? '(1 2 (3 4))) #f) (test (tree-cyclic? '(1 . 2)) #f) (test (tree-cyclic? '(1 2 . 3)) #f) (test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-cdr! (cddr lst) lst) (list 1 lst))) #t) (test (tree-cyclic? (let ((lst (list 1 (list 1 3) 2))) (set-cdr! (cddr lst) lst) (list 1 (cdr lst)))) #t) (test (tree-cyclic? (let ((lst (list (cons 1 3) 2))) (set-cdr! (cdr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 4) (cons 2 3)))) (set-cdr! (car lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 4) (cons 2 3)))) (set-cdr! (cadr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (car lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cdar lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (car lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cdar lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cadr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cadr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cadr lst) (cdr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cadr lst) (cdr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (caddr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list (list (list 4 5 6)))))) (set-car! (caaar lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list (list (list (list 4 5 6))))))) (set-car! (caaaar lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (caddr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (caddr lst) (cdr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (caddr lst) (cdr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (caddr lst) (cddr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (caddr lst) (cddr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cdaddr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cdaddr lst) lst))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cdaddr lst) (cdr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cdaddr lst) (cdr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-car! (cdaddr lst) (cddr lst)))) #t) (test (tree-cyclic? (let ((lst (list (list 1 2) (list 3) (list 4 5 6)))) (set-cdr! (cdaddr lst) (cddr lst)))) #t) (let-temporarily (((*s7* 'safety) 1)) (test (for-each (define-bacro (_b1_ a) `(* ,a 2)) (let ((<1> (list #f))) (set-cdr! <1> <1>) (vector (let (( (list #f #f))) (set-cdr! (cdr ) <1>) ) #f #f))) 'error)) (let () (let* ((end '(2)) (tree (list end end))) (test (tree-cyclic? tree) #f)) (test (let ((L (list 1 (list 6 7) 3)) (L1 (list 4 5 3))) (set-car! (cdr L1) L) (set-car! (cadr L) L1) (tree-cyclic? (list 1 L 2))) #t) (define (setf top L) (if (pair? top) (begin (if (not (car top)) (set-car! top L) (setf (car top) L)) (setf (cdr top) L)))) (test (let ((L1 (list (list #f)))) (let ((L2 (list (list 0) (list #f)))) (setf L1 L2) (setf L2 L2) (tree-cyclic? L1))) #t) (test (let ((L1 (list 1 2))) (let ((L2 (cons L1 (cons L1 L1)))) (tree-cyclic? L2))) #f) (test (let ((L1 (list 1 2))) (let ((L2 (cons (cons 1 L1) (cons 1 L1)))) (tree-cyclic? L2))) #f) ) ;;; changed these 9-Nov-23 to insist that the "tree" be a list ;;; tree-leaves -------- (test (tree-leaves '(lambda () 1)) 3) (test (tree-leaves ()) 0) (test (tree-leaves 1) 'error) (test (tree-leaves '(a . b)) 2) (test (tree-leaves '(1 (2 3) (4 (5 . 6) . 7))) 7) (test (tree-leaves '((() (1) (())))) 3) (test (tree-leaves '(1 (2 (3 (4)) (5 . 6)) 7)) 7) (let-temporarily (((*s7* 'safety) 1)) (test (tree-leaves (let ((cp (list 1))) (set-cdr! cp cp) (list '+ 1 (list 'quote cp)))) 3)) ; infinite loop #_quote ;;; tree-memq -------- (test (tree-memq 'a '(a b c)) #t) (test (tree-memq 'a '(b c . a)) #t) (test (tree-memq 'a '(b c . e)) #f) (test (tree-memq 'a '(c b c)) #f) (test (tree-memq 'a '(b c ((b a)))) #t) (test (tree-memq 3 '(b c ((b 3)))) #t) ; actually this should be tree-memv (test (tree-memq #\a '(a b ((c (#\a))))) #t) (test (tree-memq #\a '(a b ((c (#\A))))) #f) (test (tree-memq :a '(a b ((c)))) #f) (test (tree-memq :a '(a b :a)) #t) (test (tree-memq () '(a b)) #t) (test (tree-memq 'a ()) #f) (test (tree-memq 'a :a) 'error) (test (tree-memq 'a (hash-table 'a 1)) 'error) ;;; tree-count -------- (test (tree-count 'x '(a b c)) 0) (test (tree-count 'x '(a x c)) 1) (test (tree-count 'x '(a x x)) 2) (test (tree-count 'x '(a x x) 1) 1) (test (tree-count 'x '(x x x) 2) 2) (test (tree-count 'x 'x) 'error) (test (tree-count 'x 'x 'x) 'error) (test (tree-count 'x '(a x x x) 1) 1) (when with-bignums (test (tree-count 'x '(a x c) (bignum 10)) 1) (test (tree-count 'x () (bignum 10)) 0)) ;; tree-count uses eq? which means these two can be different: ;; (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (tree-count 0 x))) ;; (begin (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (tree-count 0 x)))) (func)) ;;; tree-set-memq -------- ;;; changed 9-Nov-23 to allow set to include anything that tree-memq can handle (test (tree-set-memq '(a b) '(1 (2 3 a) 4)) #t) (test (tree-set-memq '(a b) '(1 (2 3 b) 4)) #t) (test (tree-set-memq '(a b) '(1 (2 3 c) 4)) #f) (test (tree-set-memq '(a) ()) #f) (test (tree-set-memq '(#\a) '(1 #\a 2)) #t) (test (tree-set-memq '(a #\a) '(1 2 a)) #t) (test (tree-set-memq '(a) 32) 'error) (test (tree-set-memq 32 ()) 'error) (test (tree-set-memq () '(a b c)) #f) (let-temporarily (((*s7* 'safety) 1)) (test (tree-count 'a (let ((lst (list 1))) (set-cdr! lst lst))) 'error) (test (tree-leaves (let ((lst (list 1))) (set-cdr! lst lst))) 'error) (test (tree-memq 'a (let ((lst (list 1))) (set-cdr! lst lst))) 'error) (test (tree-set-memq '(a b c) (let ((lst (list 1))) (set-cdr! lst lst))) 'error) (test (tree-set-memq (let ((<1> (list #f))) (set-cdr! <1> <1>) (let (( (list #f #f))) (set-cdr! (cdr ) <1>) )) ((lambda* ((a 1)) (+ a 1)) 1)) 'error) (test (let () (define (func) (tree-leaves (signature float-vector))) (define (hi) (func)) (hi)) 'error) ;; these two check that tree-cyclic? ignores quoted circular lists (test (member 1 (list 2 3) (lambda (a b) `(x ,(let ((lst (list 1))) (set-cdr! lst lst))) #f)) #f) (test (member 1 (list 3 2) (lambda (a b) (set-cdr! '(x) (let ((lst (list 1))) (set-cdr! lst lst))) (or))) #f)) (let-temporarily (((*s7* 'safety) 1)) (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (test (tree-leaves lst) 'error) (test (tree-memq 'a lst) 'error) (test (tree-set-memq '(a b c) lst) 'error) (test (tree-count 'a lst) 'error))) ;;; -------------------------------------------------------------------------------- ;;; VECTORS ;;; -------------------------------------------------------------------------------- ;;; -------------------------------------------------------------------------------- ;;; vector? (test (vector? (make-vector 6)) #t) (test (vector? (make-vector 6 #\a)) #t) (test (vector? (make-vector 0)) #t) ;; (test (vector? #*1011) #f) (test (vector? #(0 (2 2 2 2) "Anna")) #t) (test (vector? #()) #t) (test (vector? #("hi")) #t) (test (vector? (vector 1)) #t) (test (let ((v (vector 1 2 3))) (vector? v)) #t) (for-each (lambda (arg) (test (vector? arg) #f)) (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (vector?) 'error) (test (vector? #() #(1)) 'error) (test (vector? begin) #f) (test (vector? vector?) #f) ;;; make a shared ref -- we'll check it later after enough has happened that an intervening GC is likely (define check-subvector-after-gc #f) (let ((avect (make-vector '(6 6) 32))) (do ((i 0 (+ i 1))) ((= i 6)) (do ((j 0 (+ j 1))) ((= j 6)) (set! (avect i j) (cons i j)))) (set! check-subvector-after-gc (avect 3))) (if (not with-bignums) (test (vector? (make-float-vector 3 pi)) #t)) (test (vector? (make-vector 3 pi)) #t) (test (vector? (subvector (make-int-vector '(2 3)) 0 6 '(3 2))) #t) (test (vector? #r(+nan.0)) #t) (test (vector? #r(+inf.0)) #t) (test (vector? #(-nan.0 -inf.0)) #t) (test (vector-rank (vector-ref #(1 2 #2d((2 3) (4 5)) 7) 2)) 2) (test (vector-ref (vector-ref #(1 2 #2d((2 3) (4 5)) 7) 2) 1 0) 4) ;;; -------------------------------------------------------------------------------- ;;; make-vector (test (let ((v (make-vector 3 #f))) (and (vector? v) (= (vector-length v) 3) (eq? (vector-ref v 1) #f))) #t) (test (let ((v (make-vector 1 1))) (and (vector? v) (= (vector-length v) 1) (vector-ref v 0))) 1) (test (let ((v (make-vector 0 1))) (and (vector? v) (= (vector-length v) 0))) #t) (test (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) #(0 1 2 3 4)) (test (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) #(0 1 4 9 16)) (test (make-vector 2 'hi) #(hi hi)) (test (make-vector 0) #()) (test (make-vector -0) #()) (test (make-vector 0 'hi) #()) (test (make-vector 3 (make-vector 1 'hi)) #(#(hi) #(hi) #(hi))) (test (make-vector 3 #(hi)) #(#(hi) #(hi) #(hi))) (test (make-vector 9/3 (list)) #(() () ())) (test (make-vector 3/1 (make-vector 1 (make-vector 1 'hi))) #(#(#(hi)) #(#(hi)) #(#(hi)))) (test (make-float-vector 0 0.0) #()) (test (make-vector 0 0.0) #()) (test (let ((v (make-vector 3 0))) (set! (vector-ref v 1) 32) v) #(0 32 0)) (test (let ((v (make-int-vector 3))) (set! (vector-ref v 1) 0) v) (make-int-vector 3 0)) (for-each (lambda (arg) (test (vector-ref (make-vector 1 arg) 0) arg)) (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) (test (make-vector) 'error) ;(test (make-vector 1 #f #t) 'error) (test (make-vector 1 2 3) 'error) (test (make-vector most-positive-fixnum) 'error) (test (make-vector most-negative-fixnum) 'error) (test (make-vector '(2 -2)) 'error) (test (make-vector (list 2 -2 -3)) 'error) (test (make-vector (cons 2 3)) 'error) (test (make-vector '(2 3 . 4)) 'error) (test (make-vector '(2 (3))) 'error) (test (make-vector 3 0 #f 1) 'error) (test (with-input-from-string "#0d()" read) 'error) ; in sbcl #0() -> #(), guile gives a confused error "too few elements", but #1() -> #()! (test (make-vector '(0)) #()) (test (make-vector ()) 'error) ; see above (in sbcl (make-array '()) -> #0A0) (test (make-vector (list 8796093022208 8796093022208)) 'error) (test (make-vector (list 8796093022208 2)) 'error) (test (make-vector (list 8796093022208 -8796093022208)) 'error) (test (make-vector 3 1 byte?) #u(1 1 1)) (test (make-vector 3 1 integer?) #i(1 1 1)) (test (make-vector 3 1 float?) #r(1 1 1)) (test (make-vector 3 1 #t) #(1 1 1)) (test (make-vector 3 #\a byte?) 'error) (test (make-vector 3 256 byte?) 'error) (test (make-vector 3 1.5 integer?) 'error) (test (make-vector 3 1+i float?) 'error) (let ((fv (make-vector 3 1.0 float?))) (test (vector-set! fv 0 1+i) 'error) (test (set! (fv 0) #\a) 'error) (copy #r(0 1 2) fv) (test fv #r(0 1 2)) (test (sort! fv char)) (test fv #r(2 1 0)) (test (float-vector? fv) #t) (float-vector-set! fv 0 32.0) (test (float-vector-ref fv 0) 32.0) (test (int-vector-ref fv 0) 'error)) (test (make-float-vector 0 1.0) #r()) (test (make-vector 0 1.0 float?) #r()) (test (make-vector 0 1+i float?) 'error) (test (make-vector 0 1+i integer?) 'error) (test (make-vector 0 1+i byte?) 'error) (test (make-vector 0 1 cons) 'error) (test (make-vector 1 1.0 symbol?) 'error) (test (make-vector 1 'a symbol?) #(a)) (test (signature (make-vector 1 'a symbol?)) (cons 'symbol? (cons 'vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test ((object->let (make-vector 1 'a symbol?)) 'signature) (signature (make-vector 1 'a symbol?))) (test (arity (make-vector '(2 3) 'a symbol?)) '(1 . 2)) (test (arity (make-vector 0 'a symbol?)) #f) (test (equal? (make-vector 1 'a symbol?) (make-vector 1 'a symbol?)) #t) (test (equal? (make-vector 1 'a symbol?) (make-vector 1 1 number?)) #f) (test (equivalent? (make-vector 1 'a symbol?) (make-vector 1 1 number?)) #f) (let ((v (make-vector 1 'a symbol?))) (let ((v1 (copy v))) (test (vector-set! v1 0 123) 'error) (test (set! (v1 0) 123) 'error) (test (signature v1) (signature v))) (let ((sv (subvector v 0 1))) (test (vector-set! sv 0 123) 'error) (test (set! (sv 0) 123) 'error) (test (signature sv) (signature v)))) (let-temporarily (((*s7* 'safety) 1)) (let ((v (make-vector 1 'a symbol?))) (vector-set! v 0 'b) (test (v 0) 'b) (test (vector-set! v 0 1.5) 'error)) (let ((v (make-vector '(2 3) 'a symbol?))) (vector-set! v 0 0 'b) (test (v 0 0) 'b) (test (vector-set! v 0 0 1.5) 'error)) (let ((v (make-vector 1 'a symbol?))) (define (fv) (vector-set! v 0 'b)) (fv) (test (v 0) 'b) (test (let () (define (fv1) (vector-set! v 0 1.5)) (fv1)) 'error) (test (let () (define (fv2) (set! (v 0) 1.5)) (fv2)) 'error) (test (let () (define (fv1) (vector-set! v 0 'c)) (fv1) v) #(c)) (test (let () (define (fv2) (set! (v 0) 'd)) (fv2) v) #(d)) (test (let () (define (fv1) (vector-set! v 0 1.5)) (fv1) (fv1) v) 'error) (test (let () (define (fv2) (set! (v 0) 1.5)) (fv2) (fv2) v) 'error) (test (let () (define (fv1) (vector-set! v 0 'c)) (fv1) (fv1) v) #(c)) (test (let () (define (fv2) (set! (v 0) 'd)) (fv2) (fv2) v) #(d))) (for-each (lambda (typ arg) (catch #t (lambda () (make-vector 1 arg typ)) (lambda (type info) (format *stderr* ";11949: (make-vector 1 ~S ~S): ~A~%" arg typ (apply format #f info))))) (list undefined? unspecified? eof-object? boolean? gensym? syntax? symbol? let? openlet? keyword? continuation? number? integer? byte? real? complex? rational? random-state? char? string? input-port? output-port? iterator? null? pair? list? byte-vector? float-vector? complex-vector? int-vector? subvector? vector? hash-table? weak-hash-table? procedure? macro? dilambda? sequence? float? proper-list?) (list # # # #t (gensym) when 'a (inlet 'a 1) (openlet (inlet 'a 1)) :key (call/cc (lambda (r) r)) 1 1 1 1 1+i 1/2 (random-state 1234) #\a "a" (current-input-port) (current-output-port) (make-iterator '(1 2)) () '(1) '(1) #u(1) #r(1) #c(1+i) #i(1) (subvector #(1) 0 1) #(1) (hash-table 'a 1) (make-weak-hash-table) abs quasiquote (dilambda (lambda () 1) (lambda (val) val)) '(1) 1.0 '(1))) ;;; also bignum? (test (let ((v (make-vector 2 1 integer?))) (fill! v 3) v) #i(3 3)) (test (let ((v (make-vector 2 1 integer?))) (fill! v 1/3) v) 'error) (test (let () (define (f) (vector-fill! (make-byte-vector 256 1) (string (integer->char 255)))) (f)) 'error) (test (let ((v (make-vector 3 1 integer?))) (copy #(1 2 3) v) v) #i(1 2 3)) (test (let ((v (make-vector 3 1 integer?))) (copy #u(1 2 3) v) v) #i(1 2 3)) (test (let ((v (make-vector 3 1 integer?))) (copy #(1 1/2 3) v) v) 'error) (test (let ((v (make-vector 2 'a symbol?))) (fill! v 3) v) 'error) (test (let ((v (make-vector 2 'a symbol?))) (fill! v 'b) v) #(b b)) (test (let ((v (make-vector 3 'a symbol?))) (copy #(1 2 3) v) v) 'error) (test (let ((v (make-vector 3 'a symbol?))) (copy #(a b c) v) v) #(a b c)) (test (let ((v (make-vector 3 'a symbol?))) (copy '(1 2 3) v) v) 'error) (test (let ((v (make-vector 3 'a symbol?))) (copy '(a b c) v) v) #(a b c)) (test (let ((v (make-vector 3 'a symbol?))) (copy "123" v) v) 'error) (test (let ((v (make-vector 3 'a symbol?))) (copy (hash-table 'a 1) v) v) 'error) (test (let ((v (make-vector 3 'a symbol?))) (copy (inlet 'a 1) v) v) 'error) (test (let ((v (make-vector 3 'a symbol?))) (copy () v) v) #(a a a)) ; ?? (test (let ((v (make-vector 3 'a symbol?))) (copy 1 v) v) 'error) (test (let ((v (make-vector 3 'a symbol?))) (copy #u(1 2 3) v) v) 'error) (test (let ((v (make-vector 3 'a symbol?))) (copy #i(1 2 3) v) v) 'error) (test (let ((v (make-vector 3 'a symbol?))) (copy #r(1 2 3) v) v) 'error) (test (let ((v (make-vector 3 1.0 real?))) (copy #r(2.0 3.0 1.0) v) (sort! v <) v) #(1.0 2.0 3.0)) (test (let ((v (vector 1 2 3))) (+ (let-temporarily (((v 0) 4)) (v 0)) (v 1))) 6) (test (let ((v (make-vector 3 0 number?))) (copy #i(1 2 3) v) (+ (let-temporarily (((v 0) 4)) (v 0)) (v 1))) 6) (test (let ((v (make-vector 3 0 number?))) (let-temporarily (((v 0) #\a)) (v 0))) 'error) ) ; let-temp safety=1 (let ((x (make-vector 1 #() vector?))) (test (vector-set! x 0 #(1)) #(1)) (test (vector-ref x 0) #(1)) (test (vector-set! x 0 #i(1)) #i(1)) (test (vector-ref x 0) #i(1))) (when full-s7test (catch #t (lambda () (make-vector 1001 '(1) hash-table?)) (lambda args 'error)) (gc) (for-each (lambda (typ1 arg1) (for-each (lambda (typ2 arg2) (catch #t (lambda () (let ((v1 (make-vector 1 arg1 typ1)) (v2 (make-vector 1 arg2 typ2))) (if (and (equal? v1 v2) (not (equal? (v1 0) (v2 0)))) (format *stderr* ";(equal? ~S ~S ~S ~S): #t?~%" arg1 typ1 arg2 typ2) (if (and (not (equal? v1 v2)) (equal? (v1 0) (v2 0))) (format *stderr* ";(equal? ~S ~S ~S ~S): #f?~%" arg1 typ1 arg2 typ2))) (if (and (equivalent? v1 v2) (not (equivalent? (v1 0) (v2 0)))) (format *stderr* ";(equivalent? ~S ~S ~S ~S): #t?~%" arg1 typ1 arg2 typ2) (if (and (not (equivalent? v1 v2)) (equivalent? (v1 0) (v2 0))) (format *stderr* ";(equivalent? ~S ~S ~S ~S): #f?~%" arg1 typ1 arg2 typ2))))) (lambda (type info) (format *stderr* ";equal? ~S ~S ~S ~S: ~A~%" arg1 typ1 arg2 typ2 (apply format #f info))))) (list undefined? unspecified? eof-object? boolean? gensym? syntax? symbol? let? openlet? keyword? continuation? number? integer? byte? float? real? complex? rational? random-state? char? string? input-port? output-port? iterator? null? pair? list? byte-vector? float-vector? complex-vector? int-vector? subvector? vector? hash-table? weak-hash-table? procedure? macro? dilambda? sequence? proper-list?) (list # # # #t (gensym) when 'a (inlet 'a 1) (openlet (inlet 'a 1)) :key (call/cc (lambda (r) r)) 1 1 1 1 1 1 1 (random-state 1234) #\a "a" (current-input-port) (current-output-port) (make-iterator '(1)) () '(1) '(1) #u(1) #r(1) #c(1+i) #i(1) (subvector #(1) 0 1) #(1) (hash-table 'a 1) (make-weak-hash-table) abs quasiquote (dilambda (lambda () 1) (lambda (val) val)) '(1) '(1)))) (list undefined? unspecified? eof-object? boolean? gensym? syntax? symbol? let? openlet? keyword? continuation? number? integer? byte? float? real? complex? rational? random-state? char? string? input-port? output-port? iterator? null? pair? list? byte-vector? float-vector? complex-vector? int-vector? subvector? vector? hash-table? weak-hash-table? procedure? macro? dilambda? sequence? proper-list?) (list # # # #t (gensym) when 'a (inlet 'a 1) (openlet (inlet 'a 1)) :key (call/cc (lambda (r) r)) 1 1 1 1 1 1 1 (random-state 1234) #\a "a" (current-input-port) (current-output-port) (make-iterator '(1)) () '(1) '(1) #u(1) #r(1) #c(1+i) #i(1) (subvector #(1) 0 1) #(1) (hash-table 'a 1) (make-weak-hash-table) abs quasiquote (dilambda (lambda () 1) (lambda (val) val)) '(1) '(1)))) ;; -------- (for-each (lambda (arg) (test (make-vector arg) 'error) (test (make-vector (list 2 arg)) 'error)) (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) (test (eval-string "#2147483649D()") 'error) (test (type-of (eval-string "#-9223372036854775808D()")) 'error) (test (eval-string "#922D()") 'error) (test (eval-string "#(1 2 . 3)") 'error) (test (eval-string "#(1 2 . ())") #(1 2)) (test (eval-string "#i(1 2 . 3)") 'error) (test (eval-string "#i(1 2 3+i)") 'error) (test (eval-string "#i(1 2 ())") 'error) (test (eval-string "#i(1 2 1.5)") 'error) (test (eval-string "#i(1 2 1.0)") 'error) (test (eval-string "#r(1.0 2.0 . 3.0)") 'error) (test (eval-string "#r(1.0 2.0 3.0+i)") 'error) (test (eval-string "#r(1.0 2.0 ())") 'error) (test (eval-string "#r(1 2)") (float-vector 1.0 2.0)) (test (eval-string "#c(1+i 2-i)") (complex-vector 1.0+i 2.0-i)) (test (eval-string "#2d((1 2) (3 4) . 5)") 'error) (test (eval-string "#2d((1 2) (3 . 4))") 'error) (test (eval-string "#2d((1 2) (3 4 . ()))") #2d((1 2) (3 4))) (test (eval-string "#(1 2 . (3 4))") #(1 2 3 4)) ;;; subvector (test (let ((v1 #2d((1 2 3) (4 5 6)))) (let ((v2 (subvector v1 0 6 '(6)))) v2)) #(1 2 3 4 5 6)) (test (let ((v1 #(1 2 3 4 5 6))) (let ((v2 (subvector v1 0 6 '(3 2)))) v2)) #2d((1 2) (3 4) (5 6))) (test (subvector #2d() 0 0 '(0)) #()) (test (subvector '(1) 0 1 '(1)) 'error) (test (subvector #(1) '(2)) 'error) (test (subvector #(1) 0 2 '(1 2)) 'error) (test (subvector #(1 2 3 4) ()) 'error) (test (subvector #(1 2 3 4) 0 most-positive-fixnum) 'error) (test (subvector #(1 2 3 4) 0 most-negative-fixnum) 'error) (test (subvector #(1 2 3 4) 0 -1) 'error) (test (subvector #(1 2 3 4) 0 5) 'error) (test (subvector #(1 2 3 4) 0 0) #()) (test (subvector #(1 2 3 4) 0 2 '(2)) #(1 2)) (test (subvector #(1 2 3 4) 0 2 '(2 1)) #2d((1) (2))) (test (subvector #(1 2 3 4) 0 0 '(0)) #()) (test (subvector #() 1) 'error) (test (subvector #() 0) #()) (test (subvector #(1) 0 0) #()) (let ((v #(1))) (test (subvector-vector (subvector v 0 0)) v)) (test (subvector #(1) 1 2) 'error) (test (subvector (make-vector 3) 1 most-positive-fixnum) 'error) (test (subvector (make-vector 3) 1 4) 'error) (test (subvector (make-vector 3) 0 4) 'error) (test (subvector (make-vector 3) -1 2) 'error) (test (subvector (vector 1 2 3 4 5 6) 0 3 '(3 2)) 'error) (test (subvector (vector 1 2 3 4 5 6) 0 6 '(2 2)) 'error) (test (subvector (make-vector 2 1) 0 (bignum 2)) #(1 1)) (test (subvector (make-vector (list 2 3) #f) 0 (bignum 3)) #(#f #f #f)) (test (subvector) 'error) (for-each (lambda (arg) (test (subvector arg) 'error) (test (subvector #(1 2 3) arg) 'error)) (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)))) (let ((v #2d((1 2) (3 4)))) (test (subvector v 0 2 '((1 2) (3 4))) 'error) (test (subvector v 0 0 ()) 'error) (test (subvector v 0 1 '(1.4)) 'error) (test (subvector v 0 2 '(14 15)) 'error) (test (subvector v 0 4 (list most-positive-fixnum)) 'error) (test (subvector v 0 4 '(-1 0)) 'error) (test (subvector v most-positive-fixnum '(1)) 'error)) (let ((v (float-vector 0.0 1.0 2.0))) (let ((v1 (subvector v 0 3 (list 1 3)))) (test (float-vector? v1) #t) (test (equivalent? (v 0) (v1 0 0)) #t))) (let ((v (vector 0.0 1.0 2.0))) (let ((v1 (subvector v 0 3 (list 1 3)))) (test (vector? v1) #t) (test (equivalent? (v 0) (v1 0 0)) #t))) (let ((v (int-vector 0 1 2))) (let ((v1 (subvector v 0 3 (list 1 3)))) (test (int-vector? v1) #t) (test (equivalent? (v 0) (v1 0 0)) #t))) (let ((v (byte-vector 0 1 2))) (let ((v1 (subvector v 0 3 (list 1 3)))) (test (byte-vector? v1) #t) (test (equivalent? (v 0) (v1 0 0)) #t))) (let ((v (make-int-vector 3))) (set! (v 1) 1) (set! (v 2) 2) (let ((v1 (subvector v 0 3 (list 1 3)))) (test (float-vector? v1) #f) (test (int-vector? v1) #t) (test (integer? (v1 0 2)) #t) (test (= (v 2) (v1 0 2)) #t))) (let ((v (vector 0 1 2 3 4 5 6 7 8))) (test (subvector v 1 7 (list 3 2)) #2d((1 2) (3 4) (5 6))) (test (subvector v 2 8 (list 3 2)) #2d((2 3) (4 5) (6 7))) (test (subvector v 2 5 (list 3)) #(2 3 4)) (test (subvector v 0 3 (list 3)) (subvector v 0 3 (list 3))) (test (subvector v -1 3 (list 3)) 'error) (test (subvector v 10 3 (list 3)) 'error) (test (subvector v 3.2 3 (list 3)) 'error) (test (subvector v "0" 3 (list 3)) 'error) ) (test (subvector #() 1) 'error) (test (subvector #() 0 1) 'error) (test (subvector #(1) 1 2) 'error) (test (subvector #(1) 0 1) #(1)) (let ((a (vector 1 2 3)) (b (vector 4 5 6))) (test (subvector (append a b) 0 6 '(2 3)) #2d((1 2 3) (4 5 6)))) (let ((a #2d((1 2) (3 4))) (b #2d((5 6) (7 8)))) (test (subvector (append a b) 0 8 '(2 4)) #2d((1 2 3 4) (5 6 7 8))) (test (subvector (append a b) 0 8 '(4 2)) #2d((1 2) (3 4) (5 6) (7 8))) (test (subvector (append (a 0) (b 0) (a 1) (b 1)) 0 8 '(2 4)) #2d((1 2 5 6) (3 4 7 8))) (test (subvector (append (a 0) (b 0) (a 1) (b 1)) 0 8 '(4 2)) #2d((1 2) (5 6) (3 4) (7 8)))) (test (subvector (subvector (float-vector 1.0 2.0 3.0 4.0) 0 4 '(2 2)) 0 0 '(0)) #()) (test (subvector (subvector (float-vector 1.0 2.0 3.0 4.0) 0 4 '(2 2)) 0 1 '(1)) (float-vector 1.0)) (test ((subvector (subvector (float-vector 1.0 2.0 3.0 4.0) 0 4 '(2 2)) 0 4 '(4 1)) 2 0) 3.0) (test (subvector (complex-vector 1+i 1-i 2+i 2-i) 1 3) (complex-vector 1-i 2+i)) (let ((v (subvector (float-vector 1 2 3) 0 3))) (test (copy v) (subvector (float-vector 1 2 3) 0 3)) (test (length v) 3) (test (reverse v) (float-vector 3 2 1)) (test v #r(1 2 3)) (set! v (reverse! v)) (test v #r(3 2 1))) (let () (define (f) (let* ((fv #r(1 2 3 4 5)) (sv (subvector fv 1 5))) fv)) (f) (f)) ; unheap transfer bug ;;; subvector? (let ((v (vector 0 1 2 3 4 5 6 7 8))) (test (subvector? (subvector v 1 3)) #t) (test (subvector? v) #f)) (for-each (lambda (arg) (test (subvector? arg) #f) (test (subvector-position arg) 'error) (test (subvector-vector arg) 'error)) (list #\a () -1 #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) (test (subvector?) 'error) (test (subvector? (subvector-vector (subvector #(1) 0 1))) #f) (test (vector? (subvector-vector (subvector #(1) 0 1))) #t) ;;; subvector-position (let ((v (vector 0 1 2 3 4 5 6 7 8))) (test (subvector-position (subvector v 1 3)) 1) (test (subvector-position (subvector v 0 1)) 0) (test (subvector-position (subvector v 1 5 '(2 2))) 1)) (let ((b (make-byte-vector '(2 3)))) (do ((i 0 (+ i 1))) ((= i 2)) (do ((j 0 (+ j 1))) ((= j 3)) (set! (b i j) (+ (* i 3) j)))) (test b #u2d((0 1 2) (3 4 5))) (let ((b1 (byte-vector-ref b 1))) (test b1 #u(3 4 5)) (test (subvector? b1) #t) (test (subvector-vector b1) b) (test (subvector-position (byte-vector-ref b 0)) 0) (test (subvector-position b1) 3))) (test (subvector-position (vector-ref #2d((1 2 3) (4 5 6)) 1)) 3) (test (subvector-position (float-vector-ref #r2d((1 2 3) (4 5 6)) 1)) 3) (test (subvector-position (int-vector-ref #i2d((1 2 3) (4 5 6)) 1)) 3) (test (subvector-position v) 'error) (test (subvector-position) 'error) (test (subvector-position (subvector #(1 2 3) 1 2)) 1) ; 2 = new dims, 1 = offset (test (subvector-position (subvector #(0 1 2 3) 2 3)) 2) (test (subvector-position (subvector #r(0 1 2 3) 2 2)) 2) (test (subvector-position (subvector #i(0 1 2 3) 2 3)) 2) (test (subvector-position (subvector #u(0 1 2 3) 2 3)) 2) (test (subvector-position (subvector #2d() 0)) 0) (test (subvector-position (subvector #u() 0)) 0) ;;; subvector-vector (let ((v (vector 0 1 2 3 4 5 6 7 8))) (test (subvector-vector (subvector v 0 2)) v) (test (subvector-vector v) 'error)) (let ((v (int-vector 0 1 2 3 4 5 6 7 8))) (test (subvector-vector (subvector v 0 2)) v)) (let ((v (float-vector 0 1 2 3 4 5 6 7 8))) (test (subvector-vector (subvector v 0 2)) v)) (let ((v (byte-vector 0 1 2 3 4 5 6 7 8))) (test (subvector-vector (subvector v 0 2)) v)) (let ((v (subvector #u() 0))) (test (subvector-vector v) #u())) (let ((v #(3 1 2 4 0))) (sort! (subvector v 2 5) <) (test v #(3 1 0 2 4))) (when full-s7test ;; this hits a gc mark bug (now fixed) (let ((v (subvector (make-int-vector '(2 3)) 0 6))) (gc) (gc) (object->let v))) ;;; -------- (let-temporarily (((*s7* 'print-length) 123123123)) (test (object->string (make-vector 2048 #f)) "(make-vector 2048 #f)") (test (object->string (make-vector '(12 2048) #)) "(make-vector '(12 2048) #)") (test (object->string (make-float-vector 2048 1.0)) "(make-float-vector 2048 1)") (test (object->string (make-int-vector 2048 32)) "(make-int-vector 2048 32)") (test (object->string (make-int-vector '(12 2048) 2)) "(make-int-vector '(12 2048) 2)") (test (object->string (make-string 20000 #\space)) "(make-string 20000 #\\space)") (test (object->string (make-byte-vector 2000 12)) "(make-byte-vector 2000 12)")) (when with-bignums (let ((v (float-vector (bignum "1.0") (bignum "2.0")))) (test (float-vector? v) #t) (test (v 0) 1.0))) (test (vector? (float-vector)) #t) (test (vector? (int-vector)) #t) (when with-block (test (float-vector? _c_obj_) #t)) (test (float-vector? 1 2) 'error) (test (float-vector?) 'error) (test (int-vector? 1 2) 'error) (test (int-vector?) 'error) (for-each (lambda (arg) (if (float-vector? arg) (format *stderr* ";~A is a float-vector?~%" arg)) (test (float-vector arg) 'error) (if (int-vector? arg) (format *stderr* ";~A is an int-vector?~%" arg)) (test (int-vector arg) 'error)) (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand #() #t (vector 1 2 3) (lambda (a) (+ a 1)))) ;;; make-float-vector (test (float-vector? (make-float-vector 3)) #t) (test (float-vector? (make-float-vector 3 pi)) #t) (test ((make-float-vector 3) 1) 0.0) (test (float-vector? (float-vector)) #t) (test (float-vector? (make-float-vector 0)) #t) (test (float-vector? (int-vector)) #f) (test (equal? (float-vector) (int-vector)) #t) (test (equal? (vector) (int-vector)) #t) (test (equal? (make-float-vector 3 1.0) (float-vector 1.0 1.0 1.0)) #t) (test (equal? (make-float-vector 3 1/2) (float-vector 0.5 0.5 0.5)) #t) (test ((make-float-vector '(2 3) 2.0) 1 2) 2.0) (test (nan? ((make-float-vector 3 1/0) 0)) #t) (for-each (lambda (arg) (test (make-float-vector arg) 'error) (test (make-float-vector 3 arg) 'error)) (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) (test (equal? (vector) (float-vector)) #t) (test (float-vector? (make-float-vector 3 0)) #t) (test (float-vector? (make-float-vector 3 1/2)) #t) (test (float-vector? #r(1.0)) #t) (let ((v (make-vector 1 2.0 float?))) (test (float-vector? v) #t) (test (float-vector-ref v 0) 2.0)) (test (make-float-vector -12) 'error) (test (make-float-vector -12 1.0) 'error) (test (make-float-vector 4294967298) 'error) (test (make-float-vector 4294967298 1.0) 'error) (unless with-bignums (test (s7-optimize '((float-vector-ref (make-float-vector 4294967298 1.0) 0))) 'error) ; try to hit make_float_vector_p_pp (test (s7-optimize '((float-vector-ref (make-float-vector -8 1.0) 0))) 'error)) ;; from tvect for op_let_3a_old(!) (define (tvmax+loc vect) ; has to be global to hit the code (let ((len (length vect)) (mx 0.0) (loc 0)) (do ((i 0 (+ i 1))) ((= i len) (list mx loc)) (when (> (abs (vect i)) mx) (set! mx (vect i)) (set! loc i))))) (define (tvf111) (let ((v (make-int-vector 1)) (a #f)) (set! (v 0) 1) (tvmax+loc v) (do ((i 0 (+ i 1))) ((= i 1)) (set! a (tvmax+loc v))) (test a '(1 0)))) (tvf111) (let () ; thash for float_vector_p_d (define (f size) (let ((vct-hash (make-hash-table size equal?))) (do ((i 0 (+ i 1))) ((= i size)) (hash-table-set! vct-hash (float-vector i) i)) (do ((i 0 (+ i 1))) ((= i size)) (unless (= (hash-table-ref vct-hash (float-vector i)) i) (display "oops"))) (set! vct-hash #f))) (f 8)) ;;; make-int-vector (test (int-vector? (make-int-vector 3)) #t) (test (int-vector? (make-int-vector 3 2)) #t) (test ((make-int-vector 3) 1) 0) (test (int-vector? (int-vector)) #t) (test (int-vector? (make-int-vector 0)) #t) (test (int-vector? (float-vector)) #f) (test (int-vector? (vector)) #f) (test (int-vector? #i(1)) #t) (unless with-bignums (let ((v (make-vector 1 2 integer?))) ; this is big-integer in gmp case (test (int-vector? v) #t) (test (int-vector-ref v 0) 2))) (when with-bignums (let ((v (make-int-vector (bignum "1")))) (test (int-vector? v) #t) (test (length v) 1) (test (make-int-vector 3 (bignum "1")) #i(1 1 1)) (test (make-int-vector (bignum "3") 1) #i(1 1 1)) (test (make-int-vector (bignum "3") (bignum "1")) #i(1 1 1)) (test (make-float-vector (bignum "2") 1.0) #r(1.0 1.0)) (test (make-float-vector 3 (bignum "1.0")) #r(1.0 1.0 1.0)) (test (make-float-vector (bignum "3") 1.0) #r(1.0 1.0 1.0)) (test (make-float-vector (bignum "3") (bignum "1.0")) #r(1.0 1.0 1.0)) (test (make-byte-vector 3 (bignum "1")) #u(1 1 1)) (test (make-byte-vector (bignum "3") 1) #u(1 1 1)) (test (make-byte-vector (bignum "3") (bignum "1")) #u(1 1 1)) (set! v (make-byte-vector 3)) (fill! v (bignum "1")))) (test ((lambda () (make-vector (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))) (vector? (make-float-vector '(2 3) 1))))) #(2)) (when with-block (test ((lambda () (list (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))) (append (block) (block))))) (list 1 2 (block)))) (test (equal? (make-int-vector 3 1) (int-vector 1 1 1)) #t) (test ((make-int-vector '(2 3) 2) 1 2) 2) (test (make-int-vector -3) 'error) (test (make-float-vector -3) 'error) (test (make-vector -3) 'error) (test (make-byte-vector -3) 'error) (test (make-vector (list 1 pi)) 'error) (test (eval-string "#r2d((1 2) (3 #\\a))") 'error) (test (eval-string "#i2d((1 2) (3 #\\a))") 'error) (let ((v (make-vector 1 2 byte?))) (test (byte-vector? v) #t) (test (byte-vector-ref v 0) 2)) (test (make-int-vector 1 integer?) 'error) (test (make-int-vector 1 0 integer?) 'error) (test (make-int-vector -12) 'error) (test (make-int-vector -12 1.0) 'error) (test (make-int-vector 4294967298) 'error) (test (make-int-vector 4294967298 1.0) 'error) (unless with-bignums (test (s7-optimize '((int-vector-ref (make-int-vector 4294967298 1.0) 0))) 'error) (test (s7-optimize '((int-vector-ref (make-int-vector -8 1.0) 0))) 'error)) (for-each (lambda (arg) (test (make-int-vector arg) 'error) (test (make-int-vector 3 arg) 'error)) (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i 1/2 pi #t (vector 1 2 3) (lambda (a) (+ a 1)))) (test (equal? (vector) (int-vector)) #t) (test (catch #t (lambda () (make-float-vector 3.0)) (lambda args (let ((type (car args)) (errmsg (apply format #f (cadr args)))) (list type errmsg)))) '(wrong-type-arg "make-float-vector first argument, 3.0, is a real but should be an integer or a list of integers")) (test (catch #t (lambda () (make-int-vector 3.0)) (lambda args (let ((type (car args)) (errmsg (apply format #f (cadr args)))) (list type errmsg)))) '(wrong-type-arg "make-int-vector first argument, 3.0, is a real but should be an integer or a list of integers")) (test (catch #t (lambda () (make-vector 3.0)) (lambda args (let ((type (car args)) (errmsg (apply format #f (cadr args)))) (list type errmsg)))) '(wrong-type-arg "make-vector first argument, 3.0, is a real but should be an integer or a list of integers")) (test (eval-string "#(0 1 . 2)") 'error) (test (eval-string "#r(0 1 . 2)") 'error) (test (eval-string "#i(0 1 . 2)") 'error) ;;; float-vector-ref ;;; float-vector-set! (test (float-vector-ref (float-vector 1.0 2.0) 1) 2.0) (for-each (lambda (arg) (test (float-vector-ref arg 0) 'error) (test (float-vector-ref (float-vector 1.0) arg) 'error)) (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) (let ((v (make-float-vector (list 2 3) 1.0)) (v1 (make-float-vector 3))) (set! (v 1 1) 2.0) (test (v 1 1) 2.0) (test (v 0 1) 1.0) (test (float-vector-ref v 1 1) 2.0) (test (float-vector-ref #r2d((1 2) (3 4)) 1 1) 4.0) (test (float-vector-ref v 0) (float-vector 1.0 1.0 1.0)) (test (float-vector-set! v 0 0 3.0) 3.0) (test (float-vector-ref v 0 0) 3.0) (test (float-vector-ref v1 3) 'error) (test (float-vector-ref v 1 3) 'error) (test (float-vector-ref v 2 2) 'error) (test (float-vector-ref v1 most-positive-fixnum) 'error) (test (float-vector-ref v1 most-negative-fixnum) 'error) (test (float-vector-set! v1 3 0.0) 'error) (test (float-vector-set! v 1 3 0.0) 'error) (test (float-vector-set! v 2 2 0.0) 'error) (test (float-vector-set! v1 most-positive-fixnum 0.0) 'error) (test (float-vector-set! v1 most-negative-fixnum 0.0) 'error) (test (float-vector-set! v1 0 0+i) 'error) (for-each (lambda (arg) (test (float-vector-ref v 0 arg) 'error) (test (float-vector-set! arg 0 1.0) 'error) (test (float-vector-set! v1 arg) 'error) (test (float-vector-set! v1 0 arg) 'error) (test (float-vector-set! v 0 arg 1.0) 'error)) (list #\a () #f "hi" 1+i 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand #t (vector 1 2 3) (lambda (a) (+ a 1)))) (test (float-vector-ref v) 'error) (test (float-vector-set! v) 'error) (test (float-vector-ref v1 0 1) 'error) (test (float-vector-ref v 0 1 0) 'error) (test (float-vector-ref v1 -1) 'error) (float-vector-set! v1 0 2/5) (test (float-vector-ref v1 0) 0.4) (test (float-vector-set! v1 1 4.0) 4.0) (test (float-vector-ref v1 1) 4.0) (test (float-vector-ref v 3 0) 'error) (test (float-vector-ref v 1 3) 'error) (test (fill! v 0.0) 0.0)) (test (float-vector-ref (float-vector) 0) 'error) (let ((v (float-vector 1 2 3))) (set! (float-vector-ref v 1) 32) (test v (float-vector 1 32 3)) (set! (v 0) 64) (test v (float-vector 64 32 3)) (test (float-vector-set! v 2 (float-vector-set! v 1 0.0)) 0.0) (test v (float-vector 64 0 0))) (let ((v0 (make-float-vector '(3 0))) (v1 (make-float-vector '(0 3))) (v2 (make-float-vector '(2 3))) (v3 (make-float-vector '(1 3))) (v4 (make-float-vector '(3 1)))) (test (float-vector? v0) #t) (test (float-vector-ref v0 0 0) 'error) (test (vector? v0) #t) (test (vector-ref v0 0 0) 'error) (test (v0 0 0) 'error) (test (float-vector? v1) #t) (test (float-vector-ref v1 0 0) 'error) (test (vector? v1) #t) (test (vector-ref v1 0 0) 'error) (test (v1 0 0) 'error) (test (equal? v0 v1) #f) (test (float-vector? (float-vector-ref v2 1)) #t) (test (float-vector-set! v2 1 32.0) 'error) (test (float-vector-set! (float-vector-ref v2 1) 1 32.0) 32.0) (test (float-vector-ref v2 1 1) 32.0) (test (float-vector-ref v3 0) (float-vector 0 0 0)) (test (float-vector-ref v4 0) (float-vector 0)) ) (let () (define (hi) (let ((v2 (make-float-vector '(2 3)))) (float-vector-set! v2 1 12.0) v2)) (test (hi) 'error)) (let () (define (f1) ; opt_d_7piid_sfff (let ((fv (make-float-vector '(2 3)))) (do ((i 0 (+ i 1))) ((= i 2) fv) (float-vector-set! fv (+ i 0) (+ i 1) (* 2.0 3.0))))) (test (f1) #r2d((0.0 6.0 0.0) (0.0 0.0 6.0))) (define (f2) ; opt_d_7pii_sff (let ((iv (make-float-vector '(2 3) 1.0)) (sum 0.0)) (do ((i 0 (+ i 1))) ((= i 2) sum) (set! sum (+ sum (iv (- (+ i 1) 1) (+ i 1))))))) (test (f2) 2.0) (define (f3) ; opt_d_7pii_sff (let ((iv (make-float-vector '(2 3) 1.0)) (sum 0.0)) (do ((i 0 (+ i 1))) ((= i 2) sum) (set! sum (+ sum (float-vector-ref iv (- (+ i 1) 1) (+ i 1))))))) (test (f3) 2.0)) (let () ; regression test for optimizer safe_c_opcq_opcq bug (define (fx n x y) (make-float-vector (if x (+ n 1) n) (if y 0 (/ pi 2)))) (test (equivalent? (fx 3 #f #f) (make-float-vector 3 (/ pi 2))) #t) (test (equivalent? (fx 3 #f #t) (make-float-vector 3)) #t) (test (equivalent? (fx 3 #t #f) (make-float-vector 4 (/ pi 2))) #t) (test (equivalent? (fx 3 #t #t) (make-float-vector 4)) #t) (define (fx1 n x y) (make-float-vector (if x (+ n 1) (- n 1)) (if y (* pi 2) (/ pi 2)))) (test (equivalent? (fx1 3 #f #f) (make-float-vector 2 (/ pi 2))) #t) (test (equivalent? (fx1 3 #f #t) (make-float-vector 2 (* pi 2))) #t) (test (equivalent? (fx1 3 #t #f) (make-float-vector 4 (/ pi 2))) #t) (test (equivalent? (fx1 3 #t #t) (make-float-vector 4 (* pi 2))) #t) (define (fx2 n x y) (make-float-vector (if x (+ n 1) n) (if y (* pi 2) 0.0))) (test (equivalent? (fx2 3 #f #f) (make-float-vector 3)) #t) (test (equivalent? (fx2 3 #f #t) (make-float-vector 3 (* pi 2))) #t) (test (equivalent? (fx2 3 #t #f) (make-float-vector 4)) #t) (test (equivalent? (fx2 3 #t #t) (make-float-vector 4 (* pi 2))) #t) (define (fx3 n y) ; same for safe_c_opssq_opcq (make-float-vector (+ n n) (if y 0.0 (/ pi 2)))) (test (equivalent? (fx3 3 #f) (make-float-vector 6 (/ pi 2))) #t) (test (equivalent? (fx3 3 #t) (make-float-vector 6)) #t) (let ((v (make-float-vector 6))) (test (equivalent? (fx3 3 #t) v) #t)) ) (let ((fv (make-float-vector 10)) (ten 10)) (define (fvf) (do ((i 0 (+ i 1))) ((= i ten)) (float-vector-set! fv i 1.0))) (fvf) (test fv #r(1 1 1 1 1 1 1 1 1 1)) (define (fzf) (do ((i 3 (+ i 1))) ((= i 8)) (float-vector-set! fv i 0))) (fzf) (test fv #r(1 1 1 0 0 0 0 0 1 1))) (let () ; optimizer type check (define (f1) (let ((v (float-vector 1 2 3)) (s "asdf")) (do ((i 0 (+ i 1))) ((= i 3) v) (float-vector-set! v i 123) (set! v s)))) (test (f1) 'error) (define (f2) (let ((v (float-vector 1 2 3))) (do ((i 0 (+ i 1))) ((= i 3) v) (float-vector-set! v i 123) (set! v "asdf")))) (test (f2) 'error) (define (f3) (let ((v (float-vector 1 2 3))) (do ((i 0 (+ i 1))) ((= i 3) v) (float-vector-set! v i 123) (set! v (substring "asdfg" 0 4))))) (test (f3) 'error)) (let ((rv #r(.0 ; a comment +inf.0 #| another |# 1e5 #xa.a))) (test (equivalent? rv (float-vector 0.0 +inf.0 100000.0 10.625)) #t)) (let ((iv #i(9223372036854775807 -0 0000))) (test iv (int-vector most-positive-fixnum 0 0))) (let ((fv (float-vector 0 1))) (test (float-vector-ref fv 0 0) 'error) (test (vector-ref fv 0 0) 'error) (test (fv 0 0) 'error)) (let ((fv #r2d((1 2) (3 4)))) (test (float-vector-ref fv 0 0 0) 'error) (test (float-vector-ref fv 0 0 0 0) 'error) (test (vector-ref fv 0 0 0) 'error) (test (fv 0 0 0) 'error)) (let () (define (h14) (let ((v (make-float-vector (list 10 10))) (v1 (make-vector 10))) (do ((i 0 (+ i 1))) ((= i 10) v1) (vector-set! v1 0 (float-vector-set! v 0 0 2.0))))) ; cell_optimize d_7piid d_to_p fixup */ (let ((v (h14))) (test (v 0) 2.0))) ;;; complex-vector ;;; complex-vector-set! ;;; complex-vector-ref ;;; complex-vector? ;;; make-complex-vector (let ((c (complex-vector 1+i 2-3i))) (test (complex-vector? c) #t) (test (length c) 2) (test (vector-length c) 2) (test (vector-rank c) 1) (test (vector-ref c 0) 1+i) (test (vector-ref c 1) 2-3i) (test (complex-vector-ref c 0) 1+i) (test (vector-set! c 0 0+i) 0+i) (test (vector-ref c 0) 0+i) (test (complex-vector-set! c 1 2+i) 2+i) (test (complex-vector-ref c 1) 2+i) (test (object->string c) "#c(0.0+1.0i 2.0+1.0i)") (test (complex-vector-set! c 1 -2-i) -2-i) (test (object->string c) "#c(0.0+1.0i -2.0-1.0i)")) (let ((c #c(0+i 32 1/2 1.5))) (test (complex-vector? c) #t) (test (length c) 4) (test (complex-vector-ref c 0) 0+i) (test (complex-vector-ref c 1) 32.0) (test (complex-vector-ref c 2) 0.5) (test (complex-vector-ref c 3) 1.5) (test (reverse c) #c(1.5 0.5 32.0 0+i)) (test (complex-vector-ref c 3) 1.5) (test (reverse! c) #c(1.5 0.5 32.0 0+i)) (test (complex-vector-ref c 3) 0+i) (test (copy c) #c(1.5 0.5 32.0 0+i)) (let ((c1 (make-vector 3))) (copy c c1) (test c1 #(1.5 0.5 32.0))) ) (let ((c #2c((0+i 1+i) (0-i 1-i)))) (test (complex-vector? c) #t) (test (complex-vector-ref c 0 0) 0+i) (test (complex-vector-ref c 0 1) 1+i) (test (complex-vector-ref c 1 0) 0-i) (test (complex-vector-ref c 1 1) 1-i) (test (vector-rank c) 2) (test (vector-dimensions c) '(2 2))) (let ((c (make-complex-vector 3 0+i))) (test (complex-vector? c) #t) (test (length c) 3) (test (complex-vector-ref c 0) 0+i) (fill! c 0-i) (test (complex-vector-ref c 0) 0-i) (set! (c 0) 3+i) (test (c 0) 3+i) (test (vector->list c) '(3+i 0-i 0-i)) (test (append c c) #c(3+i 0-i 0-i 3+i 0-i 0-i)) (test (object->let c) (inlet 'value #c(3+1i 0-1i 0-1i) 'type 'complex-vector? 'size 3 'dimensions '(3) 'mutable? #t))) (let ((c (make-complex-vector '(2 3) 0+i))) (test (complex-vector? c) #t) (test (length c) 6) (test (complex-vector-ref c 0 0) 0+i) (test (complex-vector-ref c 1) #c(0+i 0+i 0+i))) (let ((ci (make-iterator #c(1+i 2-i 3+i)))) (test (iterate ci) 1+i) (test (iterate ci) 2-i) (test (ci) 3+i) (test (map values #c(1+i 2-i 3+2i)) '(1+i 2-i 3+2i)) (let ((c (complex-vector 1+i 2-2i 0+3i))) (let ((subc (subvector c 1))) (test subc #c(2-2i 0+3i))))) (let ((c #c(0+i 32 1/2 1.5))) (define (f1 x) (x 0)) (test (f1 c) 0+i) (let ((c1 #c(0 0+i 0+2i))) (let ((H (hash-table c 32 c1 -1))) (test (hash-table-ref H c) 32) (test (H c1) -1)) (let ((c2 (copy c1))) (let ((c3 (copy c2))) (set! (c3 0) 1e-16) (test (equal? c1 c2) #t) (test (equal? c1 c3) #f) (test (equivalent? c1 c3) #t) (test (equivalent? c1 c) #f))))) (test (let ((v #r(1 2 3)) (tf9 set!)) (define (func) (catch #t (lambda () (tf9 (v) #r())) (lambda (type info) 'error))) (func) (func)) 'error) (test (let ((v #i(1 2 3)) (tf9 set!)) (define (func) (catch #t (lambda () (tf9 (v) #i())) (lambda (type info) 'error))) (func) (func)) 'error) (test (append #c(1+i 2+2i) #c(0+i 0+2i)) #c(1+i 2+2i 0+i 0+2i)) (test (append #c(1+i 2+2i) #i(1 2)) #c(1+i 2+2i 1 2)) (test (let ((cv (make-complex-vector 8 1-i)) (v (make-vector 8 #f))) (copy cv v)) (make-vector 8 1-i)) (test (let ((cv (make-complex-vector 8 1+i)) (v (make-vector 8 1-i))) (copy v cv)) (make-complex-vector 8 1-i)) (when with-block (test (let () (define (func) (complex-vector-ref (block 1.0 2.0 3.0) 0)) (func)) 'error) (test (let () (define (func) (complex-vector-set! (block 1.0 2.0 3.0) 0 1.232)) (func)) 'error)) (unless with-bignums (test (let ((alias float-vector-ref)) (s7-optimize (list (list 'alias (list 'hash-table) 'x)))) #)) ;;; int-vector-ref ;;; int-vector-set! (test (int-vector-ref (int-vector 1 2) 1) 2) (for-each (lambda (arg) (test (int-vector-ref arg 0) 'error) (test (int-vector-ref (int-vector 1) arg) 'error)) (list #\a () #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) (let ((v (make-int-vector (list 2 3) 1)) (v1 (make-int-vector 3))) (set! (v 1 1) 2) (test (v 1 1) 2) (test (v 0 1) 1) (test (int-vector-ref v 1 1) 2) (test (int-vector-ref #i2d((1 2) (3 4)) 1 1) 4) (test (int-vector-ref v 0) (int-vector 1 1 1)) (test (int-vector-set! v 0 0 3) 3) (test (int-vector-ref v 0 0) 3) (test (int-vector-ref v1 3) 'error) (test (int-vector-ref v 1 3) 'error) (test (int-vector-ref v 2 2) 'error) (test (int-vector-ref v1 most-positive-fixnum) 'error) (test (int-vector-ref v1 most-negative-fixnum) 'error) (test (int-vector-set! v1 3 0) 'error) (test (int-vector-set! v 1 3 0) 'error) (test (int-vector-set! v 2 2 0) 'error) (test (int-vector-set! v1 most-positive-fixnum 0) 'error) (test (int-vector-set! v1 most-negative-fixnum 0) 'error) (test (int-vector-set! v1 0 0+i) 'error) (for-each (lambda (arg) (test (int-vector-ref v 0 arg) 'error) (test (int-vector-set! arg 0 1) 'error) (test (int-vector-set! v1 arg) 'error) (test (int-vector-set! v1 0 arg) 'error) (test (int-vector-set! v 0 arg 1) 'error)) (list #\a () #f "hi" 1+i 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand #t (vector 1 2 3) (lambda (a) (+ a 1)))) (test (int-vector-ref v) 'error) (test (int-vector-set! v) 'error) (test (int-vector-ref v1 0 1) 'error) (test (int-vector-ref v 0 1 0) 'error) (test (int-vector-ref v1 -1) 'error) (int-vector-set! v1 0 2) (test (int-vector-ref v1 0) 2) (test (int-vector-set! v1 1 4) 4) (test (int-vector-ref v1 1) 4) (test (int-vector-ref v 3 0) 'error) (test (int-vector-ref v 1 3) 'error) (test (fill! v 0) 0)) (test (int-vector-ref (int-vector) 0) 'error) (let ((v (int-vector 1 2 3))) (set! (int-vector-ref v 1) 32) (test v (int-vector 1 32 3)) (set! (v 0) 64) (test v (int-vector 64 32 3)) (test (int-vector-set! v 2 (int-vector-set! v 1 0)) 0) (test v (int-vector 64 0 0))) (let ((v0 (make-int-vector '(3 0))) (v1 (make-int-vector '(0 3))) (v2 (make-int-vector '(2 3))) (v3 (make-int-vector '(1 3))) (v4 (make-int-vector '(3 1)))) (test (int-vector? v0) #t) (test (int-vector-ref v0 0 0) 'error) (test (vector? v0) #t) (test (vector-ref v0 0 0) 'error) (test (v0 0 0) 'error) (test (int-vector? v1) #t) (test (int-vector-ref v1 0 0) 'error) (test (vector? v1) #t) (test (vector-ref v1 0 0) 'error) (test (v1 0 0) 'error) (test (equal? v0 v1) #f) (test (int-vector? (int-vector-ref v2 1)) #t) (test (int-vector-set! v2 1 32) 'error) (test (int-vector-set! (int-vector-ref v2 1) 1 32) 32) (test (int-vector-ref v2 1 1) 32) (test (int-vector-ref v3 0) (int-vector 0 0 0)) (test (int-vector-ref v4 0) (int-vector 0)) ) (let ((fv (int-vector 0 1))) (test (int-vector-ref fv 0 0) 'error) (test (vector-ref fv 0 0) 'error) (test (fv 0 0) 'error)) (let ((fv #i2d((1 2) (3 4)))) (test (int-vector-ref fv 0 0 0) 'error) (test (int-vector-ref fv 0 0 0 0) 'error) (test (vector-ref fv 0 0 0) 'error) (test (fv 0 0 0) 'error)) (let () (define (hi) (let ((v2 (make-int-vector '(2 3)))) (int-vector-set! v2 1 12) v2)) (test (hi) 'error)) (let () (define (f1) (let ((x (float-vector 0.0))) (set! (x 0) (complex 1 2)))) (test (let ((x (float-vector 0.0))) (set! (x 0) 1+i)) 'error) (test (f1) 'error) (define (f2) (let ((x (int-vector 0))) (int-vector-set! x 0 (complex 1 2)))) (test (let ((x (int-vector 0))) (set! (x 0) 0+i)) 'error) (test (f2) 'error) (define (f3) (let ((x (float-vector 0.0))) (float-vector-set! x 0 (complex 1 2)))) (test (f3) 'error) (define (f4) (let ((x (int-vector 0))) (set! (x 0) (complex 1 2)))) (test (f4) 'error)) (when with-bignums (test (int-vector 1 (bignum "2")) #i(1 2)) (test (float-vector 1.0 (bignum "2.0")) #r(1.0 2.0))) (let ((iv (make-int-vector 10)) (ten 10)) (define (ivf) (do ((i 0 (+ i 1))) ((= i ten)) (int-vector-set! iv i 1))) (ivf) (test iv #i(1 1 1 1 1 1 1 1 1 1)) (define (izf) (do ((i 3 (+ i 1))) ((= i 8)) (int-vector-set! iv i 0))) (izf) (test iv #i(1 1 1 0 0 0 0 0 1 1))) (let () (define (f) ; opt_i_7pii_sff (let ((iv (make-int-vector '(2 3) 1)) (sum 0)) (do ((i 0 (+ i 1))) ((= i 2) sum) (set! sum (+ sum (iv (- (+ i 1) 1) (+ i 1))))))) (test (f) 2) (define (g) ; opt_i_7pii_sff (let ((iv (make-byte-vector '(2 3) 1)) (sum 0)) (do ((i 0 (+ i 1))) ((= i 2) sum) (set! sum (+ sum (iv (- (+ i 1) 1) (+ i 1))))))) (test (g) 2)) (let () (define (f1) ; vector_length_i_7p (let ((v (vector (vector 1) (vector 2 3) (vector 4 5 6))) (sum 0) (size 3)) (do ((i 0 (+ i 1))) ((= i size) sum) (set! sum (+ sum (vector-length (vector-ref v i))))))) (test (f1) 6)) (let ((iv (make-int-vector (list 2 3) 1)) ; optimizer bug (c 3)) (define (f1) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1) (vector-ref v 0)) (vector-set! v 0 (int-vector-set! iv 0 0 c))))) (define (f2) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1) (vector-ref v 0)) (vector-set! v 0 (int-vector-set! iv 0 0 3))))) (test (f1) 3) (test (f2) 3)) (let () (define fvref float-vector-ref) (define ivref int-vector-ref) (define bvref byte-vector-ref) (define vref vector-ref) (test (let ((a7 (subvector #i2d((1 2) (3 4)) 1 3 '(2 1)))) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (ivref a7 0)))) (func)) #i(2)) (test (let ((a7 (subvector #u2d((1 2) (3 4)) 1 3 '(2 1)))) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (bvref a7 0)))) (func)) #u(2)) (test (let ((a7 (subvector #r2d((1 2) (3 4)) 1 3 '(2 1)))) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (fvref a7 0)))) (func)) #r(2)) (test (let ((a7 (subvector #2d((1 2) (3 4)) 1 3 '(2 1)))) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (vref a7 0)))) (func)) #(2))) (when full-s7test (define (iota-iv len) (let ((b (make-int-vector len))) (do ((i 0 (+ i 1))) ((= i len) b) (int-vector-set! b i i)))) (do ((i 0 (+ i 1))) ((= i 512)) (let* ((b (iota-iv i)) (b1 (reverse b)) (b2 (reverse! b))) (unless (equal? b1 b2) (format *stderr* "reverse iota-iv ~D: ~A~% ~A~%" i b1 b2))))) (when full-s7test (define (iota-fv len) (let ((b (make-float-vector len))) (do ((i 0 (+ i 1)) (x 0.0 (+ x 1.0))) ((= i len) b) (float-vector-set! b i x)))) (do ((i 0 (+ i 1))) ((= i 512)) (let* ((b (iota-fv i)) (b1 (reverse b)) (b2 (reverse! b))) (unless (equal? b1 b2) (format *stderr* "reverse iota-fv ~D: ~A~% ~A~%" i b1 b2))))) (when full-s7test (define (iota-v len) (let ((b (make-vector len))) (do ((i 0 (+ i 1))) ((= i len) b) (vector-set! b i i)))) (do ((i 0 (+ i 1))) ((= i 512)) (let* ((b (iota-v i)) (b1 (reverse b)) (b2 (reverse! b))) (unless (equal? b1 b2) (format *stderr* "reverse iota-v ~D: ~A~% ~A~%" i b1 b2))))) (when full-s7test (define (iota-bv len) (let ((b (make-byte-vector len))) (do ((i 0 (+ i 1))) ((= i len) b) (byte-vector-set! b i (modulo i 256))))) (do ((i 0 (+ i 1))) ((= i 512)) (let* ((b (iota-bv i)) (b1 (reverse b)) (b2 (reverse! b))) (unless (equal? b1 b2) (format *stderr* "reverse iota-bv ~D: ~A~% ~A~%" i b1 b2))))) (let ((ivset int-vector-set!)) ; int_vector_set_p_ppp error case (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (ivset catch (make-byte-vector '(2 3) 1) (symbol "a" "b")))) (test (f) 'error)) (let ((x 0)) ; same but at index check (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (int-vector-set! #i() `(x 1) (abs x)))) (test (f) 'error)) ;;; -------------------------------------------------------------------------------- ;;; vector (test (vector 1 2 3) #(1 2 3)) (test (vector 1 '(2) 3) #(1 (2) 3)) (test (vector) #()) (test (vector (vector (vector))) #(#(#()))) (test (vector (vector) (vector) (vector)) #(#() #() #())) (test (vector (list)) #(())) (test #(1 #\a "hi" hi) (vector 1 #\a "hi" 'hi)) (test (let ((v (make-vector 4 "hi"))) (vector-set! v 0 1) (vector-set! v 1 #\a) (vector-set! v 3 'hi) v) #(1 #\a "hi" hi)) (let ((x 34)) (test (vector x 'x) #(34 x))) (for-each (lambda (arg) (test (vector-ref (vector arg) 0) arg)) (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1)))) (test (vector 1 . 2) 'error) (test (apply vector (cons 1 2)) 'error) (when with-bignums (test (append #(922337203685477580123123) #(2)) (vector 922337203685477580123123 2))) ;;; -------------------------------------------------------------------------------- ;;; vector->list ;;; list->vector (test (vector->list #(0)) (list 0)) (test (vector->list (vector)) ()) (test (vector->list #(a b c)) '(a b c)) (test (vector->list #(#(0) #(1))) '(#(0) #(1))) (test (vector? (list-ref (let ((v (vector 1 2))) (vector-set! v 1 v) (vector->list v)) 1)) #t) (test (vector->list #i(1 2)) '(1 2)) (test (list->vector ()) #()) (test (list->vector '(a b c)) #(a b c)) (test (list->vector (list (list 1 2) (list 3 4))) #((1 2) (3 4))) (test (list->vector ''foo) #(#_quote foo)) (test (list->vector (list)) #()) (test (list->vector (list 1)) #(1)) (test (list->vector (list (list))) #(())) (test (list->vector (list 1 #\a "hi" 'hi)) #(1 #\a "hi" hi)) (test (list->vector ''1) #(#_quote 1)) (test (list->vector '''1) #(#_quote '1)) (for-each (lambda (arg) (if (proper-list? arg) (test (vector->list (list->vector arg)) arg))) lists) (set! lists ()) (test (list->vector (vector->list (vector))) #()) (test (list->vector (vector->list (vector 1))) #(1)) (test (vector->list (list->vector (list))) ()) (test (vector->list (list->vector (list 1))) '(1)) (test (reinvert 12 vector->list list->vector #(1 2 3)) #(1 2 3)) (test (vector->list) 'error) (test (list->vector) 'error) (test (vector->list #(1) #(2)) 'error) (test (list->vector '(1) '(2)) 'error) (for-each (lambda (arg) (test (vector->list arg) 'error)) (list #\a 1 () (list 1) '(1 . 2) #f 'a-symbol "hi" abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (let ((x (cons #\a #\b))) (set-cdr! x x) (list->vector x)) 'error) (test (list->vector (cons 1 2)) 'error) (test (list->vector '(1 2 . 3)) 'error) (test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (list->vector lst)) 'error) (test (let ((lst (list #\a #\b))) (set! (cdr (cdr lst)) lst) (apply vector lst)) 'error) (for-each (lambda (arg) (test (list->vector arg) 'error)) (list "hi" #\a 1 '(1 . 2) (cons #\a #\b) 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (vector->list #(1 2 3 4) 0) '(1 2 3 4)) (test (vector->list #(1 2 3 4) 2) '(3 4)) (test (vector->list #(1 2 3 4) 0 4) '(1 2 3 4)) (test (vector->list #(1 2 3 4) 4 4) ()) (test (vector->list #(1 2 3 4) 1 2) '(2)) (test (vector->list #(1 2 3 4) -1 4) 'error) (test (vector->list #(1 2 3 4) 1 0) 'error) (test (vector->list #(1 2 3 4) 5) 'error) (test (vector->list #(1 2 3 4) 1 5) 'error) (test (vector->list #(1 2 3 4) 1 2 3) 'error) (unless pure-s7 (test (vector->list #(1 2 3 4) 1 #f) 'error)) (test (vector->list #(1 2 3 4) #f) 'error) (test (vector->list #(1 2 3 4) #f 1) 'error) (test (vector->list #() 0 10) 'error) (test (vector->list #(1) 0 2) 'error) (test (vector->list #() 0 0) ()) (test (vector->list #(1) 1) ()) (test (vector->list #(1) 0) '(1)) (test (vector->list #() #\null) 'error) (test (vector->list #() 0 #\null) 'error) (test (vector->list #() -1) 'error) (test (vector->list #(1) -1) 'error) (test (vector->list #(1) 0 -1) 'error) (test (vector->list #(1) -2 -1) 'error) (test (vector->list #(1) most-negative-fixnum) 'error) (test (vector->list #(1) 2) 'error) (test (vector->list (make-int-vector 3)) '(0 0 0)) (test (vector->list (make-float-vector 3)) '(0.0 0.0 0.0)) (for-each (lambda (arg) (test (vector->list #(0 1 2 3 4 5) arg) 'error) (test (vector->list #(0 1 2 3 4 5) 1 arg) 'error)) (list #\a "hi" () (list 1) '(1 . 2) 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (let () ; vector_to_list_p_p (define (f) (let ((v (vector 1 2 3))) (do ((i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (vector->list #())) (vector-set! v 1 (vector->list #(4 5 6)))))) (test (f) #(() (4 5 6) 3))) (when full-s7test ; GC checks (let () (define (func) (map values (vector->list (make-int-vector '(4 128) 100000)))) ; check GC protection (do ((i 0 (+ i 1))) ((= i 1000)) (func))) (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (make-float-vector '(128 3) (/ pi 2))))))) (do ((i 0 (+ i 1))) ((= i 10000)) (func))) (let () ; GC protection in fx_cons_ac (define (f) (do ((i 0 (+ i 1))) ((= i 10000)) (let () (define (func) (let () (apply values (cons (vector 0 1 2 3 (make-list 256 1)) ())))) (func) (func)))) (f)) (let () ; GC protection in list_p_p (define (f) (do ((i 0 (+ i 1))) ((= i 10000)) (let () (define (func) (let () (apply values (list (vector -inf.0 case (symbol "(\")") 0+i (make-list 256 1)))))) (func) (func)))) (f)) (let () ; GC protection in list_ppp_p (define (f) (do ((i 0 (+ i 1))) ((= i 10000)) (let () (define (func) (let () (apply values (list 1 (vector -inf.0 case (symbol "(\")") 0+i (make-list 256 1)) 2)))) (func) (func)))) (f)) (let () ; fx_cons_aa (define (f) (do ((i 0 (+ i 1))) ((= i 10000)) (let () (define (func) (let () (apply values (cons (vector 0 1 2 3 4) (make-list 256))))) (func) (func)))) (f)) (let () (define (f) ; fx_cons_as (define (func) (let ((L (list 32))) (apply values (cons (vector 0 1 2 3 (make-list 256 1)) L)))) (do ((i 0 (+ i 1))) ((= i 10000)) (func) (func))) (f)) (let () (define (f) (do ((i 0 (+ i 1))) ((= i 10000)) (let () (define (func) (let () (apply values (cons (cons (vector -inf.0 case (symbol "(\")") 0+i (make-list 256 1)) ()) ())))) (func) (func)))) (f)) (let () (define (func x) (do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 10000)) (list x (make-int-vector '(2 3) 1) (make-list 256 1))))) (func 2)) ; opt_p_ppp_sff (let () ; make_closure_unchecked bug (define (func) (do ((j 0 (+ j 1))) ((= j 100)) (do ((i 0 (+ i 1))) ((= i 1000)) (char? (lambda (a) (values a (+ a 1))))))) (func)) (let () ; opt_p_pp_ff (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 10000)) (let ((x #f)) (sort! (vector 3 2 4 5 1) (lambda (a b) (let-temporarily ((x (list (logand) (list-ref (make-list 512) (logior))))) (> a b)))))))) (func)) (let () (define* (sym5 a :rest b) (cons a (copy b))) (define (f1) (do ((i 0 (+ i 1))) ((= i 10000)) (sym5 '(()) (string #\c #\null #\b) (make-list 512)))) ; 1M is a better limit (f1)) (test (let () (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 10000)) (write (make-float-vector '(128 3) pi) (open-output-string))))) (func)) #t) ;; this doesn't hit the GC problem in this context, but maybe it's useful -- opt_p_pp_ff (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 10000)) (#_vector (apply-values (make-list 512)) #f))) (func) (func)) #t) ; pair_append (let () ; g_sort float_vector (data is the free cell, not vec) (define (f) (let ((x #f) (i 0)) (do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 100)) (apply values (sort! (make-float-vector '(128 3) pi) (lambda a (copy a))) ()))))) (f)) (do ((i 0 (+ i 1))) ((= i 100)) (let () (define (func) (let ((x #f) (i 0)) (do ((j 0 (+ j 1))) ((= j 1)) (do ((i 0 (+ i 1))) ((= i 100)) (apply values (inlet ) (make-list 512) ()))))) (func) (func)) (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 100)) (apply values (#_open-output-string ) (make-list 512) #\\\\7 ())))) (func) (func))) (let ((H_4 (make-hash-table 8 (let ((eqf (lambda (a b) (equal? a b))) (mapf (lambda (a) (hash-code a)))) (cons eqf mapf))))) (do ((i 0 (+ i 1))) ((= i 10)) (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 100)) (copy (hash-table +nan.0 1) H_4)))) (func) (func)))) (test (let () (define* (sym6 a b :rest c) (list a b (copy c))) (define (func) (do ((i 0 (+ i 1))) ((= i 100)) (sym6 (values 1.0 letrec* (cons i i) (log 1.0) (log 2.0) (log 3.0) (log 4.0) (log 5.0) (make-list 512))))) (func)) #t) (let () ;elist_5 protect copy_any_list in no_setter_error_nr (define (_fnc12_ x) (- x 1)) (define (f) (do ((i 0 (+ i 1))) ((= i 50)) ; doesn't hit the error in this context even with 1000! (catch #t (lambda () (define (func) ((lambda (a) #f) (set! (values 512 0 0 1 1 0 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1) (_fnc12_)))) (func)) (lambda args #f)))) (test (f) #t)) ) ;;; -------------------------------------------------------------------------------- ;;; vector-length (test (vector-length (vector)) 0) (test (vector-length (vector 1)) 1) (test (vector-length (make-vector 128)) 128) (test (vector-length #(a b c d e f)) 6) (test (vector-length #()) 0) (test (vector-length (vector #\a (list 1 2) (vector 1 2))) 3) (test (vector-length #(#(#(hi)) #(#(hi)) #(#(hi)))) 3) (test (vector-length (vector 1 2 3 4)) 4) (test (vector-length (let ((v (vector 1 2))) (vector-set! v 1 v) v)) 2) (test (vector-length (let ((v (vector 1 2))) (vector-set! v 1 v) (vector-ref v 1))) 2) (test (vector-length (make-int-vector 3 0)) 3) (if (not with-bignums) (test (vector-length (make-float-vector 3 pi)) 3)) (if (not with-bignums) (test (vector-length (make-float-vector '(2 3) pi)) 6)) (test (vector-length #r(1 2)) 2) (test (vector-length) 'error) (test (vector-length #(1) #(2)) 'error) (for-each (lambda (arg) (test (vector-length arg) 'error)) (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (let ((ivals (make-int-vector 3))) ; vector_length_p_p (define (unzero v) (let ((v1 (copy v))) (do ((i 0 (+ i 1))) ((= i (vector-length v1)) v1) (if (zero? (v1 i)) (set! (v1 i) 1))))) (test (unzero ivals) #i(1 1 1))) ;;; -------------------------------------------------------------------------------- ;;; vector-rank ;;; vector-dimension ;;; vector-dimensions (test (vector-rank #()) 1) (test (vector-dimensions #()) '(0)) (test (vector-dimension #() 0) 0) (test (vector-dimension #() 0 0) 'error) (test (vector-dimension #() 1) 'error) (test (vector-dimension #()) 'error) (test (vector-rank #(1 2)) 1) (test (vector-dimensions #(1 2)) '(2)) (test (vector-dimension #(1 2) 0) 2) (test (vector-dimension #(1 2) -1) 'error) (test (vector-dimension #(1 2) 1) 'error) (test (vector-rank (make-vector '(2 3))) 2) (test (vector-dimensions (make-vector '(2 3))) '(2 3)) (test (vector-dimension (make-vector '(2 3)) 0) 2) (test (vector-dimension (make-vector '(2 3)) 1) 3) (test (vector-rank (make-vector '(2 1 3))) 3) (test (vector-dimensions (make-vector '(2 1 3))) '(2 1 3)) (test (vector-rank (make-vector '(2 0 3))) 3) (test (vector-dimensions (make-vector '(2 0 3))) '(2 0 3)) (test (vector-dimension (make-vector '(2 0 3)) 1) 0) (test (vector-dimension (make-vector '(2 0 3)) 2) 3) (test (vector-rank (make-vector 0)) 1) (test (vector-dimensions (make-vector 0)) '(0)) (test (vector-dimensions _c_obj_) '(16)) (let ((v (make-vector 24))) (test (vector-rank (subvector v 0 24 '(3 8))) 2) (test (vector-rank (subvector v 2 10 '(2 2 2))) 3)) (for-each (lambda (arg) (test (vector-rank arg) 'error) (test (vector-dimension arg 0) 'error) (test (vector-dimensions arg) 'error)) (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (vector-rank (make-int-vector '(2 3))) 2) (test (vector-dimensions (make-int-vector '(2 3))) '(2 3)) (test (vector-dimension (make-int-vector '(2 3)) 1) 3) (test (vector-rank (make-byte-vector '(2 3))) 2) (test (vector-dimensions (make-byte-vector '(2 3))) '(2 3)) (test (vector-dimension (make-byte-vector '(2 3)) 0) 2) (test (vector-dimension (make-byte-vector '(2 3)) 1) 3) (test (vector-rank (make-float-vector '(2 3))) 2) (test (vector-dimensions (make-float-vector '(2 3))) '(2 3)) (test (vector-dimensions) 'error) (test (vector-dimensions #() #()) 'error) (test (vector-dimensions (vector)) '(0)) (test (vector-dimensions (vector 0)) '(1)) (test (vector-dimensions (vector-ref #2d((1 2 3) (3 4 5)) 0)) '(3)) (test (vector-dimensions (vector-ref #3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) 0)) '(2 3)) (test (vector-dimensions (vector-ref #3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) 0 1)) '(3)) (test (set! (vector-dimensions #(1 2)) 1) 'error) (test (let ((v #(1 2 3))) (set! (car (vector-dimensions v)) 0) v) #(1 2 3)) (test (hash-table 1 (vector-dimensions (block))) (hash-table 1 '(0))) ;;; -------------------------------------------------------------------------------- ;;; vector-typer (let ((v #(1 2))) (for-each (lambda (arg) (test (vector-typer arg) 'error) (test (set! (vector-typer arg) integer?) 'error) (test (set! (vector-typer v) arg) 'error)) (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i :hi (if #f #f) (lambda (a) (+ a 1))))) (let () (define (typer x) (symbol? x)) (define v (make-vector 9 'a typer)) (define v1 (make-vector 3 1)) (test (equal? typer (vector-typer v)) #t) (test (vector-typer (make-int-vector 3)) integer?) (test (vector-typer (make-vector 9 1 integer?)) integer?) (test (let ((L (subvector (make-vector 3 'a symbol?)))) (vector-typer L)) symbol?) (test (vector-typer v1) #f) (test (set! (vector-typer v1) integer?) integer?) (test (vector-typer v1) integer?) (test (set! (v1 0) pi) 'error) ; vector-set! third argument 3.141592653589793, is a real, but the vector's element type checker, integer?, rejects it (test (set! (vector-typer (int-vector 1 2 3)) integer?) integer?) (test (catch #t (lambda () (set! (vector-typer (int-vector 1 2 3)) (lambda (x) (float? x)))) (lambda (t i) (apply format #f i))) "vector-typer can't set #i(1 2 3) typer to #") (test (catch #t (lambda () (set! (vector-typer (vector 1 2 3)) (lambda (x) (float? x)))) (lambda (t i) (apply format #f i))) "vector-typer second argument, #, is a function but should be a named function") (test (catch #t (lambda () (set! (vector-typer (vector 1)) (macro (mac a) `(+ 1 ,a)))) (lambda (t i) (apply format #f i))) "vector-typer second argument, #, is a macro but should be a built-in procedure, a closure, #f or #t") (test (catch #t (lambda () (set! (vector-typer (vector 1)) (lambda (a) #f))) (lambda (t i) (apply format #f i))) "vector-typer second argument, #, is a function but should be a named function") (test (catch #t (lambda () (set! (vector-typer (vector 1 2 3)) abs)) (lambda (t i) (apply format #f i))) "vector-typer second argument, abs, is a c-function but should be a boolean procedure") (test (set! (vector-typer (vector 1 2 3)) typer) typer) ; current contents are not checked ) (let () (define (vector-type v) (let* ((data (object->let v)) (sig (and (defined? 'signature data #t) (let-ref data 'signature)))) (and (pair? sig) (car sig)))) (define (vtyper v) #t) (let ((V1 (make-vector 3 1 vtyper))) (set! (V1 0) 0) (test (object->string V1 :readable) "(let (( (vector 0 1 1))) (set! (vector-typer ) vtyper) )") (test (vector-type V1) 'vtyper)) (test (vector-type (make-vector 3 'a symbol?)) 'symbol?) (test (vector-type (vector 0 1)) #f)) (let () (define (vtyper v) #t) (let ((V1 (make-vector 1024 #f vtyper))) (test (object->string V1 :readable) "(make-vector 1024 #f vtyper)"))) (test (object->string (make-int-vector 1024 1) :readable) "(make-int-vector 1024 1)") (test (let ((v (make-vector 3 'a symbol?))) (object->string v :readable)) "(let (( (vector 'a 'a 'a))) (set! (vector-typer ) symbol?) )") (let ((v (immutable! (make-vector '(2 3) 'a symbol?)))) (test (object->string v :readable) "(let (( (subvector (immutable! (vector 'a 'a 'a 'a 'a 'a)) 0 6 '(2 3)))) (set! (vector-typer ) symbol?) )")) (let () ;; typers expect s7 to raise error (define (vtyper val) (or (integer? val) (boolean? val))) (define v (make-vector 3 0 vtyper)) (set! (v 0) #f) (test v #(#f 0 0)) (set! (v 1) 21) (test v #(#f 21 0)) (test (catch #t (lambda () (set! (v 2) "asdf")) (lambda (typ info) (apply format #f info))) "vector-set! third argument \"asdf\", is a string, but the vector's element type checker, vtyper, rejects it") (define h (make-hash-table 3 #f (cons vtyper vtyper))) (set! (h 0) #t) (test h (hash-table 0 #t)) (set! (h 1) 21) (test h (hash-table 0 #t 1 21)) (test (catch #t (lambda () (set! (h 2) "asdf")) (lambda (typ info) (apply format #f info))) "hash-table-set! third argument \"asdf\", is a string, but the hash-table's value type checker, vtyper, rejects it") (test (catch #t (lambda () (set! (h "asdf") 2)) (lambda (typ info) (apply format #f info))) "hash-table-set! second argument \"asdf\", is a string, but the hash-table's key type checker, vtyper, rejects it") (set! (h 0) #f) (test h (hash-table 1 21)) ;; symbol setters handle errors themselves (define int #t) (set! (setter 'int) boolean?) (set! int #f) (test int #f) (test (catch #t (lambda () (set! int 21)) (lambda (t info) (apply format #f info))) "set! int, 21 is an integer but should be boolean") (set! (setter 'int) (lambda (s v) (if (or (boolean? v) (integer? v)) v (error 'wrong-type-arg "can't set! ~S to ~S" s v)))) (set! int #f) (test int #f) (set! int 21) (test int 21) (test (catch #t (lambda () (set! int "asdf")) (lambda (typ info) (apply format #f info))) "can't set! int to \"asdf\"") ;; function setters also handle errors themselves (define f1 (dilambda (lambda () 3) (lambda (v) 32))) (test (f1) 3) (test (set! (f1) 12) 32) (set! (setter f1) #f) (test (catch #t (lambda () (set! (f1) 12)) (lambda (typ info) (apply format #f info))) "f1 (a function) does not have a setter: (set! (f1) 12)")) (let ((V (make-vector 2 'a symbol?))) (let ((S1 (subvector V 0 1)) (S2 (subvector V 1 2))) (set! (vector-typer S1) (define (S1-typer e) (and (symbol? e) (memq e '(a b c))))) (set! (vector-typer S2) (define (S2-typer e) (and (symbol? e) (memq e '(d e f))))) (set! (S1 0) 'b) (set! (S2 0) 'e) (test V #(b e)) (test (set! (S1 0) 'z) 'error) ; vector-set! third argument 'z, is a symbol, but the vector's element type checker, S1-typer, rejects it (test (set! (S2 0) 'z) 'error) ; vector-set! third argument 'z, is a symbol, but the vector's element type checker, S2-typer, rejects it (test V #(b e)))) (test (vector-typer (append (make-vector 1 'a symbol?) (make-vector 2 'b symbol?))) symbol?) (test (vector-typer (append (make-vector 1 'a symbol?) (make-vector 2))) #f) (test (vector-typer (append (make-vector 1 'a symbol?) (list 1 2))) #f) (let () ; check that has_simple_elements bit is cleared if typer reset to #f or non-simple c-func (define-constant V_A (let ((v (make-vector 8))) (set! (vector-typer v) symbol?) v)) (set! (vector-typer V_A) #f) (fill! V_A V_A) (test (format #f "~A" V_A) "#1=#(#1# #1# #1# #1# #1# #1# #1# #1#)") (test (string-wi=? (format #f "~W" V_A) "(let ((<1> (vector #f #f #f #f #f #f #f #f))) (set! (<1> 0) <1>) (set! (<1> 1) <1>) (set! (<1> 2) <1>) (set! (<1> 3) <1>) (set! (<1> 4) <1>) (set! (<1> 5) <1>) (set! (<1> 6) <1>) (set! (<1> 7) <1>) <1>)") #t)) (let () (define-constant V_B (let ((v (make-vector 8))) (set! (vector-typer v) symbol?) v)) (set! (vector-typer V_B) vector?) (fill! V_B V_B) (test (format #f "~S" V_B) "#1=#(#1# #1# #1# #1# #1# #1# #1# #1#)")) (let ((v (make-vector 8))) (set! (vector-typer v) symbol?) (immutable! v) (test (set! (vector-typer v) integer?) 'error) (test (set! (vector-typer v) #t) 'error)) (let ((v (make-vector 8))) (immutable! v) (test (set! (vector-typer v) integer?) 'error) (test (set! (vector-typer v) #t) 'error)) ;;; -------------------------------------------------------------------------------- ;;; vector-ref (test (vector-ref #(1 1 2 3 5 8 13 21) 5) 8) (test (vector-ref #(1 1 2 3 5 8 13 21) (let ((i (round (* 2 (acos -1))))) (if (inexact? i) (inexact->exact i) i))) 13) (test (let ((v (make-vector 1 0))) (vector-ref v 0)) 0) (test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref v 1)) (list 2)) (test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref v 2)) #(#\a #\a #\a)) (test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 2) 1)) #\a) (test (vector-ref #(a b c) 1) 'b) (test (vector-ref #(()) 0) ()) (test (vector-ref #(#()) 0) #()) (test (vector-ref (vector-ref (vector-ref #(1 (2) #(3 (4) #(5))) 2) 2) 0) 5) (test (let ((v (vector 1 2))) (vector-set! v 1 v) (eq? (vector-ref v 1) v)) #t) (test (let ((v (make-int-vector 3))) (vector-ref v 1)) 0) (test (let ((v (make-vector 3 0))) (vector-ref v 1)) 0) (test (let ((v (make-float-vector 3 1.0))) (vector-ref v 1)) 1.0) (test (let ((v (make-int-vector 6 0))) (vector-set! v 3 32) (let ((v1 (subvector v 0 6 '(2 3)))) (vector-ref v1 1 0))) 32) (test (vector-ref) 'error) (test (vector-ref #(1)) 'error) (test (vector-ref #(1) 0 0) 'error) (test (vector-ref () 0) 'error) (test (vector-ref #(1) 1) 'error) (test (vector-ref #2d((1 2) (3 4)) 3 0) 'error) (test (vector-ref #2d((1 2) (3 4)) 0 3) 'error) (test (vector-ref #2d((1 2) (3 4)) 0 0 0) 'error) (test (let ((v (make-vector 1 0))) (vector-ref v 1)) 'error) (test (let ((v (make-vector 1 0))) (vector-ref v -1)) 'error) (test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 2) 3)) 'error) (test (let ((v (vector 1 (list 2) (make-vector 3 #\a)))) (vector-ref (vector-ref v 3) 0)) 'error) (test (vector-ref (vector) 0) 'error) (test (vector-ref #() 0) 'error) (test (vector-ref #() -1) 'error) (test (vector-ref #() 1) 'error) (test (vector-ref #(1 2 3) (floor .1)) 1) (test (vector-ref #(1 2 3) (floor 0+0i)) 1) (test (vector-ref #10d((((((((((0 1)))))))))) 0 0 0 0 0 0 0 0 0 1) 1) (test (#(1 2) 1) 2) (test (#(1 2) 1 2) 'error) (test ((#("hi" "ho") 0) 1) #\i) (test (((vector (list 1 2) (cons 3 4)) 0) 1) 2) (test ((#(#(1 2) #(3 4)) 0) 1) 2) (test ((((vector (vector (vector 1 2) 0) 0) 0) 0) 0) 1) (test ((((list (list (list 1 2) 0) 0) 0) 0) 0) 1) (test ((((list (list (list 1 2) 0) 0) 0) 0) ((((vector (vector (vector 1 2) 0) 0) 0) 0) 0)) 2) (test (#(1 2) -1) 'error) (test (#()) 'error) (test (#(1)) 'error) (test (#2d((1 2) (3 4))) 'error) (test (apply (make-vector '(1 2))) 'error) (test (type-of (eval-string "#2/3d(1 2)")) 'error) (test (type-of (eval-string "#2.1d(1 2)")) 'error) (test (eval-string "#(1 2 . 3)") 'error) (test (#(#(#(#t))) 0 0 0) #t) (test (let ((v (make-vector 3 0 #t))) (v 0 0)) 'error) (test (let ((v (make-int-vector '(2 2)))) (v 0 0 0)) 'error) (test (let ((v (make-float-vector 3))) (vector-ref v 0 0)) 'error) (test (let ((v (make-vector '(2 2) 0.0 #t))) (vector-ref v 0 0 0)) 'error) (test (let ((v (make-vector 3 0))) (v 0 0)) 'error) (test (let ((v (make-vector '(2 2) 0))) (v 0 0 0)) 'error) (let ((v #(1 2 3))) (for-each (lambda (arg) ; (format *stderr* "~A~%" arg) (test (vector-ref arg 0) 'error) (test (v arg) 'error) (test (v arg 0) 'error) (test (vector-ref v arg) 'error) (test (vector-ref v arg 0) 'error) (test (vector-ref #2d((1 2) (3 4)) 0 arg) 'error)) (list "hi" () #() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)) (make-hash-table)))) (test (vector-ref #(#(1 2 3) #(4 5 6)) 1) #(4 5 6)) (test (vector-ref #(#(1 2 3) #(4 5 6)) 1 2) 6) (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1) #(#(7 8 9) #(10 11 12))) (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0) #(7 8 9)) (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2) 9) (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 3) 'error) (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2 0) 'error) (test (#(#(1 2 3) #(4 5 6)) 1) #(4 5 6)) (test (#(#(1 2 3) #(4 5 6)) 1 2) 6) (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1) #(#(7 8 9) #(10 11 12))) (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0) #(7 8 9)) (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2) 9) (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 3) 'error) (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) 1 0 2 0) 'error) (test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1)) #(4 5 6)) (test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1 2)) 6) (test (let ((L #(#(1 2 3) #(4 5 6)))) (L 1 2 3)) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1)) #(#(7 8 9) #(10 11 12))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0)) #(7 8 9)) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0 2)) 9) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L 1 0 2 3)) 'error) (test (let ((L #(#(1 2 3) #(4 5 6)))) ((L 1) 2)) 6) (test (let ((L #(#(1 2 3) #(4 5 6)))) (((L 1) 2) 3)) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1) 0)) #(7 8 9)) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (((L 1) 0) 2)) 9) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1 0) 2)) 9) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L 1) 0 2)) 9) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((((L 1) 0) 2) 3)) 'error) (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref (L 1) 2)) 6) (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref ((L 1) 2) 3)) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (L 1) 0)) #(7 8 9)) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((vector-ref (L 1) 0) 2)) 9) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (((L 1) 0) 2) 3)) 'error) (let ((zero 0) (one 1) (two 2) (three 3) (thirty-two 32)) (test (vector-ref #(#(1 2 3) #(4 5 6)) one) #(4 5 6)) (test (vector-ref #(#(1 2 3) #(4 5 6)) one two) 6) (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one) #(#(7 8 9) #(10 11 12))) (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero) #(7 8 9)) (test (vector-ref #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero two) 9) (test (#(#(1 2 3) #(4 5 6)) one) #(4 5 6)) (test (#(#(1 2 3) #(4 5 6)) one two) 6) (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one) #(#(7 8 9) #(10 11 12))) (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero) #(7 8 9)) (test (#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) one zero two) 9) (test (let ((L #(#(1 2 3) #(4 5 6)))) (L one)) #(4 5 6)) (test (let ((L #(#(1 2 3) #(4 5 6)))) (L one two)) 6) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one)) #(#(7 8 9) #(10 11 12))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one zero)) #(7 8 9)) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (L one zero two)) 9) (test (let ((L #(#(1 2 3) #(4 5 6)))) ((L one) two)) 6) (test (let ((L #(#(1 2 3) #(4 5 6)))) (((L one) two) 3)) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one) zero)) #(7 8 9)) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (((L one) zero) two)) 9) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one zero) two)) 9) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((L one) zero two)) 9) (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-ref (L one) two)) 6) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-ref (L one) zero)) #(7 8 9)) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) ((vector-ref (L one) zero) two)) 9)) (test ((#(#(:hi) #\a (3)) (#("hi" 2) 1)) (#2d((#() ()) (0 #(0))) 1 ('(cons 0) 1))) 3) (test (#(1 2 3) (#(1 2 3) 1)) 3) (test ((#(#(1 2)) (#(1 0) 1)) (#(3 2 1 0) 2)) 2) (test (apply min (#(1 #\a (3)) (#(1 2) 1))) 3) ; i.e vector ref here 2 levels -- (#(1 2) 1) is 2 and (#(1 #\a (3)) 2) is (3) ;;; vector-ref optimizer checks (define global_vector (vector 1 2 3)) (let () (define (hi i) (vector-ref global_vector i)) (test (hi 1) 2)) (let () (define (hi i) (vector-ref global_vector (vector-ref global_vector i))) (test (hi 0) 2)) (test (let ((v #(0 1 2 3 4 5))) (define (f1) (v 4/3)) (f1)) 'error) (test (let ((v "012345")) (define (f1) (v 4/3)) (f1)) 'error) (test (let ((v (list 0 1 2 3 4 5))) (define (f1) (v 4/3)) (f1)) 'error) (define-constant -a-global-vector- (vector 1 2 3)) (let () (define (fg a) (vector-ref -a-global-vector- a)) (test (fg 0) 1)) (let () (define (f1) (let ((v (vector #f)) (X #2d((1 2) (3 4)))) (do ((i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (vector-ref X 1))))) (test (f1) #(#(3 4)))) (let () (define (f1) (let ((v (vector #f)) (X #2d((1 2) (3 4)))) (do ((i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (vector-ref X 2))))) (test (f1) 'error)) (let () (define (f1) (let ((I 0) (v (vector #f)) (X #2d((1 2) (3 4)))) (do ((i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (vector-ref X (+ I 1)))))) (test (f1) #(#(3 4)))) (let () (define (f1) (let ((I 1) (v (vector #f)) (X #2d((1 2) (3 4)))) (do ((i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (vector-ref X (+ I 1)))))) (test (f1) 'error)) (set! global_vector #2d((1 2) (3 4))) (let () (define (f1) (let ((I 1) (v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (vector-ref global_vector I))))) (test (f1) #(#(3 4)))) (let () (define (f1) (let ((I 2) (v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (vector-ref global_vector I))))) (test (f1) 'error)) (test (#("asdf") 0 1) #\s) (test (#("asdf") 0 1 0) 'error) (test (let () (define (px x) (vector-ref x 0)) (define (fpx x y) (+ (px x) (px y))) (define (tfpx) (let ((v1 #(1 2 3)) (v2 #(2 3 1))) (fpx v1 v2))) (tfpx)) 3) ; fx_c_ff (test (let ((v #2d((3 2 1) (6 5 4))) (b1 123) (b2 0)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (imag-part (v b1 b2)))) (f)) 'error) ; opt_p_pii_sss bug (let () ;; coverage tests (not otherwise hit in this file) (define (f1) (let ((v1 (list (list (list 1)) (list (list 2)) (list (list 3)) (list (list 4)))) (sum 0)) (do ((i 0 (+ i 1))) ((= i 4) sum) (set! sum (+ sum (v1 i 0 0)))))) (test (f1) 10) (define (f2) (let ((v2 (make-vector '(10 2 2) 1.0)) (sum 0.0)) (set! (v2 1 0 0) 2.0) (set! (v2 2 0 0) 3.0) (set! (v2 3 0 0) 4.0) (do ((i 0 (+ i 1))) ((= i 4) sum) (set! sum (+ sum (v2 i 0 0)))))) (test (f2) 10.0) (define (f3) (let ((v3 (make-float-vector '(10 2 2) 1.0)) (sum 0.0)) (set! (v3 1 0 0) 2.0) (set! (v3 2 0 0) 3.0) (set! (v3 3 0 0) 4.0) (do ((i 0 (+ i 1))) ((= i 4) sum) (set! sum (+ sum (v3 i 0 0)))))) (test (f3) 10.0) (define (f4) (let ((v4 (make-int-vector '(10 2 2) 1)) (sum 0)) (set! (v4 1 0 0) 2) (set! (v4 2 0 0) 3) (set! (v4 3 0 0) 4) (do ((i 0 (+ i 1))) ((= i 4) sum) (set! sum (+ sum (v4 i 0 0)))))) (test (f4) 10) (define (fi) (let ((v4 (make-int-vector (expt 2 9))) (sum 0)) (do ((i 0 (+ i 1))) ((= i 9)) (vector-set! v4 (expt 2 i) i)) (let ((v4a (subvector v4 0 (length v4) (make-list 9 2)))) (do ((i 1 (+ i 1))) ((= i 2) sum) (set! sum (+ sum (v4a i 0 0 0 0 0 0 0 0) (v4a 0 i 0 0 0 0 0 0 0) (v4a 0 0 i 0 0 0 0 0 0) (v4a 0 0 0 i 0 0 0 0 0))))))) (test (fi) 26) (define (f5) (let ((v5 (make-byte-vector '(10 2 2) 1)) (sum 0)) (set! (v5 1 0 0) 2) (set! (v5 2 0 0) 3) (set! (v5 3 0 0) 4) (do ((i 0 (+ i 1))) ((= i 4) sum) (set! sum (+ sum (v5 i 0 0)))))) (test (f5) 10) (define (f6) (let ((v6 (hash-table 0 (list (list 1)) 1 (list (list 2)) 2 (list (list 3)) 3 (list (list 4)))) (sum 0)) (do ((i 0 (+ i 1))) ((= i 4) sum) (set! sum (+ sum (v6 i 0 0)))))) (test (f6) 10)) ;;; some error checks (let ((arr (make-vector '(2 3 4) #f))) (test (vector-ref arr 1 1 4) 'error) (test (vector-ref arr 1 3 1) 'error) (test (vector-ref arr 2 0 0) 'error) (test (vector-set! arr 1 1 4 #t) 'error) (test (vector-set! arr 1 3 1 #t) 'error) (test (vector-set! arr 2 0 0 #t) 'error)) ;;; -------------------------------------------------------------------------------- ;;; vector-set! (test (let ((vec (vector 0 '(2 2 2 2) "Anna"))) (vector-set! vec 1 '("Sue" "Sue")) vec) #(0 ("Sue" "Sue") "Anna")) (test (let ((v (vector 1 2 3))) (vector-set! v 1 32) v) #(1 32 3)) (let ((v (make-vector 8 #f))) (for-each (lambda (arg) (vector-set! v 1 arg) (test (vector-ref v 1) arg)) (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))) (test (let ((v (vector 1 2 3))) (vector-set! v 1 0) v) #(1 0 3)) (test (let ((v (vector #f))) (vector-set! v 0 (vector)) v) #(#())) (test (let ((v (vector 1 (list 2) (vector 1 2 3)))) (vector-set! (vector-ref v 2) 0 21) v) #(1 (2) #(21 2 3))) (test (let ((v (make-int-vector 3))) (vector-set! v 1 32) (vector->list v)) '(0 32 0)) (test (let ((v (make-int-vector 3 0))) (set! (v 1) 32) (vector->list v)) '(0 32 0)) (test (vector-set! (vector 1 2) 0 4) 4) (test (vector-set!) 'error) (test (vector-set! #(1)) 'error) (test (vector-set! #(1) 0) 'error) (test (vector-set! #(1) 0 0 1) 'error) (test (vector-set! #(1) 0 0 1 2 3) 'error) (test (vector-set! #(1) #(0) 1) 'error) (test (vector-set! #(1 2) 0 2) 2) (test (let ((x 2) (v (vector 1 2))) (vector-set! (let () (set! x 3) v) 1 23) (list x v)) '(3 #(1 23))) (test (let ((v #(1 2))) (vector-set! v 0 32)) 32) (test (let ((v #(1 2))) (set! (v 0) 32)) 32) (test (let ((v #(1 2))) (set! (vector-ref v 0) 32)) 32) (test (let ((v (make-vector '(2 3) 0))) (set! (v (values 0 1)) 23) v) #2d((0 23 0) (0 0 0))) (for-each (lambda (arg) (test (vector-set! arg 0 0) 'error)) (list "hi" () #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (lambda (a) (+ a 1)) (make-hash-table))) (let ((v (vector 1 2 3))) (for-each (lambda (arg) (test (vector-set! v arg 0) 'error)) (list "hi" () #() #\a -1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t (make-vector 3) (lambda (a) (+ a 1))))) (for-each (lambda (arg) (test (vector-set! arg 0 0) 'error)) (list "hi" () #\a 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (let ((v #(#(0 1) #(2 3)))) (vector-set! (vector-ref v 1) 1 4) (test (v 1 1) 4) (set! ((vector-ref v 1) 1) 5) (test (v 1 1) 5) (set! ((v 1) 1) 6) (test (v 1 1) 6) (vector-set! (v 1) 1 7) (test (v 1 1) 7) (set! (v 1 1) 8) (test (v 1 1) 8)) (let ((v (vector))) (test (vector-set! v 0 0) 'error) (test (vector-set! v 1 0) 'error) (test (vector-set! v -1 0) 'error)) (test (vector-set! #() 0 123) 'error) (test (vector-set! #(1 2 3) 0 123) 123) (test (let ((v #(1 2 3))) (set! (v 0) '(+ 1 2)) v) #((+ 1 2) 2 3)) (test (let ((v #(1 2 3))) (set! (v '(+ 1 1)) 2) v) 'error) (test (let ((v #(1 2 3))) (set! (v (+ 1 1)) 2) v) #(1 2 2)) (test (let ((g (lambda () #(1 2 3)))) (vector-set! (g) 0 #\?) (g)) #(#\? 2 3)) (test (let ((g (lambda () '(1 . 2)))) (set-car! (g) 123) (g)) '(123 . 2)) (test (let ((g (lambda () '(1 2)))) (list-set! (g) 0 123) (g)) '(123 2)) (test (let ((g (lambda () (symbol->string 'hi)))) (string-set! (g) 1 #\a) (symbol->string 'hi)) "hi") (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 32) L) #(#(1 2 3) 32)) (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 0 32) L) #(#(1 2 3) #(32 5 6))) (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 0 2 32) L) 'error) (test (let ((L #(#(1 2 3) #(4 5 6)))) (vector-set! L 1 3 32) L) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 32) L) #(#(#(1 2 3) #(4 5 6)) 32)) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12)))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 2 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12)))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 0 2 1 32) L) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (vector-set! L 1 4 2 32) L) 'error) (test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1) 32) L) #(#(1 2 3) 32)) (test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 0) 32) L) #(#(1 2 3) #(32 5 6))) (test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 0 2) 32) L) 'error) (test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (L 1 3) 32) L) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1) 32) L) #(#(#(1 2 3) #(4 5 6)) 32)) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0) 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12)))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12)))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 0 2 1) 32) L) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (L 1 4 2) 32) L) 'error) (test (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1) 0) 32) L) #(#(1 2 3) #(32 5 6))) (test (let ((L #(#(1 2 3) #(4 5 6)))) (set! (((L 1) 0) 2) 32) L) 'error) (test (let ((L #(#(1 2 3) #(4 5 6)))) (set! ((L 1) 3) 32) L) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((L 1) 0) 32) L) #(#(#(1 2 3) #(4 5 6)) #(32 #(10 11 12)))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (((L 1) 0) 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12)))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((((L 1) 0) 2) 1) 32) L) 'error) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! (((L 1) 4) 2) 32) L) 'error) (test (let ((L #(#(#(1 2 3))))) (set! ((L 0) 0 1) 32) L) #(#(#(1 32 3)))) (test (let ((L #(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))))) (set! ((L 1 0) 2) 32) L) #(#(#(1 2 3) #(4 5 6)) #(#(7 8 32) #(10 11 12)))) (test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))) (set! (L 0 0 1) 32) L) #(#(#(#(1 2 3) 32) #(#(7 8 9) #(10 11 12))) #(13 14 15))) (test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))) (set! ((L 0) 0 1 2) 32) L) #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15))) (test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))) (set! ((L 0 0) 1 2) 32) L) #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15))) (test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))) (set! ((L 0 0 1) 2) 32) L) #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15))) (test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))) (set! (((L 0) 0) 1 2) 32) L) #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15))) (test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))) (set! (((L 0 0) 1) 2) 32) L) #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15))) (test (let ((L #(#(#(#(1 2 3) #(4 5 6)) #(#(7 8 9) #(10 11 12))) #(13 14 15)))) (set! ((((L 0) 0) 1) 2) 32) L) #(#(#(#(1 2 3) #(4 5 32)) #(#(7 8 9) #(10 11 12))) #(13 14 15))) (test (eq? (car (catch #t (lambda () (set! (#(1)) 2)) (lambda args args))) 'wrong-number-of-args) #t) (test (eq? (car (catch #t (lambda () (set! (#(1) 0 0) 2)) (lambda args args))) 'no-setter) #t) (test (eq? (car (catch #t (lambda () (set! ((#(1) 0) 0) 2)) (lambda args args))) 'no-setter) #t) ; (set! (1 ...)) (test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L) 1) 32) L) (lambda args args))) 'wrong-number-of-args)) #t) (test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L)) 32) L) (lambda args args))) 'wrong-number-of-args)) #t) (test (let ((L #(#(1 2 3) #(4 5 6)))) (eq? (car (catch #t (lambda () (set! ((L 1) 2)) L) (lambda args args))) 'syntax-error)) #t) (let ((v #(1 2 3))) (define (vr v a) (vector-ref v (+ a 1))) (test (vr v 1) 3)) (let () (define (fillv) (let ((v (make-vector 10))) (do ((i 0 (+ i 1))) ((= i 10) v) (vector-set! v i i)))) (test (fillv) #(0 1 2 3 4 5 6 7 8 9))) (let () (define (fillv) (let ((v (make-vector 10))) (do ((i -10 (+ i 1))) ((= i 0) v) (vector-set! v (+ i 10) i)))) (test (fillv) #(-10 -9 -8 -7 -6 -5 -4 -3 -2 -1))) (let () (define (vv) (let ((v #(0 1)) (i 0) (x 2)) (vector-set! v i (+ (vector-ref v i) x)))) (test (vv) 2)) (let () (define (hi) (let ((v1 #(0 1)) (i 0) (j 1)) (vector-set! v1 i (vector-ref v1 j)))) (hi) 1) (let () (define (fillv) (let ((v (make-vector '(3 3) #f boolean?))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i i #t)))) (test (fillv) #2d((#t #f #f) (#f #t #f) (#f #f #t)))) (let () (define (fillv) (let ((v (make-vector '(3 3) '- symbol?))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i i '+)))) (test (fillv) #2d((+ - -) (- + -) (- - +)))) (let () (define (h111) (let ((v (make-vector (list 3 3)))) (do ((k 0 (+ k 1))) ((= k 3) v) (do ((i 0 (+ i 1))) ((= i 3)) (vector-set! v k i (+ i (* k 3))))))) (test (h111) #2d((0 1 2) (3 4 5) (6 7 8)))) (test (let ((v (immutable! (make-vector '(2 2) 0)))) (define (func) (vector-set! v 1 0 1)) (func)) 'error) ;; check that we can back out when a type changes (let ((v (make-vector 10 1)) (s (make-string 10 #\a))) (define (f x) (set! (x 0) #\b) (set! (x 1) #\b) x) (test (f v) #(#\b #\b 1 1 1 1 1 1 1 1)) ; unopt -> op_vector_set_3 (test (f v) #(#\b #\b 1 1 1 1 1 1 1 1)) ; op_vector_set_3 (test (f s) "bbaaaaaaaa")) ; op_vector_set_3 -> set_unchecked -> implicit_set (let ((v (make-vector '(2 4) 1)) ; same but op_vector_set_4 (s (hash-table 0 #(0 0) 1 #(0 0)))) (define (f x) (set! (x 0 0) #\b) (set! (x 1 0) #\b) x) (test (f v) #2d((#\b 1 1 1) (#\b 1 1 1))) (test (f v) #2d((#\b 1 1 1) (#\b 1 1 1))) (test (f s) (hash-table 0 #(#\b 0) 1 #(#\b 0)))) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (set! (#(a 0 (3)) 1) 0))) (f)) #t) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (let ((v (make-vector 1 'a symbol?))) (define (fv2) (set! (v 0) 'd)) (fv2) v))) (f))#t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! #i(1) i begin))) (func)) 'error) (test (let () (define-constant a51 #i(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! a51 i begin))) (func)) 'error) (test (let () (define-constant a51 #i(1 2 3 4)) (define (func) (vector-set! a51 0 begin)) (func)) 'error) (test (let () (define-constant a51 #i(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (int-vector-set! a51 i begin))) (func)) 'error) (test (let () (define-constant a51 #r(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! a51 i begin))) (func)) 'error) (test (let () (define-constant a51 #u(1 2 3 4)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! a51 i begin))) (func)) 'error) (test (let () ; vector_set_p_pip! (define-constant aa4 (subvector #i2d((1 2) (3 4)))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (subvector #i(0 1 2) (vector-set! aa4 1 -1)))) (f)) 'error) ;;; -------------------------------------------------------------------------------- ;;; vector-fill! (test (fill! (vector 1 2) 4) 4) (test (let ((v (vector 1 2 3))) (vector-fill! v 0) v) #(0 0 0)) (test (let ((v (vector))) (vector-fill! v #f) v) #()) (let ((v (make-vector 8 #f))) (for-each (lambda (arg) (vector-fill! v arg) (test (vector-ref v 1) arg)) (list #\a 1 () (list 1) '(1 . 2) #f "hi" 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #t (vector 1 2 3) (lambda (a) (+ a 1))))) (test (let ((str "hi") (v (make-vector 3))) (vector-fill! v str) (string-set! (vector-ref v 0) 1 #\a) str) "ha") (test (let ((lst (list 1 2)) (v (make-vector 3))) (vector-fill! v lst) (list-set! (vector-ref v 0) 1 #\a) lst) '(1 #\a)) (test (let ((v (vector 1 2 3))) (vector-set! v -1 0)) 'error) (test (let ((v (vector 1 2 3))) (vector-set! v 3 0)) 'error) (test (vector-fill! #(1 2) 2) 2) (test (vector-fill! #() 0) 0) (test (vector-fill! (vector) 0) 0) (test (let ((v (vector 1))) (vector-fill! v 32) (v 0)) 32) (test (let ((v (make-vector 11 0))) (vector-fill! v 32) (v 10)) 32) (test (let ((v (make-vector 16 0))) (vector-fill! v 32) (v 15)) 32) (test (let ((v (make-vector 3 0))) (vector-fill! v 32) (v 1)) 32) (test (let ((v (make-vector 3 0))) (fill! v 32) (v 1)) 32) (test (let ((v #2d((1 2 3) (4 5 6)))) (vector-fill! (v 1) 12) v) #2d((1 2 3) (12 12 12))) (test (let ((v #i(1 2))) (fill! v 3) v) #i(3 3)) (for-each (lambda (arg) (test (vector-fill! arg 0) 'error)) (list "hi" #\a () 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (when with-bignums (let ((v (make-vector 2 0.0))) (vector-fill! v 1180591620717411303424) (num-test (v 1) (expt 2 70)) (vector-fill! v 3/1180591620717411303424) (num-test (v 0) 3/1180591620717411303424) (vector-fill! v 1180591620717411303424.0) (num-test (v 1) 1180591620717411303424.0) (vector-fill! v (complex (expt 2 70) 1.0)) (num-test (v 0) (complex (expt 2 70) 1.0)) (set! v (complex-vector 1-i)) (vector-fill! v (complex (expt 2 70) 1.0)) (num-test (v 0) (complex (expt 2 70) 1.0)) (set! v (float-vector 1.0)) (vector-fill! v (bignum "2.0")) (num-test (v 0) 2.0) (vector-fill! v pi) (num-test (v 0) pi) (set! v (float-vector 0.0 0.0 0.0)) (vector-fill! v (bignum "2.0") 1 2) (num-test (v 0) 0.0) (num-test (v 1) 2.0) (set! v (make-int-vector 1)) (vector-fill! v (bignum "2")) (num-test (v 0) 2) (set! v (make-int-vector 3 0)) (vector-fill! v (bignum "2") 1 2) (num-test (v 0) 0) (num-test (v 1) 2)) (test (let () (define (func) (vector-fill! (make-vector 3 'a symbol?) (bignum 1/3))) (func)) 'error)) (let ((v (make-vector 3))) (vector-fill! v v) (test (v 0) v) (set! (v 1) 32) (test ((v 0) 1) 32)) (test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0) v) #(21 21 21 21 21)) (test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0 5) v) #(21 21 21 21 21)) (test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 0 3) v) #(21 21 21 4 5)) (test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 2 3) v) #(1 2 21 4 5)) (test (let ((v (vector 1 2 3 4 5))) (vector-fill! v 21 3 3) v) #(1 2 3 4 5)) (if (not with-bignums) (test (let ((v (make-float-vector 3 pi))) (vector-fill! v 0.0) (vector->list v)) '(0.0 0.0 0.0))) (test (let ((v (make-int-vector 3 1))) (vector-fill! v "2.5")) 'error) (test (let ((v (make-float-vector 3 pi))) (vector-fill! v #\a)) 'error) (test (let ((v (make-float-vector 3))) (vector-fill! v 1+i) v) 'error) (test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 3/4) (vector->list v)) '(0.75 0.75 0.75)) (test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 3) (vector->list v)) '(3.0 3.0 3.0)) (test (let ((v (make-int-vector 3))) (vector-fill! v 1+i) v) 'error) (test (let ((v (make-int-vector 3 0))) (vector-fill! v 3/4) v) 'error) (test (let ((v (make-int-vector 3 0))) (vector-fill! v 3.0) v) 'error) (test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1) (vector->list v)) '(1 2 2)) (test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1 1) (vector->list v)) '(1 1 1)) (test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1 2) (vector->list v)) '(1 2 1)) (test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1 3) (vector->list v)) '(1 2 2)) (test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 0 3) (vector->list v)) '(2 2 2)) (test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 1 4) (vector->list v)) 'error) (test (let ((v (make-int-vector 3 1))) (vector-fill! v 2 -1) (vector->list v)) 'error) (test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 1.0 1) (vector->list v)) '(0.0 1.0 1.0)) (test (let ((v (make-int-vector 3 1))) (vector-fill! v "2.5" 1)) 'error) (test (let ((v (make-float-vector 3 pi))) (vector-fill! v #\a 0 1)) 'error) (test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 1+i 1) v) 'error) (test (let ((v (make-float-vector 3 0.0))) (vector-fill! v 3/4 1) (vector->list v)) '(0.0 0.75 0.75)) (test (let ((v (make-float-vector 3))) (vector-fill! v 3 2) (vector->list v)) '(0.0 0.0 3.0)) (test (let ((v (make-int-vector 3 0))) (vector-fill! v 1+i 2) v) 'error) (test (let ((v (make-int-vector 3 0))) (vector-fill! v 3/4 0 1) v) 'error) (test (let ((v (make-int-vector 3))) (vector-fill! v 3.0 2) v) 'error) (test (vector-fill! #() 0 "hi") 'error) (test (vector-fill! #() 0 -1 3) 'error) (test (vector-fill! #() 0 1) 'error) (test (vector-fill! #() 0 0 4/3) 'error) (test (vector-fill! (float-vector 1 2) 1+i) 'error) (test (vector-fill! (int-vector 1 2) 1+i) 'error) (test (let ((v1 (make-float-vector 20 0.0)) (v2 (make-float-vector 20 1.0))) (vector-fill! v1 1.0) (equivalent? v1 v2)) #t) (let () (define (boolean|integer? x) (or (boolean? x) (integer? x))) (let ((v (make-vector 3 #f boolean|integer?))) (vector-set! v 0 #t) (test v #(#t #f #f)) (vector-set! v 1 1) (test v #(#t 1 #f)) (test (vector-set! v 0 #\a) 'error) (test v #(#t 1 #f)) (test (signature v) (let ((L (list 'boolean|integer? 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (fill! v 1) (test v #(1 1 1)) (test (fill! v #\a) 'error) (let ((v1 (make-vector 3))) (copy v v1) (test v1 #(1 1 1)) (let ((v2 (make-int-vector 3 3))) (copy v2 v) (test v #(3 3 3)) (let ((v3 (make-float-vector 3 3.0))) (test (copy v3 v) 'error)))))) (let () (define (vtype? x) (and (symbol? x) (char=? ((symbol->string x) 0) #\a))) (let ((v (make-vector 3 'a vtype?))) (test v #(a a a)) (set! (v 0) 'a1) (test v #(a1 a a)) (test (set! (v 1) :a2) 'error) ; first char is #\: (test (vector-set! v 2 'b) 'error) (test (fill! v 123) 'error))) ;;; -------------------------------------------------------------------------------- ;;; vector-append (test (vector-append #() #2d()) #()) (test (vector-append) #()) (test (vector-append #()) #()) (test (vector-append #(1 2)) #(1 2)) (test (vector-append #(1) #(2 3) #() #(4)) #(1 2 3 4)) (test (vector-append #(1) #2d((2 3) (4 5)) #3d()) #(1 2 3 4 5)) (test (vector-append #2d((1 2) (3 4)) #3d(((5 6) (7 8)) ((9 10) (11 12)))) #(1 2 3 4 5 6 7 8 9 10 11 12)) (test (vector-append (vector 1 2) (make-int-vector 1 3) #(4)) #(1 2 3 4)) (test (vector-append (vector 1 2) (make-float-vector 1) #(4)) #(1 2 0.0 4)) (test (vector->list (vector-append (make-int-vector 1 3) (make-int-vector 2 1))) '(3 1 1)) (test (vector->list (vector-append (make-float-vector 1 0.0) (make-float-vector 2 1.0))) '(0.0 1.0 1.0)) (test (vector-append (byte-vector 0) (vector 1)) #u(0 1)) (unless pure-s7 (test (vector-append (vector 1) (openlet (inlet 'vector-append (lambda args (#_vector-append (car args) #(2 3)))))) #(1 2 3))) (unless pure-s7 (for-each (lambda (arg) (test (vector-append arg) 'error) (test (vector-append #(1 2) arg) 'error)) (list "hi" #\a () 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))) (test (equal? (make-vector 3 1) (make-int-vector 3 1)) #t) (let ((iv (make-int-vector 3 1)) (fv (make-float-vector 3 2.0)) (vv (make-vector 3 #f))) (test (equal? (vector-append iv iv iv) (make-int-vector 9 1)) #t) (test (vector-append iv iv vv) 'error) (test (vector-append iv fv iv) 'error) ;(int-vector 1 1 1 2 2 2 1 1 1)) (test (vector-append iv fv fv) 'error) ;(int-vector 1 1 1 2 2 2 2 2 2)) (test (vector-append iv fv vv) 'error) (test (vector-append iv vv iv) 'error) (test (vector-append fv iv iv) (float-vector 2.0 2.0 2.0 1 1 1 1 1 1)) ; #(2.0 2.0 2.0 1 1 1 1 1 1)) (test (vector-append fv iv fv) (float-vector 2.0 2.0 2.0 1 1 1 2.0 2.0 2.0)) ; #(2.0 2.0 2.0 1 1 1 2.0 2.0 2.0)) (test (vector-append fv fv iv) (float-vector 2.0 2.0 2.0 2.0 2.0 2.0 1 1 1)) ; #(2.0 2.0 2.0 2.0 2.0 2.0 1 1 1)) (test (vector-append fv fv fv) (make-float-vector 9 2.0)) (test (vector-append fv fv vv) 'error) (test (vector-append vv iv iv) #(#f #f #f 1 1 1 1 1 1)) (test (vector-append vv iv fv) #(#f #f #f 1 1 1 2.0 2.0 2.0)) (test (vector-append vv iv vv) #(#f #f #f 1 1 1 #f #f #f)) (test (vector-append vv fv iv) #(#f #f #f 2.0 2.0 2.0 1 1 1)) (test (vector-append vv fv fv) #(#f #f #f 2.0 2.0 2.0 2.0 2.0 2.0)) (test (vector-append vv fv vv) #(#f #f #f 2.0 2.0 2.0 #f #f #f)) (test (vector-append vv vv iv) #(#f #f #f #f #f #f 1 1 1)) (test (vector-append vv vv fv) #(#f #f #f #f #f #f 2.0 2.0 2.0)) (test (vector-append vv vv vv) #(#f #f #f #f #f #f #f #f #f))) (test (equal? (vector-append (float-vector 1 2 3) #()) (float-vector 1 2 3)) #t) (test (equal? (vector-append (float-vector) #(1 2 3) #() (make-int-vector 0 0)) (float-vector 1 2 3)) #t) (test (equal? (float-vector) (vector-append (float-vector))) #t) (test (equal? (vector-append #() (float-vector) (make-int-vector 3 1) (vector)) (make-vector 3 1)) #t) (test (equal? (vector-append (int-vector 1 2 3) #()) (int-vector 1 2 3)) #t) (test (equal? (vector-append (int-vector) #(1 2 3) #() (make-int-vector 0 0)) (int-vector 1 2 3)) #t) (test (equal? (int-vector) (vector-append (int-vector))) #t) (test (equal? (vector-append #() (int-vector) (make-int-vector 3 1) (vector)) (make-vector 3 1)) #t) (when full-s7test (define (test-append size) (let ((strs ()) (vecs ()) (fvecs ()) (ivecs ()) (ifvecs ()) (allvecs ()) (bvecs ()) (lsts ())) (do ((i 0 (+ i 1))) ((= i size)) (set! strs (cons (make-string size (integer->char (+ 1 (random 255)))) strs)) (set! bvecs (cons (string->byte-vector (make-string size (integer->char (random 256)))) bvecs)) (set! vecs (cons (make-vector size i) vecs)) (set! ivecs (cons (make-int-vector size i) ivecs)) (set! fvecs (cons (make-float-vector size (* i 1.0)) fvecs)) (set! ifvecs (cons (make-vector size (if (even? i) (* i 1.0) i)) ifvecs)) (set! allvecs (cons (make-vector size (if (even? i) (* i 1.0) i)) allvecs)) (set! lsts (cons (make-list size i) lsts))) (let ((lst (apply append lsts)) (vec (apply vector-append vecs)) (fvec (apply vector-append fvecs)) (ivec (apply vector-append ivecs)) (ifvec (apply vector-append ifvecs)) (allvec (apply vector-append allvecs)) (str (apply string-append strs)) (bvec (apply append bvecs))) (test (vector? vec) #t) (test (length vec) (* size size)) (test (float-vector? fvec) #t) (test (length fvec) (* size size)) (test (int-vector? ivec) #t) (test (length ivec) (* size size)) (test (vector? allvec) #t) (test (length allvec) (* size size)) (test (vector? ifvec) #t) (test (length ifvec) (* size size)) (test (pair? lst) #t) (test (length lst) (* size size)) (test (string? str) #t) (test (length str) (* size size)) (test (byte-vector? bvec) #t) (test (length bvec) (* size size)) ))) (do ((i 1 (* i 10))) ((> i 1000)) (test-append i))) (test (vector-append #i(2 1) #(2 1) #r(2.0 1.5)) 'error) (let () (define (f2) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (vector-append (vector 0 1) (vector 2)))))) (test (f2) #(0 1 2)) ; vector_append_p_pp (define (f3) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (vector-append (vector 0 1) (vector 2) (vector 3 4)))))) (test (f3) #(0 1 2 3 4))) ; vector_append_p_ppp ;;; -------------------------------------------------------------------------------- ;;; miscellaneous vectors (test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6) (test (let ((sum 0)) (for-each (lambda (n m) (set! sum (+ sum n (- m)))) (vector 1 2 3) (vector 4 5 6)) sum) -9) (test (let () (for-each (lambda (n) (error 'wrong-type-arg "oops")) (vector)) #f) #f) (test (let ((sum 0)) (for-each (lambda (n m p) (set! sum (+ sum n (- m) (* 2 p)))) (vector 1 2 3) (vector 4 5 6) (vector 6 7 8)) sum) 33) (test (let ((sum 0)) (for-each (lambda (n) (for-each (lambda (m) (set! sum (+ sum (* m n)))) (vector 1 2 3))) (vector 4 5 6)) sum) 90) (test (call/cc (lambda (return) (for-each (lambda (n) (return "oops")) (vector 1 2 3)))) "oops") (test (call/cc (lambda (return) (for-each (lambda (n) (if (even? n) (return n))) (vector 1 3 8 7 9 10)))) 8) (for-each (lambda (data) (let ((v data) (c #f) (y 0)) (do ((i 0 (+ i 1))) ((= i 10)) (set! (v i) i)) (let ((tag (call/cc (lambda (exit) (for-each (lambda (x) (call/cc (lambda (return) (set! c return))) (if (and (even? (inexact->exact x)) (> x y) (< x 10)) (begin (set! (v (inexact->exact y)) 100) (set! y x) (exit x)) (set! y x))) v))))) (if (and (number? tag) (< tag 10)) (c))) (let ((correct (vector 0 100 2 100 4 100 6 100 8 9))) (do ((i 0 (+ i 1))) ((= i (length v))) (if (not (= (correct i) (inexact->exact (v i)))) (format #t ";for-each call/cc data: ~A~%" v)))))) (list (make-vector 10) (make-list 10))) (test (map (lambda (n) (+ 1 n)) (vector 1 2 3)) '(2 3 4)) (test (map (lambda (n m) (- n m)) (vector 1 2 3) (vector 4 5 6)) '(-3 -3 -3)) (test (map (lambda (n m p) (+ n m p)) (vector 1 2 3) (vector 4 5 6) (vector 6 7 8)) '(11 14 17)) (test (map (lambda (n) (map (lambda (m) (* m n)) (vector 1 2 3))) (vector 4 5 6)) '((4 8 12) (5 10 15) (6 12 18))) (test (call/cc (lambda (return) (map (lambda (n) (return "oops")) (vector 1 2 3)))) "oops") (test (call/cc (lambda (return) (map (lambda (n) (if (even? n) (return n))) (vector 1 3 8 7 9 10)))) 8) (test (map (lambda (x) x) (make-int-vector 3 0)) '(0 0 0)) (test (map (lambda (x) x) (let ((v (make-int-vector 3 0))) (set! (v 1) 1) (set! (v 2) 2) v)) '(0 1 2)) (test (map (lambda (x) x) (make-float-vector 3 0.0)) '(0.0 0.0 0.0)) (test (let ((lst ())) (for-each (lambda (n) (set! lst (cons n lst))) (let ((v (make-int-vector 3 0))) (set! (v 1) 1) v)) lst) '(0 1 0)) (test (vector? (symbol-table)) #t) (let ((v (make-vector 3 (vector 1 2)))) (test (equal? (v 0) (v 1)) #t) (test (eq? (v 0) (v 1)) #t) (test (eqv? (v 0) (v 1)) #t)) (let ((v (vector (vector 1 2) (vector 1 2) (vector 1 2)))) (test (equal? (v 0) (v 1)) #t) (test (eq? (v 0) (v 1)) #f) (test (eqv? (v 0) (v 1)) #f)) (let ((v (vector (vector (vector (vector 1 2) 3) 4) 5))) (test (v 0) #(#(#(1 2) 3) 4)) (test (v 1) 5) (test (((v 0) 0) 1) 3) (test ((((v 0) 0) 0) 1) 2)) (test (make-vector 1 (make-vector 1 (make-vector 1 0))) #(#(#(0)))) (test (vector->list (let ((v (make-int-vector 3 0))) (set! (v 0) 32) (set! (v 1) -1) (set! (v 2) 2) (sort! v <))) '(-1 2 32)) (let ((v1 (make-vector 3 1))) (num-test (v1 1) 1) (set! (v1 1) 2) (num-test (v1 1) 2) (let ((i0 0) (i2 2)) (num-test (v1 i0) 1) (num-test (vector-ref v1 i2) 1) (set! (v1 i0) 0) (num-test (v1 0) 0) (set! (v1 i0) i2) (num-test (v1 i0) i2)) (test (vector-dimensions v1) '(3)) (set! v1 (make-vector '(3 2))) (test (vector-dimensions v1) '(3 2)) (vector-set! v1 1 1 0) (num-test (vector-ref v1 1 1) 0) (let ((i0 1) (i1 1) (i2 32)) (set! (v1 i0 i1) i2) (num-test (vector-ref v1 1 1) 32) (num-test (v1 i0 i1) i2) (vector-set! v1 0 1 3) (num-test (v1 0 1) 3) (num-test (v1 1 1) 32)) (set! v1 (make-vector '(2 4 3) 1)) (test (vector-dimensions v1) '(2 4 3)) (num-test (vector-ref v1 1 1 1) 1) (vector-set! v1 0 0 0 32) (num-test (v1 0 0 0) 32) (set! (v1 0 1 1) 3) (num-test (v1 0 1 1) 3)) (let-temporarily (((*s7* 'print-length) 32)) (let ((vect1 #3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))) (vect2 #2d((1 2 3 4 5 6) (7 8 9 10 11 12))) (vect3 #(1 2 3 4 5 6 7 8 9 10 11 12 13 14)) (vect4 #3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))) (vect1t (make-int-vector '(2 2 3) 0))) (let ((v (subvector vect1t 0 12 '(12)))) (set! (v 0) 1) (set! (v 1) 2) (set! (v 2) 3) (set! (v 3) 3) (set! (v 4) 4) (set! (v 5) 5) (set! (v 6) 5) (set! (v 7) 6) (set! (v 8) 1) (set! (v 9) 7) (set! (v 10) 8) (set! (v 11) 2)) (do ((i 1 (+ i 1))) ((= i 15)) (set! (*s7* 'print-length) i) (let ((str (object->string vect1))) (test str (case i ((1) "#3d(((1 ...)...)...)") ((2) "#3d(((1 2 ...)...)...)") ((3) "#3d(((1 2 3)...)...)") ((4) "#3d(((1 2 3) (3 ...))...)") ((5) "#3d(((1 2 3) (3 4 ...))...)") ((6) "#3d(((1 2 3) (3 4 5))...)") ((7) "#3d(((1 2 3) (3 4 5)) ((5 ...)...))") ((8) "#3d(((1 2 3) (3 4 5)) ((5 6 ...)...))") ((9) "#3d(((1 2 3) (3 4 5)) ((5 6 1)...))") ((10) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 ...)))") ((11) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 ...)))") ((12) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))") ((13) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))") ((14) "#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")))) (let ((str (object->string vect1t))) (test str (case i ((1) "#i3d(((1 ...)...)...)") ((2) "#i3d(((1 2 ...)...)...)") ((3) "#i3d(((1 2 3)...)...)") ((4) "#i3d(((1 2 3) (3 ...))...)") ((5) "#i3d(((1 2 3) (3 4 ...))...)") ((6) "#i3d(((1 2 3) (3 4 5))...)") ((7) "#i3d(((1 2 3) (3 4 5)) ((5 ...)...))") ((8) "#i3d(((1 2 3) (3 4 5)) ((5 6 ...)...))") ((9) "#i3d(((1 2 3) (3 4 5)) ((5 6 1)...))") ((10) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 ...)))") ((11) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 ...)))") ((12) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))") ((13) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))") ((14) "#i3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))")))) (let ((str (object->string vect4))) (test str (case i ((1) "#3d(((1 ...)...)...)") ((2) "#3d(((1 2)...)...)") ((3) "#3d(((1 2) (3 ...)...)...)") ((4) "#3d(((1 2) (3 4)...)...)") ((5) "#3d(((1 2) (3 4) (5 ...))...)") ((6) "#3d(((1 2) (3 4) (5 6))...)") ((7) "#3d(((1 2) (3 4) (5 6)) ((7 ...)...))") ((8) "#3d(((1 2) (3 4) (5 6)) ((7 8)...))") ((9) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 ...)...))") ((10) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10)...))") ((11) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 ...)))") ((12) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))") ((13) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))") ((14) "#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))")))) (let ((str (object->string vect2))) (test str (case i ((1) "#2d((1 ...)...)") ((2) "#2d((1 2 ...)...)") ((3) "#2d((1 2 3 ...)...)") ((4) "#2d((1 2 3 4 ...)...)") ((5) "#2d((1 2 3 4 5 ...)...)") ((6) "#2d((1 2 3 4 5 6)...)") ((7) "#2d((1 2 3 4 5 6) (7 ...))") ((8) "#2d((1 2 3 4 5 6) (7 8 ...))") ((9) "#2d((1 2 3 4 5 6) (7 8 9 ...))") ((10) "#2d((1 2 3 4 5 6) (7 8 9 10 ...))") ((11) "#2d((1 2 3 4 5 6) (7 8 9 10 11 ...))") ((12) "#2d((1 2 3 4 5 6) (7 8 9 10 11 12))") ((13) "#2d((1 2 3 4 5 6) (7 8 9 10 11 12))") ((14) "#2d((1 2 3 4 5 6) (7 8 9 10 11 12))")))) (let ((str (object->string vect3))) (test str (case i ((1) "#(1 ...)") ((2) "#(1 2 ...)") ((3) "#(1 2 3 ...)") ((4) "#(1 2 3 4 ...)") ((5) "#(1 2 3 4 5 ...)") ((6) "#(1 2 3 4 5 6 ...)") ((7) "#(1 2 3 4 5 6 7 ...)") ((8) "#(1 2 3 4 5 6 7 8 ...)") ((9) "#(1 2 3 4 5 6 7 8 9 ...)") ((10) "#(1 2 3 4 5 6 7 8 9 10 ...)") ((11) "#(1 2 3 4 5 6 7 8 9 10 11 ...)") ((12) "#(1 2 3 4 5 6 7 8 9 10 11 12 ...)") ((13) "#(1 2 3 4 5 6 7 8 9 10 11 12 13 ...)") ((14) "#(1 2 3 4 5 6 7 8 9 10 11 12 13 14)"))))) (let ((vect5 (make-vector '(2 3)))) (set! (vect5 0 0) vect1) (set! (vect5 0 1) vect2) (set! (vect5 0 2) vect3) (set! (vect5 1 0) vect4) (set! (vect5 1 1) (vector 1 2 3)) (set! (vect5 1 2) #2d()) (do ((i 1 (+ i 1))) ((= i 15)) (set! (*s7* 'print-length) i) (let ((str (object->string vect5))) (test str (case i ((1) "#2d((#3d(((1 ...)...)...) ...)...)") ((2) "#2d((#3d(((1 2 ...)...)...) #2d((1 2 ...)...) ...)...)") ((3) "#2d((#3d(((1 2 3)...)...) #2d((1 2 3 ...)...) #(1 2 3 ...))...)") ((4) "#2d((#3d(((1 2 3) (3 ...))...) #2d((1 2 3 4 ...)...) #(1 2 3 4 ...)) (#3d(((1 2) (3 4)...)...) ...))") ((5) "#2d((#3d(((1 2 3) (3 4 ...))...) #2d((1 2 3 4 5 ...)...) #(1 2 3 4 5 ...)) (#3d(((1 2) (3 4) (5 ...))...) #(1 2 3) ...))") ((6) "#2d((#3d(((1 2 3) (3 4 5))...) #2d((1 2 3 4 5 6)...) #(1 2 3 4 5 6 ...)) (#3d(((1 2) (3 4) (5 6))...) #(1 2 3) #2d()))") ((7) "#2d((#3d(((1 2 3) (3 4 5)) ((5 ...)...)) #2d((1 2 3 4 5 6) (7 ...)) #(1 2 3 4 5 6 7 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 ...)...)) #(1 2 3) #2d()))") ((8) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 ...)...)) #2d((1 2 3 4 5 6) (7 8 ...)) #(1 2 3 4 5 6 7 8 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8)...)) #(1 2 3) #2d()))") ((9) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1)...)) #2d((1 2 3 4 5 6) (7 8 9 ...)) #(1 2 3 4 5 6 7 8 9 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 ...)...)) #(1 2 3) #2d()))") ((10) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 ...))) #2d((1 2 3 4 5 6) (7 8 9 10 ...)) #(1 2 3 4 5 6 7 8 9 10 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10)...)) #(1 2 3) #2d()))") ((11) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 ...))) #2d((1 2 3 4 5 6) (7 8 9 10 11 ...)) #(1 2 3 4 5 6 7 8 9 10 11 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 ...))) #(1 2 3) #2d()))") ((12) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2d((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2d()))") ((13) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2d((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 13 ...)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2d()))") ((14) "#2d((#3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2))) #2d((1 2 3 4 5 6) (7 8 9 10 11 12)) #(1 2 3 4 5 6 7 8 9 10 11 12 13 14)) (#3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))) #(1 2 3) #2d()))")))))))) (set! (*s7* 'print-length) 40) (test (object->string (make-int-vector 3 0)) "#i(0 0 0)") (let ((v (make-vector '(2 2)))) (set! (v 0 0) 1) (set! (v 0 1) 2) (set! (v 1 0) 3) (set! (v 1 1) 4) (set! (v 0 1) #2d((1 2) (3 4))) (test (object->string v) "#2d((1 #2d((1 2) (3 4))) (3 4))")) (let ((v (make-int-vector '(2 2)))) (set! (v 0 0) 1) (set! (v 0 1) 2) (set! (v 1 0) 3) (set! (v 1 1) 4) (test (object->string v) "#i2d((1 2) (3 4))")) (let ((v #2d((1 2) (3 4)))) (set! (v 0 1) #2d((1 2) (3 4))) (test (object->string v) "#2d((1 #2d((1 2) (3 4))) (3 4))")) (let ((v (make-vector '(2 3)))) (do ((i 0 (+ i 1))) ((= i 2)) (do ((j 0 (+ j 1))) ((= j 3)) (set! (v i j) (list i j)))) (test (v 0 0) '(0 0)) (test ((v 1 2) 0) 1) (test (v 1 2 0) 1) (test (v 1 2 0 0) 'error) (test (object->string v) "#2d(((0 0) (0 1) (0 2)) ((1 0) (1 1) (1 2)))")) (test (object->string (make-float-vector 3 1.0)) "#r(1.0 1.0 1.0)") (test (object->string (make-float-vector 3 -1.5)) "#r(-1.5 -1.5 -1.5)") (test (object->string (make-int-vector 3 1)) "#i(1 1 1)") (test (object->string (make-int-vector 3 -1)) "#i(-1 -1 -1)") (test (object->string (make-int-vector 0 0)) "#i()") (test (object->string #r()) "#r()") (test (object->string (make-float-vector '(3 2 0) 0.0)) "#r3d()") (test (let ((v1 (make-vector '(3 2) 1)) (v2 (make-vector '(3 2) 2)) (sum 0)) (for-each (lambda (n m) (set! sum (+ sum n m))) v1 v2) sum) 18) (test (vector->list (make-vector '(2 3) 1)) '(1 1 1 1 1 1)) (test (vector->list #2d((1 2) (3 4))) '(1 2 3 4)) (test (list->vector '((1 2) (3 4))) #((1 2) (3 4))) (test (vector->list (make-vector (list 2 0))) ()) (test (vector-dimensions #2d((1 2 3))) '(1 3)) (test (#2d((1 2 3) (4 5 6)) 0 0) 1) (test (#2d((1 2 3) (4 5 6)) 0 1) 2) (test (#2d((1 2 3) (4 5 6)) 1 1) 5) (test (#3d(((1 2) (3 4)) ((5 6) (7 8))) 0 0 0) 1) (test (#3d(((1 2) (3 4)) ((5 6) (7 8))) 1 1 0) 7) (test (#4d((((1) (2)) ((3) (4)) ((5) (6)))) 0 0 0 0) 1) (test (vector? #2d((1 2) (3 4))) #t) (test ((#2d((1 #2d((2 3) (4 5))) (6 7)) 0 1) 1 0) 4) (test ((((((((((#10d((((((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))) (((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))))) (((((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))) (((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1)))))))))) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 1) (test (#10d((((((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))) (((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))))) (((((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1))))))) (((((((1) (1))) (((1) (1))))) (((((1) (1))) (((1) (1)))))))))) 0 0 0 0 0 0 0 0 0 0) 1) (let ((v (make-vector (make-list 100 1) 0))) (test (equal? v #100d((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) #t) (test (apply v (make-list 100 0)) 0) (test (v 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) 0)) ;; eval-string here else these are read errors (test (eval-string "#3d(((1 2) (3 4)) ((5 6) (7)))") 'error) (test (eval-string "#3d(((1 2) (3 4)) ((5) (7 8)))") 'error) (test (eval-string "#3d(((1 2) (3 4)) (() (7 8)))") 'error) (test (eval-string "#3d(((1 2) (3 4)) ((5 6) (7 8 9)))") 'error) (test (eval-string "#3d(((1 2) (3 4)) (5 (7 8 9)))") 'error) (test (eval-string "#3d(((1 2) (3 4)) ((5 6) (7 . 8)))") 'error) (test (eval-string "#3d(((1 2) (3 4)) ((5 6) (7 8 . 9)))") 'error) (test (eval-string "#3d(((1 2) (3 4)) ((5 6) ()))") 'error) (test (eval-string "#3d(((1 2) (3 4)) ((5 6)))") 'error) (test (vector-dimensions #3d(((1 2) (3 4)) ((5 6) (7 8)))) '(2 2 2)) (test (vector-dimensions #2d((1 2 3) (4 5 6))) '(2 3)) (test (vector-dimensions #4d((((1) (2)) ((3) (4)) ((5) (6))))) '(1 3 2 1)) (test (vector-length #3d(((1 2) (3 4)) ((5 6) (7 8)))) 8) (test (length #2d((1 2 3) (4 5 6))) 6) (test (#2d((1 (2) 3) (4 () 6)) 0 1) '(2)) (test (#2d((1 (2) 3) (4 () 6)) 1 1) ()) (test (#2d((1 (2) 3) (4 6 ())) 1 2) ()) (test (#2d((() (2) ()) (4 5 6)) 0 2) ()) (test (equal? (make-vector 0) (make-vector '(0))) #t) (test (equal? #() (make-vector '(0))) #t) (test (equal? #2d((1 2) (3 4)) #2d((1 2) (3 4))) #t) (test (eq? #2d((1 2) (3 4)) #2d((1 2) (3 4))) #f) (test (eqv? #2d((1 2) (3 4)) #2d((1 2) (3 4))) #f) (test (make-vector (1 . 2) "hi") 'error) (test (make-vector (cons 1 2) "hi") 'error) (test (equal? (make-vector 0) (vector)) #t) (test (equal? #() (vector)) #t) (test (equal? (make-int-vector 0 0) (make-int-vector 0 0)) #t) (test (equal? #() (make-int-vector 0 0)) #t) (test (equal? (make-vector '(2 0)) (make-int-vector '(2 0) 0)) #t) (test (equal? (make-vector '(2 0)) (make-int-vector '(0 2) 0)) #f) (let ((v (make-vector '(2 3) 0))) (num-test (vector-length v) 6) (test (vector-dimensions v) '(2 3)) (num-test (v 0 0) 0) (num-test (v 1 2) 0) (test (v 2 2) 'error) (test (v 2 -1) 'error) (test (v 2 0) 'error) (set! (v 0 1) 1) (num-test (v 0 1) 1) (num-test (v 1 0) 0) (set! (v 1 2) 2) (num-test (v 1 2) 2) (test (set! (v 2 2) 32) 'error) (test (set! (v 1 -1) 0) 'error) (test (set! (v 2 0) 0) 'error) (num-test (vector-ref v 0 1) 1) (num-test (vector-ref v 1 2) 2) (test (vector-ref v 2 2) 'error) (test (vector-ref v 1 -1) 'error) (vector-set! v 1 1 64) (num-test (vector-ref v 1 1) 64) (num-test (vector-ref v 0 0) 0) (test (vector-ref v 1 2 3) 'error) (test (vector-set! v 1 2 3 4) 'error) (test (v 1 1 1) 'error) (test (set! (v 1 1 1) 1) 'error)) (let ((v1 (make-vector '(3 2) 0)) (v2 (make-vector '(2 3) 0)) (v3 (make-vector '(2 3 4) 0)) (v4 (make-vector 6 0)) (v5 (make-vector '(2 3) 0))) (test (equal? v1 v2) #f) (test (equal? v1 v3) #f) (test (equal? v1 v4) #f) (test (equal? v2 v2) #t) (test (equal? v3 v2) #f) (test (equal? v4 v2) #f) (test (equal? v5 v2) #t) (test (equal? v4 v3) #f) (test (vector-dimensions v3) '(2 3 4)) (test (vector-dimensions v4) '(6)) (num-test (v3 1 2 3) 0) (set! (v3 1 2 3) 32) (num-test (v3 1 2 3) 32) (num-test (vector-length v3) 24) (num-test (vector-ref v3 1 2 3) 32) (vector-set! v3 1 2 3 -32) (num-test (v3 1 2 3) -32) (test (v3 1 2) #(0 0 0 -32)) (test (set! (v3 1 2) 3) 'error) (test (vector-ref v3 1 2) #(0 0 0 -32)) (test (vector-set! v3 1 2 32) 'error)) (test (let ((v #2d((1 2) (3 4)))) (vector-fill! v #t) v) #2d((#t #t) (#t #t))) (test (eval-string "#2d((1 2) #2d((3 4) 5 6))") 'error) (test (string=? (object->string #2d((1 2) (3 #2d((3 4) (5 6))))) "#2d((1 2) (3 #2d((3 4) (5 6))))") #t) (test (string=? (object->string #3d(((#2d((1 2) (3 4)) #(1)) (#3d(((1))) 6)))) "#3d(((#2d((1 2) (3 4)) #(1)) (#3d(((1))) 6)))") #t) (test (make-vector '(2 -2)) 'error) (test (make-vector '(2 1/2)) 'error) (test (make-vector '(2 1.2)) 'error) (test (make-vector '(2 2+i)) 'error) (test (make-vector '(2 "hi")) 'error) (let ((v (make-vector '(1 1 1) 32))) (test (vector? v) #t) (test (equal? v #()) #f) (test (vector->list v) '(32)) (test (vector-ref v 0) '#2d((32))) (test (vector-set! v 0 0) 'error) (test (vector-ref v 0 0) #(32)) (test (vector-set! v 0 0 0) 'error) (test (vector-ref v 0 0 0) 32) (test (let () (vector-set! v 0 0 0 31) (vector-ref v 0 0 0)) 31) (test (vector-length v) 1) (test (vector-dimensions v) '(1 1 1)) (test (object->string v) "#3d(((31)))") ) (test (vector? #3d(((32)))) #t) (test (equal? #3d(((32))) #()) #f) (test (vector->list #3d(((32)))) '(32)) (test (#3d(((32))) 0) '#2d((32))) (test (set! (#3d(((32))) 0) 0) 'error) (test (#3d(((32))) 0 0) #(32)) (test (set! (#3d(((32))) 0 0) 0) 'error) (test (#3d(((32))) 0 0 0) 32) (test (vector-length #3d(((32)))) 1) (test (vector-dimensions #3d(((32)))) '(1 1 1)) (test (object->string #3d(((32)))) "#3d(((32)))") (let ((v1 (make-vector '(1 0)))) (test (vector? v1) #t) (test (equal? v1 #()) #f) (test (vector->list v1) ()) (test (vector-ref v1 0) 'error) (test (vector-set! v1 0 0) 'error) (test (vector-ref v1 0 0) 'error) (test (vector-set! v1 0 0 0) 'error) (test (vector-length v1) 0) (test (vector-dimensions v1) '(1 0)) (test (object->string v1) "#2d()") ) (let ((v2 (make-vector '(10 3 0)))) (test (vector? v2) #t) (test (equal? v2 #()) #f) (test (vector->list v2) ()) (test (vector-ref v2) 'error) (test (vector-set! v2 0) 'error) (test (vector-ref v2 0) 'error) (test (vector-set! v2 0 0) 'error) (test (vector-ref v2 0 0) 'error) (test (vector-set! v2 0 0 0) 'error) (test (vector-ref v2 1 2 0) 'error) (test (vector-set! v2 1 2 0 0) 'error) (test (vector-length v2) 0) (test (vector-dimensions v2) '(10 3 0)) (test (object->string v2) "#3d()") ) (let ((v3 (make-vector '(10 0 3)))) (test (vector? v3) #t) (test (equal? v3 #()) #f) (test (vector->list v3) ()) (test (vector-ref v3) 'error) (test (vector-set! v3 0) 'error) (test (vector-ref v3 0) 'error) (test (vector-set! v3 0 0) 'error) (test (vector-ref v3 0 0) 'error) (test (vector-set! v3 0 0 0) 'error) (test (vector-ref v3 1 0 2) 'error) (test (vector-set! v3 1 0 2 0) 'error) (test (vector-length v3) 0) (test (vector-dimensions v3) '(10 0 3)) (test (object->string v3) "#3d()") ) (test (((#(("hi") ("ho")) 0) 0) 1) #\i) (test (string-ref (list-ref (vector-ref #(("hi") ("ho")) 0) 0) 1) #\i) (test (equal? #2d() (make-vector '(0 0))) #t) (test (equal? #2d() (make-vector '(1 0))) #f) (test (equal? (make-vector '(2 2) 2) #2d((2 2) (2 2))) #t) (test (equal? (make-vector '(2 2) 2) #2d((2 2) (1 2))) #f) (test (equal? (make-vector '(1 2 3) 0) (make-vector '(1 2 3) 0)) #t) (test (equal? (make-vector '(1 2 3) 0) (make-vector '(1 3 2) 0)) #f) (test (make-vector '1 2 3) 'error) (test (set! (vector) 1) 'error) (test (set! (make-vector 1) 1) 'error) (test (equal? (make-vector 10 ()) (make-hash-table 10)) #f) (test (equal? #() (copy #())) #t) (test (equal? #2d() (copy #2d())) #t) (test (fill! #() 1) 1) (test (fill! #2d() 1) 1) (test (equal? #2d((1 2) (3 4)) (copy #2d((1 2) (3 4)))) #t) (test (equal? #3d() #3d(((())))) #f) (test (equal? #3d() #3d()) #t) (test (equal? #1d() #1d()) #t) (test (equal? #3d() #2d()) #f) (test (equal? #3d() (copy #3d())) #t) (test (equal? #2d((1) (2)) #2d((1) (3))) #f) (test (equal? #2d((1) (2)) (copy #2d((1) (2)))) #t) (test (equal? (make-vector '(3 0 1)) (make-vector '(3 0 2))) #f) (test (eval-string "#0d()") 'error) (let ((v #2d((1 2 3) (4 5 6)))) (let ((v1 (v 0)) (v2 (v 1))) (if (not (equal? v1 #(1 2 3))) (format #t ";(v 0) subvector: ~A~%" v1)) (if (not (equal? v2 #(4 5 6))) (format #t ";(v 1) subvector: ~A~%" v2)) (let ((v3 (copy v1))) (if (not (equal? v3 #(1 2 3))) (format #t ";(v 0) copied subvector: ~A~%" v3)) (if (not (= (length v3) 3)) (format #t ";(v 0) copied length: ~A~%" (length v3))) (if (not (equal? v3 (copy (v 0)))) (format #t ";(v 0) copied subvectors: ~A ~A~%" v3 (copy (v 0))))))) (let ((v1 (make-vector '(3 2 1) #f)) (v2 (make-vector '(3 2 1) #f))) (test (equal? v1 v2) #t) (set! (v2 0 0 0) 1) (test (equal? v1 v2) #f)) (test (equal? (make-vector '(3 2 1) #f) (make-vector '(1 2 3) #f)) #f) (test (map (lambda (n) n) #2d((1 2) (3 4))) '(1 2 3 4)) (test (let ((vals ())) (for-each (lambda (n) (set! vals (cons n vals))) #2d((1 2) (3 4))) vals) '(4 3 2 1)) (test (map (lambda (x y) (+ x y)) #2d((1 2) (3 4)) #1d(4 3 2 1)) '(5 5 5 5)) (test (let ((vals ())) (for-each (lambda (x y) (set! vals (cons (+ x y) vals))) #2d((1 2) (3 4)) #1d(4 3 2 1)) vals) '(5 5 5 5)) (let ((v #2d((#(1 2) #(3 4)) (#2d((5 6) (7 8)) #2d((9 10 11) (12 13 14)))))) (test (v 0 0) #(1 2)) (test (v 0 1) #(3 4)) (test (v 1 0) #2d((5 6) (7 8))) (test (v 1 1) #2d((9 10 11) (12 13 14))) (test ((v 1 0) 0 1) 6) (test ((v 0 1) 1) 4) (test ((v 1 1) 1 2) 14)) (let ((v #2d((#((1) #(2)) #(#(3) (4))) (#2d(((5) #(6)) (#(7) #(8))) #2d((#2d((9 10) (11 12)) (13)) (14 15)))))) (test (v 0 0) #((1) #(2))) (test (v 0 1) #(#(3) (4))) (test (v 1 0) #2d(((5) #(6)) (#(7) #(8)))) (test (v 1 1) #2d((#2d((9 10) (11 12)) (13)) (14 15))) (test ((v 1 0) 0 1) #(6)) (test (((v 1 0) 0 1) 0) 6) (test ((v 0 1) 1) '(4)) (test (((v 1 1) 0 0) 1 0) 11)) (test (let ((V #2d((1 2 3) (4 5 6)))) (V 0)) #(1 2 3)) (test (let ((V #2d((1 2 3) (4 5 6)))) (V 1)) #(4 5 6)) (test (let ((V #2d((1 2 3) (4 5 6)))) (V 2)) 'error) (test (let ((V #2d((1 2 3) (4 5 6)))) (set! (V 1) 0)) 'error) (test (let ((V #2d((1 2 3) (4 5 6)))) (let ((V1 (V 0))) (set! (V1 1) 32) V)) '#2d((1 32 3) (4 5 6))) (test (let ((V #2d((1 2 3) (4 5 6)))) (let ((V1 (V 0))) (set! (V1 3) 32) V)) 'error) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 1)) '#2d((7 8 9) (10 11 12))) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 1 1)) #(10 11 12)) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 0 1)) #(4 5 6)) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (V 2 1)) 'error) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) ((V 0) 1)) #(4 5 6)) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (set! (((V 0) 1) 1) 32) V) '#3d(((1 2 3) (4 32 6)) ((7 8 9) (10 11 12)))) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-set! V 0 1 1 32) V) '#3d(((1 2 3) (4 32 6)) ((7 8 9) (10 11 12)))) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-set! V 1 1 0 32) V) '#3d(((1 2 3) (4 5 6)) ((7 8 9) (32 11 12)))) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-length (V 1))) 6) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-dimensions (V 1))) '(2 3)) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-length (V 0 1))) 3) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12))))) (vector-dimensions (V 0 1))) '(3)) (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))) (one 1) (zero 0)) (let ((V1 (V one zero)) (sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) V1) sum)) 24) ; 7 8 9 (test (let ((V '#3d(((1 2 3) (4 5 6)) ((7 8 9) (10 11 12)))) (two 2) (one 1) (zero 0)) (let ((V10 (V one zero)) (V00 (V zero zero)) (V01 (V zero one)) (V11 (V one one)) (sum 0)) (for-each (lambda (n0 n1 n2 n3) (set! sum (+ sum n0 n1 n2 n3))) V00 V01 V10 V11) sum)) 78) (let-temporarily (((*s7* 'print-length) 32)) (test (object->string (make-vector '(8 8) 0)) "#2d((0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0) (0 0 0 0 0 0 0 0)...)") (test (object->string (make-vector 64 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...)") (test (object->string (make-vector 32 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)") (test (object->string (make-vector 33 0)) "#(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ...)") (test (object->string (make-vector '(8 4) 0)) "#2d((0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0) (0 0 0 0))")) (let-temporarily (((*s7* 'print-length) 1024)) (test (object->string (make-vector '(2 1 2 1 2 1 2 1 2 1 2 1 2 1) 0)) "#14d((((((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))) (((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))))) (((((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))) (((((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))) (((((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))) (((((((0) (0))) (((0) (0))))) (((((0) (0))) (((0) (0))))))))))))))") (test (object->string (make-vector '(16 1 1 1 1 1 1 1 1 1 1 1 1 1) 0)) "#14d((((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))) (((((((((((((0))))))))))))))") ;;; now see if our shared vector has survived... (test (and (vector? check-subvector-after-gc) (= (length check-subvector-after-gc) 6) (do ((i 0 (+ i 1)) (happy #t)) ((= i 6) happy) (if (or (not (pair? (check-subvector-after-gc i))) (not (equal? (check-subvector-after-gc i) (cons 3 i)))) (set! happy #f)))) #t) (set! check-subvector-after-gc #f)) ;;; -------- circular structures ------- ;;; here's an oddity: (let ((l1 (make-list 1 #f)) (l2 (make-list 3 #f))) (set-cdr! l1 l1) (set-cdr! (list-tail l2 2) l2) (test (equal? l1 l2) #t)) ; but (eq? l1 (cdr l1)): #t, and (eq? l2 (cdr l2)): #f (let ((l1 (make-list 1 #f)) (l2 (make-list 3 #f))) (set-car! l1 #t) (set-car! l2 #t) (set-cdr! l1 l1) (set-cdr! (list-tail l2 2) l2) (test (equal? l1 l2) #f)) ;;; Guile agrees on the first, but hangs on the second ;;; CL says the first is false, but hangs on the second ;;; r7rs agrees with s7 here, to my dismay. ;;; other cases: (let ((l1 (list #f #f)) (l2 (list #f #f))) (set-cdr! l1 l1) (set-cdr! (cdr l2) l2) (test (equal? l1 l2) #t)) (let ((l1 (list #f #f #f)) (l2 (list #f #f #f))) (set-cdr! (cdr l1) l1) (set-cdr! (cddr l2) l2) (test (equal? l1 l2) #t)) ; r7rs says #t I think, this was #f until 16-Jan-20 (let ((l1 (list #f #f #f)) (l2 (list #f #f #f))) (set-cdr! (cdr l1) l1) (set-cdr! (cddr l2) (cdr l2)) (test (equal? l1 l2) #t)) ;;; Gauche says #t #f #t #t #t, as does chibi ;;; Guile-2.0 hangs on all, as does Chicken (let ((l1 (list #t #f #f)) (l2 (list #t #f #t))) (set-cdr! (cdr l1) l1) (set-cdr! (cddr l2) (cdr l2)) (test (equal? l1 l2) #t)) (let ((l1 (list #t #f #f)) (l2 (list #t #f #f #t))) (set-cdr! (cddr l1) l1) (set-cdr! (cdddr l2) (cdr l2)) (test (equal? l1 l2) #t)) ;;; cyclic-sequences (define* (make-circular-list n init) (let ((l (make-list n init))) (set-cdr! (list-tail l (- n 1)) l))) (define (cyclic? obj) (not (null? (cyclic-sequences obj)))) (for-each (lambda (arg) (test (cyclic? arg) #f)) (list "hi" "" #\null #\a () #() 1 '(1 . 2) (cons #\a #\b) #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)) (let ((x '(1 2))) (list x x)) (let ((x #(1 2))) (vector x x)) (let ((x "a")) (list (vector x) x)) (let ((x (hash-table 'a 1))) (vector x (list x x) (inlet 'b x))) (let ((x '(1))) (let ((y (list x))) (list x (list y)))))) (test (cyclic-sequences) 'error) (test (cyclic-sequences (list 1 2) (list 3 4)) 'error) (test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences y))) (list (length x) (eq? (car x) y)))) '(1 #t)) (test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences (vector y)))) (list (length x) (eq? (car x) y)))) '(1 #t)) (test (let ((y (make-circular-list 3))) (let ((x (cyclic-sequences (list y (vector y))))) (list (length x) (eq? (car x) y)))) '(1 #t)) (test (let* ((y (list 1)) (x (vector y))) (set! (y 0) x) (eq? x (car (cyclic-sequences x)))) #t) (test (let ((x (hash-table 'a (make-circular-list 1)))) (eq? (car (cyclic-sequences x)) (x 'a))) #t) (test (let ((x (list (make-circular-list 1) (make-circular-list 2)))) (length (cyclic-sequences x))) 2) (test (let ((l1 '(1))) (let ((l2 (cons l1 l1))) (cyclic-sequences l2))) ()) (test (let ((l1 '(1))) (let ((l2 (list l1 l1))) (cyclic-sequences l2))) ()) (test (let ((y '(1))) (let ((x (list (make-circular-list 1) y y))) (set-cdr! (cddr x) (cdr x)) (let ((z (cyclic-sequences x))) (list (length z) (and (memq (cdr x) z) #t))))) ; "and" here just to make the result easier to check '(2 #t)) (test (let ((z (vector 1 2))) (let ((y (list 1 z 2))) (let ((x (hash-table 'x y))) (set! (z 1) x) (length (cyclic-sequences z))))) 1) (test (let ((x '(1 2))) (let ((y (list x x))) (let ((z (vector x y))) (null? (cyclic-sequences z))))) #t) (test (let ((v (vector 1 2 3 4))) (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (set! (v 0) v) (set! (v 3) lst) (length (cyclic-sequences v)))) 2) (test (infinite? (length (make-circular-list 3))) #t) (test (object->string (make-circular-list 3)) "#1=(#f #f #f . #1#)") (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (apply + lst) 'error) (test (cyclic? lst) #t) (test (eq? (car (cyclic-sequences lst)) lst) #t)) (let ((l1 (list 1))) (test (object->string (list l1 1 l1)) "((1) 1 (1))") ; was "(#1=(1) 1 #1#)" (test (cyclic? (list l1 1 l1)) #f)) (let ((lst (list 1 2))) (set! (cdr (cdr lst)) (cdr lst)) (test (object->string lst) "(1 . #1=(2 . #1#))") (test-wi (object->string lst :readable) "(let ((<1> (list 2))) (set-cdr! <1> <1>) (let (( (list 1))) (set-cdr! <1>) ))")) ; (1 . #1=(2 . #1#)) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (object->string (append '(1) lst)) "(1 . #1=(1 2 3 . #1#))")) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (append lst ()) 'error)) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (sort! lst <) 'error)) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (object->string (list lst)) "(#1=(1 2 3 . #1#))")) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (object->string (make-list 4 lst)) "(#1=(1 2 3 . #1#) #1# #1# #1#)")) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (object->string (vector lst lst)) "#(#1=(1 2 3 . #1#) #1#)")) (let ((lst `(+ 1 2 3))) (set! (cdr (cdddr lst)) (cddr lst)) (test (object->string lst) "(+ 1 . #1=(2 3 . #1#))")) (let ((x (list 1 2))) (test (equal? x x) #t) (test (equal? x (cdr x)) #f) (test (equal? x ()) #f)) (let ((x (list 1 (list 2 3) (list (list 4 (list 5))))) (y (list 1 (list 2 3) (list (list 4 (list 5)))))) (test (equal? x y) #t)) (let ((x (list 1 (list 2 3) (list (list 4 (list 5))))) (y (list 1 (list 2 3) (list (list 4 (list 5) 6))))) (test (equal? x y) #f)) (test (length ()) 0) (test (length (cons 1 2)) -1) (test (length '(1 2 3)) 3) (let ((lst1 (list 1 2))) (test (length lst1) 2) (list-set! lst1 0 lst1) (test (length lst1) 2) ; its car is a circular list, but it isn't (test (eq? ((cyclic-sequences lst1) 0) lst1) #t) (test (list->string lst1) 'error) (let ((lst2 (list 1 2))) (set-car! lst2 lst2) (test (equal? lst1 lst2) #t) (test (equivalent? lst1 lst2) #t) (test (eq? lst1 lst2) #f) (test (eqv? lst1 lst2) #f) (test (pair? lst1) #t) (test (null? lst1) #f) (test (car lst2) lst2) (test (car lst1) lst1) (test (let () (fill! lst1 32) lst1) '(32 32)))) (let ((lst1 (list 1))) (test (length lst1) 1) (set-cdr! lst1 lst1) (test (infinite? (length lst1)) #t) (test (eq? (cdr ((cyclic-sequences lst1) 0)) lst1) #t) (test (null? lst1) #f) (test (pair? lst1) #t) (let ((lst2 (cons 1 ()))) (set-cdr! lst2 lst2) (test (equal? lst1 lst2) #t) (test (equivalent? lst1 lst2) #t) (set-car! lst2 0) (test (equal? lst1 lst2) #f) (test (equivalent? lst1 lst2) #f) (test (infinite? (length lst2)) #t))) (let ((lst1 (list 1))) (set-cdr! lst1 lst1) (test (list-tail lst1 0) lst1) (test (list-tail lst1 3) lst1) (test (list-tail lst1 10) lst1)) (let ((lst1 (let ((lst (list 'a))) (set-cdr! lst lst) lst))) (test (apply lambda lst1 (list 1)) 'error)) ; lambda parameter 'a is used twice in the lambda argument list ! (let ((lst1 (list 1)) (lst2 (list 1))) (set-car! lst1 lst2) (set-car! lst2 lst1) (test (equal? lst1 lst2) #t) (test (equivalent? lst1 lst2) #t) (test (length lst1) 1) (let ((lst3 (list 1))) (test (equal? lst1 lst3) #f) (test (equivalent? lst1 lst3) #f) (set-cdr! lst3 lst3) (test (equal? lst1 lst3) #f) (test (equivalent? lst1 lst3) #f))) (let ((lst1 (list 'a 'b 'c))) (set! (cdr (cddr lst1)) lst1) (test (infinite? (length lst1)) #t) (test (memq 'd lst1) #f) (test (memq 'a lst1) lst1) (test (memq 'b lst1) (cdr lst1))) (let ((lst1 (list 1 2 3))) (list-set! lst1 1 lst1) (test (object->string lst1) "#1=(1 #1# 3)")) (let ((lst1 (let ((lst (list 1))) (set-cdr! lst lst) lst))) (test (list-ref lst1 9223372036854775807) 'error) (test (list-set! lst1 9223372036854775807 2) 'error) (test (list-tail lst1 9223372036854775807) 'error) (test (make-vector lst1 9223372036854775807) 'error) (let-temporarily (((*s7* 'safety) 1)) (test (not (member (map (lambda (x) x) lst1) '(() (1)))) #f) (newline) ; geez -- just want to allow two possible ok results, so "not" makes it boolean (test (not (member (map (lambda (x y) x) lst1 lst1) '(() (1)))) #f) (test (for-each (lambda (x) x) lst1) #) ; was 'error (test (for-each (lambda (x y) x) lst1 lst1) #) ; was 'error (test (not (member (map (lambda (x y) (+ x y)) lst1 '(1 2 3)) (list () '(2)))) #f))) (test (map abs (let ((lst (list 0))) (set! (cdr lst) lst))) '(0)) (test (map (lambda (x) x) (let ((lst (list 0))) (set! (cdr lst) lst))) '(0)) (test (map abs (let ((lst (list 0 1))) (set-cdr! (cdr lst) lst))) '(0 1 0)) (test (map (lambda (x) x) (let ((lst (list 0 1))) (set-cdr! (cdr lst) lst))) '(0 1)) (let ((lst1 (list 1 -1))) (set-cdr! (cdr lst1) lst1) (let ((vals (map * '(1 2 3 4) lst1))) (test vals '(1 -2 3)))) ; was '(1 -2 3 -4), then later (1 -2) -- as in other cases above, map/for-each stop when a cycle is encountered (test (let ((lst '(a b c))) (set! (cdr (cddr lst)) lst) (map cons lst '(0 1 2 3 4 5))) '((a . 0) (b . 1) (c . 2) (a . 3) (b . 4))) ; as above (test (object->string (let ((l1 (list 0 1))) (set! (l1 1) l1) (copy l1))) "(0 #1=(0 #1#))") ;;; this changed 11-Mar-15 ;;;(test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) (copy lst))) "(1 . #1=(1 . #1#))") (test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) (copy lst))) "#1=(1 . #1#)") (test (object->string (let ((lst (list 1 2))) (set! (cdr lst) lst) lst)) "#1=(1 . #1#)") (test (object->string (let ((l1 (list 1 2))) (copy (list l1 4 l1)))) "((1 2) 4 (1 2))") ; was "(#1=(1 2) 4 #1#)" ;;;(test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) (copy lst))) "(1 2 3 . #1=(2 3 . #1#))") (test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) (copy lst))) "(1 . #1=(2 3 . #1#))") (test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cdr lst)) lst)) "(1 . #1=(2 3 . #1#))") (test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cddr lst)) (copy lst))) "(1 2 . #1=(3 . #1#))") (test (object->string (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) (cddr lst)) lst)) "(1 2 . #1=(3 . #1#))") ;;;(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) (copy lst))) "(1 2 3 4 . #1=(3 4 . #1#))") (test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) (copy lst))) "(1 2 . #1=(3 4 . #1#))") (test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cddr lst)) lst)) "(1 2 . #1=(3 4 . #1#))") ;;;(test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) (copy lst))) "(1 2 3 4 . #1=(2 3 4 . #1#))") (test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) (copy lst))) "(1 . #1=(2 3 4 . #1#))") (test (object->string (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) (cdr lst)) lst)) "(1 . #1=(2 3 4 . #1#))") (test (object->string (vector (let ((lst (list 1))) (set-cdr! lst lst)))) "#(#1=(1 . #1#))") (test (object->string (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (set! (car lst) (vector lst)) lst)) "#1=(#(#1#) 2 . #1#)") (test-wi (object->string (vector (let ((lst (list 1))) (set-cdr! lst lst))) :readable) ; #(#1=(1 . #1#)) "(let ((<1> (list 1))) (set-cdr! <1> <1>) (vector <1>))") ; #(#1=(1 . #1#)) (test-wi (object->string (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (set! (car lst) (vector lst)) lst) :readable) ; #1=(#(#1#) 2 . #1#) "(let ((<1> (list #f 2))) (set-car! <1> (vector <1>)) (set-cdr! (cdr <1>) <1>) <1>)") ; #1=(#(#1#) 2 . #1#) (test-wi (let ((v (vector 1 2))) (set! (v 0) v) (object->string v :readable)) ; #1=#(#1# 2) "(let ((<1> (vector #f 2))) (set! (<1> 0) <1>) <1>)") ; #1=#(#1# 2) (test-wi (let ((v (make-vector '(2 2) 0))) (set! (v 1 1) v) (object->string v :readable)) ; #1=#2d((0 0) (0 #1#)) "(let ((<1> (subvector (vector 0 0 0 #f) 0 4 '(2 2)))) (set! (<1> 1 1) <1>) <1>)") ; #1=#2d((0 0) (0 #1#)) (test (reverse '(1 2 (3 4))) '((3 4) 2 1)) (test (let ((lst (list 1 2 3))) (set! (lst 2) lst) (object->string (reverse lst))) "(#1=(1 2 #1#) 2 1)") (test (let ((l1 (cons 1 ()))) (set-cdr! l1 l1) (object->string (reverse l1))) "(#1=(1 . #1#) 1 1 1)") (test (equal? (vector 0) (vector 0)) #t) (test (equal? (vector 0 #\a "hi" (list 1 2 3)) (vector 0 #\a "hi" (list 1 2 3))) #t) (test (let ((v (vector 0))) (equal? (vector v) (vector v))) #t) (let ((v1 (make-vector 1 0))) (set! (v1 0) v1) (test (vector? v1) #t) (let ((v2 (vector 0))) (vector-set! v2 0 v2) (test (vector-length v1) 1) (test (equal? v1 v2) #t) (test (equal? (vector-ref v1 0) v1) #t) (test (equal? (vector->list v1) (list v1)) #t) (vector-fill! v1 0) (test (equal? v1 (vector 0)) #t) (let ((v3 (copy v2))) (test (equal? v2 v3) #t) (vector-set! v3 0 0) (test (equal? v3 (vector 0)) #t)) )) (let ((v1 (make-vector 1 0)) (v2 (vector 0))) (set! (v1 0) v2) (set! (v2 0) v1) (test (equal? v1 v2) #t)) (test (vector? (let ((v (vector 0))) (set! (v 0) v) (v 0 0 0 0))) #t) ; ? (let* ((l1 (list 1 2)) (v1 (vector 1 2)) (l2 (list 1 l1 2)) (v2 (vector l1 v1 l2))) (vector-set! v1 0 v2) (list-set! l1 1 l2) (test (equal? v1 v2) #f)) (let ((v1 (make-vector 1 0))) (set! (v1 0) v1) (let ((v2 (vector 0))) (vector-set! v2 0 v2) (test (equal? v1 v2) #t))) (let ((v1 (make-vector 1 0))) (set! (v1 0) v1) (test (eq? ((cyclic-sequences v1) 0) v1) #t) (test (object->string v1) "#1=#(#1#)")) (let ((l1 (cons 0 ()))) (set-cdr! l1 l1) (test (list->vector l1) 'error)) (let ((lst (list "nothing" "can" "go" "wrong"))) (let ((slst (cddr lst)) (result ())) (set! (cdr (cdddr lst)) slst) (test (do ((i 0 (+ i 1)) (l lst (cdr l))) ((or (null? l) (= i 12)) (reverse result)) (set! result (cons (car l) result))) '("nothing" "can" "go" "wrong" "go" "wrong" "go" "wrong" "go" "wrong" "go" "wrong")))) #| ;;; here is a circular function (let () (define (cfunc) (begin (display "cfunc! ") #f)) (let ((clst (procedure-source cfunc))) (set! (cdr (cdr (car (cdr (cdr clst))))) (cdr (car (cdr (cdr clst)))))) (cfunc)) |# (test (let ((l (list 1 2))) (list-set! l 0 l) (string=? (object->string l) "#1=(#1# 2)")) #t) (test (let ((lst (list 1))) (set! (car lst) lst) (set! (cdr lst) lst) (string=? (object->string lst) "#1=(#1# . #1#)")) #t) (test (let ((lst (list 1))) (set! (car lst) lst) (set! (cdr lst) lst) (equal? (car lst) (cdr lst))) #t) (test (let ((lst (cons 1 2))) (set-cdr! lst lst) (string=? (object->string lst) "#1=(1 . #1#)")) #t) (test (let ((lst (cons 1 2))) (set-car! lst lst) (string=? (object->string lst) "#1=(#1# . 2)")) #t) (test (let ((lst (cons (cons 1 2) 3))) (set-car! (car lst) lst) (string=? (object->string lst) "#1=((#1# . 2) . 3)")) #t) (test (let ((v (vector 1 2))) (vector-set! v 0 v) (string=? (object->string v) "#1=#(#1# 2)")) #t) (test (let* ((l1 (list 1 2)) (l2 (list l1))) (list-set! l1 0 l1) (string=? (object->string l2) "(#1=(#1# 2))")) #t) (test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) lst) (object->string lst)) "#1=(1 2 3 . #1#)") (test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) (cdr lst)) (object->string lst)) "(1 . #1=(2 3 . #1#))") (test (let ((lst (list 1 2 3))) (set! (cdr (cdr (cdr lst))) (cdr (cdr lst))) (object->string lst)) "(1 2 . #1=(3 . #1#))") (test (let ((lst (list 1 2 3))) (set! (car lst) (cdr lst)) (object->string lst)) "((2 3) 2 3)") ; was "(#1=(2 3) . #1#)" (test (let ((lst (list 1 2 3))) (set! (car (cdr lst)) (cdr lst)) (object->string lst)) "(1 . #1=(#1# 3))") (test (let ((lst (list 1 2 3))) (set! (car (cdr lst)) lst) (object->string lst)) "#1=(1 #1# 3)") (test (let ((l1 (list 1))) (let ((l2 (list l1 l1))) (object->string l2))) "((1) (1))") ; was "(#1=(1) #1#)" (let ((v (vector #f))) (vector-set! v 0 v) (test (with-output-to-string (lambda () (display v) (newline) (display (subvector v 0 1)) (newline))) "#1=#(#1#)\n#(#1=#(#1#))\n")) (let ((v (make-vector '(2 2) #f))) (fill! v v) (test (with-output-to-string (lambda () (display v) (newline) (display (subvector v 0 4)) (newline))) "#1=#2d((#1# #1#) (#1# #1#))\n#(#1=#2d((#1# #1#) (#1# #1#)) #1# #1# #1#)\n")) (test (let* ((v1 (vector 1 2)) (v2 (vector v1))) (vector-set! v1 1 v1) (string=? (object->string v2) "#(#1=#(1 #1#))")) #t) (test (let ((v1 (make-vector 3 1))) (vector-set! v1 0 (cons 3 v1)) (string=? (object->string v1) "#1=#((3 . #1#) 1 1)")) #t) (test (let ((h1 (make-hash-table 11)) (old-print-length (*s7* 'print-length))) (set! (*s7* 'print-length) 32) (hash-table-set! h1 "hi" h1) (let ((result (object->string h1))) (set! (*s7* 'print-length) old-print-length) (let ((val (string=? result "#1=(hash-table \"hi\" #1#)"))) (unless val (format #t ";hash display:~% ~A~%" result)) val))) #t) (test (let* ((l1 (list 1 2)) (v1 (vector 1 2)) (l2 (list 1 l1 2)) (v2 (vector l1 v1 l2))) (vector-set! v1 0 v2) (list-set! l1 1 l2) (string=? (object->string v2) "#2=#(#1=(1 #3=(1 #1# 2)) #(#2# 2) #3#)")) #t) (test (let ((l1 (list 1 2)) (l2 (list 1 2))) (set! (car l1) l2) (set! (car l2) l1) (object->string (list l1 l2))) "(#1=(#2=(#1# 2) 2) #2#)") (test (let* ((l1 (list 1 2)) (l2 (list 3 4)) (l3 (list 5 l1 6 l2 7))) (set! (cdr (cdr l1)) l1) (set! (cdr (cdr l2)) l2) (string=? (object->string l3) "(5 #1=(1 2 . #1#) 6 #2=(3 4 . #2#) 7)")) #t) (test (let* ((lst1 (list 1 2)) (lst2 (list (list (list 1 (list (list (list 2 (list (list (list 3 (list (list (list 4 lst1 5)))))))))))))) (set! (cdr (cdr lst1)) lst1) (string=? (object->string lst2) "(((1 (((2 (((3 (((4 #1=(1 2 . #1#) 5))))))))))))")) #t) (test (equal? '(a) (list 'a)) #t) (test (equal? '(a b . c) '(a b . c)) #t) (test (equal? '(a b (c . d)) '(a b (c . d))) #t) (test (equal? (list "hi" "hi" "hi") '("hi" "hi" "hi")) #t) (let ((l1 (list "hi" "hi" "hi")) (l2 (list "hi" "hi" "hi"))) (fill! l1 "ho") (test (equal? l1 l2) #f) (fill! l2 (car l1)) (test (equal? l1 l2) #t)) (let ((lst (list 1 2 3 4))) (fill! lst "hi") (test (equal? lst '("hi" "hi" "hi" "hi")) #t)) (let ((vect (vector 1 2 3 4))) (fill! vect "hi") (test (equal? vect #("hi" "hi" "hi" "hi")) #t)) (let ((lst (list 1 2 (list 3 4) (list (list 5) 6)))) (test (equal? lst '(1 2 (3 4) ((5) 6))) #t) (fill! lst #f) (test (equal? lst '(#f #f #f #f)) #t)) (let ((lst (list 1 2 3 4))) (set! (cdr (cdddr lst)) lst) (test (equal? lst lst) #t) (test (eq? lst lst) #t) (test (eqv? lst lst) #t) (fill! lst #f) (test (object->string lst) "#1=(#f #f #f #f . #1#)") (let ((l1 (copy lst))) (test (equal? lst l1) #t) (test (eq? lst l1) #f) (test (eqv? lst l1) #f))) (let ((lst '(#\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{ #\| #\} #\~))) (let ((str (apply string lst))) (let ((lstr (list->string lst))) (let ((strl (string->list str))) (test (eq? str str) #t) (test (eq? str lstr) #f) (test (eqv? str str) #t) (test (eqv? str lstr) #f) (test (equal? str lstr) #t) (test (equal? str str) #t) (test (eq? lst strl) #f) (test (eqv? lst strl) #f) (test (equal? lst strl) #t) (let ((l2 (copy lst)) (s2 (copy str))) (test (eq? l2 lst) #f) (test (eq? s2 str) #f) (test (eqv? l2 lst) #f) (test (eqv? s2 str) #f) (test (equal? l2 lst) #t) (test (equal? s2 str) #t)))))) (let ((vect #(#\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{ #\| #\} #\~))) (let ((lst (vector->list vect))) (let ((vect1 (list->vector lst))) (test (eq? lst lst) #t) (test (eq? lst vect) #f) (test (eqv? lst lst) #t) (test (eqv? lst vect) #f) (test (equal? vect1 vect) #t) (test (equal? lst lst) #t) (test (eq? vect vect1) #f) (test (eqv? vect vect1) #f) (test (equal? vect vect1) #t) (let ((l2 (copy vect)) (s2 (copy lst))) (test (eq? l2 vect) #f) (test (eq? s2 lst) #f) (test (eqv? l2 vect) #f) (test (eqv? s2 lst) #f) (test (equal? l2 vect) #t) (test (equal? s2 lst) #t))))) (let* ((vals (list "hi" #\A 1 'a #(1) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #\f '(1 . 2))) (vlen (length vals))) (define (fillv size vect) (do ((n 0 (+ n 1))) ((= n size)) (let ((choice (random 4)) (len (random 4))) (if (= choice 0) (let ((v (make-vector len))) (do ((k 0 (+ k 1))) ((= k len)) (vector-set! v k (list-ref vals (random vlen)))) (vector-set! vect n v)) (if (= choice 1) (let ((lst (make-list len #f))) (do ((k 0 (+ k 1))) ((= k len)) (list-set! lst k (list-ref vals (random vlen)))) (vector-set! vect n lst)) (vector-set! vect n (list-ref vals (random vlen)))))))) (do ((i 0 (+ i 1))) ((= i 20)) (let* ((size (max 1 (random 20))) (vect (make-vector size ()))) (fillv size vect) (test (eq? vect vect) #t) (test (eqv? vect vect) #t) (test (equal? vect vect) #t) (let ((lst1 (vector->list vect))) (let ((lst2 (copy lst1))) (test (eq? lst1 lst2) #f) (test (eqv? lst1 lst2) #f) (test (equal? lst1 lst2) #t)))))) (let* ((lst1 (list 1 2 3)) (vec1 (vector 1 2 lst1))) (list-set! lst1 2 vec1) (let* ((lst2 (list 1 2 3)) (vec2 (vector 1 2 lst2))) (list-set! lst2 2 vec2) (test (equal? lst1 lst2) #t) (test (equal? vec1 vec2) #t) (vector-set! vec1 1 vec1) (test (equal? lst1 lst2) #f) (test (equal? vec1 vec2) #f) )) (let* ((base (list #f)) (lst1 (list 1 2 3)) (vec1 (vector 1 2 base))) (list-set! lst1 2 vec1) (let* ((lst2 (list 1 2 3)) (vec2 (vector 1 2 base))) (list-set! lst2 2 vec2) (set! (car lst1) lst1) (set! (car lst2) lst2) (set! (cdr (cddr lst1)) base) (set! (cdr (cddr lst2)) base) (test (length (cyclic-sequences lst2)) 1) (test (equal? lst1 lst2) #t) (test (equal? vec1 vec2) #t) (test (object->string lst1) "#1=(#1# 2 #(1 2 (#f)) #f)"))) ; was "#1=(#1# 2 #(1 2 #2=(#f)) . #2#)" (let ((base (list 0 #f))) (let ((lst1 (list 1 base 2)) (lst2 (list 1 base 2))) (set! (cdr (cdr base)) base) (test (equal? lst1 lst2) #t))) (let ((base1 (list 0 #f)) (base2 (list 0 #f))) (let ((lst1 (list 1 base1 2)) (lst2 (list 1 base2 2))) (set! (cdr (cdr base1)) lst2) (set! (cdr (cdr base2)) lst1) (test (equal? lst1 lst2) #t) (test (object->string lst1) "#1=(1 (0 #f 1 (0 #f . #1#) 2) 2)"))) (let () (define-macro (c?r path) (define (X-marks-the-spot accessor tree) (if (eq? tree 'X) accessor (and (pair? tree) (or (X-marks-the-spot (cons 'car accessor) (car tree)) (X-marks-the-spot (cons 'cdr accessor) (cdr tree)))))) (let ((body 'lst)) (for-each (lambda (f) (set! body (list f body))) (reverse (X-marks-the-spot () path))) `(dilambda (lambda (lst) ,body) (lambda (lst val) (set! ,body val))))) (define (copy-tree lis) (if (pair? lis) (cons (copy-tree (car lis)) (copy-tree (cdr lis))) lis)) (let* ((l1 '(0 (1 (2 (3 (4 (5 (6 (7 (8)))))))))) (l2 (list 0 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 (list 7 (list 8)))))))))) (l3 (copy-tree l1)) (cxr (c?r (0 (1 (2 (3 (4 (5 (6 (7 (X)))))))))))) (set! (cxr l1) 3) (set! (cxr l2) 4) (test (equal? l1 l2) #f) (test (equal? l1 l3) #f) (set! (cxr l2) 3) (test (cxr l2) 3) (test (cxr l1) 3) (test (cxr l3) 8) (test (equal? l1 l2) #t) (test (equal? l2 l3) #f)) (let* ((l1 '(0 (1 (2 (3 (4 (5 (6 (7 (8)))))))))) (l2 (list 0 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 (list 7 (list 8)))))))))) (l3 (copy-tree l1)) (cxr (c?r (0 (1 (2 (3 (4 (5 (6 (7 (8 . X)))))))))))) (set! (cxr l1) l1) (set! (cxr l2) l2) (test (equal? l1 l2) #t) (test (equal? l1 l3) #f) (test (object->string l2) "#1=(0 (1 (2 (3 (4 (5 (6 (7 (8 . #1#)))))))))")) (let* ((l1 '(0 ((((((1)))))))) (l2 (copy-tree l1)) (cxr (c?r (0 ((((((1 . X)))))))))) (set! (cxr l1) l2) (set! (cxr l2) l1) (test (equal? l1 l2) #t)) (let* ((l1 '(0 1 (2 3) 4 5)) (cxr (c?r (0 1 (2 3 . X) 4 5)))) (set! (cxr l1) (cdr l1)) (test (object->string l1) "(0 . #1=(1 (2 3 . #1#) 4 5))")) (let* ((l1 '(0 1 (2 3) 4 5)) (l2 '(6 (7 8 9) 10)) (cxr1 (c?r (0 1 (2 3 . X) 4 5))) (cxr2 (c?r (6 . X))) (cxr3 (c?r (6 (7 8 9) 10 . X))) (cxr4 (c?r (0 . X)))) (set! (cxr1 l1) (cxr2 l2)) (set! (cxr3 l2) (cxr4 l1)) (test (object->string l1) "(0 . #1=(1 (2 3 (7 8 9) 10 . #1#) 4 5))") (test (cadr l1) 1) (test (cadddr l1) 4) ) (let ((l1 '((a . 2) (b . 3) (c . 4))) (cxr (c?r ((a . 2) (b . 3) (c . 4) . X)))) (set! (cxr l1) (cdr l1)) (test (assq 'a l1) '(a . 2)) (test (assv 'b l1) '(b . 3)) (test (assoc 'c l1) '(c . 4)) (test (object->string l1) "((a . 2) . #1=((b . 3) (c . 4) . #1#))") (test (assq 'asdf l1) #f) (test (assv 'asdf l1) #f) (test (assoc 'asdf l1) #f) ) (let ((l1 '(a b c d e)) (cxr (c?r (a b c d e . X)))) (set! (cxr l1) (cddr l1)) (test (memq 'b l1) (cdr l1)) (test (memv 'c l1) (cddr l1)) (test (member 'd l1) (cdddr l1)) (test (object->string l1) "(a b . #1=(c d e . #1#))") (test (memq 'asdf l1) #f) (test (memv 'asdf l1) #f) (test (member 'asdf l1) #f) (test (pair? (member 'd l1)) #t) ; #1=(d e c . #1#) ) (let ((x 0)) (let ((lst `(call-with-exit (lambda (return) (set! x (+ x 1)) (if (> x 10) (return x) 0))))) (let ((acc1 (c?r (call-with-exit (lambda (return) . X)))) (acc2 (c?r (call-with-exit (lambda (return) (set! x (+ x 1)) (if (> x 10) (return x) 0) . X))))) (set! (acc2 lst) (acc1 lst)) (test (eval lst (curlet)) 11)))) ) (let () ;; anonymous recursion... (define (fc?r path) (define (X-marks-the-spot accessor tree) (if (pair? tree) (or (X-marks-the-spot (cons 'car accessor) (car tree)) (X-marks-the-spot (cons 'cdr accessor) (cdr tree))) (if (eq? tree 'X) accessor #f))) (let ((body 'lst)) (for-each (lambda (f) (set! body (list f body))) (reverse (X-marks-the-spot () path))) (let ((getr (apply lambda '(lst) body ())) (setr (apply lambda '(lst val) `(set! ,body val) ()))) (dilambda getr setr)))) (let ((body '(if (not (pair? (cdr lst))) lst (begin (set! lst (cdr lst)) X)))) ; X is where we jump back to the start (let ((recurse (fc?r body))) (set! (recurse body) body) (test ((apply lambda '(lst) body ()) '(1 2 3)) '(3))))) (let ((v #2d((1 2) (3 4)))) (set! (v 1 0) v) (test (object->string v) "#1=#2d((1 2) (#1# 4))") (test (length v) 4) (test ((((v 1 0) 1 0) 1 0) 0 0) 1)) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (lst 100) 2) (test ((cdddr (cdddr (cdddr lst))) 100) 2) (set! (lst 100) 32) (test (object->string lst) "#1=(1 32 3 . #1#)")) (let* ((l1 (list 1 2)) (l2 (list l1 l1))) (set! (l1 0) 32) (test (equal? l2 '((32 2) (32 2))) #t)) (let ((q (list 1 2 3 4))) (set! (cdr (cdddr q)) q) (test (car q) 1) (set! (car q) 5) (set! q (cdr q)) (test (car q) 2) (test (object->string q) "#1=(2 3 4 5 . #1#)")) (let () (define make-node vector) (define prev (dilambda (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val)))) (define next (dilambda (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val)))) (define data (dilambda (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val)))) (let* ((head (make-node () 0 ())) (cur head)) (do ((i 1 (+ i 1))) ((= i 8)) (let ((next-node (make-node cur i ()))) (set! (next cur) next-node) (set! cur (next cur)))) (set! (next cur) head) (set! (prev head) cur) (test (object->string head) "#1=#(#7=#(#6=#(#5=#(#4=#(#3=#(#2=#(#8=#(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #1#) 0 #8#)") #| ;; in CL: (let* ((head (vector nil 0 nil)) (cur head)) (do ((i 1 (+ i 1))) ((= i 8)) (let ((node (vector nil i nil))) (setf (aref node 0) cur) (setf (aref cur 2) node) (setf cur node))) (setf (aref head 0) cur) (setf (aref cur 2) head) (format t "~A~%" head)) -> "#1=#(#2=#(#3=#(#4=#(#5=#(#6=#(#7=#(#8=#(#1# 1 #7#) 2 #6#) 3 #5#) 4 #4#) 5 #3#) 6 #2#) 7 #1#) 0 #8#)" |# (let ((ahead (do ((cur head (next cur)) (dat () (cons (data cur) dat))) ((member (data cur) dat) (reverse dat))))) (let ((behind (do ((cur (prev head) (prev cur)) (dat () (cons (data cur) dat))) ((member (data cur) dat) dat)))) (test (equal? ahead behind) #t))))) (let () (define make-node list) (define prev (dilambda (lambda (node) (node 0)) (lambda (node val) (set! (node 0) val)))) (define next (dilambda (lambda (node) (node 2)) (lambda (node val) (set! (node 2) val)))) (define data (dilambda (lambda (node) (node 1)) (lambda (node val) (set! (node 1) val)))) (let* ((head (make-node () 0 ())) (cur head)) (do ((i 1 (+ i 1))) ((= i 8)) (let ((next-node (make-node cur i ()))) (set! (next cur) next-node) (set! cur (next cur)))) (set! (next cur) head) (set! (prev head) cur) (test (object->string head) "#1=(#7=(#6=(#5=(#4=(#3=(#2=(#8=(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #1#) 0 #8#)") (let ((ahead (do ((cur head (next cur)) (dat () (cons (data cur) dat))) ((member (data cur) dat) (reverse dat))))) (let ((behind (do ((cur (prev head) (prev cur)) (dat () (cons (data cur) dat))) ((member (data cur) dat) dat)))) (test (equal? ahead behind) #t)))) (let* ((head (make-node () 0 ())) (cur head)) (do ((i 1 (+ i 1))) ((= i 32)) (let ((next-node (make-node cur i ()))) (set! (next cur) next-node) (set! cur (next cur)))) (set! (next cur) head) (set! (prev head) cur) (let-temporarily (((*s7* 'print-length) 128)) (test (object->string head) "#1=(#31=(#30=(#29=(#28=(#27=(#26=(#25=(#24=(#23=(#22=(#21=(#20=(#19=(#18=(#17=(#16=(#15=(#14=(#13=(#12=(#11=(#10=(#9=(#8=(#7=(#6=(#5=(#4=(#3=(#2=(#32=(#1# 1 #2#) 2 #3#) 3 #4#) 4 #5#) 5 #6#) 6 #7#) 7 #8#) 8 #9#) 9 #10#) 10 #11#) 11 #12#) 12 #13#) 13 #14#) 14 #15#) 15 #16#) 16 #17#) 17 #18#) 18 #19#) 19 #20#) 20 #21#) 21 #22#) 22 #23#) 23 #24#) 24 #25#) 25 #26#) 26 #27#) 27 #28#) 28 #29#) 29 #30#) 30 #31#) 31 #1#) 0 #32#)")))) (let ((x (list '+ 1))) (set-cdr! (cdr x) x) (do ((i 0 (+ i 1))) ((= i 6)) (set! x (cons x x))) (test (object->string x) "(#6=(#5=(#4=(#3=(#2=(#1=(+ 1 . #1#) . #1#) . #2#) . #3#) . #4#) . #5#) . #6#)")) (test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (append lst lst ())) 'error) (test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (object->string (append (list lst) (list lst) ()))) "(#1=(1 2 3 . #1#) #1#)") (let ((ht (make-hash-table 3))) (set! (ht "hi") ht) (test (object->string ht) "#1=(hash-table \"hi\" #1#)") (test (equal? (ht "hi") ht) #t)) (let ((l1 '(0)) (l2 '(0))) (set! (car l1) l1) (set! (cdr l1) l1) (set! (car l2) l2) (set! (cdr l2) l2) (test (object->string l1) "#1=(#1# . #1#)") (test (equal? l1 l2) #t) (set! (cdr l1) l2) (test (object->string l1) "#1=(#1# . #2=(#2# . #2#))") (test (equal? l1 l2) #t) (set! (cdr l1) ()) (test (equal? l1 l2) #f)) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (map (lambda (a b) (+ a b)) (list 4 5 6) lst) '(5 7 9))) (test (let ((lst (list 1 2 3)) (result ())) (set! (cdr (cddr lst)) lst) (for-each (lambda (a b) (set! result (cons (+ a b) result))) (list 4 5 6) lst) result) '(9 7 5)) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (map (lambda (a b) (+ a b)) (vector 4 5 6) lst) '(5 7 9))) (test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (map (lambda (a b) (+ a b)) (vector 4 5 6 7 8 9 10) lst)) '(5 7 9 8)) ; this now quits when it sees the cycle (test (map (lambda (a) a) '(0 1 2 . 3)) '(0 1 2)) (test (let ((ctr 0)) (for-each (lambda (a) (set! ctr (+ ctr a))) '(1 2 . 3)) ctr) 3) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (map (lambda (a b) (+ a b)) () lst) ())) (test (let ((lst (list 1 2 3)) (ctr 0)) (set! (cdr (cddr lst)) lst) (for-each (lambda (a b) (set! ctr (+ ctr (+ a b)))) lst ()) ctr) 0) (test (let ((lst (list 1))) (set! (cdr lst) (car lst)) (object->string lst)) "(1 . 1)") (test (let ((lst (list 1))) (set! (car lst) (cdr lst)) (object->string lst)) "(())") (let ((ctr 0) (lst `(let ((x 3)) (set! ctr (+ ctr 1)) (set! (cdr (cddr lst)) `((+ x ctr))) (+ x 1)))) (test (eval lst) 4) (test (eval lst) 5) (test (eval lst) 6)) (when (= (*s7* 'debug) 0) ; fact assumes below that procedure-source is unaltered (let () (define fact ; Reini Urban, http://autocad.xarch.at/lisp/self-mod.lsp.txt (let ((old ()) (result ())) (define (last lst) (list-tail lst (- (length lst) 1))) (define (butlast lis) (let ((len (length lis))) (if (<= len 1) () (let ((result ())) (do ((i 0 (+ i 1)) (lst lis (cdr lst))) ((= i (- len 1)) (reverse result)) (set! result (cons (car lst) result))))))) (lambda (n) (cond ((zero? n) 1) (#t (set! old (procedure-source fact)) (set! fact (apply lambda '(n) `((cond ,@(butlast (cdr (car (cdr (cdr old))))) ((= n ,n) ,(let () (set! result (* n (fact (- n 1)))) result)) ,@(last (cdr (car (cdr (cdr old))))))))) result))))) (test (fact 3) 6) (test (fact 5) 120) (test (fact 2) 2))) (test (let ((f #f)) (set! f (lambda () (let* ((code (procedure-source f)) (pos (- (length code) 1))) (set! (code pos) (+ (code pos) 1))) 1)) (f) (f) (f)) 4) (let* ((x (list 1 2 3)) ; from Lambda the Ultimate I think -- I lost the reference (y (list 4 5)) (z (cons (car x) (cdr y))) (w (append y z)) (v (cons (cdr x) (cdr y)))) (set-car! x 6) (set-car! y 7) (set-cdr! (cdr x) (list 8)) (test (object->string (list x y z w v)) "((6 2 8) (7 5) (1 5) (4 5 1 5) ((2 8) 5))")) ;; was "((6 . #3=(2 8)) (7 . #1=(5)) #2=(1 . #1#) (4 5 . #2#) (#3# . #1#))" ;; circular eval (test (let ((e (list (list '+ 1)))) (set-cdr! (car e) e) (eval e)) 'error) (test (let ((e (list (list '+ 1 2)))) (set-cdr! (cdar e) e) (eval e)) 'error) (test (let ((e (list (list '+ 1 2) 3))) (set-cdr! (cdar e) e) (eval e)) 'error) (test (let ((e (list (list '+ 1) 3 4))) (set-cdr! (cdar e) e) (eval e)) 'error) (test (let ((x '(1 2 3))) (set! (x 0) (cons x 2)) (eval (list-values 'let () (list-values 'define '(f1) (list-values 'list-set! x 0 (list-values 'cons x 2))) '(catch #t f1 (lambda a 'error))))) 'error) (test (let ((x '(car (list 1 2 3)))) (set! (x 0) x) (eval (list-values 'let () (list-values 'define '(f1) x) '(catch #t f1 (lambda a 'error))))) 'error) #| (define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below "(for-each-permutation func vals) applies func to every permutation of vals" ;; (for-each-permutation (lambda args (format #t "~{~A~^ ~}~%" args)) '(1 2 3)) (define (pinner cur nvals len) (if (= len 1) (apply func (cons (car nvals) cur)) (do ((i 0 (+ i 1))) ; I suppose a named let would be more Schemish ((= i len)) (let ((start nvals)) (set! nvals (cdr nvals)) (let ((cur1 (cons (car nvals) cur))) ; add (car nvals) to our arg list (set! (cdr start) (cdr nvals)) ; splice out that element and (pinner cur1 (cdr start) (- len 1)) ; pass a smaller circle on down (set! (cdr start) nvals)))))) ; restore original circle (let ((len (length vals))) (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle (pinner () vals len) (set-cdr! (list-tail vals (- len 1)) ()))) ; restore its original shape ;; a slightly faster version (avoids consing and some recursion) (define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below "(for-each-permutation func vals) applies func to every permutation of vals" ;; (for-each-permutation (lambda args (format #t "~A~%" args)) '(1 2 3)) (let ((cur (make-list (length vals)))) (define (pinner nvals len) (if (= len 2) (begin (set! (cur 0) (car nvals)) (set! (cur 1) (cadr nvals)) (apply func cur) (set! (cur 1) (car nvals)) (set! (cur 0) (cadr nvals)) (apply func cur)) (do ((i 0 (+ i 1))) ((= i len)) (let ((start nvals)) (set! nvals (cdr nvals)) (set! (cur (- len 1)) (car nvals)) (set! (cdr start) (cdr nvals)) ; splice out that element and (pinner (cdr start) (- len 1)) ; pass a smaller circle on down (set! (cdr start) nvals))))) ; restore original circle (let ((len (length vals))) (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle (pinner vals len) (set-cdr! (list-tail vals (- len 1)) ())))) ; restore its original shape |# ;; and continuing down that line... (define (for-each-permutation func vals) ; for-each-combination -- use for-each-subset below "(for-each-permutation func vals) applies func to every permutation of vals" ;; (for-each-permutation (lambda args (format #t "~A~%" args)) '(1 2 3)) (let ((cur (make-list (length vals)))) (define (pinner nvals len) (if (= len 3) (let ((a0 (car nvals)) (a1 (cadr nvals)) (a2 (caddr nvals)) (c1 (cdr cur)) (c2 (cddr cur))) (set-car! cur a2) (set-car! c1 a0) (set-car! c2 a1) (apply func cur) (set-car! cur a0) (set-car! c1 a2) ;(set-car! c2 a1) (apply func cur) ;(set-car! cur a0) (set-car! c1 a1) (set-car! c2 a2) (apply func cur) (set-car! cur a1) (set-car! c1 a0) ;(set-car! c2 a2) (apply func cur) ;(set-car! cur a1) (set-car! c1 a2) (set-car! c2 a0) (apply func cur) (set-car! cur a2) (set-car! c1 a1) ;(set-car! c2 a0) (apply func cur) ) (do ((i 0 (+ i 1))) ((= i len)) (let ((start nvals)) (set! nvals (cdr nvals)) (list-set! cur (- len 1) (car nvals)) (set-cdr! start (cdr nvals)) ; splice out that element and (pinner (cdr start) (- len 1)) ; pass a smaller circle on down (set-cdr! start nvals))))) ; restore original circle (let ((len (length vals))) (if (< len 2) (apply func vals) (if (= len 2) (let ((c1 (cdr cur))) (set-car! cur (car vals)) (set-car! c1 (cadr vals)) (apply func cur) (set-car! c1 (car vals)) (set-car! cur (cadr vals)) (apply func cur)) (begin (set-cdr! (list-tail vals (- len 1)) vals) ; make vals into a circle (pinner vals len) (set-cdr! (list-tail vals (- len 1)) ()))))))) ; restore its original shape #| ;; much slower: (define (for-each-permutation func vals) (define (heap-permutation size n) (if (= size 1) (apply func vals) (do ((i 0 (+ i 1))) ((= i size)) (heap-permutation (- size 1) n) (if (odd? size) (let ((temp (vals 0))) (set! (vals 0) (vals (- size 1))) (set! (vals (- size 1)) temp)) (let ((temp (vals i))) (set! (vals i) (vals (- size 1))) (set! (vals (- size 1)) temp)))))) (heap-permutation (length vals) (length vals))) |# (when full-s7test (let() (define ops '(+ *)) (define args '(1 pi 1+i 2/3 x y)) (define (listify lst) ((if (memq (car lst) ops) list (if (null? (cdr lst)) append values)) (if (null? (cdr lst)) (car lst) (values (car lst) (listify (cdr lst)))))) (call-with-output-file "t923.scm" (lambda (p) (format p "(define t923-old-eps (*s7* 'equivalent-float-epsilon))~%(set! (*s7* 'equivalent-float-epsilon) 1e-13)~%~%") ;; 1e-15 here depends on add_p_ppp order -- it needs to mimic g_add, (+ (+ x y) z), else limit needs to be 1e-14 not 1e-15 (let ((fctr 0)) (for-each-permutation (lambda lst (let ((expr (list (listify lst)))) (format p "(define (f~D x y) ~{~^~S ~})~%" fctr expr) (format p "(let ((e1 (f~D 3 4)))~%" fctr) (format p " (let ((e2 (let ((x 3) (y 4)) ~{~^~S ~})))~%" expr) (format p " (unless (equivalent? e1 e2)~% (format *stderr* \"16151 ~{~^~S ~}: ~~A ~~A~~%\" e1 e2))))~%~%" expr)) (set! fctr (+ fctr 1))) (append ops args))) (format p "(set! (*s7* 'equivalent-float-epsilon) t923-old-eps)~%"))) (load "t923.scm"))) ;; t224 also applies this to +/* (let ((perms '((3 1 2) (1 3 2) (1 2 3) (2 1 3) (2 3 1) (3 2 1))) (pos ())) (for-each-permutation (lambda args (call-with-exit (lambda (ok) (let ((ctr 0)) (for-each (lambda (a) (if (equal? a args) (begin (set! pos (cons ctr pos)) (ok))) (set! ctr (+ ctr 1))) perms))))) '(1 2 3)) (test pos '(5 4 3 2 1 0))) (test (let ((v1 (make-vector 16 0)) (v2 (make-vector 16 0))) (set! (v2 12) v2) (set! (v1 12) v1) (equal? v1 v2)) ; hmmm -- not sure this is correct #t) (test (let ((lst1 (list 1)) (lst2 (list 1))) (set-cdr! lst1 lst1) (set-cdr! lst2 lst2) (equal? lst1 lst2)) #t) (test (let ((hi 3)) (let ((e (curlet))) (set! hi (curlet)) (object->string e))) "#1=(inlet 'hi #2=(inlet 'e #1#))") ; was "#1=(inlet 'hi (inlet 'e #1#))") (let ((e (inlet 'a 0 'b 1))) (let ((e1 (inlet 'a e))) (set! (e 'b) e1) (test (equal? e (copy e)) #t) (test (object->string e) "#1=(inlet 'a 0 'b (inlet 'a #1#))"))) ;; eval circles -- there are many more of these that will cause stack overflow (test (let ((x '(1 2 3))) (set! (x 0) (cons x 2)) (eval `(let () (define (f1) (list-set! ,x 0 (cons ,x 2))) (catch #t f1 (lambda a 'error))))) 'error) (test (let ((x '(car (list 1 2 3)))) (set! (x 0) x) (eval `(let () (define (f1) ,x) (catch #t f1 (lambda a 'error))))) 'error) (test (apply + (cons 1 2)) 'error) (test (let ((L (list 0))) (set-cdr! L L) (apply + L)) 'error) (test (let ((L (list 0))) (set-cdr! L L) (format #f "(~S~{~^ ~S~})~%" '+ L)) "(+ 0)\n") ; 28-Nov-18 (test (apply + (list (let ((L (list 0 1))) (set-cdr! L L) L))) 'error) (test (apply + (let ((L (list 0 1))) (set-cdr! L L) L)) 'error) (test (length (let ((E (inlet 'value 0))) (varlet E 'self E))) 2) ;(test (apply case 2 (list (let ((L (list (list 0 1)))) (set-cdr! L L) L))) 'error) ;(test (apply cond (list (let ((L (list 0 1))) (set-cdr! L L) L))) 'error) ;(test (apply quote (let ((L (list 0 1))) (set-car! L L) L)) 'error) ;(test (apply letrec (hash-table) (let ((L (list 0 1))) (set-car! L L) L)) 'error) ;I now think the caller should check for these, not s7 ;;; -------------------------------------------------------------------------------- ;;; HOOKS ;;; make-hook ;;; hook-functions ;;; -------------------------------------------------------------------------------- (let-temporarily (((hook-functions *error-hook*) ()) ((hook-functions *load-hook*) ()) ((hook-functions *unbound-variable-hook*) ()) ((hook-functions *missing-close-paren-hook*) ())) (for-each (lambda (arg) (test (set! *unbound-variable-hook* arg) 'error) (test (set! *missing-close-paren-hook* arg) 'error) (test (set! *load-hook* arg) 'error) (test (set! (hook-functions *unbound-variable-hook*) arg) 'error) (test (set! (hook-functions *missing-close-paren-hook*) arg) 'error) (test (set! (hook-functions *error-hook*) arg) 'error) (test (set! (hook-functions *load-hook*) arg) 'error) (test (set! (hook-functions *unbound-variable-hook*) (list arg)) 'error) (test (set! (hook-functions *missing-close-paren-hook*) (list arg)) 'error) (test (set! (hook-functions *error-hook*) (list arg)) 'error) (test (set! (hook-functions *load-hook*) (list arg)) 'error)) (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi # #(1 2 3) #(()) "hi" '(1 . 2) '(1 2 3)))) (test (hook-functions (lambda () 1)) ()) (test (hook-functions) 'error) (let ((h (make-hook 'x))) (for-each (lambda (arg) (test (set! (hook-functions h) arg) 'error)) (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi # #(1 2 3) #(()) "hi" '(1 . 2) '(1 2 3)))) (let ((hook-val #f)) (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! hook-val (hook 'variable)) (set! (hook 'result) 123))))) (let ((val (catch #t (lambda () (+ 1 one-two-three)) (lambda args (apply format *stderr* (cadr args)) 'error)))) (test val 124)) (test (equal? one-two-three 123) #t) (test (equal? hook-val 'one-two-three) #t))) (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32))))) (let ((val (+ 1 _an_undefined_variable_i_hope_))) (test val 33)) (let ((val (+ 1 _an_undefined_variable_i_hope_))) (test (call/cc (lambda (_a_) (_a_ val))) 33)) (let ((val (* _an_undefined_variable_i_hope_ _an_undefined_variable_i_hope_))) (test val 1024))) (let ((x #f)) (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! x 0) (set! (hook 'result) #)) (lambda (hook) (set! (hook 'result) 32)) (lambda (hook) (if (not (number? (hook 'result))) (format *stderr* "oops -- *unbound-variable-hook* func called incorrectly~%")))))) (let ((val (+ 1 _an_undefined_variable_i_hope_))) (test val 33)) (test x 0) (test (+ 1 _an_undefined_variable_i_hope_) 33))) (define (-a-rootlet-entry- x) (- x (abs x))) (define -a-rootlet-entry-value- #f) (define old-r-hook (hook-functions *rootlet-redefinition-hook*)) (set! (hook-functions *rootlet-redefinition-hook*) (list (lambda (hook) (set! -a-rootlet-entry-value- (hook 'value))))) (define (-a-rootlet-entry- x) (+ x (abs x))) (unless (and (procedure? -a-rootlet-entry-value-) (equal? (procedure-source -a-rootlet-entry-value-) (if (positive? (*s7* 'debug)) '(lambda (x) (trace-in (curlet)) (+ x (abs x))) '(lambda (x) (+ x (abs x)))))) (format *stderr* "rootlet redef: ~W~%" -a-rootlet-entry-value-)) (set! (hook-functions *rootlet-redefinition-hook*) old-r-hook) ;;; optimizer bug involving unbound variable (let () (define (opt1) (let ((val (let () (define (hi x y) (let ((m (memq x y)) (loc (and m (- x (length m))))) loc)) (hi 'a '(a b c))))) (format #t "~A: opt1 got ~S but expected 'error~%~%" (port-line-number) val))) (catch #t opt1 (lambda (type info) (if (not (eq? type 'unbound-variable)) (format *stderr* "opt1 type: ~A, info: ~A~%" type info)) 'error))) (let () (define (opt2) (let ((val (let () (define (hi x y) (let* ((n (memq x y)) (loc (and m (- x (length m)))) (m (+ n 1))) loc)) (hi 'a '(a b c))))) (format #t "~A: opt2 got ~S but expected 'error~%~%" (port-line-number) val))) (catch #t opt2 (lambda (type info) (if (not (eq? type 'unbound-variable)) (format *stderr* "opt2 type: ~A, info: ~A~%" type info)) 'error))) (let () (define (opt3) (let ((val (let () (define (hi x y) (do ((m (memq x y) 0) (loc (and m (- x (length m))) 0)) (loc #t))) (hi 'a '(a b c))))) (format #t "~A: opt3 got ~S but expected 'error~%~%" (port-line-number) val))) (catch #t opt3 (lambda (type info) (if (not (eq? type 'unbound-variable)) (format *stderr* "opt3 type: ~A, info: ~A~%" type info)) 'error))) (let () (define (opt4) (let () (define (hi x y) (letrec ((m (memq x y)) (loc (and m (length m)))) loc)) (hi 'a '(a b c)))) (catch #t opt4 (lambda (type info) 'error))) (let () (define (opt5) (let ((val (let () (define (hi x y) (letrec* ((n (memq x y)) (loc (and m (- x (length m)))) (m (+ n 1))) loc)) (hi 'a '(a b c))))) (format #t "~A: opt5 got ~S but expected 'error~%~%" (port-line-number) val))) (catch #t opt5 (lambda (type info) 'error))) (let () (define (opt6) (let ((val (let () (define (hi x) (let ((m (memq n x)) (loc (and m (- x (length m))))) (define n 1) loc)) (hi '(a b c))))) (format #t "~A: opt6 got ~S but expected 'error~%~%" (port-line-number) val))) (catch #t opt6 (lambda (type info) (if (not (eq? type 'unbound-variable)) (format *stderr* "opt6 type: ~A, info: ~A~%" type info)) 'error))) (let () (define (opt7) (let ((val (let () (define* (f1 (a (+ m 1)) (m (+ a 1))) (+ a m)) (f1)))) (format #t "~A: opt7 got ~S but expected 'error~%~%" (port-line-number) val))) (catch #t opt7 (lambda (type info) 'error))) (let () (define (opt8) (let ((val (let () (let ((x 1)) (set! x (+ m 1)) (define m 2) x)))) (format #t "~A: opt8 got ~S but expected 'error~%~%" (port-line-number) val))) (catch #t opt8 (lambda (type info) (if (not (eq? type 'unbound-variable)) (format *stderr* "opt8 type: ~A, info: ~A~%" type info)) 'error))) (let () (define (opt9) (let ((val (let () (let ((x 1)) (set! x (and m (length m))) (define m 2) x)))) (format #t "~A: opt9 got ~S but expected 'error~%~%" (port-line-number) val))) (catch #t opt9 (lambda (type info) (if (not (eq? type 'unbound-variable)) (format *stderr* "opt9 type: ~A, info: ~A~%" type info)) 'error))) (let () (define (opt10) (let () (define* (f1 (a (and m (length m))) (m 1)) (+ a m)) (f1))) ; but not unbound var error! isn't this a bug? (catch #t opt10 (lambda (type info) 'error))) (let () (define (makel depth) (if (= depth 10) (list depth) (set! ___lst (list (makel (+ depth 1)))))) (test (makel 0) 'error)) (let ((val #f)) (let-temporarily (((hook-functions *load-hook*) (list (lambda (hook) (if (or val (defined? 'load-hook-test)) (format #t ";*load-hook*: ~A ~A?~%" val load-hook-test)) (set! val (hook 'name)))))) (with-output-to-file "load-hook-test.scm" (lambda () (format #t "(define (load-hook-test val) (+ val 1))"))) (load "load-hook-test.scm") (if (or (not (string? val)) (not (string=? val "load-hook-test.scm"))) (format #t ";*load-hook-test* file: ~S~%" val)) (if (not (defined? 'load-hook-test)) (format #t ";load-hook-test function not defined?~%") (if (not (= (load-hook-test 1) 2)) (format #t ";load-hook-test: ~A~%" (load-hook-test 1)))))) (let-temporarily (((hook-functions *error-hook*) ())) (test (hook-functions *error-hook*) ()) (set! (hook-functions *error-hook*) (list (lambda (hook) #f))) (test (list? (hook-functions *error-hook*)) #t)) (let-temporarily (((hook-functions *missing-close-paren-hook*) (list (lambda (h) (set! (h 'result) 'incomplete-expr))))) (test (catch #t (lambda () (eval-string "(+ 1 2")) (lambda args (car args))) 'incomplete-expr) (test (catch #t (lambda () (eval-string "(")) (lambda args (car args))) 'incomplete-expr) (test (catch #t (lambda () (eval-string "(abs ")) (lambda args (car args))) 'incomplete-expr)) (let ((h (make-hook 'x))) (test (procedure? h) #t) (test (eq? h h) #t) (test (eqv? h h) #t) (test (equal? h h) #t) (test (equivalent? h h) #t) (test (arity h) (cons 0 1)) (let ((h1 (copy h))) (test (eq? h h1) #f) ; fluctutates... (test (equivalent? h h1) #t)) (test (hook-functions h) ()) (test (h) #) (test (h 1) #) (test (h 1 2) 'error) (let ((f1 (lambda (hook) (set! (hook 'result) (hook 'x))))) (set! (hook-functions h) (list f1)) (test (member f1 (hook-functions h)) (list f1)) (test (hook-functions h) (list f1)) (test (h 1) 1) (set! (hook-functions h) ()) (test (hook-functions h) ()) (let ((f2 (lambda* args (set! ((car args) 'result) ((car args) 'x))))) (set! (hook-functions h) (list f2)) (test (hook-functions h) (list f2)) (test (h 1) 1))) (for-each (lambda (arg) (test (set! (hook-functions h) arg) 'error)) (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi # # #)) (set! (hook-functions h) (list (lambda (hk) (set! (hk 'result) (hk 'xyzzy))))) (test (h 123) #)) (let ((h (make-hook))) (test (procedure? h) #t) (test (documentation h) "") (test (hook-functions h) ()) (test (h) #) (test (arity h) (cons 0 0)) (test (h 1) 'error) (let ((f1 (lambda (hook) (set! (hook 'result) 123)))) (set! (hook-functions h) (list f1)) (test (member f1 (hook-functions h)) (list f1)) (test (hook-functions h) (list f1)) (test (h) 123) (set! (hook-functions h) ()) (test (hook-functions h) ()) (let ((f2 (lambda* args (set! ((car args) 'result) 321)))) (set! (hook-functions h) (list f2)) (test (hook-functions h) (list f2)) (test (h) 321)))) (let ((h (make-hook '(a 32) 'b))) (test (procedure? h) #t) (test (hook-functions h) ()) (test (arity h) (cons 0 2)) (test (h) #) (test (h 1) #) (test (h 1 2) #) (test (h 1 2 3) 'error) (let ((f1 (lambda (hook) (set! (hook 'result) (+ (hook 'a) (or (hook 'b) 0)))))) (set! (hook-functions h) (list f1)) (test (member f1 (hook-functions h)) (list f1)) (test (hook-functions h) (list f1)) (test (h) 32) (test (h 1) 1) (test (h 1 2) 3) (set! (hook-functions h) ()) (test (hook-functions h) ()))) (let ((hk (make-hook 'x))) ; test closure_setter restoration using a hook (define (func) (map hk (list 0 6))) (set! (setter hk) (lambda (x) x)) (test (procedure? (setter hk)) #t) (func) (test (procedure? (setter hk)) #t)) (test (let () (define h (make-hook 'x)) (set! (hook-functions h) (list (lambda (hk) (set! (hk 'result) (hk 'abs))))) (h 123)) #) ; new version of make-hook (let-temporarily (((*s7* 'safety) 1)) (test (format #f "~W" (make-hook (cons 'ho (list (values (list (let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>))))))) ; segfault if not checked "#")) (let () (for-each (lambda (arg) (test (make-hook arg) 'error)) (list "hi" #f 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi # # #))) (let ((h (make-hook))) (let ((f1 (lambda (hook) (if (number? (hook 'result)) (set! (hook 'result) (+ (hook 'result) 1)) (set! (hook 'result) 0))))) (test (h) #) (set! (hook-functions h) (list f1)) (test (h) 0) (set! (hook-functions h) (list f1 f1 f1)) (test (h) 2))) (if (not (defined? 'hook-push)) (define (hook-push hook func) (set! (hook-functions hook) (cons func (hook-functions hook))))) (let ((h (make-hook))) (hook-push h (lambda (hook) (set! (hook 'result) 32))) ; (test (dynamic-wind h h h) 32) (test (catch h h h) 32) ) (let ((h (make-hook 'x))) (hook-push h (lambda (hook) (set! (hook 'result) (hook 'x)))) (test (continuation? (call/cc h)) #t) (set! (hook-functions h) (list (lambda (hook) (set! (hook 'result) (+ 1 (hook 'x)))))) (test (map h '(1 2 3)) '(2 3 4)) ) (let () (define-macro (hook . body) `(let ((h (make-hook))) (set! (hook-functions h) (list (lambda (h) (set! (h 'result) (begin ,@body))))) h)) (let ((x 0)) (define hi (hook (set! x 32) (+ 2 3 1))) (test (hi) 6) (test x 32))) (let () (define-macro (hooked-catch hook . body) `(catch #t (lambda () ,@body) (lambda args (let ((val (apply ,hook args))) (if (eq? val #) ; hook did not do anything (apply error args) ; so re-raise the error val))))) (let ((a-hook (make-hook 'error-type :rest 'error-info))) (set! (hook-functions a-hook) (list (lambda (hook) ;(format #t "hooked-catch: ~A~%" (apply format #t (car (hook 'error-info)))) (set! (hook 'result) 32)))) (test (hooked-catch a-hook (abs "hi")) 32) (set! (hook-functions a-hook) ()) (test (catch #t (lambda () (hooked-catch a-hook (abs "hi"))) (lambda args 123)) 123) )) (when (provided? 'autoload) (let ((loaded #f)) (let-temporarily (((hook-functions *autoload-hook*) (list (lambda (h) (set! loaded (cons (h 'name) (h 'file))))))) (autoload 'pp "write.scm") (pp '(1 2)) (test loaded (cons 'pp "write.scm"))))) (let () (define *breaklet* #f) (define *step-hook* (make-hook 'code 'e)) (define-macro* (trace/break code . break-points) (define (caller tree) (if (pair? tree) (cons (if (pair? (car tree)) (if (and (symbol? (caar tree)) (procedure? (symbol->value (caar tree)))) (if (member (car tree) break-points) `(__break__ ,(caller (car tree))) `(__call__ ,(caller (car tree)))) (caller (car tree))) (car tree)) (caller (cdr tree))) tree)) `(call-with-exit (lambda (__top__) ,(caller code)))) (define (go . args) (and (let? *breaklet*) (apply (*breaklet* 'go) args))) (define (clear-break) (set! *breaklet* #f)) (define-macro (__call__ code) `(*step-hook* ',code (curlet))) (define-macro (__break__ code) `(begin (call/cc (lambda (go) (set! *breaklet* (curlet)) (__top__ (format #f "break at: ~A~%" ',code)))) ,code)) (set! (hook-functions *step-hook*) (list (lambda (hook) (set! (hook 'result) (eval (hook 'code) (hook 'e)))) (lambda (hook) (define (uncaller tree) (if (pair? tree) (cons (if (and (pair? (car tree)) (memq (caar tree) '(__call__ __break__))) (uncaller (cadar tree)) (uncaller (car tree))) (uncaller (cdr tree))) tree)) (format (current-output-port) ": ~A -> ~A~40T~A~%" (uncaller (hook 'code)) (hook 'result) (if (and (not (eq? (hook 'e) (rootlet))) (not (defined? '__top__ (hook 'e)))) (map values (hook 'e)) ""))))) (let ((str (with-output-to-string (lambda () (trace/break (let ((a (+ 3 1)) (b 2)) (if (> (* 2 a) b) 2 3))))))) (test (or (string-wi=? str ": (+ 3 1) -> 4 : (* 2 a) -> 8 ((a . 4) (b . 2)) : (> (* 2 a) b) -> #t ((a . 4) (b . 2)) ") (string-wi=? str ": (+ 3 1) -> 4 : (* 2 a) -> 8 ((b . 2) (a . 4)) : (> (* 2 a) b) -> #t ((b . 2) (a . 4)) ")) #t))) ;;; #_ stuff (test ((lambda () (if (#_round pi) #f))) #f) (test ((lambda () (when (#_round pi) #f))) #f) (test ((lambda () (#_cond (* 1)))) 1) (test (let () (define (f1) (abs (#_logand))) (f1)) 1) (test ((lambda () (abs (#_logand)))) 1) (test ((lambda () (abs (#_logand 2 3)))) 2) (test (call-with-exit (lambda (g) (abs (#_logand)))) 1) (test (let () (define (func) (append (#_begin (tree-cyclic?)))) (func)) 'error) (test (let () (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) (#_with-baffle (inlet (values 1 2) (symbol? x)))))) (func)) 'error) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (#_provide :readable))) (func)) #t) (test (pair? (let () (define (func) (list-values (#_quasiquote (odd?)) (let ((<1> (list 1 #f))) (set! (<1> 1) (let (( (list #f 3))) (set-car! <1>) )) <1>))) (func))) #t) (test (let () (define (hi) (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x)) (hi)) 44) (test (hook-functions *error-hook*) ()) (test (hook-functions *read-error-hook*) ()) (let () (define (reader-hooks h) (let ((type (h 'type)) (data (h 'data))) (if type (set! (h 'result) (case (data 0) ((#\T) (and (string=? data "T") ;(format #t "#T should be #t~%") #t)) ((#\F) (and (string=? data "F") ;(format #t "#F should be #f~%") ''#f))))))) (set! (hook-functions *read-error-hook*) (list reader-hooks)) (test (eval-string "#T") #t) (test (eval-string "(list #F)") '(#f)) (set! (hook-functions *read-error-hook*) ()) (let-temporarily (((hook-functions *read-error-hook*) (list reader-hooks))) (test (eval-string "#T") #t)) (test (hook-functions *read-error-hook*) ())) ;;; -------------------------------------------------------------------------------- ;;; HASH-TABLES ;;; -------------------------------------------------------------------------------- ;;; make-hash-table ;;; make-weak-hash-table ;;; hash-table ;;; weak-hash-table ;;; hash-table? ;;; weak-hash-table? ;;; hash-table-entries ;;; hash-table-ref ;;; hash-table-set! ;;; hash-code ;;; hash-table-key-typer ;;; hash-table-value-typer (let ((ht (make-hash-table))) (test (hash-table? ht) #t) (test (equal? ht ht) #t) (test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14) (test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14) (test (let () (hash-table-set! ht 123 "hiho") (hash-table-ref ht 123)) "hiho") (test (let () (hash-table-set! ht 3.14 "hi") (hash-table-ref ht 3.14)) "hi") (test (let () (hash-table-set! ht pi "hiho") (hash-table-ref ht pi)) "hiho") (test (hash-table-ref ht "123") #f) (let ((ht1 (copy ht))) (test (hash-table? ht1) #t) (test (iterator? ht1) #f) (test (iterator? (make-iterator ht1)) #t) (test (= (length ht) (length ht1)) #t) (test (equal? ht ht1) #t) (test (eq? ht ht) #t) (test (eqv? ht ht) #t) (set! (ht 'key) 32) (set! (ht1 'key) 123) (test (and (= (ht 'key) 32) (= (ht1 'key) 123)) #t) (set! (ht "key") 321) (test (ht "key") 321) (test (ht 'key) 32) (set! (ht 123) 43) (set! (ht "123") 45) (test (ht 123) 43) (test (ht "123") 45) (test (hash-table-set! ht "1" 1) 1) (test (set! (ht "2") 1) 1) (test (set! (hash-table-ref ht "3") 1) 1) (test (hash-table-ref ht "3") 1)) (test (let () (set! (hash-table-ref ht 'key) 32) (hash-table-ref ht 'key)) 32) (for-each (lambda (arg) (test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))) (for-each (lambda (arg) (test (hash-table-set! arg 'key 32) 'error)) (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (integer? (hash-code arg)) #t)) (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2) '(1 2) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) #f (lambda (a) (+ a 1)) (macro (a) `(+ ,a 1)) :hi (if #f #f) # #)) (for-each (lambda (arg) (test (hash-code 123 arg) 'error)) (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2) '(1 2) _ht_ quasiquote macroexpand 1/0 (log 0) #f (macro (a) `(+ ,a 1)) :hi (if #f #f) # #)) (test (hash-code) 'error) (unless with-bignums (test (hash-code (cosh 128)) 0) (test (hash-code 1.0e17) 0) (test (hash-code -1.0e17) 0)) (test (hash-code +nan.0) 0) (test (hash-code +inf.0) 0) (test (hash-code 1.0e15) 1000000000000000) (test (catch #t (lambda () (hash-table-ref (hash-table 'a 1) 'b 2)) (lambda (typ info) (apply format #f info))) "(hash-table-ref (hash-table 'a 1) 'b 2) becomes (#f 2), but #f can't take arguments") (test (catch #t (lambda () (let ((h (hash-table 'b 1))) (h 'a 'asdf))) (lambda (typ info) (apply format #f info))) "((hash-table 'b 1) 'a 'asdf) becomes (apply #f ...), but #f can't take arguments") (test (catch #t (lambda () (let ((h (hash-table 'a (hash-table 'b 1)))) (h 'a 'c 'd))) (lambda (typ info) (apply format #f info))) "((hash-table 'b 1) 'c 'd) becomes (#f 'd), but #f can't take arguments") (test (catch #t (lambda () (let ((h (hash-table))) (hash-table-ref h 'a 'asdf))) (lambda (typ info) (apply format #f info))) "(hash-table-ref (hash-table) 'a 'asdf) becomes (#f 'asdf), but #f can't take arguments") (test (catch #t (lambda () (let ((L (list 1))) (list-ref L 0 2))) (lambda (typ info) (apply format #f info))) "(list-ref (1) 0 2) becomes (1 2), but 1 can't take arguments") (test (catch #t (lambda () (let ((L (list 1))) (L 0 2))) (lambda (typ info) (apply format #f info))) "((1) 0 2) becomes (apply 1 ...), but 1 can't take arguments") (test (catch #t (lambda () (let ((L (list (list 0)))) (L 0 0 2))) (lambda (typ info) (apply format #f info))) "((0) 0 2) becomes (0 2), but 0 can't take arguments") (test (catch #t (lambda () (let ((V (vector 1 2))) (V 0 1))) (lambda (typ info) (apply format #f info))) "(#(1 2) 0 1) becomes (apply 1 ...), but 1 can't take arguments") (test (catch #t (lambda () (let ((V (vector 1 2))) (vector-ref V 0 1))) (lambda (typ info) (apply format #f info))) "(#(1 2) 0 1) becomes (apply 1 ...), but 1 can't take arguments") (test (catch #t (lambda () (let ((V (vector (vector 0 12)))) (V 0 1 0))) (lambda (typ info) (apply format #f info))) "(#(0 12) 1 0) becomes (apply 12 ...), but 12 can't take arguments") (test (catch #t (lambda () (let ((V (int-vector 1 2))) (V 0 1))) (lambda (typ info) (apply format #f info))) "vector-ref: too many indices: (0 1)") (test (catch #t (lambda () (let ((L (inlet))) (L 'a :asdf))) (lambda (typ info) (apply format #f info))) "((inlet) 'a :asdf) becomes (# :asdf), but # can't take arguments") (test (catch #t (lambda () (let ((L (inlet 'a (inlet 'b 1)))) (L 'a 'b 'c))) (lambda (typ info) (apply format #f info))) "((inlet 'b 1) 'b 'c) becomes (1 'c), but 1 can't take arguments") (test (catch #t (lambda () (let ((L (list 1))) (set! (L 0 2) 32))) (lambda (typ info) (apply format #f info))) "in (set! (L 0 2) 32), ((1) 0) is 1 which can't take arguments") (test (catch #t (lambda () (let ((L (list (list 0)))) (set! (L 0 0 2) 32))) (lambda (typ info) (apply format #f info))) "in (set! (L 0 0 2) 32), ((0) 0) is 0 which can't take arguments") (test (catch #t (lambda () (let ((h (hash-table 'b 1))) (set! (h 'a 'asdf) 32))) (lambda (typ info) (apply format #f info))) "in (set! (h 'a 'asdf) 32), 'a does not exist in (hash-table 'b 1)") (test (catch #t (lambda () (let ((h (hash-table 'b 1))) (set! (h 'b 'asdf) 32))) (lambda (typ info) (apply format #f info))) "in (set! (h 'b 'asdf) 32), ((hash-table 'b 1) 'b) is 1 which can't take arguments") (test (catch #t (lambda () (let ((h (hash-table 'a (hash-table 'b 1)))) (set! (h 'a 'c 'd) 32))) (lambda (typ info) (apply format #f info))) "in (set! (h 'a 'c 'd) 32), 'c does not exist in (hash-table 'b 1)") (test (catch #t (lambda () (let ((v (hash-table 'a (list 1 2)))) (set! (v 'a 1) 5))) (lambda (typ info) (apply format #f info))) 5) (test (catch #t (lambda () (let ((v (hash-table 'a (hash-table 'b 1)))) (set! (v 'a 'b 'b) 32) v)) (lambda (typ info) (apply format #f info))) "in (set! (v 'a 'b 'b) 32), ((hash-table 'b 1) 'b) is 1 which can't take arguments") (test (catch #t (lambda () (let ((L (inlet 'a (inlet 'b 1)))) (set! (L 'a 'b 'c) 32))) (lambda (typ info) (apply format #f info))) "in (set! (L 'a 'b 'c) 32), ((inlet 'b 1) 'b) is 1 which can't take arguments") (test (catch #t (lambda () (let ((L (inlet))) (set! (L 'a :asdf) 32))) (lambda (typ info) (apply format #f info))) "in (set! (L 'a :asdf) 32), ((inlet) 'a) is # which can't take arguments") (test (catch #t (lambda () (set! (abs 1) 2)) (lambda (typ info) (apply format #f info))) "abs (a c-function) does not have a setter: (set! (abs 1) 2)") (test (catch #t (lambda () (set! (when #t 3) 21) ) (lambda (type info) (apply format #f info))) "when (syntactic) does not have a setter: (set! (when #t 3) 21)") (test (catch #t (lambda () (call-with-exit (lambda (go) (set! (go 1) 2)))) (lambda (type info) (apply format #f info))) "go (a goto (from call-with-exit)) does not have a setter: (set! (go 1) 2)") (test (catch #t (lambda () (eval '(call/cc (lambda (go) (set! (go 1) 2))))) (lambda (type info) (apply format #f info))) "go (a continuation) does not have a setter: (set! (go 1) 2)") (test (catch #t (lambda () (let ((L (inlet))) (let-ref L 'a :asdf))) (lambda (type info) (apply format #f info))) "let-ref: too many arguments: (let-ref (inlet) a :asdf)") (test (catch #t (lambda () (let ((V (vector 1 2))) (set! (vector-ref V 0 1) 32))) (lambda (type info) (apply format #f info))) "too many arguments for vector-set!: (#(1 2) 0 1 32)") (test (catch #t (lambda () (let ((V (vector 1 2))) (vector-set! V 0 1 32))) (lambda (type info) (apply format #f info))) "too many arguments for vector-set!: (#(1 2) 0 1 32)") (test (catch #t (lambda () (let ((V (vector 1 2))) (set! (V 0 1) 32))) (lambda (type info) (apply format #f info))) "in (set! (V 0 1) 32), (#(1 2) 0) is 1 which can't take arguments") (test (catch #t (lambda () (set! (:asdf 3) 2)) (lambda (type info) (apply format #f info))) "in (set! (:asdf 3) 2), :asdf has no setter") (test (catch #t (lambda () (set! (_asdf_ 3) 3)) (lambda (type info) (apply format #f info))) "unbound variable _asdf_ in (set! (_asdf_ 3) 3)") (test (catch #t (lambda () (make-hash-table 8 eq? #t)) (lambda (type info) (apply format #f info))) "make-hash-table third argument, #t, is boolean but should be either #f or (cons key-type-check value-type-check)") (test (catch #t (lambda () (make-hash-table 8 eq? (cons integer? ()))) (lambda (type info) (apply format #f info))) "make-hash-table third argument, (integer?), is a pair but should be (key-type . value-type)") (test (catch #t (lambda () (make-hash-table 8 eq? (cons (lambda (x) x) integer?))) (lambda (type info) (apply format #f info))) "make-hash-table: in the third argument, (# . integer?), (the key/value type checkers) the first function is anonymous") (test (catch #t (lambda () (make-hash-table 8 eq? (cons integer? (lambda (x) x)))) (lambda (type info) (apply format #f info))) "make-hash-table: in the third argument, (integer? . #), (the key/value type checkers) the second function is anonymous") (test (catch #t (lambda () (make-hash-table 8 eq? (cons (lambda (a b) a) integer?))) (lambda (type info) (apply format #f info))) "make-hash-table: in the third argument, (# . integer?), (the key/value type checkers) both functions should take one argument") (test (catch #t (lambda () (make-hash-table 8 eq? (cons integer? (lambda (a b) a)))) (lambda (type info) (apply format #f info))) "make-hash-table: in the third argument, (integer? . #), (the key/value type checkers) both functions should take one argument") (test (catch #t (lambda () (make-hash-table 8 eq? (cons expt integer?))) (lambda (type info) (apply format #f info))) "make-hash-table: in the third argument, (expt . integer?), (the key/value type checkers) both functions should take one argument") (test (catch #t (lambda () (make-hash-table 8 eq? (cons integer? expt))) (lambda (type info) (apply format #f info))) "make-hash-table: in the third argument, (integer? . expt), (the key/value type checkers) both functions should take one argument") (test (catch #t (lambda () (make-hash-table 8 string=? (cons symbol? symbol?))) (lambda (type info) (apply format #f info))) "make-hash-table: in the third argument, the key type function is not compatible with the equality function: (symbol? . symbol?)") (define (hash-table-equalizer h) (let ((data (object->let h))) (and (defined? 'function data #t) (let-ref data 'function)))) (define (hash-table-key/value-types h) (let* ((data (object->let h)) (sig (and (defined? 'signature data #t) (let-ref data 'signature)))) (and (pair? sig) (list (caddr sig) (car sig))))) (test (hash-table-equalizer (make-hash-table 8 eq? (cons symbol? integer?))) 'eq?) (test (hash-table-key/value-types (make-hash-table 8 eq? (cons symbol? integer?))) '(symbol? integer?)) (test (let ((H (hash-table 'a (hash-table 'b 1)))) (apply H (list 'a 'b))) 1) (let ((ht1 (make-hash-table 31)) (ht2 (make-hash-table 31))) (if (not (equal? ht1 ht2)) (format #t ";ht1 and ht2 are empty, but not equal??~%")) ;; these first tests take advantage of s7's hashing function (hash-table-set! ht1 'abc 1) (hash-table-set! ht1 'abcabc 2) (hash-table-set! ht1 'abcabcabc 3) (hash-table-set! ht2 'abcabcabc 3) (hash-table-set! ht2 'abcabc 2) (hash-table-set! ht2 'abc 1) (if (not (equal? ht1 ht2)) (format #t ";ht1 and ht2 have the same key value pairs, but are not equal??~%")) (test (make-hash-table 1 (call-with-exit (lambda (goto) goto))) 'error) (test (make-hash-table 1 atan) 'error) (set! ht2 (make-hash-table 31)) (hash-table-set! ht2 'abc 1) (hash-table-set! ht2 'abcabc 2) (hash-table-set! ht2 'abcabcabc 3) (if (not (equal? ht1 ht2)) (format #t ";ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%")) (hash-table-set! ht2 'abc "1") (if (equal? ht1 ht2) (format #t ";ht1 and ht2 are equal but values are not~%")) (hash-table-set! ht2 'abc 1) (if (not (equal? ht1 ht2)) (format #t ";after reset ht1 and ht2 have the same key value pairs in the same order, but are not equal??~%")) (hash-table-set! ht2 1 'abc) (if (equal? ht1 ht2) (format #t ";ht1 and ht2 are equal but entries are not~%")) (hash-table-set! ht1 1 'abc) (if (not (equal? ht1 ht2)) (format #t ";after add ht1 and ht2 have the same key value pairs, but are not equal??~%")) ;; these should force chaining in any case (set! ht1 (make-hash-table 31)) (set! ht2 (make-hash-table 60)) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht1 i (* i 2)) (hash-table-set! ht2 i (* i 2))) (if (not (equal? ht1 ht2)) (format #t ";ht1 and ht2 have the same (integer) key value pairs in the same order, but are not equal??~%")) (let ((h1 (hash-table "a" 1)) (h2 (hash-table 'a 1))) (set! (h2 "a") 1) (set! (h2 'a) #f) test (equal? h1 h2) #t) (let ((ht (make-hash-table))) (set! (ht (expt 2 40)) 40) (set! (ht (expt 2 50)) 50) (set! (ht (- (expt 2 60))) -60) ; these all hash into 0 unfortunately -- maybe fold halves? (test (ht (expt 2 40)) 40) (test (ht (expt 2 50)) 50) (test (ht (expt 2 60)) #f) (test (ht (- (expt 2 60))) -60) (test (ht (expt 2 41)) #f)) (set! ht2 (make-hash-table 31)) (do ((i 99 (- i 1))) ((< i 0)) (hash-table-set! ht2 i (* i 2))) (test (hash-table-entries ht2) 100) (if (not (equal? ht1 ht2)) (format #t ";ht1 and ht2 have the same (integer) key value pairs, but are not equal??~%")) (fill! ht1 ()) (test (hash-table-entries ht1) 100) (test (ht1 32) ())) (let ((h (make-hash-table))) (test (hash-table-entries h) 0) (set! (h 'a) 1) (test (hash-table-entries h) 1) (set! (h 'a) #f) (test (hash-table-entries h) 0) (set! (h 'a) 'b) (test (h 'a) 'b)) (let () (define (f1) ; hash_table_entries_i_7p (let ((H (list (hash-table 'a 1 'b 2))) (sum 0) (size 3)) (do ((i 0 (+ i 1))) ((= i size) sum) (set! sum (+ sum (hash-table-entries (car H))))))) (test (f1) 6)) (let ((h (make-hash-table))) (define (f t) (set! (t 'a) 'b)) (f h) (f h) (test (h 'a) 'b)) (let ((ht (make-hash-table)) (l1 '(x y z)) (l2 '(y x z))) (set! (hash-table-ref ht 'x) 123) (define (hi) (hash-table-ref ht (cadr l1))) ; 123 (test (hi) #f)) (let () ; hash-code (define (make-hash size) (make-vector size ())) (define (hash-ref table key) (let ((loc (modulo (hash-code key) (length table)))) (cond ((assoc key (table loc)) => cdr) (else #f)))) (define (hash-set! table key value) (let ((loc (modulo (hash-code key) (length table)))) (cond ((assoc key (table loc)) => (lambda (key/value) (set-cdr! key/value value))) (else (set! (table loc) (cons (cons key value) (table loc))))))) (let ((h (make-hash 8))) (hash-set! h 'abc 1) (test (hash-ref h 'abc) 1) (hash-set! h "cba" #\c) (test (hash-ref h "cba") #\c) (do ((i 0 (+ i 1))) ((= i 12)) (hash-set! h i (* i 2))) (test (hash-ref h 3) 6) (test (hash-ref h 'abc) 1) (test (hash-ref h "asdf") #f))) (test (make-hash-table most-positive-fixnum) 'error) ;(test (make-hash-table (+ 1 (expt 2 31))) 'error) ; out-of-memory error except in clang (test (make-hash-table most-negative-fixnum) 'error) (test (make-hash-table (* 8796093022208 8796093022208)) 'error) (test (make-hash-table 8796093022208) 'error) (test (make-hash-table 21 eq? 12) 'error) (test (make-hash-table 21 12) 'error) (test (make-hash-table 21 eq? #f 12) 'error) (test (hash-table? (make-hash-table 8 #f #f)) #t) (test (make-hash-table eq? eq?) 'error) (test (make-hash-table eq? eq? 12) 'error) (test (make-hash-table ()) 'error) (test (make-hash-table 3 ()) 'error) (test (make-hash-table eq? ()) 'error) (test (make-hash-table 0) 'error) (test (make-hash-table -4) 'error) (test (make-hash-table (ash 1 32)) 'error) (test (let ((imh (immutable! (hash-table 'a 1 'b 2)))) (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (hash-table-set! (or imh) 't 1))) (define (hi) (func)) (hi)) 'error) (test (let ((h (hash-table 'a (hash-table 'b 2)))) (h 'a 'b)) 2) (let ((h (hash-table))) (hash-table-set! h 'a (+ (or (hash-table-ref h 'a) 0) 1)) (test (hash-table-ref h 'a) 1) (hash-table-set! h 'a (+ (or (hash-table-ref h 'a) 0) 1)) (test (hash-table-ref h 'a) 2)) (let ((h (hash-table))) (define (hash-inc) (hash-table-set! h 'a (+ 1 (or (hash-table-ref h 'a) 0))) (hash-table-set! h 'a (+ (or (hash-table-ref h 'a) 0) 1))) (hash-inc) (test (hash-table-ref h 'a) 2)) (let () (define (f8) ; this shows why hash_ref -> entry_ref can't work (let ((H (hash-table 'x 1)) (sum 0)) (do ((i 0 (+ i 1))) ((= i 30) sum) (set! sum (+ sum (H 'x))) (hash-table-set! H 'x #f) ; release 'x entry (hash-table-set! H 'y -1) ; grab 'x entry for 'y (hash-table-set! H 'x 2)))) ; change 'x value (test (f8) 59)) (for-each (lambda (arg) (test (make-hash-table arg) 'error)) (list "hi" #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (catch 'wrong-type-arg (lambda () (make-hash-table 8 (cons 32 symbol?))) (lambda (type info) (apply format #f info))) "make-hash-table: first entry of type info, 32, is an integer, but should be a function") (test (catch 'wrong-type-arg (lambda () (make-hash-table 8 (cons symbol? 32))) (lambda (type info) (apply format #f info))) "make-hash-table: second entry of type info, 32, is an integer, but should be a function") (test (catch 'wrong-type-arg (lambda () (make-hash-table 8 (cons symbol? symbol?))) (lambda (type info) (apply format #f info))) "make-hash-table's equality function, symbol?, (car of the second argument) should be a function of two arguments") (test (catch 'wrong-type-arg (lambda () (make-hash-table 8 (cons eq? symbol?))) (lambda (type info) (apply format #f info))) "make-hash-table mapper function, symbol?, should return an integer") (test (catch 'wrong-type-arg (lambda () (make-hash-table 8 (cons string-ref symbol?))) (lambda (type info) (apply format #f info))) "make-hash-table checker function, string-ref, should return a boolean value") (test (catch 'wrong-type-arg (lambda () (make-hash-table 8 (cons equal? equal?))) (lambda (type info) (apply format #f info))) "make-hash-table's mapping function, equal?, (cdr of the second argument) should be a function of one argument") (test (copy (inlet 'a 1) (make-hash-table 8 #f (cons symbol? cons))) 'error) (test (copy (inlet 'a 1) (make-hash-table 8 #f (cons cons symbol?))) 'error) (let ((h (hash-table))) (hash-table-set! h 0/0 1) (unless with-bignums (test (object->string h) "(hash-table +nan.0 1)")) (hash-table-set! h 0/0 #f) (unless with-bignums (test (object->string h) "(hash-table +nan.0 1)"))) (let ((h (hash-table +nan.0 1))) (test (h +nan.0) #f)) (let ((ht (hash-table :a 1/0))) (test (nan? (ht :a)) #t) (set! (ht 1/0) :a) (test (ht 1/0) #f)) ; NaNs aren't equal? (let () (define nan1 +nan.0) (define nan2 -nan.0) (let ((H (hash-table))) (set! (H nan1) 1) (test (H nan1) #f) (test (H nan2) #f) (set! (H nan2) 2) (test (object->string H) "(hash-table +nan.0 2 +nan.0 1)") (test (H nan1) #f) (test (H nan2) #f) (test (H +nan.0) #f) (test (H -nan.0) #f) (set! (H -nan.0) 3) (test (object->string H) "(hash-table +nan.0 3 +nan.0 2 +nan.0 1)")) (define vn1 (float-vector +nan.0)) (define vn2 (float-vector -nan.0)) (let ((H (hash-table))) (set! (H vn1) 1) (test (H vn1) 1) (set! (H vn2) 2) (test (object->string H) "(hash-table #r(+nan.0) 2 #r(+nan.0) 1)") (test (equal? vn1 vn1) #t)) ; see below (let ((H (hash-table))) (set! (H #(0)) 1) (test (H #(0)) 1) (test (H #(0.0)) #f) (test (H (vector 0)) 1)) (let ((H (hash-table)) (L1 (list +nan.0)) (L2 (list +nan.0))) (set! (H L1) 1) (test (H L1) 1) (test (H L2) #f) (test (equal? (list +nan.0) (list +nan.0)) #f) (test (equal? L1 L1) #t)) ;; is this inconsistent? It's the same object, so its contents aren't relevant?? ;; otherwise anything with a NaN in it can't be equal? even to itself -- seems perverse. ;; guile: ;; scheme@(guile-user)> (equal? (vector +nan.0) (vector +nan.0)) ;; $1 = #t ;; s7: ;; <1> (equal? (vector +nan.0) (vector +nan.0)) ;; #f ;; <2> (equal? (float-vector +nan.0) (float-vector +nan.0)) ;; #f ;; <3> (equivalent? (float-vector +nan.0) (float-vector +nan.0)) ;; #t (let ((typed-hash (make-hash-table 8 eq? (cons symbol? integer?)))) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (char-upcase (string-ref typed-hash else)))) (test (f) 'error)) ; opt_p_pp_sf_href problem (let ((imfv2 #r2d((1 2 3) (4 5 6))) (V_2 (let ((v (make-vector 1))) (set! (v 0) v) v))) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (imfv2 V_2 (hash-table-ref or call-with-exit)))) (test (f) 'error)) ; and another! (let () (define (func) (let ((lt (inlet 'a 1))) (do ((i 0 (+ i 1))) ((= i 2)) (lt or)))) (test (func) 'error)) ; and another!! (let ((H (make-hash-table 8 equivalent?))) (set! (H nan1) 1) (test (H nan1) 1) (test (H nan2) 1) (set! (H nan2) 2) (test (object->string H) "(hash-table +nan.0 2)") (test (H nan1) 2) (test (H nan2) 2) (test (H +nan.0) 2) (test (H -nan.0) 2) (set! (H -nan.0) 3) (test (object->string H) "(hash-table +nan.0 3)")) (let ((H (make-hash-table 8 equivalent?))) (set! (H vn1) 1) (test (H vn1) 1) (set! (H vn2) 2) (test (object->string H) "(hash-table #r(+nan.0) 2)"))) (test (hash-table 'a #f 'b 1) (hash-table 'b 1)) (test (hash-table 'a #f) (hash-table)) (let ((ht (make-hash-table))) (define (f1) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i #t))) (f1) (test (hash-table-entries ht) 100) (set! ht (make-hash-table)) (define (f2) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i 0))) (f2) (test (hash-table-entries ht) 100) (set! ht (make-hash-table)) (define (f3) (do ((i 0 (+ i 1))) ((= i 100)) (hash-table-set! ht i i))) (f3) (test (hash-table-entries ht) 100)) (let ((ht (make-hash-table))) (define (f1) (do ((i 0 (+ i 1))) ((= i 1000)) (hash-table-set! ht i #t))) (f1) (test (hash-table-entries ht) 1000)) (let ((hi (make-hash-table 7))) (test (object->string hi) "(hash-table)") (set! (hi 1) "1") (test (object->string hi) "(hash-table 1 \"1\")") (set! (hi -1) "-1") (test (or (string=? (object->string hi) "(hash-table -1 \"-1\" 1 \"1\")") (string=? (object->string hi) "(hash-table 1 \"1\" -1 \"-1\")")) #t) (set! (hi 9) "9") (test (or (string=? (object->string hi) "(hash-table 9 \"9\" -1 \"-1\" 1 \"1\")") (string=? (object->string hi) "(hash-table 9 \"9\" 1 \"1\" -1 \"-1\")")) #t) (set! (hi -9) "-9") (test (or (string=? (object->string hi) "(hash-table -9 \"-9\" 9 \"9\" -1 \"-1\" 1 \"1\")") (string=? (object->string hi) "(hash-table 9 \"9\" 1 \"1\" -9 \"-9\" -1 \"-1\")")) #t) (test (hi 1) "1") (test (hi -1) "-1") (test (hi -9) "-9") (set! (hi 2) "2") (test (or (string=? (object->string hi) "(hash-table -9 \"-9\" 9 \"9\" -1 \"-1\" 1 \"1\" 2 \"2\")") (string=? (object->string hi) "(hash-table 9 \"9\" 1 \"1\" 2 \"2\" -9 \"-9\" -1 \"-1\")")) #t) (let-temporarily (((*s7* 'print-length) 3)) (test (or (string=? (object->string hi) "(hash-table -9 \"-9\" 9 \"9\" -1 \"-1\" ...)") (string=? (object->string hi) "(hash-table 9 \"9\" 1 \"1\" 2 \"2\" ...)")) #t) (set! (*s7* 'print-length) 0) (test (object->string hi) "(hash-table ...)") (test (object->string (hash-table)) "(hash-table)"))) (let ((ht (make-hash-table 277))) (test (hash-table? ht) #t) (test (>= (length ht) 277) #t) (test (hash-table-entries ht) 0) (test (let () (hash-table-set! ht 'key 3.14) (hash-table-ref ht 'key)) 3.14) (test (let () (hash-table-set! ht "ky" 3.14) (hash-table-ref ht "ky")) 3.14) (for-each (lambda (arg) (test (let () (hash-table-set! ht 'key arg) (hash-table-ref ht 'key)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))) (for-each (lambda (arg) (test (hash-table? arg) #f)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2))) (test (hash-table? (make-vector 3 ())) #f) (test (let ((ht (make-hash-table))) (set! (ht 'a) 123) (map values ht)) '((a . 123))) (let ((ht (make-hash-table))) (test (hash-table-ref ht 'not-a-key) #f) (test (hash-table-ref ht "not-a-key") #f) (hash-table-set! ht 'key 3/4) (hash-table-set! ht "key" "hi") (test (hash-table-ref ht "key") "hi") (test (hash-table-ref ht 'key) 3/4) (hash-table-set! ht 'asd 'hiho) (test (hash-table-ref ht 'asd) 'hiho) (hash-table-set! ht 'asd 1234) (test (hash-table-ref ht 'asd) 1234)) (let ((ht (make-hash-table))) (define (ht-add h) (+ (h 1) (h 2))) (hash-table-set! ht 1 2) (hash-table-set! ht 2 3) (test (ht-add ht) 5)) (let () (define h4 (make-hash-table 8 =)) (test (set! (h4 'a) 3) (if (> (*s7* 'safety) 0) 'error 3)) (define h5 (make-hash-table 8 string=?)) (test (set! (h5 'a) 3) (if (> (*s7* 'safety) 0) 'error 3)) (define h6 (make-hash-table 8 eq?)) (test (set! (h6 21) 3) (if (> (*s7* 'safety) 0) 'error 3)) (test (make-hash-table 8 >) 'error)) (let ((let1 (inlet 'a 1)) (let2 (inlet 'a 1)) (let3 (inlet 'a 2)) (let4 (inlet 'b 1)) (let5 (inlet 'a 1 'a 2))) (test (equal? let1 let2) #t) (test (equal? let1 let3) #f) (test (equal? let1 let5) #t) (let ((hash1 (hash-table let1 32))) (test (integer? (hash1 let1)) #t) (test (integer? (hash1 let2)) #t) (test (integer? (hash1 let3)) #f) (test (integer? (hash1 let4)) #f) (test (integer? (hash1 let5)) #t))) (test ((hash-table 1.5 #t #f #t) #f) #t) ; this is checking hash_float if debugging (test ((hash-table 1.5 #t 1 #t) 1) #t) (let ((let1 (inlet 'a 1 'b 2)) (let2 (inlet 'b 2 'a 1)) (let3 (inlet 'a 1 'b 1))) (test (equal? let1 let2) #t) (let ((hash1 (hash-table let1 32))) (test (integer? (hash1 let1)) #t) (test (integer? (hash1 let2)) #t) (test (integer? (hash1 let3)) #f))) (let ((hash1 (hash-table 'a 1 'b 2)) (hash2 (hash-table 'b 2 'a 1))) (test (equal? hash1 hash2) #t) (let ((hash3 (hash-table hash1 32))) (test (integer? (hash3 hash1)) #t) (test (integer? (hash3 hash2)) #t))) (let ((hash1 (hash-table 'b 2 'a 1))) (let ((hash2 (make-hash-table (* (length hash1) 2)))) (set! (hash2 'a) 1) (set! (hash2 'b) 2) (test (equal? hash1 hash2) #t) (let ((hash3 (make-hash-table (* 2 (length hash2))))) (set! (hash3 hash1) 32) (test (integer? (hash3 hash1)) #t) (test (integer? (hash3 hash2)) #t)))) (for-each (lambda (arg) (test (hash-table-ref arg 'key) 'error)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (let ((ht1 (make-hash-table 653)) (ht2 (make-hash-table 277))) (test (equal? ht1 ht2) #t) ; equal? because both are empty (hash-table-set! ht1 'key 'hiho) (hash-table-set! ht2 (hash-table-ref ht1 'key) 3.14) (test (>= (length ht1) 653) #t) (test (hash-table-ref ht2 'hiho) 3.14) (test (hash-table-ref ht2 (hash-table-ref ht1 'key)) 3.14)) (let ((ht1 (make-hash-table))) (set! (ht1 1) 'hi) (let ((ht2 (make-hash-table))) (set! (ht2 1) ht1) (test ((ht2 1) 1) 'hi))) (let ((ht1 (make-hash-table))) (set! (ht1 1/0) "NaN!") (let ((nan 1/0)) (test (ht1 nan) #f) (set! (ht1 nan) 0) (test (ht1 nan) #f) (unless (or with-windows with-bignums) (test (object->string ht1) "(hash-table +nan.0 0 +nan.0 \"NaN!\")")))) (let ((h (make-hash-table 8 eqv?))) (set! (h +nan.0) 'ok) (test (h +nan.0) #f)) (let ((h1 (make-hash-table 8 equivalent?)) (h2 (make-hash-table 8 equivalent?))) (hash-table-set! h2 (let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>) 1) (test (object->string (append h1 h2)) "(hash-table #1=#(#1#) 1)")) (unless with-bignums (let ((ht1 (make-hash-table))) (set! (ht1 1) "1") (set! (ht1 1.0) "1.0") (test (ht1 1) "1") (set! (ht1 1/0) "nan") (test (ht1 0/0) #f) (test (ht1 1/0) #f) (set! (ht1 (/ (log 0) (log 0))) "nan-nani") (test (ht1 (/ (log 0) (log 0))) #f) (test (ht1 (- 0/0)) #f) (test (ht1 (real-part (/ (log 0) (log 0)))) #f) (test (ht1 (complex 0/0 1/0)) #f) (set! (ht1 (real-part (log 0))) "-inf") (test (ht1 (real-part (log 0))) "-inf") (set! (ht1 (- (real-part (log 0)))) "inf") (test (ht1 (- (real-part (log 0)))) "inf") (set! (ht1 (log 0)) "log(0)") (test (ht1 (log 0)) "log(0)") (set! (ht1 (complex 80143857/25510582 1)) "pi+i") (test (ht1 (complex pi (- 1.0 1e-16))) #f))) (when with-bignums (test (hash-table-ref (let ((h (make-hash-table 8 eqv?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b) (test (hash-table-ref (let ((h (make-hash-table 8 eqv?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) h) (bignum 2.0)) 'b) (test (hash-table-ref (hash-table 1.0 'a 2.0 'b 3.0 'c) 2.0) 'b) (test (hash-table-ref (hash-table 1.0 'a (bignum 2.0) 'b 3.0 'c) 2.0) 'b) (test (hash-table-ref (hash-table 1.0 'a 2.0 'b 3.0 'c) (bignum 2.0)) 'b) (test (hash-table-ref (hash-table 1 'a 2 'b 3 'c) (bignum 2)) 'b) (test (hash-table-ref (hash-table 1/3 'a 2/3 'b 3/2 'c) (bignum 2/3)) 'b) (test (hash-table-ref (hash-table 1+i 'a 2/3+i 'b 3+i 'c) (bignum 2/3+i)) 'b) (test (hash-table-ref (hash-table (bignum 1) 'a (bignum 2) 'b (bignum 3) 'c) (bignum 2)) 'b) (test (hash-table-ref (hash-table (bignum 1) 'a (bignum 2) 'b (bignum 3) 'c) 2) 'b) (test (hash-table-ref (hash-table (bignum 1.0) 'a (bignum 2.0) 'b (bignum 3.0) 'c) (bignum 2.0)) 'b) (test (hash-table-ref (hash-table (bignum 1.0) 'a (bignum 2.0) 'b (bignum 3.0) 'c) 2.0) 'b) (test (hash-table-ref (let ((h (make-hash-table 8 =))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b) (test (hash-table-ref (let ((h (make-hash-table 8 equal?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b) (test (hash-table-ref (let ((h (make-hash-table 8 eqv?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b) (test (hash-table-ref (let ((h (make-hash-table 8 eqv?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) h) (bignum 2.0)) 'b) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 1.0) 'a) (set! (h 2.0) 'b) (set! (h 3.0) 'c) h) (bignum 2.0)) 'b)) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 10000000001/10000000000) 'a) h) 1) #f) (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 10000000001/10000000000) 'a) h) 1) 'a) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 10000000001/10000000000) 'a) h) 1.0) 'a) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 10000000001/10000000000) 'a) h) 1.0+1.0e-10i) 'a)) (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h -10000000001/10000000000) 'a) h) -1) 'a) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h -10000000001/10000000000) 'a) h) -1.0) 'a) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h -10000000001/10000000000) 'a) h) -1.0+1.0e-10i) 'a)) (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 1+1.0e-10i) 'a) h) 1) 'a) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 1+1.0e-10i) 'a) h) 1.0) 'a) (test (hash-table-ref (let ((h (make-hash-table 8 equivalent?))) (set! (h 1+1.0e-10i) 'a) h) 1.0-1.0e-10i) 'a)) (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (let ((eps5 5.0e-10) (eps1 1.0e-10) (eps9 9.0e-10) (eps10 1.0001e-9) (h (make-hash-table 8 equivalent?)) (keys (list 0 1.0 2.0 -2.0 1/2 7/2 1.5 2.5 3 (+ 1.0 5.0e-8) -1.0e-8 -11/2 0+i 1-i 8-1.0e-10i))) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) val) (test (hash-table-ref h (exact->inexact key)) val)) (test (hash-table-ref h (+ key eps1)) val) (test (hash-table-ref h (+ key eps5)) val) (test (hash-table-ref h (+ key eps9)) val) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) val) (test (hash-table-ref h (- key eps5)) val) (test (hash-table-ref h (- key eps9)) val) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 =)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val)) (test (hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 eqv?)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 equal?)) ; like eqv? (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys))) (when with-bignums (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (let ((eps5 5.0e-10) (eps1 1.0e-10) (eps9 9.0e-10) (eps10 1.0001e-9) (h (make-hash-table 8 equivalent?)) (keys (map bignum (list 0 1.0 2.0 -2.0 1/2 7/2 1.5 2.5 3 (+ 1.0 5.0e-8) -1.0e-8 -11/2 0+i 1-i)))) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) val) (test (hash-table-ref h (exact->inexact key)) val)) (test (hash-table-ref h (+ key eps1)) val) (test (hash-table-ref h (+ key eps5)) val) (test (hash-table-ref h (+ key eps9)) val) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) val) (test (hash-table-ref h (- key eps5)) val) (test (hash-table-ref h (- key eps9)) val) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 =)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val)) (test (hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 eqv?)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 equal?)) ; like eqv? (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys))) (define (big-hash-table-ref table key) (hash-table-ref table (bignum key))) (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (let ((eps5 5.0e-10) (eps1 1.0e-10) (eps9 9.0e-10) (eps10 1.0001e-9) (h (make-hash-table 8 equivalent?)) (keys (list 0 1.0 2.0 -2.0 1/2 7/2 1.5 2.5 3 (+ 1.0 5.0e-8) -1.0e-8 -11/2 0+i 1-i))) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (big-hash-table-ref h (inexact->exact key)) val) (test (big-hash-table-ref h (exact->inexact key)) val)) (test (big-hash-table-ref h (+ key eps1)) val) (test (big-hash-table-ref h (+ key eps5)) val) (test (big-hash-table-ref h (+ key eps9)) val) (test (big-hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (big-hash-table-ref h (- key eps1)) val) (test (big-hash-table-ref h (- key eps5)) val) (test (big-hash-table-ref h (- key eps9)) val) (test (big-hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 =)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (big-hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val)) (test (big-hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val))) (test (big-hash-table-ref h (+ key eps1)) #f) (test (big-hash-table-ref h (+ key eps5)) #f) (test (big-hash-table-ref h (+ key eps9)) #f) (test (big-hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (big-hash-table-ref h (- key eps1)) #f) (test (big-hash-table-ref h (- key eps5)) #f) (test (big-hash-table-ref h (- key eps9)) #f) (test (big-hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 eqv?)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (big-hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (big-hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (big-hash-table-ref h (+ key eps1)) #f) (test (big-hash-table-ref h (+ key eps5)) #f) (test (big-hash-table-ref h (+ key eps9)) #f) (test (big-hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (big-hash-table-ref h (- key eps1)) #f) (test (big-hash-table-ref h (- key eps5)) #f) (test (big-hash-table-ref h (- key eps9)) #f) (test (big-hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 equal?)) ; like eqv? (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (big-hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (big-hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (big-hash-table-ref h (+ key eps1)) #f) (test (big-hash-table-ref h (+ key eps5)) #f) (test (big-hash-table-ref h (+ key eps9)) #f) (test (big-hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (big-hash-table-ref h (- key eps1)) #f) (test (big-hash-table-ref h (- key eps5)) #f) (test (big-hash-table-ref h (- key eps9)) #f) (test (big-hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys))) (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (let ((eps5 5.0e-10) (eps1 1.0e-10) (eps9 9.0e-10) (eps10 1.0001e-9) (h (make-hash-table 8 equivalent?)) (keys (list 0 1.0 2.0 -2.0 1/2 7/2 1.5 2.5 3 (+ 1.0 5.0e-8) -1.0e-8 -11/2 0+i 1-i))) (for-each (lambda (key) (hash-table-set! h (bignum key) (number->string (bignum key)))) keys) (for-each (lambda (key) (let ((val (number->string (bignum key)))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) val) (test (hash-table-ref h (exact->inexact key)) val)) (test (hash-table-ref h (+ key eps1)) val) (test (hash-table-ref h (+ key eps5)) val) (test (hash-table-ref h (+ key eps9)) val) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) val) (test (hash-table-ref h (- key eps5)) val) (test (hash-table-ref h (- key eps9)) val) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 =)) (for-each (lambda (key) (hash-table-set! h (bignum key) (number->string (bignum key)))) keys) (for-each (lambda (key) (let ((val (number->string (bignum key)))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val)) (test (hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 eqv?)) (for-each (lambda (key) (hash-table-set! h (bignum key) (number->string (bignum key)))) keys) (for-each (lambda (key) (let ((val (number->string (bignum key)))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys) (set! h (make-hash-table 8 equal?)) ; like eqv? (for-each (lambda (key) (hash-table-set! h (bignum key) (number->string (bignum key)))) keys) (for-each (lambda (key) (let ((val (number->string (bignum key)))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (+ key (* (max (real-part key) 1.0) eps10))) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) (test (hash-table-ref h (- key (* (max (real-part key) 1.0) eps10))) #f))) keys)))) (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (let ((eps5 5.0e-10) (eps1 1.0e-10) (eps9 9.0e-10) (eps10 1.0001e-9) (h (make-hash-table 8 equivalent?)) (keys (list +inf.0 -inf.0 +nan.0 -nan.0 +inf.0+i 1-inf.0i))) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (test (hash-table-ref h (+ key eps1)) val) (test (hash-table-ref h (+ key eps5)) val) (test (hash-table-ref h (+ key eps9)) val) (test (hash-table-ref h (- key eps1)) val) (test (hash-table-ref h (- key eps5)) val) (test (hash-table-ref h (- key eps9)) val) )) keys) (set! h (make-hash-table 8 =)) ; infinities are =: (= +inf.0 (+ +inf.0 1.0e-10)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (and (not (nan? key)) (number->string key)))) (test (hash-table-ref h key) val) (test (hash-table-ref h (+ key eps1)) (and (infinite? (real-part key)) val)) ; eps is applied to real part (test (hash-table-ref h (+ key eps5)) (and (infinite? (real-part key)) val)) (test (hash-table-ref h (+ key eps9)) (and (infinite? (real-part key)) val)) (test (hash-table-ref h (- key eps1)) (and (infinite? (real-part key)) val)) (test (hash-table-ref h (- key eps5)) (and (infinite? (real-part key)) val)) (test (hash-table-ref h (- key eps9)) (and (infinite? (real-part key)) val)) )) keys))) (when with-bignums (let-temporarily (((*s7* 'hash-table-float-epsilon) 1.0e-9)) (let ((eps5 5.0e-10) (eps1 1.0e-10) (eps9 9.0e-10) (eps10 1.0001e-9) (h (make-hash-table 8 equivalent?)) (keys (list 18446744073709551614 18446744073709551614/3 18446744073709551615.0 18446744073709551614+i -18446744073709551616 -18446744073709551616/3 -18446744073709551617.0 -18446744073709551616-18446744073709551614i 9223372036854775807 -9223372036854775807 9007199254740992 9223372036854775800.1 -9223372036854775800.1+i 92233720368547758/19 92233720368547758/5 ))) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) val) (test (hash-table-ref h (exact->inexact key)) val)) (test (hash-table-ref h (+ key eps1)) val) (test (hash-table-ref h (+ key eps5)) val) (test (hash-table-ref h (+ key eps9)) val) (test (hash-table-ref h (- key eps1)) val) (test (hash-table-ref h (- key eps5)) val) (test (hash-table-ref h (- key eps9)) val) )) keys) (set! h (make-hash-table 8 =)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (= key (inexact->exact key)) val)) (test (hash-table-ref h (exact->inexact key)) (and (= key (exact->inexact key)) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) )) keys) (set! h (make-hash-table 8)) (for-each (lambda (key) (hash-table-set! h key (number->string key))) keys) (for-each (lambda (key) (let ((val (number->string key))) (test (hash-table-ref h key) val) (when (real? key) (test (hash-table-ref h (inexact->exact key)) (and (exact? key) val)) (test (hash-table-ref h (exact->inexact key)) (and (inexact? key) val))) (test (hash-table-ref h (+ key eps1)) #f) (test (hash-table-ref h (+ key eps5)) #f) (test (hash-table-ref h (+ key eps9)) #f) (test (hash-table-ref h (- key eps1)) #f) (test (hash-table-ref h (- key eps5)) #f) (test (hash-table-ref h (- key eps9)) #f) )) keys) ))) (let ((ht (make-hash-table))) (set! (ht (string #\a #\null #\b)) 1) (test (ht (string #\a #\null #\b)) 1) (test (ht (string #\a)) #f) (set! (ht (string #\a #\null #\b)) 12) (test (ht (string #\a #\null #\b)) 12) (fill! ht #f) (test (hash-table-entries ht) 0) (set! (ht #u(3 0 21)) 1) (test (ht #u(3 0 21)) 1)) (let ((hash (make-hash-table))) (hash-table-set! hash "01234567" 1) (hash-table-set! hash "012345678" 2) (hash-table-set! hash "12345678" 3) (hash-table-set! hash "012345670" 4) (hash-table-set! hash "0123456701234567" 5) (hash-table-set! hash "0123456" 6) (hash-table-set! hash "012345" 7) (hash-table-set! hash "01234" 8) (hash-table-set! hash "0123" 9) (hash-table-set! hash "012" 10) (hash-table-set! hash "01235" 11) (test (hash-table-ref hash "01234567") 1) (test (hash-table-ref hash "012345678") 2) (test (hash-table-ref hash "12345678") 3) (test (hash-table-ref hash "012345670") 4) (test (hash-table-ref hash "0123456701234567") 5) (test (hash-table-ref hash "0123456") 6) (test (hash-table-ref hash "012345") 7) (test (hash-table-ref hash "01234") 8) (test (hash-table-ref hash "0123") 9) (test (hash-table-ref hash "012") 10) (test (hash-table-ref hash "01235") 11)) (let ((ht (hash-table 'a #t))) (test (hash-table-entries ht) 1) (do ((i 0 (+ i 1))) ((= i 10)) (set! (ht 'a) #f) (set! (ht 'a) #t)) (test (hash-table-entries ht) 1)) (when with-bignums (let ((ht (make-hash-table))) (set! (ht pi) 1) (test (ht pi) 1) (set! (ht (bignum "1")) 32) (test (ht (bignum "1")) 32) (set! (ht (/ (bignum "11") (bignum "3"))) 12) (test (ht (/ (bignum "11") (bignum "3"))) 12) (set! (ht (bignum "1+i")) -1) (test (ht (bignum "1+i")) -1) (set! (ht 3) 2) (test (ht 3) 2) (set! (ht 3.0) 3) (test (ht 3.0) 3))) (test (hash-table?) 'error) (test (hash-table? 1 2) 'error) (test (make-hash-table most-positive-fixnum) 'error) (test (make-hash-table most-negative-fixnum) 'error) (test (make-hash-table 10 1) 'error) (let () ; size bug noticed by K.M. -- libasan reports it (define hash (make-hash-table 1)) ;; Size must be 1. (set! (hash :hello) "a50") (gc)) (let ((ht (make-hash-table))) (test (hash-table? ht ht) 'error) (test (hash-table-ref ht #\a #\b) 'error) (test (hash-table-ref ht) 'error) (test (hash-table-ref) 'error) (test (hash-table-set!) 'error) (test (hash-table-set! ht) 'error) (test (hash-table-set! ht #\a) 'error) (test (hash-table-set! ht #\a #\b #\c) 'error) (set! (ht 'key) 32) (test (fill! ht 123) 123) (test (ht 'key) 123) (set! (ht 'key) 32) (test (ht 'key) 32) (set! (ht :key) 123) (test (ht 'key) 32) (test (ht :key) 123) (fill! ht ()) (test (ht 'key) ())) (let ((H (hash-table))) (test (set! (H (inlet 'a 1 'b 2 'c 3)) 1) 1) (test (H (inlet 'a 1 'b 2 'c 3)) 1) (test (set! (H (inlet 'b 2 'c 3 'a 1)) 2) 2) (test (H (inlet 'a 1 'b 2 'c 3)) 2) (test (equal? (inlet 'b 2 'c 3 'a 1) (inlet 'a 1 'b 2 'c 3)) #t) (test H (hash-table (inlet 'a 1 'b 2 'c 3) 2))) (let ((H (hash-table))) (test (set! (H (c-pointer 0)) 1) 1) (test (H (c-pointer 0)) 1) (test (set! (H (c-pointer 0)) 2) 2) (test (H (c-pointer 0)) 2) (test (set! (H (c-pointer 1)) 3) 3) (test (hash-table-entries H) 2) (test (H (c-pointer 1)) 3) (test (equal? (c-pointer 0) (c-pointer 0)) #t) (test (eq? (c-pointer 0) (c-pointer 0)) #f)) (let ((H (hash-table))) (test (hash-table-set! H #asdf 1) 1) (test (hash-table-ref H #asdf) 1) (test (set! (H #) 2) 2) (test (H #) 2)) (let ((ht (make-hash-table))) (test (hash-table-set! ht #\a 'key) 'key) (for-each (lambda (arg) (test (hash-table-set! ht arg 3.14) 3.14)) (list #\a #(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (hash-table-ref ht arg) 3.14)) (list #\a #(1 2 3) 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (length ht 123) 'error)) (for-each (lambda (arg) (test (make-hash-table arg) 'error)) (list "hi" -1 0 #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (test (object->string (hash-table 'a lst)) "(hash-table 'a #1=(1 2 . #1#))") (test (object->string (hash-table lst lst)) "(hash-table #1=(1 2 . #1#) #1#)") (test (object->string (hash-table lst 1)) "(hash-table #1=(1 2 . #1#) 1)")) (let () (define ht (make-hash-table)) (set! (ht 123) "123") (set! (ht 456) "456") (define hti (make-iterator ht)) (test (iterator? hti) #t) (test (object->string hti) "#") (test (equal? hti hti) #t) (test (eq? hti hti) #t) (test (eqv? hti hti) #t) (test (equivalent? hti hti) #t) (let ((hti2 hti)) (test (equal? hti2 hti) #t) (test (equivalent? hti2 hti) #t) (set! hti2 (copy hti)) (test (equal? hti2 hti) #t) (test (equivalent? hti2 hti) #t) (test (let ((val (hti2))) (or (equal? val '(123 . "123")) (equal? val '(456 . "456")))) #t) ; order depends on table size (test (equal? hti2 hti) #f) (test (equivalent? hti2 hti) #f) ) (let ((vals (list (hti) (hti)))) (if (not (equal? (sort! vals (lambda (a b) (< (car a) (car b)))) '((123 . "123") (456 . "456")))) (format #t ";iterator: ~A~%" vals)) (let ((val (hti))) (if (not (eof-object? val)) (format #t ";iterator at end: ~A~%" val))) (let ((val (hti))) (if (not (eof-object? val)) (format #t ";iterator at end (2): ~A~%" val))))) (test (make-iterator) 'error) (test (make-iterator (make-hash-table) 1) 'error) (test (iterator?) 'error) (test (iterator? 1 2) 'error) (let () (define (get-iter) (let ((ht (hash-table 'a 1 'b 2))) (test (hash-table-entries ht) 2) (make-iterator ht))) (let ((hti (get-iter))) (gc) (let ((a (hti))) (let ((b (hti))) (let ((c (hti))) (test (let ((lst (list a b c))) (or (equal? lst '((a . 1) (b . 2) #)) (equal? lst '((b . 2) (a . 1) #)))) #t)))))) (let ((ht1 (make-hash-table)) (ht2 (make-hash-table))) (test (equal? ht1 ht2) #t) (test (equal? ht1 (make-vector (length ht1) ())) #f) (hash-table-set! ht1 'key 'hiho) (test (equal? ht1 ht2) #f) (hash-table-set! ht2 'key 'hiho) (test (equal? ht1 ht2) #t) (hash-table-set! ht1 'a ()) (test (ht1 'a) ()) ) (let ((ht (make-hash-table 1))) (test (>= (length ht) 1) #t) (set! (ht 1) 32) (test (>= (length ht) 1) #t)) (let ((ht (hash-table "hi" 32 "ho" 1))) (test (hash-table-entries ht) 2) (test (ht "hi") 32) (test (ht "ho") 1)) (let ((ht (hash-table "hi" 32 "ho" 1))) (test (hash-table-entries ht) 2) (test (ht "hi") 32) (test (ht "ho") 1)) (let ((ht (hash-table))) (test (hash-table? ht) #t) (test (>= (length ht) 1) #t) (test (ht 1) #f)) (let ((ht (hash-table))) (test (hash-table? ht) #t) (test (>= (length ht) 1) #t) (test (ht 1) #f)) (test (let () (define gakk (make-hash-table 10 (cons equal? (lambda (x) #t)))) (gakk #f)) 'error) (test (let ((h (make-hash-table 8 (cons equal? (lambda (x) pi))))) (hash-table-set! h 'a 0)) 'error) (test (set! ((hash-table 'a 1.5)) 32) 'error) ; no key for (implicit) hash-table-set! (for-each (lambda (arg) (test (hash-table arg) 'error) (test ((hash-table 'a arg) 'a) arg) (test ((hash-table arg 'a) arg) 'a)) (list "hi" -1 0 #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t abs # # (lambda () 1))) (let ((ht (make-hash-table)) (lst (list 1))) (set-cdr! lst lst) (set! (ht lst) lst) (let ((lst1 (list 1 2))) (set-cdr! (cdr lst1) lst1) (set! (ht lst1) lst1) (test (ht lst) lst) (test (ht lst1) lst1) (test (or (string=? (object->string ht) "(hash-table #1=(1 2 . #1#) #1# #2=(1 . #2#) #2#)") (string=? (object->string ht) "(hash-table #1=(1 . #1#) #1# #2=(1 2 . #2#) #2#)")) #t))) (test (set! (hash-table) 1) 'error) (test (set! (hash-table) 1) 'error) (test (set! (make-hash-table) 1) 'error) (let ((ht (make-hash-table))) (test (map (lambda (x) x) ht) ()) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 0) (test (map (lambda (x y) (cons x y)) (list 1 2 3) ht) ()) ;(test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) #(1 2 3) ht) ctr) 0) ; this is now an error 15-Jan-15 (test (map (lambda (x y) (cons x y)) ht "123") ()) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht ()) ctr) 'error) ; 2 args (let ((rt (reverse ht))) (test (map (lambda (x) x) rt) ()) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) rt) ctr) 0)) (set! (ht 1) 32) ;; these need to be independent of entry order (test (sort! (map (lambda (x) (cdr x)) ht) <) '(32)) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 1) (test (map (lambda (x y) (cons x y)) () ht) ()) (test (let ((ctr 0)) (for-each (lambda (x y) (set! ctr (+ ctr 1))) ht "") ctr) 0) (test (sort! (map (lambda (x y) (max (cdr x) y)) ht (list 1 2 3)) <) '(32)) (test (let ((ctr 0)) (for-each (lambda (x y) (set! ctr (max (cdr x) y))) ht #(1 2 3)) ctr) 32) (let ((rt (reverse ht))) (test (equal? (rt 32) 1) #t) (test (equal? (rt 1) #f) #t) (test (ht (rt 32)) 32) (test (sort! (map (lambda (x) (cdr x)) rt) <) '(1)) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) rt) ctr) 1) (for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht) (set! (rt 32) 123) (test (rt 32) 123) (test (ht 32) #f) (test (ht 1) 32)) (set! (ht 2) 1) (test (ht (ht 2)) 32) (test (sort! (map (lambda (x) (cdr x)) ht) <) '(1 32)) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 2) (set! (ht 3) 123) (test (sort! (map (lambda (x) (cdr x)) ht) <) '(1 32 123)) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 3) (test (let ((ctr 0)) (for-each (lambda (x y) (set! ctr (+ ctr 1))) ht '(1)) ctr) 1) (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr 1))) "12" ht '(1)) ctr) 1) (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr 1))) "12" ht '(1 2)) ctr) 2) (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr 1))) "12345" ht '(1 2 3 4 5 6)) ctr) 3) (test (sort! (map (lambda (x y) (max x (cdr y))) (list -1 -2 -3 -4) ht) <) '(1 32 123)) (test (let ((sum 0)) (for-each (lambda (x y) (set! sum (+ sum x (cdr y)))) #(10 20 30) ht) sum) 216) (let ((rt (reverse ht))) (for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht)) (set! (ht (list 1 2 3)) "hi") (test (ht '(1 2 3)) "hi") (test (ht 2) 1) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 4) (set! (ht "hi") 2) (test (ht "hi") 2) (test (ht (ht (ht "hi"))) 32) (let ((rt (reverse ht))) (test (rt "hi") '(1 2 3)) (test (rt 2) "hi") (for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht) (set! (rt 2) "ho") (test (rt 2) "ho") (test (ht '(1 2 3)) "hi") (set! (rt 123) 321) (test (rt 123) 321) (test (ht 3) 123)) (fill! ht 0) (set! (ht "hi") 1) (set! (ht "hoi") 2) (test (sort! (map (lambda (x) (cdr x)) ht) <) '(0 0 0 0 1 2)) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 6) (let ((rt (reverse ht))) (test (rt 2) "hoi") (set! (rt 2) "ha") (test (ht "hoi") 2)) (set! (ht #\a) #\b) (test (ht #\a) #\b) (test (ht "hi") 1) (set! ht (hash-table)) (set! (ht #(1)) #(2)) (test (ht #(1)) #(2)) (set! (ht '(1)) '(3)) (set! (ht "1") "4") ;(set! (ht ht) "5") ;(test (ht ht) "5") (test (ht '(1)) '(3)) (test (let ((ctr 0)) (for-each (lambda (x) (set! ctr (+ ctr 1))) ht) ctr) 3) (let ((rt (reverse ht))) ;(test (rt "5") ht) (test (rt "4") "1") (for-each (lambda (x) (test (ht (rt (cdr x))) (cdr x)) (test (rt (ht (car x))) (car x))) ht)) ) (let ((ht (make-hash-table))) (let ((str (string (integer->char 255))) (u8 #u(254 0)) (rl 1e18) (int most-negative-fixnum) (rat (/ 1 most-negative-fixnum))) (set! (ht str) 1) (set! (ht u8) 2) (set! (ht rl) 3) (set! (ht int) 4) (set! (ht rat) 5) (test (ht str) 1) (test (ht u8) 2) (test (ht rl) 3) (test (ht int) 4) (test (ht rat) 5))) (let ((ht1 (make-hash-table 32)) (ht2 (make-hash-table 1024))) (do ((i 0 (+ i 1))) ((= i 256)) (let ((str (number->string i))) (set! (ht1 str) i) (set! (ht2 i) str))) (let ((cases 0)) (for-each (lambda (a b) (if (not (equal? (string->number (car a)) (cdr a))) (format #t ";hash-table for-each (str . i): ~A?~%" a)) (if (not (equal? (number->string (car b)) (cdr b))) (format #t ";hash-table for-each (i . str): ~A?~%" b)) (set! cases (+ cases 1))) ht1 ht2) (if (not (= cases 256)) (format #t ";hash-table for-each cases: ~A~%" cases))) (let ((iter1 (make-iterator ht1)) (iter2 (make-iterator ht2))) (test (equal? iter1 iter2) #f) (test (equivalent? iter1 iter2) #f) (test (iterator? iter2) #t) (let ((cases 0)) (do ((a (iter1) (iter1)) (b (iter2) (iter2))) ((or (eof-object? a) (eof-object? b))) (if (not (equal? (string->number (car a)) (cdr a))) (format #t ";hash-table iter1 (str . i): ~A?~%" a)) (if (not (equal? (number->string (car b)) (cdr b))) (format #t ";hash-table iter2 (i . str): ~A?~%" b)) (set! cases (+ cases 1))) (if (not (= cases 256)) (format #t ";hash-table iter1/2 cases: ~A~%" cases))))) (let ((ht (make-hash-table 31))) (let ((ht1 (make-hash-table 31))) (set! (ht1 'a1) 'b1) (set! (ht 'a0) ht1) (test ((ht 'a0) 'a1) 'b1) (test (hash-table-ref ht 'a0 'a1) 'b1) (test (ht 'a0 'a1) 'b1))) (let ((ht (make-hash-table 31)) (e (curlet))) (define (a-func a) (+ a 1)) (define-macro (a-macro a) `(+ 1 , a)) (define (any-func a) (let ((x a)) (lambda () x))) (set! (ht abs) 1) (set! (ht begin) 2) (set! (ht quasiquote) 3) (set! (ht a-func) 4) (set! (ht a-macro) 5) (set! (ht (any-func 6)) 6) (set! (ht e) 7) (test (ht e) 7) (set! (ht (rootlet)) 8) (test (ht abs) 1) (test (ht round) #f) (test (ht quasiquote) 3) (test (ht begin) 2) (test (ht lambda) #f) (test (ht a-func) 4) (test (ht a-macro) 5) (test (ht (any-func 6)) #f) (test (ht (rootlet)) 8) (call-with-exit (lambda (return) (set! (ht return) 9) (test (ht return) 9))) ;(set! (ht ht) 10) ;(test (ht ht) 10) ) ;;; weak-hash-table? (for-each (lambda (arg) (test (weak-hash-table? arg) #f)) (list "hi" () -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (weak-hash-table? (hash-table)) #f) (test (weak-hash-table? (make-weak-hash-table)) #t) (test (weak-hash-table? (append (weak-hash-table 'a 1) (weak-hash-table 'b 2))) #t) (test (weak-hash-table? (append (hash-table 'a 1) (weak-hash-table 'b 2))) #f) (test (weak-hash-table? (append (weak-hash-table 'a 1) (hash-table 'b 2))) #t) (test (weak-hash-table? (append (weak-hash-table 'a 1) (vector (cons 'b 2)))) #t) (test (reverse (weak-hash-table 'a 1 'b 2)) (weak-hash-table 1 'a 2 'b)) (test (weak-hash-table? (reverse (weak-hash-table 'a 1))) #t) (test (let ((h (make-weak-hash-table))) (set! (h 'a) 1) (object->string h :readable)) "(weak-hash-table 'a 1)") (test (equal? (weak-hash-table 'a 1) (weak-hash-table 'a 1)) #t) (test (object->string (weak-hash-table)) "(weak-hash-table)") (test (object->string (make-iterator (weak-hash-table 'a 1))) "#") (test (object->string (make-iterator (weak-hash-table 'a 1)) :readable) "(make-iterator (weak-hash-table 'a 1))") (test (object->string (immutable! (weak-hash-table)) :readable) "(immutable! (weak-hash-table))") (test (object->string (reverse (weak-hash-table 'a 1 'b 2))) "(weak-hash-table 1 a 2 b)") (when full-s7test (do ((z 0 (+ z 1))) ((= z 10)) (let ((keys (make-vector 100)) (wht (make-weak-hash-table))) (do ((i 0 (+ i 1))) ((= i 100)) (set! (keys i) (list (random 100) (random 100))) (set! (wht (keys i)) i)) (do ((i 0 (+ i 1))) ((= i 10000)) (let ((key (random 100))) (set! (keys key) (list (random 100) (random 100))) (if (> (random 100) 50) (set! (wht (keys key)) i) (if (> (random 100) 90) (do ((k 0 (+ k 1))) ((= k 100)) (set! (wht (keys k)) k))))) (when (zero? (hash-table-entries wht)) (do ((k 0 (+ k 1))) ((= k 100)) (set! (wht (keys k)) k)))))) (let ((wht (make-weak-hash-table))) (do ((i 0 (+ i 1))) ((= i 1000)) (set! (wht (list i)) i)) (do ((i 0 (+ i 1))) ((= i 1000)) (for-each (lambda (p) (unless (pair? p) (format *stderr* "p: ~S~%" p))) wht)))) (test (let ((h1 (hash-table 'a 1 'b 2)) (h2 (make-hash-table 31))) (set! (h2 'a) 1) (set! (h2 'b) 2.0) (equivalent? h1 h2)) #t) (test (let ((h1 (hash-table 'a 1 'b 2)) (h2 (make-hash-table 31))) (set! (h2 'a) 1.0) (set! (h2 'b) 2) (equivalent? (list h1) (list h2))) #t) ;(test (let ((ht (make-hash-table))) (hash-table-set! ht ht 1) (ht ht)) #f) ; this is #f now because the old ht is not equal to the new one (different number of entries) ;(test (let ((ht (make-hash-table))) (hash-table-set! ht ht ht) (equal? (ht ht) ht)) #t) (test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (object->string ht)) "#1=(hash-table 'a #1#)") (test (let ((h1 (make-hash-table))) (hash-table-set! h1 "hi" h1) (object->string h1)) "#1=(hash-table \"hi\" #1#)") (test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (equivalent? ht (copy ht))) #t) (test (let ((ht (make-hash-table))) (hash-table-set! ht 'a ht) (equal? ht (copy ht))) #t) (test (hash-table 'a 1 'b) 'error) ;; there's no real need for multidim hashes: (let ((ht (make-hash-table))) (set! (ht (cons 'a 1)) 'b) (set! (ht (cons 'a 2)) 'c) (set! (ht (cons 'b 1)) 'd) (test (ht '(a . 1)) 'b) (test (ht '(b . 1)) 'd) (set! (ht '(a . 2)) 32) (test (ht '(a . 2)) 32) (let ((lst1 (list 1)) (lst2 (list 1))) (set-car! lst1 lst2) (set-car! lst2 lst1) (set! (ht lst1) 32) (set! (ht lst2) 3) (test (equal? lst1 lst2) #t) (test (ht lst1) 3) (test (ht lst2) 3))) (let ((ht (make-hash-table))) (set! (ht 1.0) 'a) (set! (ht 2.0) 'b) (set! (ht 3.0) 'c) (test (ht 2.0) 'b) (set! (ht 2.0) 'd) (test (ht 2.0) 'd) (test (ht 0.0) #f) (test (ht 1.0) 'a)) (let ((ht (make-hash-table))) (test (ht) 'error) (test (ht 0 1) 'error)) (let ((h (hash-table 'a (hash-table 'b 2 'c 3) 'b (hash-table 'b 3 'c 4)))) (test (h 'a 'b) 2) (test (h 'b 'b) 3) (test (h 'a 'c) 3)) (let () (define-macro (memoize f) `(define ,f (let ((ht (make-hash-table)) (old-f ,f)) (lambda args (or (ht args) (let ((new-val (apply old-f args))) (set! (ht args) new-val) new-val)))))) (define (our-abs num) (abs num)) (memoize our-abs) (num-test (our-abs -1) 1) (with-let (funclet our-abs) (test (ht '(-1)) 1))) (let () (define-macro (define-memoized name&arg . body) (let ((arg (cadr name&arg)) (memo (gensym "memo"))) `(define ,(car name&arg) (let ((,memo (make-hash-table))) (lambda (,arg) (or (,memo ,arg) (set! (,memo ,arg) (begin ,@body)))))))) (define-memoized (f1 abc) (+ abc 2)) (test (f1 3) 5) (test (f1 3) 5) (test (f1 2) 4) (let ((ht (call-with-exit (lambda (return) (for-each (lambda (x) (if (hash-table? (cdr x)) (return (cdr x)))) (outlet (funclet f1))) #f)))) (if (not (hash-table? ht)) (format #t ";can't find memo? ~A~%" (let->list (outlet (funclet f1)))) (test (length (map (lambda (x) x) ht)) 2)))) (let () (define-macro (define-memoized name&args . body) (let ((args (cdr name&args)) (memo (gensym "memo"))) `(define ,(car name&args) (let ((,memo (make-hash-table))) (lambda ,args (or (,memo (list ,@args)) (set! (,memo (list ,@args)) (begin ,@body)))))))) (define (ack m n) (cond ((= m 0) (+ n 1)) ((= n 0) (ack (- m 1) 1)) (else (ack (- m 1) (ack m (- n 1)))))) (define-memoized (ack1 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (ack1 (- m 1) 1)) (else (ack1 (- m 1) (ack1 m (- n 1)))))) (test (ack 2 3) (ack1 2 3))) (let ((ht (make-hash-table))) (test (eq? (car (catch #t (lambda () (set! (ht) 2)) (lambda args args))) 'wrong-number-of-args) #t) ;;(test (eq? (car (catch #t (lambda () (set! (ht 0 0) 2)) (lambda args args))) 'syntax-error) #t) (test (eq? (car (catch #t (lambda () (set! ((ht 0) 0) 2)) (lambda args args))) 'no-setter) #t)) (let () (define merge-hash-tables append) (let ((ht (merge-hash-tables (hash-table 'a 1 'b 2) (hash-table 'c 3)))) (test (ht 'c) 3)) (test ((append (hash-table 'a 1 'b 2) (hash-table 'c 3)) 'c) 3)) ;;; test the eq-func business (test (make-hash-table 8 '(atan abs)) 'error) (test (make-hash-table 8 (cons atan abs)) 'error) (test (make-hash-table 8 (cons eq? sqrt)) 'error) (let ((ht (make-hash-table 8 eq?))) (test (hash-table-ref ht 'a) #f) (hash-table-set! ht 'a 1) (hash-table-set! ht 'c 'd) (test (hash-table-ref ht 'a) 1) (hash-table-set! ht "hi" 3) (test (hash-table-ref ht "hi") #f) (set! (ht '(a . 1)) "ho") (test (ht '(a . 1)) #f) (let ((ht1 (copy ht))) (test (ht1 'a) 1) (test (ht1 "hi") #f) (set! (ht1 #\a) #\b) (test (ht1 #\a) #\b) (test (ht #\a) #f) (let ((ht2 (reverse ht1))) (test (ht1 #\a) #\b) (test (ht2 #\b) #\a) (test (ht2 'd) 'c))) (do ((i 0 (+ i 1))) ((= i 32)) (set! (ht (symbol "g" (number->string i))) i)) (test (ht 'a) 1) (test (ht 'g3) 3) (set! (ht ht) 123) (test (ht ht) 123)) (let ((ht (make-hash-table 31 string=?))) (test (length ht) 32) (set! (ht "hi") 'a) (test (ht "hi") 'a) (test (ht "Hi") #f) (test (set! (ht 32) 'b) (if (> (*s7* 'safety) 0) 'error 'b)) (test (ht 32) #f) ) (let ((ht (make-hash-table 8 string=?))) (set! (ht "a string longer than 8 chars") 32) (test (ht "a string longer than 8 chars") 32) (set! (ht "") 3) (test (ht "") 3) (set! (ht "") #f) (test (ht "") #f)) (let ((ht (make-hash-table 31 char=?))) (test (length ht) 32) (set! (ht #\a) 'a) (test (ht #\a) 'a) (test (ht #\A) #f) (test (set! (ht 32) 'b) (if (> (*s7* 'safety) 0) 'error 'b)) (test (ht 32) #f) ) (unless pure-s7 (let ((ht (make-hash-table 31 string-ci=?))) (test (length ht) 32) (set! (ht "hi") 'a) (test (ht "hi") 'a) (test (ht "Hi") 'a) (test (ht "HI") 'a) (test (set! (ht 32) 'b) (if (> (*s7* 'safety) 0) 'error 'b)) (test (ht 32) #f) ) (let ((ht (make-hash-table 31 char-ci=?))) (test (length ht) 32) (set! (ht #\a) 'a) (test (ht #\a) 'a) (test (ht #\A) 'a) (test (set! (ht 32) 'b) (if (> (*s7* 'safety) 0) 'error 'b)) (test (ht 32) #f) )) (let ((ht (make-hash-table 31 =))) (test (length ht) 32) (set! (ht 1) 'a) (test (ht 1.0) 'a) (test (ht 1+i) #f) (set! (ht 32) 'b) (test (ht 32) 'b) (set! (ht 1/2) 'c) (test (ht 0.5) 'c) ) (let ((ht (make-hash-table 31 eqv?))) (test (length ht) 32) (set! (ht 1) 'a) (test (ht 1.0) #f) (set! (ht 2.0) 'b) (test (ht 2.0) 'b) (set! (ht 32) 'b) (test (ht 32) 'b) (set! (ht #\a) 1) (test (ht #\a) 1) (set! (ht ()) 2) (test (ht ()) 2) (set! (ht abs) 3) (test (ht abs) 3) ) (let ((ht (make-hash-table 8 (cons string=? (lambda (a) (string-length a)))))) (set! (ht "a") 'a) (test (ht "a") 'a) (set! (ht "abc") 'abc) (test (ht "abc") 'abc)) (let ((ht (make-hash-table 8 (cons eq? (lambda (a) (hash-table-ref a a)))))) (test (set! (ht ht) 1) 'error)) ; ;hash-table mapper called recursively (let ((ht (make-hash-table 8 (cons (lambda (a b) (string=? a b)) string-length)))) (set! (ht "a") 'a) (test (ht "a") 'a) (set! (ht "abc") 'abc) (test (ht "abc") 'abc)) (let ((ht (make-hash-table 8 (cons (lambda (a b) (string=? a b)) (lambda (a) (string-length a)))))) (set! (ht "a") 'a) (test (ht "a") 'a) (set! (ht "abc") 'abc) (test (ht "abc") 'abc)) (let ((ht (make-hash-table 8 (cons string=? string-length)))) (set! (ht "a") 'a) (test (ht "a") 'a) (set! (ht "abc") 'abc) (test (ht "abc") 'abc)) (let-temporarily (((*s7* 'equivalent-float-epsilon) 1e-15)) (let ((h (make-hash-table 8 equal?))) (set! (h (make-int-vector 3 0)) 3) (test (h (make-int-vector 3 0)) 3) (test (h (make-vector 3 0)) 3) ; vector equality changed 19-Sep-18 (test (h (make-float-vector 3 0)) #f) (let ((x 1.0) (y (+ 1.0 (* 0.5 (*s7* 'equivalent-float-epsilon)))) (z (+ 1.0 (* 1000 (*s7* 'equivalent-float-epsilon))))) ; ! (set! (h x) 12) (test (h x) 12) (test (h y) #f) (test (h z) #f)))) (let ((h (make-hash-table 8 equivalent?))) (set! (h (make-int-vector 3 0)) 3) (test (h (make-int-vector 3 0)) 3) (test (h (make-vector 3 0)) 3) (test (h (make-float-vector 3 0)) 3) (let ((x 1.0) (y (+ 1.0 (* 0.5 (*s7* 'hash-table-float-epsilon)))) (z (+ 1.0 (* 2 (*s7* 'hash-table-float-epsilon))))) (set! (h x) 12) (test (h x) 12) (test (h y) 12) (test (h z) #f) (set! (h 1/10) 3) (test (h 0.1) 3) (set! (h #(1 2.0)) 4) (test (h (vector 1 2)) 4) (set! (h 1.0) 5) (test (h 1) 5) (set! (h (list 3)) 6) (test (h (list 3.0)) 6) )) (when with-block (let ((ht (make-hash-table 31 (cons hash_heq hash_hloc)))) (test (length ht) 32) (set! (ht 'a) 'b) (test (ht 'a) 'b) (test (ht 1) #f) (let ((ht1 (reverse ht))) (test (ht1 'b) 'a))) (let () ; Radium op_x_aa needs_copied_args bugs (collides with c_object equal test) (define (f h b ind) (h b ind)) (define (ftest) (let ((h1 (make-hash-table 8 equal?))) (let ((b1 (block 0 1 2)) (b2 (block 3 4 5))) (hash-table-set! h1 b1 (hash-table :a 1)) (hash-table-set! h1 b2 (inlet :a 2)) (test (f h1 b1 :a) 1) ; #f if bug (test (f h1 b2 :a) 2)))) (ftest))) (let ((ht (make-hash-table 31 equivalent?)) (ht1 (make-hash-table 31))) (test (length ht) 32) (test (equal? ht ht1) #t) (set! (ht 3) 1) (test (ht 3) 1) (set! (ht1 3) 1) (test (equal? ht ht1) #f) (set! (ht 3.14) 'a) (test (ht 3.14) 'a) (set! (ht "hi") 123) (test (ht "hi") 123) (set! (ht 1/0) #) (test (ht 1/0) #)) (let ((ht (make-hash-table 31 (cons (lambda (a b) (eq? a b)) (lambda (a) 0))))) (test (hash-table-ref ht 'a) #f) (hash-table-set! ht 'a 1) (hash-table-set! ht 'c 'd) (test (hash-table-ref ht 'a) 1) (hash-table-set! ht "hi" 3) (test (hash-table-ref ht "hi") #f) (set! (ht '(a . 1)) "ho") (test (ht '(a . 1)) #f) (let ((ht1 (copy ht))) (test (ht1 'a) 1) (test (ht1 "hi") #f) (test (equal? ht ht1) #t) (test (equal? ht1 ht) #t) (test (equivalent? ht ht1) #t) (test (equivalent? ht1 ht) #t) (set! (ht1 #\a) #\b) (test (ht1 #\a) #\b) (test (ht #\a) #f))) (when (provided? 'snd) (let ((ht (make-hash-table 31 (cons equal? mus-type)))) (let ((g1 (make-oscil 100)) (g2 (make-oscil 100))) (set! (ht g1) 32) (test (ht g1) 32) (test (ht g2) 32) (test (equal? g1 g2) #t)))) ;;; hash-table typers (test ((object->let (make-hash-table 8 #f (cons symbol? integer?))) 'signature) '(integer? hash-table? symbol?)) (let ((x (copy (make-hash-table 8 #f (cons symbol? integer?))))) (test ((object->let x) 'signature) '(integer? hash-table? symbol?))) (test (let ((h (make-hash-table 3 #f (list symbol? integer?)))) (set! (h 'a) 1) (fill! h #\a) h) 'error) (test (let ((h (make-hash-table 3 #f (cons symbol? integer?)))) (set! (h 'a) 1) (fill! h #\a) h) 'error) (test (let ((h (make-hash-table 3 #f (cons symbol? integer?)))) (set! (h 'a) 1) (fill! h #f) h) (hash-table)) (test (hash-table? (make-hash-table 8 eqv? (cons #t integer?))) #t) (test (hash-table? (make-hash-table 8 = (cons #t integer?))) #t) (test (make-hash-table 8 = (cons char? symbol?)) 'error) (test (make-hash-table 8 string=? (cons char? symbol?)) 'error) (test (hash-table? (make-hash-table 8 equal? (cons char? symbol?))) #t) (let ((ht (make-hash-table 8 #f (cons symbol? integer?)))) (test (hash-table-set! ht 'a 1) 1) (test (hash-table-ref ht 'a) 1) (test (fill! ht 32) 32) (test (hash-table-ref ht 'a) 32) (test (fill! ht 1/2) 'error) (test (hash-table-ref ht 'a) 32) (test (fill! ht #f) #f) (test (hash-table-ref ht 'a) #f) (test (hash-table-set! ht 'a 1) 1) (let-temporarily (((ht 'a) 2)) (test (ht 'a) 2)) (test (ht 'a) 1) (test (let-temporarily (((ht 'a) 1/2)) 21) 'error) (test (ht 'a) 1) (test (hash-table-set! ht 'a 1/2) 'error) (test (hash-table-set! ht 123 1) 'error) (test (ht 'a) 1) (let ((ht1 (hash-table 'a 2))) (test (copy ht1 ht) ht) (test (ht 'a) 2)) (let ((ht1 (hash-table 'a 1/2))) (test (copy ht1 ht) 'error) (test (ht 'a) 2)) (let ((ht1 (hash-table 123 1))) (test (copy ht1 ht) 'error) (test (ht 'a) 2)) (test (set! (ht 'a) 1/2) 'error) (test (set! (ht "a") 1) 'error) (test (ht 'a) 2) (test (set! (ht 'a) 3) 3) (test (ht 'a) 3) (let () (define (st) (hash-table-set! ht 'a 4)) (st) (st) (test (ht 'a) 4) (define (st1) (hash-table-set! ht 'a 1/2)) (test (st1) 'error) (test (st1) 'error) (test (ht 'a) 4))) (let () (define (boolean-or-integer? x) (or (boolean? x) (integer? x))) (let ((ht (make-hash-table 8 #f (cons symbol? boolean-or-integer?)))) (test (signature ht) '(boolean-or-integer? hash-table? symbol?)) (test (hash-table-set! ht 'a 21) 21) (test (hash-table-set! ht 'b #t) #t) (test (hash-table-set! ht 'c pi) 'error) (test (fill! ht 1) 1) (test (hash-table-ref ht 'a) 1) (test (fill! ht #\a) 'error) (let ((ht1 (copy ht))) (test (hash-table-set! ht1 'a #\a) 'error) (test (signature ht1) '(boolean-or-integer? hash-table? symbol?)))) (define (symbol-or-pi? x) (or (symbol? x) (eq? x pi))) (let ((ht (make-hash-table 8 #f (cons symbol-or-pi? boolean-or-integer?)))) (test (signature ht) '(boolean-or-integer? hash-table? symbol-or-pi?)) (test (hash-table-set! ht 'a 21) 21) (test (hash-table-set! ht 'b #t) #t) (test (hash-table-set! ht 'c pi) 'error) (test (hash-table-set! ht pi 0) 0) (test (fill! ht 1) 1) (test (hash-table-ref ht 'a) 1) (test (fill! ht #\a) 'error) (let ((ht1 (copy ht))) (test (hash-table-set! ht1 'a #\a) 'error) (test (signature ht1) '(boolean-or-integer? hash-table? symbol-or-pi?))))) #| (define constants (vector 1)) ; etc -- see tauto.scm (define ops (list eq? eqv? equal? equivalent? = char=? string=? char-ci=? string-ci=? (cons string=? (lambda (a) (string-length a))) (cons (lambda (a b) (string=? a b)) string-length))) (for-each (lambda (op) (for-each (lambda (val) (let ((h (make-hash-table 8 op))) (catch #t (lambda () (set! (h val) #t) (if (not (eq? (h val) (op val val))) (format *stderr* "~A ~A: ~A ~A~%" op val (h val) (op val val)))) (lambda any #f)))) constants)) ops) |# (let ((H1 (make-hash-table))) (set! (H1 H1) H1) (let ((H2 (hash-table H1 H1))) (test (string-wi=? (object->string (append H2 (make-hash-table 8 #f (cons symbol? integer?))) :readable) "(let ((<1> (hash-table))) (set! (<1> <1>) <1>) (hash-table <1> <1>))") #t) (test (object->string (append H2 (hash-table))) "(hash-table #1=(hash-table #1# #1#) #1#)"))) (let () (let ((ht (make-hash-table 31 (cons (lambda (a b) (eq? a b)) (lambda (a) 0))))) (hash-table-set! ht 'a 1) (test (ht 'a) 1)) (let ((ht (make-hash-table 31 (cons (lambda* (a b) (eq? a b)) (lambda (a) 0))))) (hash-table-set! ht 'a 1) (test (ht 'a) 1)) (let ((ht (make-hash-table 31 (cons (lambda* (a (b 0)) (eq? a b)) (lambda (a) 0))))) (hash-table-set! ht 'a 1) (test (ht 'a) 1)) (test (let ((ht (make-hash-table 31 (list (eq? a b))))) (hash-table-set! ht 'a 1) (ht 'a)) 'error) (test (let ((ht (make-hash-table 31 (cons abs +)))) (hash-table-set! ht 'a 1) (ht 'a)) 'error) (test (let ((ht (make-hash-table 31 (cons eq? float-vector-ref)))) (hash-table-set! ht 'a 1) (ht 'a)) 'error) (test (let ((ht (make-hash-table 31 (dilambda (lambda (a) (eq? a b)) (lambda (a) 0))))) (hash-table-set! ht 'a 1) (ht 'a)) 'error) (test (let ((ht (make-hash-table 31 (lambda a (eq? car a) (cadr s))))) (hash-table-set! ht 'a 1) (ht 'a)) 'error) (test (let ((ht (make-hash-table 31 (cons (lambda (a b c) (eq? a b)) (lambda (a) 0))))) (hash-table-set! ht 'a 1) (ht 'a)) 'error) (test (let ((ht (make-hash-table 31 (define-macro (_m_ . args) #f)))) (hash-table-set! ht 'a 1) (ht 'a)) 'error) (test (let ((ht (make-hash-table 31 abs))) (hash-table-set! ht 'a 1) (ht 'a)) 'error) (test (let ((ht (make-hash-table 31 list-set!))) (hash-table-set! ht 'a 1) (ht 'a)) 'error)) (let () (define (test-hash size) (let ((c #t)) (let ((int-hash (make-hash-table (max size 511) (cons (lambda (a b) (= a b)) (lambda (a) a))))) (do ((i 0 (+ i 1))) ((= i size)) (hash-table-set! int-hash i i)) (do ((i 0 (+ i 1))) ((= i size)) (let ((x (hash-table-ref int-hash i))) (if (not (= x i)) (format *stderr* ";test-hash(0) ~D -> ~D~%" i x))))) (let ((int-hash (make-hash-table (max size 511) (cons (lambda (a b) (and c (= a b))) (lambda (a) a))))) (do ((i 0 (+ i 1))) ((= i size)) (hash-table-set! int-hash i i)) (do ((i 0 (+ i 1))) ((= i size)) (let ((x (hash-table-ref int-hash i))) (if (not (= x i)) (format *stderr* ";test-hash(1) ~D -> ~D~%" i x))))) (let ((int-hash (make-hash-table (max size 511) (let ((c #f)) (cons (lambda (a b) (and (not c) (= a b))) (lambda (a) a)))))) (do ((i 0 (+ i 1))) ((= i size)) (hash-table-set! int-hash i i)) (do ((i 0 (+ i 1))) ((= i size)) (let ((x (hash-table-ref int-hash i))) (if (not (= x i)) (format *stderr* ";test-hash(2) ~D -> ~D~%" i x))))) )) (test-hash 10)) (let () ; check hash-table-increment internals (define (g word) (let ((ht (hash-table))) (hash-table-set! ht word (+ (or (hash-table-ref ht word) 0) 1)) (let ((x (hash-table-ref ht word))) (do ((i 3 (+ i 1))) ((= i 6)) (set! x i)) (hash-table-ref ht word)))) (test (g 'i) 1) (define (g1 word) (let ((ht (hash-table))) (hash-table-set! ht word (+ (or (hash-table-ref ht word) 0) 1)) (let ((x (hash-table-ref ht word))) (hash-table-set! ht word (+ (or (hash-table-ref ht word) 0) 1)) x))) (test (g1 'i) 1)) #| ;; another problem (let ((ht (make-hash-table)) (lst (list 1))) (set! (ht lst) 32) (let ((v1 (ht '(1))) (v2 (ht '(2)))) (set-car! lst 2) ; can't copy key unless equal? (let ((v3 (ht '(1))) (v4 (ht '(2)))) (list v1 v2 v3 v4)))) ; 32 #f #f #f (let ((ht (make-hash-table)) (lst (list 1))) (set! (ht (copy lst)) 32) (let ((v1 (ht '(1))) (v2 (ht '(2)))) (set-car! lst 2) (let ((v3 (ht '(1))) (v4 (ht '(2)))) (list v1 v2 v3 v4)))) ; 32 #f 32 #f |# (test (hash-table-set! (copy (make-hash-table 8 equivalent? (cons symbol? #t))) #\A (inlet 'a (inlet 'b 1))) 'error) (let ((source (hash-table #() "asdf")) (dest (make-hash-table 8 #f (cons symbol? integer?)))) (test (copy source dest) 'error)) (let ((H_3 (make-hash-table 8 (cons equal? hash-code))) (H_4 (make-hash-table 8 (let ((eqf (lambda (a b) (equal? a b))) (mapf (lambda (a) (hash-code a)))) (cons eqf mapf))))) (test (hash-table-set! H_3 # ()) ()) (test (hash-table? (copy H_3 H_4)) #t) (test (hash-table-set! H_4 'a 1) 1)) ;;; hash-table-key|value-typer (let ((h (hash-table 'a 1))) (for-each (lambda (arg) (test (hash-table-key-typer arg) 'error) (test (hash-table-value-typer arg) 'error) (test (set! (hash-table-key-typer arg) integer?) 'error) (test (set! (hash-table-key-typer h) arg) 'error) (test (set! (hash-table-value-typer h) arg) 'error)) (list "hi" #\a 1 () '(1 . 2) (cons #\a #\b) 'a-symbol #(1 2) _undef_ _null_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i :hi (if #f #f)))) (test (hash-table-key-typer (hash-table)) #f) (test (hash-table-key-typer (make-hash-table 8 eq? (cons symbol? integer?))) symbol?) (test (hash-table-value-typer (make-hash-table 8 eq? (cons symbol? integer?))) integer?) (test (hash-table-value-typer (hash-table)) #f) (let () (define H (make-hash-table 8 eq? (cons symbol? integer?))) (test (set! (hash-table-key-typer H) integer?) integer?) (test (hash-table-key-typer H) integer?) (test (set! (hash-table-key-typer H) #f) #f) (test (hash-table-key-typer H) #t) (test (set! (hash-table-key-typer H) symbol?) symbol?) (test (hash-table-key-typer H) symbol?) (test (set! (hash-table-value-typer H) integer?) integer?) (test (hash-table-value-typer H) integer?) (test (hash-table-key-typer H) symbol?)) (let ((h (make-hash-table 8 eq? (cons symbol? integer?)))) (immutable! h) (test (set! (hash-table-key-typer H) integer?) 'error)) (let ((h (make-hash-table 8))) (immutable! h) (test (set! (hash-table-key-typer H) integer?) 'error)) (let ((h (make-hash-table 8 eq? (cons symbol? integer?)))) (immutable! h) (test (set! (hash-table-value-typer H) real?) 'error)) (let ((h (make-hash-table 8))) (immutable! h) (test (set! (hash-table-value-typer H) real?) 'error)) (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (define (cf h) (lambda (h) #t)) (set! (hash-table-key-typer H) cf) (test (hash-table-set! H #t ()) 'error) (set! (hash-table-value-typer H) #t) (set! (hash-table-key-typer H) #t) (test (hash-table-set! H #t ()) ())) (let () ; check_hash_table_checker (define (f) (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (let-temporarily (((*s7* 'safety) 1)) (hash-table-set! H 'a 123)))) (test (f) 123)) (let () (define (typer x) (symbol? x)) (define h (make-hash-table 8 eq? (cons typer typer))) (test (equal? typer (hash-table-key-typer h)) #t) (test (catch #t (lambda () (set! (h 'a) 32)) (lambda (t i) (apply format #f i))) "hash-table-set! third argument 32, is an integer, but the hash-table's value type checker, typer, rejects it") (test (set! (hash-table-value-typer h) #f) #f) (test (catch #t (lambda () (set! (h 'a) 32)) (lambda (t i) (apply format #f i))) 32)) (test (hash-table-key-typer (append (let ((H (make-hash-table 4 eq? (cons symbol? integer?)))) (set! (H 'a) 1) H) (let ((H (make-hash-table 4 eq? (cons symbol? integer?)))) (set! (H 'b) 2) H))) symbol?) (test (object->string (hash-table) :readable) "(hash-table)") (test (object->string (make-hash-table 31 eqv?) :readable) "(make-hash-table 32 eqv?)") (test (let ((H (make-hash-table 8 eq?))) (object->string H :readable)) "(make-hash-table 8 eq?)") (test (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (object->string H :readable)) "(make-hash-table 8 eq? (cons symbol? integer?))") (test (let ((H (make-hash-table 8 eq?))) (set! (H 'a) 1) (object->string H :readable)) "(let (( (make-hash-table 8 eq?))) (copy (hash-table 'a 1) ))") (test (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 1) (object->string H :readable)) "(let (( (make-hash-table 8 eq? (cons symbol? integer?)))) (copy (hash-table 'a 1) ))") (test (let ((H1 (immutable! (hash-table 'a 1)))) (object->string H1 :readable)) "(immutable! (hash-table 'a 1))") (test (let () (define (10-12? val) (memv val '(10 12))) (object->string (make-hash-table 16 #f (cons #t 10-12?)) :readable)) "(make-hash-table 16 #f (cons #t 10-12?))") (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (test (object->string H :readable) "(make-hash-table 8 eq? (cons symbol? integer?))")) (let ((H (make-hash-table 8 eqv? (cons symbol? integer?)))) (test (object->string H :readable) "(make-hash-table 8 eqv? (cons symbol? integer?))")) (let ((H (make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0))))) (test (object->string H :readable) "(make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))")) (let ((H (make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)) (cons symbol? integer?)))) (test (object->string H :readable) "(make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)) (cons symbol? integer?))")) (let ((H (make-hash-table 8 (cons (lambda (a b) (eqv? a b)) (lambda (a) 0)) (cons symbol? integer?)))) (test (object->string H :readable) "(make-hash-table 8 (cons (lambda (a b) (eqv? a b)) (lambda (a) 0)) (cons symbol? integer?))")) (let ((H (make-hash-table 8 eqv? (cons integer? integer?)))) (test (object->string H :readable) "(make-hash-table 8 eqv? (cons integer? integer?))")) (let ((H (make-hash-table 8 eqv?))) (test (object->string H :readable) "(make-hash-table 8 eqv?)")) (let () (define (10-12? val) (memv val '(10 12))) (define hash (make-hash-table 8 #f (cons #t 10-12?))) (test (object->string hash :readable) "(make-hash-table 8 #f (cons #t 10-12?))")) (let () (define (10-12? val) (memv val '(10 12))) (define hash (make-hash-table 8 = (cons #t 10-12?))) (test (object->string hash :readable) "(make-hash-table 8 = (cons #t 10-12?))")) (test (object->string (make-hash-table 8 (cons string=? string-length)) :readable) "(make-hash-table 8 (cons string=? string-length))") (let ((H2 (make-hash-table 8 #f (cons string? integer?)))) (test (object->string H2 :readable) "(make-hash-table 8 #f (cons string? integer?))")) (let ((H2 (make-hash-table 8 equivalent? (cons string? integer?)))) (test (object->string H2 :readable) "(make-hash-table 8 equivalent? (cons string? integer?))")) (let ((H2 (make-hash-table 8 (cons string=? string-length) (cons string? integer?)))) (test (object->string H2 :readable) "(make-hash-table 8 (cons string=? string-length) (cons string? integer?))")) (let ((H2 (make-hash-table 8 (cons string=? string-length)))) (test (object->string H2 :readable) "(make-hash-table 8 (cons string=? string-length))")) (let ((H2 (make-hash-table 8 #f))) (test (object->string H2 :readable) "(hash-table)")) (let ((H2 (immutable! (make-hash-table 8 #f (cons string? integer?))))) (test (object->string H2 :readable) "(immutable! (make-hash-table 8 #f (cons string? integer?)))")) (let ((H2 (immutable! (make-hash-table 8 equivalent? (cons string? integer?))))) (test (object->string H2 :readable) "(immutable! (make-hash-table 8 equivalent? (cons string? integer?)))")) (let ((H2 (immutable! (make-hash-table 8 (cons string=? string-length) (cons string? integer?))))) (test (object->string H2 :readable) "(immutable! (make-hash-table 8 (cons string=? string-length) (cons string? integer?)))")) (let ((H2 (immutable! (make-hash-table 8 (cons string=? string-length))))) (test (object->string H2 :readable) "(immutable! (make-hash-table 8 (cons string=? string-length)))")) (let ((H2 (immutable! (make-hash-table 8 #f)))) (test (object->string H2 :readable) "(immutable! (hash-table))")) (let ((H2 (make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0))))) (test (object->string H2 :readable) "(make-hash-table 8 (cons (lambda (a b) (eq? a b)) (lambda (a) 0)))")) (let ((H2 (make-hash-table 8 (cons eq? (lambda (a) 0))))) (test (object->string H2 :readable) "(make-hash-table 8 (cons eq? (lambda (a) 0)))")) (let ((H2 (make-hash-table 8 (cons (lambda (a b) (eq? a b)) hash-code)))) (test (object->string H2 :readable) "(make-hash-table 8 (cons (lambda (a b) (eq? a b)) hash-code))")) (test (object->string (immutable! (hash-table))) "(hash-table)") (test (object->string (immutable! (hash-table)) :readable) "(immutable! (hash-table))") (test (object->string (immutable! (hash-table 'a 1)) :readable) "(immutable! (hash-table 'a 1))") (test (string-wi=? (object->string (immutable! (let ((H (hash-table))) (set! (H 'a) H) H)) :readable) "(let ((<1> (hash-table))) (set! (<1> 'a) <1>) (immutable! <1>))") #t) (test (object->string (make-hash-table 8 #f #f) :readable) "(hash-table)") (test (immutable? (copy (immutable! (hash-table 'a 1)))) #f) (let ((H (make-hash-table 32 (cons string=? string-length)))) (test (object->string H :readable) "(make-hash-table 32 (cons string=? string-length))") (let ((H1 (copy H))) (test (object->string H1 :readable) "(make-hash-table 32 (cons string=? string-length))")) (let ((H2 (make-hash-table 32))) (copy H H2) (test (object->string H2 :readable) "(hash-table)")) (set! (H "a") 32) (test (object->string H :readable) "(let (( (make-hash-table 32 (cons string=? string-length)))) (copy (hash-table \"a\" 32) ))") (let ((H1 (copy H))) (test (object->string H1 :readable) "(let (( (make-hash-table 32 (cons string=? string-length)))) (copy (hash-table \"a\" 32) ))") (test (set! (H1 'a) "asdf") 'error)) (let ((H2 (make-hash-table 32))) (copy H H2) (test (object->string H2 :readable) "(hash-table \"a\" 32)")) (set! H (make-hash-table 8 #f (cons symbol? integer?))) (test (object->string H :readable) "(make-hash-table 8 #f (cons symbol? integer?))") (let ((H1 (copy H))) (test (object->string H1 :readable) "(make-hash-table 8 #f (cons symbol? integer?))")) (let ((H2 (make-hash-table 32))) (copy H H2) (test (object->string H2 :readable) "(hash-table)")) (set! (H 'a) 32) (let ((H1 (copy H))) (test (object->string H1 :readable) "(let (( (make-hash-table 8 #f (cons symbol? integer?)))) (copy (hash-table 'a 32) ))")) (let ((H2 (make-hash-table 32))) (copy H H2) (test (object->string H2 :readable) "(hash-table 'a 32)")) (set! H (make-hash-table 8 (cons eq? hash-code) (cons symbol? integer?))) (test (object->string H :readable) "(make-hash-table 8 (cons eq? hash-code) (cons symbol? integer?))") (let ((H1 (copy H))) (test (object->string H1 :readable) "(make-hash-table 8 (cons eq? hash-code) (cons symbol? integer?))")) (let ((H2 (make-hash-table 32))) (copy H H2) (test (object->string H2 :readable) "(hash-table)")) (set! (H 'a) 32) (let ((H1 (copy H))) (test (hash-table-key-typer H1) symbol?) (test (object->string H1 :readable) "(let (( (make-hash-table 8 (cons eq? hash-code) (cons symbol? integer?)))) (copy (hash-table 'a 32) ))")) (let ((H2 (make-hash-table 32))) (copy H H2) (test (object->string H2 :readable) "(hash-table 'a 32)")) (let ((H1 (make-hash-table))) (set! (hash-table-value-typer H1) integer?) (test (object->string H1 :readable) "(make-hash-table 8 #f (cons #t integer?))")) (let ((H1 (make-hash-table))) (set! (H1 'a) 1) (set! (hash-table-value-typer H1) integer?) (set! (H1 'b) 2) (let ((str (object->string H1 :readable))) (test (or (string-wi=? str "(let (( (make-hash-table 8 #f (cons #t integer?)))) (copy (hash-table 'a 1 'b 2) ))") (string-wi=? str "(let (( (make-hash-table 8 #f (cons #t integer?)))) (copy (hash-table 'b 2 'a 1) ))")) #t))) (set! H (make-hash-table 8)) (let ((H1 (make-hash-table 32 (cons string=? string-length)))) (copy H H1) (test (object->string H1 :readable) "(make-hash-table 32 (cons string=? string-length))")) (let ((H2 (make-hash-table 8 #f (cons string? integer?)))) (test (hash-table-value-typer H2) integer?) (copy H H2) (test (object->string H2 :readable) "(make-hash-table 8 #f (cons string? integer?))")) (set! (H "a") 32) (let ((H1 (make-hash-table 32 (cons string=? string-length)))) (copy H H1) (test (object->string H1 :readable) "(let (( (make-hash-table 32 (cons string=? string-length)))) (copy (hash-table \"a\" 32) ))")) (let ((H2 (make-hash-table 8 #f (cons string? integer?)))) (copy H H2) (test (object->string H2 :readable) "(let (( (make-hash-table 8 string=? (cons string? integer?)))) (copy (hash-table \"a\" 32) ))")) (test (string-wi=? (let ((H (hash-table))) (set! (H 'a) H) (object->string H :readable)) "(let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>)") #t) (test (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 1) (object->string H :readable)) "(let (( (make-hash-table 8 eq? (cons symbol? integer?)))) (copy (hash-table 'a 1) ))") (test (let ((H (make-hash-table 8 eq?))) (set! (H 'a) 1) (object->string H :readable)) "(let (( (make-hash-table 8 eq?))) (copy (hash-table 'a 1) ))") (set! H (make-hash-table 8 eq?)) (set! (H 'a) H) (test (string-wi=? (object->string H :readable) "(let ((<1> (let (( (make-hash-table 8 eq?))) ))) (set! (<1> 'a) <1>) <1>)") #t) (set! H (make-hash-table 8 (cons eq? hash-code) (cons symbol? hash-table?))) (set! (H 'a) H) (test (string-wi=? (object->string H :readable) "(let ((<1> (let (( (make-hash-table 8 (cons eq? hash-code) (cons symbol? hash-table?)))) ))) (set! (<1> 'a) <1>) <1>)") #t) (let ((H1 (copy H))) (test (or (procedure? (hash-table-key-typer H1)) (procedure? (hash-table-value-typer H1))) #t) (test (string-wi=? (object->string H :readable) "(let ((<1> (let (( (make-hash-table 8 (cons eq? hash-code) (cons symbol? hash-table?)))) ))) (set! (<1> 'a) <1>) <1>)") #t)) (let ((H2 (make-hash-table 32))) (copy H H2) (test (or (procedure? (hash-table-key-typer H2)) (procedure? (hash-table-value-typer H2))) #f) (test (string-wi=? (object->string H2 :readable) "(let ((<1> (let (( (make-hash-table 8 (cons eq? hash-code) (cons symbol? hash-table?)))) ))) (set! (<1> 'a) <1>) (hash-table 'a <1>))") #t)) (set! H (make-hash-table 8 (cons equivalent? hash-code) (cons symbol? #t))) (set! (H 'a) H) (set! (H 'b) 2) (set! (H 'c) (list H)) (set! (H 'd) "hi") (let ((str (object->string H :readable))) (test H (eval-string str))) ) (let () (define H (hash-table 'a 1 'b 2 'c 3)) (let ((last-key #f)) (define (valtyp val) (or (not last-key) (eq? last-key 'a) (and (eq? last-key 'b) (<= 0 val 32)))) (define (keytyp key) (set! last-key key) #t) (set! (hash-table-key-typer H) keytyp) (set! (hash-table-value-typer H) valtyp)) ;; now a can be set but b must between 0..32 and c is immutable (test H (hash-table 'a 1 'b 2 'c 3)) (test (catch #t (lambda () (hash-table-set! H 'a 11)) (lambda (t i) (apply format #f i))) 11) (test (catch #t (lambda () (hash-table-set! H 'b 12)) (lambda (t i) (apply format #f i))) 12) (test (catch #t (lambda () (hash-table-set! H 'c 13)) (lambda (t i) (apply format #f i))) "hash-table-set! third argument 13, is an integer, but the hash-table's value type checker, valtyp, rejects it") (test H (hash-table 'a 11 'b 12 'c 3)) (test (catch #t (lambda () (hash-table-set! H 'a 111)) (lambda (t i) (apply format #f i))) 111) (test (catch #t (lambda () (hash-table-set! H 'b 112)) (lambda (t i) (apply format #f i))) "hash-table-set! third argument 112, is an integer, but the hash-table's value type checker, valtyp, rejects it") (test (catch #t (lambda () (hash-table-set! H 'c 113)) (lambda (t i) (apply format #f i))) "hash-table-set! third argument 113, is an integer, but the hash-table's value type checker, valtyp, rejects it") (test H (hash-table 'a 111 'b 12 'c 3)) (set! (H 'c) #f) (test H (hash-table 'a 111 'b 12))) (let () (define H_2 (make-hash-table 8 (cons equal? hash-code))) (set! (H_2 'a) 32) (test (H_2 'a) 32) (set! (H_2 'a) 12) (test (H_2 'a) 12) (set! (H_2 ()) #(1)) (test (H_2 ()) #(1)) (define H_3 (make-hash-table 8 (let ((eqf (lambda (a b) (equal? a b))) (mapf (lambda (a) (hash-code a)))) (cons eqf mapf)))) (set! (H_3 'a) 32) (test (H_3 'a) 32) (set! (H_3 'a) 12) (test (H_3 'a) 12) (set! (H_3 ()) #(1)) (test (H_3 ()) #(1)) (let ((H_4 (make-hash-table 8 (let ((eqf (lambda (a b) (equal? a b))) (mapf (lambda (a) (hash-code a)))) (cons eqf mapf)))) (last-key #f)) (define (valtyp val) (or (not last-key) (eq? last-key 'v1) (and (eq? last-key 'v2) (<= 0 val 32)))) (define (keytyp key) (set! last-key key) #t) (set! (hash-table-key-typer H_4) keytyp) (set! (hash-table-value-typer H_4) valtyp) (set! (H_4 'v1) "asdf") (set! (H_4 'v2) 12) (test (catch #t (lambda () (set! (H_4 'v3) 0)) (lambda (t i) (apply format #f i))) "hash-table-set! third argument 0, is an integer, but the hash-table's value type checker, valtyp, rejects it"))) (let ((L (openlet (inlet 'hash-table-key-typer (lambda (h) 123) 'hash-table-value-typer (lambda (h) 321) 'vector-typer (lambda (v) 231))))) (test (hash-table-key-typer L) 123) (test (hash-table-value-typer L) 321) (test (vector-typer L) 231)) (unless (provided? 'debug.scm) (let ((H_4 (make-hash-table 8 (let ((eqf (lambda (a b) (equal? a b))) (mapf (lambda (a) (hash-code a)))) (cons eqf mapf))))) (hash-table-set! H_4 #\7 begin) ;; (H_4 #\7) -> begin, (begin 0) -> 0! but this clobbered sc->args in implicit_index (let () (define (func) (let ((x #f) (i 0)) (let ((x (list (hash-table-ref H_4 #\7 (logxor))))) x))) (func)))) ; reuse permanent let in op_let1 (let ((H_2 (make-hash-table 8 eq? (cons symbol? integer?)))) (define (func) (copy (hash-table 'a 1) H_2)) (func) (func) (test (and (= (hash-table-entries H_2) 1) (eqv? (hash-table-ref H_2 'a) 1)) #t)) (let () (define (valtyp val) (integer? val)) (define (keytyp key) (string? key)) (define H (make-hash-table 8 (cons string=? string-length))) (set! (hash-table-key-typer H) keytyp) (set! (hash-table-value-typer H) valtyp) (hash-table-set! H "a" 1) (let ((HL (object->let H))) (test (HL 'signature) '(valtyp hash-table? keytyp)) (test (HL 'function) (list string=? string-length))) (test (object->string H :readable) "(let (( (make-hash-table 8 (cons string=? string-length) (cons keytyp valtyp)))) (copy (hash-table \"a\" 1) ))") (test (hash-table-key-typer H) keytyp) (test (hash-table-value-typer H) valtyp)) (let () (define H (make-hash-table 8 eqv? (cons string? integer?))) (hash-table-set! H "a" 1) (let ((HL (object->let H))) (test (HL 'signature) '(integer? hash-table? string?)) (test (HL 'function) 'eqv?)) (test (object->string H :readable) "(let (( (make-hash-table 8 eqv? (cons string? integer?)))) (copy (hash-table \"a\" 1) ))") (test (hash-table-key-typer H) string?) (test (hash-table-value-typer H) integer?)) (let () (define H (make-hash-table 8 string=? (cons string? integer?))) (hash-table-set! H "a" 1) (let ((HL (object->let H))) (test (HL 'signature) '(integer? hash-table? string?)) (test (HL 'function) 'string=?)) (test (object->string H :readable) "(let (( (make-hash-table 8 string=? (cons string? integer?)))) (copy (hash-table \"a\" 1) ))") (test (hash-table-key-typer H) string?) (test (hash-table-value-typer H) integer?)) (let () (define H (make-hash-table)) (define (keytyp key) (string? key)) (set! (hash-table-key-typer H) keytyp) (hash-table-set! H "a" 1) (let ((HL (object->let H))) (test (HL 'signature) '(#t hash-table? keytyp)) (test (HL 'function) 'string=?)) (test (object->string H :readable) "(let (( (make-hash-table 8 string=? (cons keytyp #t)))) (copy (hash-table \"a\" 1) ))") (test (hash-table-key-typer H) keytyp) (test (hash-table-value-typer H) #t)) (let () (define H (make-hash-table 8 #f (cons integer? integer?))) (hash-table-set! H 0 1) (let ((HL (object->let H))) (test (HL 'signature) '(integer? hash-table? integer?)) (test (HL 'function) '=)) (test (object->string H :readable) "(let (( (make-hash-table 8 #f (cons integer? integer?)))) (copy (hash-table 0 1) ))") (test (hash-table-key-typer H) integer?) (test (hash-table-value-typer H) integer?)) (let-temporarily ((*#readers* (cons (cons #\h (lambda (str) (and (string=? str "h") ; #h(...) (if (> (*s7* 'safety) 0) (immutable! (apply hash-table (read))) (apply hash-table (read)))))) *#readers*))) (test (eval-string "#h(:a 1)") (hash-table :a 1)) (test (eval-string "#h(:a 1 :b \"asdf\")") (hash-table :a 1 :b "asdf")) (test (eval-string "#h(a 1 b 2)") (hash-table 'a 1 'b 2)) ; 'a and :a are different keys in hash-tables: (test ((hash-table 'a 1) 'a) 1) ; but... (test ((hash-table :a 1) 'a) #f) ; (equal? 'a :a) is #f (test (eval-string "#h(:a #h(:b 2))") (hash-table :a (hash-table :b 2))) (test (eval-string "#h(:a #h(:b #i(2)))") (hash-table :a (hash-table :b (int-vector 2))))) ;;; -------------------------------------------------------------------------------- ;;; some implicit index tests (test (#(#(1 2) #(3 4)) 1 1) 4) (test (#("12" "34") 0 1) #\2) (test (#((1 2) (3 4)) 1 0) 3) (test (#((1 (2 3))) 0 1 0) 2) (test ((vector (hash-table 'a 1 'b 2)) 0 'a) 1) (test ((list (lambda (x) x)) 0 "hi") 'error) ; "hi") (test (let ((lst '("12" "34"))) (lst 0 1)) #\2) (test (let ((lst (list #(1 2) #(3 4)))) (lst 0 1)) 2) (test (#2d(("hi" "ho") ("ha" "hu")) 1 1 0) #\h) (test ((list (lambda (a) (+ a 1)) (lambda (b) (* b 2))) 1 2) 'error) ; 4) (test ((lambda (arg) arg) "hi" 0) 'error) (let ((L1 (list 1 2 3)) (V1 (vector 1 2 3)) (M1 #2d((1 2 3) (4 5 6) (7 8 9))) (S1 "123") (H1 (hash-table 1 1 2 2 3 3))) (let ((L2 (list L1 V1 M1 S1 H1)) (V2 (vector L1 V1 M1 S1 H1)) (H2 (hash-table 0 L1 1 V1 2 M1 3 S1 4 H1)) (M2 (let ((v (make-vector '(3 3)))) (set! (v 0 0) L1) (set! (v 0 1) V1) (set! (v 0 2) M1) (set! (v 1 0) S1) (set! (v 1 1) H1) (set! (v 1 2) L1) (set! (v 2 0) S1) (set! (v 2 1) H1) (set! (v 2 2) L1) v))) #| ;; this code generates the tests below (for-each (lambda (arg) (let* ((val (symbol->value arg)) (len (min 5 (length val)))) (do ((i 0 (+ i 1))) ((= i len)) (format *stderr* "(test (~S ~S) ~S)~%" arg i (catch #t (lambda () (val i)) (lambda args 'error))) (let ((len1 (catch #t (lambda () (min 5 (length (val i)))) (lambda args 0)))) (if (> len1 0) (do ((k 0 (+ k 1))) ((= k len1)) (format *stderr* "(test (~S ~S ~S) ~S)~%" arg i k (catch #t (lambda () (val i k)) (lambda args 'error))) (let ((len2 (catch #t (lambda () (min 5 (length (val i k)))) (lambda args 0)))) (if (> len2 0) (do ((m 0 (+ m 1))) ((= m len2)) (format *stderr* "(test (~S ~S ~S ~S) ~S)~%" arg i k m (catch #t (lambda () (val i k m)) (lambda args 'error))) (let ((len3 (catch #t (lambda () (min 5 (length (val i k m)))) (lambda args 0)))) (if (> len3 0) (do ((n 0 (+ n 1))) ((= n len3)) (format *stderr* "(test (~S ~S ~S ~S ~S) ~S)~%" arg i k m n (catch #t (lambda () (val i k m n)) (lambda args 'error))))))))))))))) (list 'L2 'V2 'M2 'H2)) |# (test (L2 0) '(1 2 3)) (test (L2 0 0) 1) (test (L2 0 1) 2) (test (L2 0 2) 3) (test (L2 1) #(1 2 3)) (test (L2 1 0) 1) (test (L2 1 1) 2) (test (L2 1 2) 3) (test (L2 2) #2d((1 2 3) (4 5 6) (7 8 9))) (test (L2 2 0) #(1 2 3)) (test (L2 2 0 0) 1) (test (L2 2 0 1) 2) (test (L2 2 0 2) 3) (test (L2 2 1) #(4 5 6)) (test (L2 2 1 0) 4) (test (L2 2 1 1) 5) (test (L2 2 1 2) 6) (test (L2 2 2) #(7 8 9)) (test (L2 2 2 0) 7) (test (L2 2 2 1) 8) (test (L2 2 2 2) 9) (test (L2 2 3) 'error) (test (L2 2 4) 'error) (test (L2 3) "123") (test (L2 3 0) #\1) (test (L2 3 1) #\2) (test (L2 3 2) #\3) (test (L2 4) H1) (test (L2 4 0) #f) (test (L2 4 1) 1) (test (L2 4 2) 2) (test (L2 4 3) 3) (test (L2 4 4) #f) (test (V2 0) '(1 2 3)) (test (V2 0 0) 1) (test (V2 0 1) 2) (test (V2 0 2) 3) (test (V2 1) #(1 2 3)) (test (V2 1 0) 1) (test (V2 1 1) 2) (test (V2 1 2) 3) (test (V2 2) #2d((1 2 3) (4 5 6) (7 8 9))) (test (V2 2 0) #(1 2 3)) (test (V2 2 0 0) 1) (test (V2 2 0 1) 2) (test (V2 2 0 2) 3) (test (V2 2 1) #(4 5 6)) (test (V2 2 1 0) 4) (test (V2 2 1 1) 5) (test (V2 2 1 2) 6) (test (V2 2 2) #(7 8 9)) (test (V2 2 2 0) 7) (test (V2 2 2 1) 8) (test (V2 2 2 2) 9) (test (V2 2 3) 'error) (test (V2 2 4) 'error) (test (V2 3) "123") (test (V2 3 0) #\1) (test (V2 3 1) #\2) (test (V2 3 2) #\3) (test (V2 4) H1) (test (V2 4 0) #f) (test (V2 4 1) 1) (test (V2 4 2) 2) (test (V2 4 3) 3) (test (V2 4 4) #f) (test (M2 0) #((1 2 3) #(1 2 3) #2d((1 2 3) (4 5 6) (7 8 9)))) (test (M2 0 0) '(1 2 3)) (test (M2 0 0 0) 1) (test (M2 0 0 1) 2) (test (M2 0 0 2) 3) (test (M2 0 1) #(1 2 3)) (test (M2 0 1 0) 1) (test (M2 0 1 1) 2) (test (M2 0 1 2) 3) (test (M2 0 2) #2d((1 2 3) (4 5 6) (7 8 9))) (test (M2 0 2 0) #(1 2 3)) (test (M2 0 2 0 0) 1) (test (M2 0 2 0 1) 2) (test (M2 0 2 0 2) 3) (test (M2 0 2 1) #(4 5 6)) (test (M2 0 2 1 0) 4) (test (M2 0 2 1 1) 5) (test (M2 0 2 1 2) 6) (test (M2 0 2 2) #(7 8 9)) (test (M2 0 2 2 0) 7) (test (M2 0 2 2 1) 8) (test (M2 0 2 2 2) 9) (test (M2 0 2 3) 'error) (test (M2 0 2 4) 'error) (test (M2 1) (vector "123" H1 '(1 2 3))) (test (M2 1 0) "123") (test (M2 1 0 0) #\1) (test (M2 1 0 1) #\2) (test (M2 1 0 2) #\3) (test (M2 1 1) H1) (test (M2 1 1 0) #f) (test (M2 1 1 1) 1) (test (M2 1 1 2) 2) (test (M2 1 1 3) 3) (test (M2 1 1 4) #f) (test (M2 1 2) '(1 2 3)) (test (M2 1 2 0) 1) (test (M2 1 2 1) 2) (test (M2 1 2 2) 3) (test (M2 2) (vector "123" H1 '(1 2 3))) (test (M2 2 0) "123") (test (M2 2 0 0) #\1) (test (M2 2 0 1) #\2) (test (M2 2 0 2) #\3) (test (M2 2 1) H1) (test (M2 2 1 0) #f) (test (M2 2 1 1) 1) (test (M2 2 1 2) 2) (test (M2 2 1 3) 3) (test (M2 2 1 4) #f) (test (M2 2 2) '(1 2 3)) (test (M2 2 2 0) 1) (test (M2 2 2 1) 2) (test (M2 2 2 2) 3) (test (M2 3) 'error) (test (M2 4) 'error) (test (H2 0) '(1 2 3)) (test (H2 0 0) 1) (test (H2 0 1) 2) (test (H2 0 2) 3) (test (H2 1) #(1 2 3)) (test (H2 1 0) 1) (test (H2 1 1) 2) (test (H2 1 2) 3) (test (H2 2) #2d((1 2 3) (4 5 6) (7 8 9))) (test (H2 2 0) #(1 2 3)) (test (H2 2 0 0) 1) (test (H2 2 0 1) 2) (test (H2 2 0 2) 3) (test (H2 2 1) #(4 5 6)) (test (H2 2 1 0) 4) (test (H2 2 1 1) 5) (test (H2 2 1 2) 6) (test (H2 2 2) #(7 8 9)) (test (H2 2 2 0) 7) (test (H2 2 2 1) 8) (test (H2 2 2 2) 9) (test (H2 2 3) 'error) (test (H2 2 4) 'error) (test (H2 3) "123") (test (H2 3 0) #\1) (test (H2 3 1) #\2) (test (H2 3 2) #\3) (test (H2 4) H1) (test (H2 4 0) #f) (test (H2 4 1) 1) (test (H2 4 2) 2) (test (H2 4 3) 3) (test (H2 4 4) #f) )) (let* ((L1 (cons 1 2)) (L2 (list L1 3))) (test (L1 0) 1) (test (L1 1) 'error) (test (L1 2) 'error) (test (L2 0 0) 1) (test (L2 0 1) 'error) (test ((cons "123" 0) 0 1) #\2)) (let ((L1 (list "123" "456" "789"))) (set-cdr! (cdr L1) L1) (test (L1 0 1) #\2) (test (L1 1 1) #\5) (test (L1 2 1) #\2) (test (L1 12 0) #\1)) (let ((L1 (list "123" "456" "789"))) (set-car! (cdr L1) L1) (test (L1 1 1 1 1 1 0 0) #\1)) (test ((list (list) "") 1 0) 'error) (test ((list (list) "") 0 0) 'error) (test (#(1 2) 0 0) 'error) (test (#(1 #()) 1 0) 'error) (test ('(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((12))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) 12) ;;; implicit index as expression (_A cases) (let ((L1 (list 1 2 3)) (V1 (vector 1 2 3)) (S1 "123") (H1 (hash-table 1 1 2 2 3 3)) (E1 (inlet :a 1 :b 2))) (define (f1 i s L V S H E) (vector (L (+ i 1)) (V (+ i 1)) (S (+ i 1)) (H (+ i 1)) (E (string->symbol s)))) (test (f1 0 "a" L1 V1 S1 H1 E1) (vector 2 2 #\2 1 1)) (test (f1 1 "b" L1 V1 S1 H1 E1) (vector 3 3 #\3 2 2)) (define (f2 i s L V S H E) (vector (L (abs i)) (V (abs i)) (S (abs i)) (H (abs i)) (E (vector-ref s 0)))) (test (f2 -2 #(b a) L1 V1 S1 H1 E1) (vector 3 3 #\3 2 2))) (when with-block (define (f3 B i) (B (+ i 1))) (define (f4 B i) (B (abs i))) (let ((b (make-block 4))) (set! (b 0) 1.0) (set! (b 1) 2.0) (test (f3 b -1) 1.0) (test (f4 b -1) 2.0))) (let ((v1 #(0 1 2 3 4 5 6 7)) (v2 #2d((0 1 2 3) (4 5 6 7))) (e1 (inlet :a 1)) (p1 (list 0 1 2 3)) (s1 "0123") ) (define (call-1 func arg1 arg2) (func arg1 arg2)) (define (call-2 func arg1 arg2) (func arg1 arg2)) (define (call-3 func arg1 arg2) (func arg1 arg2)) (define (call-4 func arg1 arg2) (func arg1 arg2)) (define (call-5 func arg1 arg2) (func arg1 arg2)) (define (call-6 func) (func 'a)) (define (call-7 func) (func 'a)) (define (call-8 func arg) (func (* 2 (+ arg 1)))) (define (call-9 func arg) (func (* 2 (+ arg 1)))) (define (call-10 func arg) (func arg)) (define (call-11 func arg) (func arg)) (define (call-12 func) (func 0)) (define (call-13 func) (func 0)) (define (call-14 func arg) (func arg 2)) (define (call-15 func arg) (func 2 arg)) (define (f+ x y) (+ x y)) (define (f- x y) (- x y)) (define* (f++ (x 0) y) (+ x y)) (define* (f-- x (y 0)) (- x y)) (define (fabs x) (abs x)) (define-macro (m+ x y) `(+ ,x ,y)) (test (call-1 + 5 2) 7) (test (call-1 f- 5 2) 3) (test (call-2 f+ 5 2) 7) (test (call-2 - 5 2) 3) (test (call-3 v2 0 3) 3) (test (call-3 list 0 3) (list 0 3)) (test (call-4 f++ 5 2) 7) (test (call-4 f-- 5 2) 3) (test (call-5 m+ 5 2) 7) (test (call-5 - 5 2) 3) (test (call-6 e1) 1) (test (call-6 symbol?) #t) (test (call-7 symbol?) #t) (test (call-7 list) (list 'a)) (test (call-8 abs -3) 4) (test (call-8 f-- 10) 22) (test (call-9 fabs -3) 4) (test (call-9 list -3) (list -4)) (test (call-10 e1 'a) 1) (test (call-10 list 'a) (list 'a)) (test (call-11 symbol? 'a) #t) (test (call-11 e1 'a) 1) (test (call-12 p1) 0) (test (call-12 s1) #\0) (test (call-13 v1) 0) (test (call-13 (lambda (x) (+ x 1))) 1) (test (call-14 * 3) 6) (test (call-14 (lambda (x y) (- x y)) 3) 1) (test (call-15 (lambda (x y) (- x y)) 3) -1) (test (call-15 - 3) -1) ) ;; multi-index get/set (let ((v (vector (hash-table 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5)) (let ((v (vector (inlet 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5)) (let ((v (vector (list 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5)) (let ((v (vector (string #\1 #\2)))) (test (v 0 1) #\2) (set! (v 0 1) #\5) (test (v 0 1) #\5)) (let ((v (vector (vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5)) (let ((v (vector (byte-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5)) (when with-block (let ((v (vector (block 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0))) (let ((v (vector (float-vector 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0)) (let ((v (vector (int-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5)) (let ((v (list (hash-table 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5)) (let ((v (list (inlet 'a 1 'b 2)))) (test (v 0 'a) 1) (set! (v 0 'a) 5) (test (v 0 'a) 5)) (let ((v (list (list 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5)) (let ((v (list (string #\1 #\2)))) (test (v 0 1) #\2) (set! (v 0 1) #\5) (test (v 0 1) #\5)) (let ((v (list (vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5)) (let ((v (list (byte-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5)) (when with-block (let ((v (list (block 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0))) (let ((v (list (float-vector 1 2)))) (test (v 0 1) 2.0) (set! (v 0 1) 5) (test (v 0 1) 5.0)) (let ((v (list (int-vector 1 2)))) (test (v 0 1) 2) (set! (v 0 1) 5) (test (v 0 1) 5)) (let ((v (hash-table 'a (hash-table 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5)) (let ((v (hash-table 'a (inlet 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5)) (let ((v (hash-table 'a (list 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5)) (let ((v (hash-table 'a (string #\1 #\2)))) (test (v 'a 1) #\2) (set! (v 'a 1) #\5) (test (v 'a 1) #\5)) (let ((v (hash-table 'a (vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5)) (let ((v (hash-table 'a (byte-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5)) (when with-block (let ((v (hash-table 'a (block 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0))) (let ((v (hash-table 'a (float-vector 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0)) (let ((v (hash-table 'a (int-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5)) (let ((v (inlet 'a (hash-table 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5)) (let ((v (inlet 'a (inlet 'a 1 'b 2)))) (test (v 'a 'a) 1) (set! (v 'a 'a) 5) (test (v 'a 'a) 5)) (let ((v (inlet 'a (list 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5)) (let ((v (inlet 'a (string #\1 #\2)))) (test (v 'a 1) #\2) (set! (v 'a 1) #\5) (test (v 'a 1) #\5)) (let ((v (inlet 'a (vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5)) (let ((v (inlet 'a (byte-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5)) (when with-block (let ((v (inlet 'a (block 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0))) (let ((v (inlet 'a (float-vector 1 2)))) (test (v 'a 1) 2.0) (set! (v 'a 1) 5) (test (v 'a 1) 5.0)) (let ((v (inlet 'a (int-vector 1 2)))) (test (v 'a 1) 2) (set! (v 'a 1) 5) (test (v 'a 1) 5)) (let ((v (vector (list 1 2)))) (set! (v 0 0) 12) (test v #((12 2)))) (let ((v (vector (vector (list 1 2))))) (set! (v 0 0 0) 12) (test v #(#((12 2))))) (let ((v (vector (list 1 2 3) #f))) (set! (v 0 1) 121) (test v #((1 121 3) #f))) (let ((v (make-vector '(2 2) #f))) (set! (v 0 0) (list 1 2 3)) (set! ((v 0 0) 1) 32) (test (v 0 0 1) 32) (set! (v 0 0 1) 12) (test v #2d(((1 12 3) #f) (#f #f)))) (test (let ((L (list 1 2 3))) (set! (L (- 4 3 1)) 2) L) '(2 2 3)) (test (let ((L (list 1 2 3)) (zero 0)) (set! (L zero) 2) L) '(2 2 3)) (test (let ((L (list (list 1 2 3)))) (set! (L (- (length L) 1) 2) 0) L) '((1 2 0))) (test (let ((L (list 1 2 3))) (set! (L) 1)) 'error) ; no index for list-set!: (set! (L) 1) (test (let ((L (hash-table 'b (hash-table 'a 1)))) (set! (L (symbol "b") (symbol "a")) 0) L) (hash-table 'b (hash-table 'a 0))) (test (let ((L (inlet 'b (inlet 'a 1)))) (set! (L (symbol "b") (symbol "a")) 0) L) (inlet 'b (inlet 'a 0))) (test (let ((L (inlet 'b (inlet 'a 1)))) (set! (L) 0) L) 'error) (test (let ((v (make-vector '(2 2) 1))) (set! (v 0 1+i) 61)) 'error) (test (let ((H (hash-table 'a (inlet 'a (list 1 2 3))))) (set! (H 'a 'a 1) 12) (H 'a 'a 1)) 12) (let ((ind 0) (sym 'a) (v (vector (hash-table 'a 1 'b 2)))) (test (v ind sym) 1) (set! (v (+ ind ind) sym) (+ ind 5)) (test (v 0 'a) 5)) (let ((v (vector (hash-table 'a "123" 'b 2)))) (test (v 0 'a 1) #\2) (set! (v 0 'a 1) #\5) (test (v 0 'a) "153")) (let ((iv (make-vector '(2 2)))) (set! (iv 1 0) 2) (set! (iv 1 1) 4) (let ((v (vector iv))) (test (v 0 1 0) 2) (set! (v 0 1 0) 5) (test (v 0 1) #(5 4)))) (let ((ov (make-vector '(2 2))) (iv (make-vector '(2 2)))) (set! (ov 1 0) iv) (set! (iv 0 1) 3) (test (ov 1 0 0 1) 3) (set! (ov 1 0 0 1) 5) (test (ov 1 0 0 1) 5)) (test (let () (define (func) (abs ((list #f #r(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1.0) (test (let () (define (func) (abs ((list #f #i(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1) (test (let () (define (func) (abs ((list #f #(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1) (test (let () (define (func) (abs ((list #f #u(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1) (test (let () (define (func) (char->integer ((list #f "123") 1 0))) (define (hi) (func)) (hi)) (char->integer #\1)) (test (let () (define (func) (abs ((list #f (lambda (x) (+ x 10))) 1 0))) (define (hi) (func)) (hi)) 'error) ; 10) (test (let () (define (func) (abs ((list #f ceiling) 1 1.1))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((list #f quasiquote) 1 2))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((list #f (define-macro (_m_ x) `(+ ,x 1))) 1 2))) (define (hi) (func)) (hi)) 3) (test (let () (define (func) (abs ((list #f (inlet 'a -2)) 1 :a))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((list #f (inlet :a -2)) 1 :a))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((list #f (inlet 'a -2)) 1 'a))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((list #f (inlet :a -2)) 1 'a))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((list #f (hash-table :a -2)) 1 :a))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((list #f (hash-table 'a -2)) 1 'a))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((list #f begin) 1 3))) (define (hi) (func)) (hi)) 3) (test (let () (define (func) (abs ((list #f when) 1 #t 4))) (define (hi) (func)) (hi)) 4) (test (let () (define (func) (abs (list-ref (list #f (list #i(1 2 3))) 1 0 0))) (define (hi) (func)) (hi)) 1) ; 'error -- implicit_index (test (let () (define (func) (abs (list-ref (list #f #i(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1) ; 'error -- same (test (let () (define (func) (abs (vector-ref (vector #f '(1 2 3)) 1 0))) (define (hi) (func)) (hi)) 1) ; same (test (let () (define (func) (abs ((inlet 'a (inlet 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((inlet 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs (hash-table-ref (hash-table 'a (hash-table 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((hash-table 'a (hash-table 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 2) (test (let () (define (func) (abs ((hash-table 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 2) ;;; (hash-table 'a 1) is different from (hash-table :a 1): (test (let () (define (func) (abs ((list #f (hash-table 'a -2)) 1 :a))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (abs ((list #f (hash-table :a -2)) 1 'a))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (abs (let-ref (inlet 'a (inlet 'b 2)) 'a 'b))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (abs (hash-table-ref (hash-table 'a (vector 1 2 3)) 'a 1))) (define (hi) (func)) (hi)) 2) ; see above 'error (when with-block (test (let ((B (block 0 1 2)) (I 1)) (set! (B (- I 1)) 32) B) (block 32 1 2)) (test (let ((B (block 0 1 2)) (I 1)) (set! (B I) (* 12 I)) B) (block 0 12 2))) ;;; -------------------------------------------------------------------------------- ;;; PORTS ;;; -------------------------------------------------------------------------------- ;;; with-output-to-string ;;; with-output-to-file ;;; call-with-output-string ;;; call-with-output-file ;;; with-input-from-string ;;; with-input-from-file ;;; call-with-input-string ;;; call-with-input-file ;;; read-char ;;; peek-char ;;; close-input-port ;;; close-output-port ;;; flush-output-port ;;; open-input-file ;;; open-output-file ;;; open-input-string ;;; open-output-string ;;; get-output-string ;;; open-input-function ;;; open-output-function ;;; write-char ;;; write-string ;;; read-byte ;;; write-byte ;;; read-line ;;; read-string ;;; read ;;; write ;;; display (define start-input-port (current-input-port)) (define start-output-port (current-output-port)) (test (input-port? (current-input-port)) #t) (test (input-port? *stdin*) #t) (test (input-port? (current-output-port)) #f) (test (input-port? *stdout*) #f) (test (input-port? (current-error-port)) #f) (test (input-port? *stderr*) #f) (for-each (lambda (arg) (if (input-port? arg) (format #t ";(input-port? ~A) -> #t?~%" arg))) (list "hi" #f (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f :hi # # #)) (test (call-with-input-file "s7test.scm" input-port?) #t) (if (not (eq? start-input-port (current-input-port))) (format #t "call-with-input-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port))) (test (let ((this-file (open-input-file "s7test.scm"))) (let ((res (input-port? this-file))) (close-input-port this-file) res)) #t) (if (not (eq? start-input-port (current-input-port))) (format #t "open-input-file clobbered current-input-port? ~A from ~A~%" start-input-port (current-input-port))) (test (call-with-input-string "(+ 1 2)" input-port?) #t) (test (let ((this-file (open-input-string "(+ 1 2)"))) (let ((res (input-port? this-file))) (close-input-port this-file) res)) #t) (test (let ((this-file (open-input-string "(+ 1 2)"))) (let ((len (length this-file))) (close-input-port this-file) len)) 7) ;;; (test (let ((str "1234567890")) (let ((p (open-input-string str))) (string-set! str 0 #\a) (let ((c (read-char p))) (close-input-port p) c))) #\1) ;;; is that result demanded by the scheme spec? perhaps make str immutable if so? (test (+ 100 (call-with-input-string "123" (lambda (p) (values (read p) 1)))) 224) (test (catch #t (lambda () (with-input-from-string "asdf" #(0 1 2))) (lambda (typ info) (apply format #f info))) "with-input-from-string second argument, #(0 1 2), is a vector but should be a thunk") (test (catch #t (lambda () (with-input-from-string "asdf" abs)) (lambda (typ info) (apply format #f info))) "abs requires 1 argument, but with-input-from-string's second argument should be a thunk") (test (catch #t (lambda () (with-input-from-string "asdf" (lambda (x y z) z))) (lambda (typ info) (apply format #f info))) "# requires 3 arguments, but with-input-from-string's second argument should be a thunk") (test (catch #t (lambda () (with-input-from-file "s7test.scm" #(0 1 2))) (lambda (typ info) (apply format #f info))) "with-input-from-file second argument, #(0 1 2), is a vector but should be a thunk") (test (catch #t (lambda () (with-input-from-file "s7test.scm" (macro (x z) x))) (lambda (typ info) (apply format #f info))) "# requires 2 arguments, but with-input-from-file's second argument should be a thunk") (test (catch #t (lambda () (with-input-from-file "s7test.scm" quasiquote)) (lambda (typ info) (apply format #f info))) "#_quasiquote requires 1 argument, but with-input-from-file's second argument should be a thunk") (test (catch #t (lambda () (with-output-to-string #(0 1 2))) (lambda (typ info) (apply format #f info))) "with-output-to-string first argument, #(0 1 2), is a vector but should be a thunk") (test (catch #t (lambda () (with-output-to-string (lambda (x . z) x))) (lambda (typ info) (apply format #f info))) "# requires 1 argument, but with-output-to-string's first argument should be a thunk") (test (catch #t (lambda () (with-output-to-file "hi" #i(0 1 2))) (lambda (typ info) (apply format #f info))) "with-output-to-file second argument, #i(0 1 2), is an int-vector but should be a thunk") (test (catch #t (lambda () (with-output-to-file "hi" (bacro (x y . z) x))) (lambda (typ info) (apply format #f info))) "# requires 2 arguments, but with-output-to-file's second argument should be a thunk") (let ((p (open-input-string "asdf"))) (test (display pi p) 'error) (test (write pi p) 'error) (test (close-output-port p) 'error) (test (flush-output-port p) 'error) (close-input-port p) (test (read p) 'error)) (let ((p (open-output-string))) (test (read-char p) 'error) (test (read-byte p) 'error) (test (read-line p) 'error) (test (read-string 1 p) 'error) (test (read-line p) 'error) (test (close-input-port p) 'error) (close-output-port p) (test (display pi p) 'error) (test (write pi p) 'error)) (let () ; write_p_p (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (write (floor pi)))) (test (with-output-to-string f) "3")) (test (call-with-input-string "1234567890" (lambda (p) (call-with-input-string "0987654321" (lambda (q) (+ (read p) (read q)))))) 2222222211) (test (call-with-input-string "12345 67890" (lambda (p) (call-with-input-string "09876 54321" (lambda (q) (- (+ (read p) (read q)) (read p) (read q)))))) -99990) (call-with-output-file "empty-file" (lambda (p) #f)) (test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-char p)))) #t) (test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read p)))) #t) (test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-byte p)))) #t) (test (call-with-input-file "empty-file" (lambda (p) (eof-object? (read-line p)))) #t) (test (load "empty-file") #) (test (call-with-input-file "empty-file" (lambda (p) (port-closed? p))) #f) (test (eof-object? (call-with-input-string "" (lambda (p) (read p)))) #t) (test (eof-object? #) #t) (test (let () (define (hi a) (eof-object? a)) (hi #)) #t) (let () (define (io-func) (lambda (p) (eof-object? (read-line p)))) (test (call-with-input-file (let () "empty-file") (io-func)) #t)) (let ((p1 #f)) (call-with-output-file "empty-file" (lambda (p) (set! p1 p) (write-char #\a p))) (test (port-closed? p1) #t)) (test (call-with-input-file "empty-file" (lambda (p) (and (char=? (read-char p) #\a) (eof-object? (read-char p))))) #t) (test (call-with-input-file "empty-file" (lambda (p) (and (string=? (symbol->string (read p)) "a") (eof-object? (read p))))) #t) ; Guile also returns a symbol here (test (call-with-input-file "empty-file" (lambda (p) (and (char=? (integer->char (read-byte p)) #\a) (eof-object? (read-byte p))))) #t) (test (call-with-input-file "empty-file" (lambda (p) (and (string=? (read-line p) "a") (eof-object? (read-line p))))) #t) (test (call-with-input-string "(lambda (a) (+ a 1))" (lambda (p) (let ((f (eval (read p)))) (f 123)))) 124) (test (call-with-input-string "(let ((x 21)) (+ x 1))" (lambda (p) (eval (read p)))) 22) (test (call-with-input-string "(1 2 3) (4 5 6)" (lambda (p) (list (read p) (read p)))) '((1 2 3) (4 5 6))) (test (let () (call-with-output-file "empty-file" (lambda (p) (write '(lambda (a) (+ a 1)) p))) (call-with-input-file "empty-file" (lambda (p) (let ((f (eval (read p)))) (f 123))))) 124) (test (let () (call-with-output-file "empty-file" (lambda (p) (write '(let ((x 21)) (+ x 1)) p))) (call-with-input-file "empty-file" (lambda (p) (eval (read p))))) 22) (test (let () (call-with-output-file "empty-file" (lambda (p) (write '(1 2 3) p) (write '(4 5 6) p))) (call-with-input-file "empty-file" (lambda (p) (list (read p) (read p))))) '((1 2 3) (4 5 6))) (call-with-output-file "empty-file" (lambda (p) (for-each (lambda (c) (write-char c p)) "#b11"))) (test (call-with-input-file "empty-file" (lambda (p) (and (char=? (read-char p) #\#) (char=? (read-char p) #\b) (char=? (read-char p) #\1) (char=? (read-char p) #\1) (eof-object? (read-char p))))) #t) (test (call-with-input-file "empty-file" (lambda (p) (and (= (read p) 3) (eof-object? (read p))))) #t) (test (call-with-input-file "empty-file" (lambda (p) (and (= (read-byte p) (char->integer #\#)) (= (read-byte p) (char->integer #\b)) (= (read-byte p) (char->integer #\1)) (= (read-byte p) (char->integer #\1)) (eof-object? (read-byte p))))) #t) (test (call-with-input-file "empty-file" (lambda (p) (and (string=? (read-line p) "#b11") (eof-object? (read-line p))))) #t) (test (load "empty-file") 3) (let ((p1 (dilambda (lambda (p) (and (= (read p) 3) (eof-object? (read p)))) (lambda (p x) #f)))) (test (call-with-input-file "empty-file" p1) #t)) (let ((port #f)) (let ((val (call-with-exit (lambda (return) (call-with-input-string "asdf" (lambda (p) (set! port p) (return 32))))))) (test (list val (port-closed? port)) '(32 #t)))) (let ((port #f)) (let ((val (call/cc (lambda (return) (call-with-input-string "asdf" (lambda (p) (set! port p) (return 32))))))) (test (list val (port-closed? port)) '(32 #f)))) (let ((port #f)) (let ((val (catch #t (lambda () (call-with-input-string "asdf" (lambda (p) (set! port p) (throw #t 32)))) (lambda (type info) (car info))))) (test (list val (port-closed? port)) '(32 #t)))) (let ((port #f)) (let ((val (catch #t (lambda () (call-with-input-string "asdf" (lambda (p) (set! port p) (error 'oops 32)))) (lambda (type info) (car info))))) (test (list val (port-closed? port)) '(32 #t)))) (let ((port #f)) (let ((val (dynamic-wind (lambda () (set! port (open-input-string "asdf"))) (lambda () 32) (lambda () (close-input-port port))))) (test (list val (port-closed? port)) '(32 #t)))) (let ((port #f)) (let ((val (call-with-exit (lambda (return) (let-temporarily ((port 12)) (return 32)))))) (test (list val (eqv? port #f)) '(32 #t)))) (let ((port #f)) (let ((val (call-with-exit (lambda (return) (let-temporarily (((*s7* 'print-length) 8)) (call-with-input-string "asdf" (lambda (p) (set! port p) (return 32)))))))) (test (list val (port-closed? port)) '(32 #t)))) (let ((port #f)) (define (reporter a b) (list (car a) (port-closed? b))) (define (f) (dynamic-unwind reporter 32) (call-with-exit (lambda (return) (call-with-input-string "asdf" (lambda (p) (set! port p) (return port)))))) (test (f) '(32 #t))) ;;; load (for-each (lambda (arg) (test (load arg) 'error) (test (load "empty-file" arg) 'error)) (list () (list 1) '(1 . 2) #f #\a 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (load) 'error) (test (load "empty-file" (curlet) 1) 'error) (test (load "not a file") 'error) (test (load "") 'error) (test (load (append "/home/" username "/cl")) 'error) (test (call-with-input-string "(display (+ 1 2))" load) 'error) (test (let () (define (func) (#_call-with-input-string (make-vector 3 'a symbol?) (lambda (x) x))) (func)) 'error) (test (let () (define (func) (#_call-with-input-file (openlet (inlet 'a 1)) (lambda (x) x))) (func)) 'error) (test (catch #t (lambda () (display 123 #t)) (lambda (t i) (apply format #f i))) "display second argument, #t, is boolean but should be an output port or #f") (test (catch #t (lambda () (write 123 #t)) (lambda (t i) (apply format #f i))) "write second argument, #t, is boolean but should be an output port or #f") (call-with-output-file "empty-file" (lambda (p) (write '(+ 1 2 3) p))) (let ((x 4)) (test (+ x (load "empty-file")) 10)) (call-with-output-file "empty-file" (lambda (p) (write '(list 1 2 3) p))) (let ((x 4)) (test (cons x (load "empty-file")) '(4 1 2 3))) (call-with-output-file "empty-file" (lambda (p) (write '(values 1 2 3) p))) (let ((x 4)) (test (+ x (load "empty-file")) 10)) (test (+ 4 (eval (call-with-input-file "empty-file" (lambda (p) (read p))))) 10) (call-with-output-file "empty-file" (lambda (p) (write '(+ x 1) p))) (let ((x 2)) (test (load "empty-file" (curlet)) 3)) (call-with-output-file "empty-file" (lambda (p) (write '(set! x 1) p))) (let ((x 2)) (load "empty-file" (curlet)) (test x 1)) (call-with-output-file "empty-file" (lambda (p) (write '(define (hi a) (values a 2)) p) (write '(hi x) p))) (let ((x 4)) (test (+ x (load "empty-file" (curlet))) 10)) (let ((x 1) (e #f)) (set! e (curlet)) (let ((x 4)) (test (+ x (load "empty-file" e)) 7))) (let () (let () (call-with-output-file "empty-file" (lambda (p) (write '(define (load_hi a) (+ a 1)) p))) (load "empty-file" (curlet)) (test (load_hi 2) 3)) (test (defined? 'load_hi) #f)) (let () (apply load '("empty-file")) (test (load_hi 2) 3)) (call-with-output-file "empty-file" (lambda (p) (display "\"empty-file\"" p))) (test (load (load "empty-file")) "empty-file") ;;; *cload-directory* (test (set! *cload-directory* 123) 'error) (let ((old-dir *cload-directory*)) (set! *cload-directory* (append "/home/" username "/cl/")) (test *cload-directory* (append "/home/" username "/cl/")) (set! *cload-directory* old-dir)) ;;; autoload (when (provided? 'autoload) (test (autoload) 'error) (test (autoload 'abs) 'error) (test (autoload :abs "dsp.scm") 'error) (for-each (lambda (arg) (test (autoload arg "dsp.scm") 'error) (test (autoload 'hi arg) 'error)) (list #f () (integer->char 65) 1 (list 1 2) _ht_ _undef_ _null_ _c_obj_ '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f)) (test (autoload 'abs "dsp.scm" 123) 'error) (test (autoload "" "dsp.scm") 'error) (autoload 'auto_test_var "empty-file") (test (defined? 'auto_test_var) #f) (call-with-output-file "empty-file" (lambda (p) (format p "(define auto_test_var 123)~%"))) (load "empty-file") (test (+ 1 auto_test_var) 124) (autoload 'auto_test_var_2 (lambda (e) (varlet e (cons 'auto_test_var_2 1)))) (test (let () (+ 1 auto_test_var_2)) 2) (autoload 'auto_test_var_3 (lambda (e) (varlet e (cons 'auto_test_var_3 1)))) (autoload 'auto_test_var_4 (lambda (e) (varlet e (cons 'auto_test_var_4 (+ auto_test_var_3 1))))) (test (let () (+ auto_test_var_4 1)) 3) (test (autoload 'auto_test_var_1 (lambda () #f)) 'error) (test (autoload 'auto_test_var_1 (lambda (a b) #f)) 'error) (let () (test (defined? 'j0) #f) (test (autoload 'j0 "libm.scm") "libm.scm") (test (j0 0.0) 1.0)) ;(test (defined? 'j0) #f) ; this changes -- currently autoload always defines its symbol globally (let () (test (autoload 'ho "s7test.scm") "s7test.scm") (test (*autoload* 'ho) "s7test.scm") (set! (*autoload* 'ho) "dsp.scm") (test (*autoload* 'ho) "dsp.scm") (test (*autoload* 123) 'error))) (let ((str3 #f)) ;; IO tests mainly (set! str3 "0123456789") (set! str3 (string-append str3 str3 str3 str3 str3 str3 str3 str3 str3 str3)) (set! str3 (string-append str3 str3 str3 str3 str3 str3 str3 str3 str3 str3)) (set! str3 (string-append str3 str3 str3)) (call-with-output-file "test.scm" (lambda (p) (format p "(define (big-string)~%") (format p " \"") (display str3 p) (format p "\\\n") ; this becomes \ in the midst of a string which we ignore (display str3 p) (format p "\"") (format p ")~%"))) (load "test.scm") (let ((str (big-string))) (test (length str) 6000)) (let ((big-string (eval (call-with-input-string (call-with-output-string (lambda (p) (format p "(lambda ()~%") (format p " \"") (display str3 p) (format p "\\\n") ; this becomes \ in the midst of a string which we ignore (display str3 p) (format p "\"") (format p ")~%"))) read)))) (let ((str (big-string))) (test (length str) 6000))) (call-with-output-file "test.scm" (lambda (p) (format p "(define (big-string)~%") (format p " \"") (display str3 p) (format p "\\\"") (display str3 p) (format p "\"") (format p ")~%"))) (load "test.scm") (let ((str (big-string))) (test (length str) 6001)) (let ((big-string (eval (call-with-input-string (call-with-output-string (lambda (p) (format p "(lambda ()~%") (format p " \"") (display str3 p) (format p "\\\"") (display str3 p) (format p "\"") (format p ")~%"))) read)))) (let ((str (big-string))) (test (length str) 6001))) (call-with-output-file "test.scm" (lambda (p) (format p ""))) (load "test.scm") ; # (let () (define (write-stuff p) (format p ";") (do ((i 0 (+ i 1))) ((= i 3000)) (let ((c (integer->char (random 128)))) (if (charinteger #\a))) (format p "(define (big-char)~% (string ") (do ((i 0 (+ i 1))) ((= i 2000)) (format p "#\\~C " (integer->char (+ a (modulo i 26))))) (format p "))~%")))) (load "test.scm") (let ((chars (big-char))) (test (length chars) 2000)) (call-with-output-file "test.scm" (lambda (p) (let ((a (char->integer #\a))) (format p "(define (big-xchar)~% (string ") (do ((i 0 (+ i 1))) ((= i 2000)) (format p "#\\x~X " (+ a (modulo i 26)))) (format p "))~%")))) (load "test.scm") (let ((chars (big-xchar))) (test (length chars) 2000)) (call-with-output-file "test.scm" (lambda (p) (format p "(define (ychar) #\\~C)" (integer->char 255)))) (load "test.scm") (test (ychar) (integer->char 255)) (let () (define (write-stuff p) (do ((i 0 (+ i 1))) ((= i 1000)) (format p "~D" i)) (format p "~%") (do ((i 0 (+ i 1))) ((= i 1000)) (format p "~D" i))) (call-with-output-file "test.scm" write-stuff)) (call-with-input-file "test.scm" (lambda (p) (let ((s1 (read-line p)) (s2 (read-line p))) (test (and (string=? s1 s2) (= (length s1) 2890)) #t)))) (call-with-output-file "test.scm" (lambda (p) (format p "(define (big-int)~%") (do ((i 0 (+ i 1))) ((= i 3000)) (format p "0")) (format p "123)~%"))) (load "test.scm") (test (big-int) 123) (call-with-output-file "test.scm" (lambda (p) (format p "(define (big-rat)~%") (do ((i 0 (+ i 1))) ((= i 3000)) (format p "0")) (format p "123/") (do ((i 0 (+ i 1))) ((= i 3000)) (format p "0")) (format p "2)~%"))) (load "test.scm") (test (big-rat) 123/2) (call-with-output-file "test.scm" (lambda (p) (format p "(define (big-hash)~% (hash-table ") (do ((i 0 (+ i 1))) ((= i 2000)) (format p "~D ~D " i (+ i 1))) (format p "))~%"))) (load "test.scm") (let ((ht (big-hash))) (let ((entries 0)) (for-each (lambda (htv) (set! entries (+ entries 1)) (if (not (= (+ (car htv) 1) (cdr htv))) (format *stderr* ";hashed: ~A~%" htv))) ht) (test entries 2000))) (call-with-output-file "test.scm" (lambda (p) (format p "(define (big-hash)~% (apply hash-table (list ") (do ((i 0 (+ i 1))) ((= i 2000)) (format p "~D ~D " i (+ i 1))) (format p ")))~%"))) (load "test.scm") (let ((ht (big-hash))) (let ((entries 0)) (for-each (lambda (htv) (set! entries (+ entries 1)) (if (not (= (+ (car htv) 1) (cdr htv))) (format *stderr* ";hashed: ~A~%" htv))) ht) (test entries 2000))) (call-with-output-file "test.scm" (lambda (p) (let ((a (char->integer #\a))) (format p "(define (big-env)~% (inlet ") (do ((i 0 (+ i 1))) ((= i 2000)) (format p "'(~A . ~D) " (string (integer->char (+ a (modulo i 26))) (integer->char (+ a (modulo (floor (/ i 26)) 26))) (integer->char (+ a (modulo (floor (/ i (* 26 26))) 26)))) i)) (format p "))~%")))) (load "test.scm") (let ((E (big-env)) (a (char->integer #\a))) (do ((i 0 (+ i 1))) ((= i 2000)) (let ((sym (string->symbol (string (integer->char (+ a (modulo i 26))) (integer->char (+ a (modulo (floor (/ i 26)) 26))) (integer->char (+ a (modulo (floor (/ i (* 26 26))) 26))))))) (let ((val (E sym))) (if (not (equal? val i)) (format *stderr* ";env: ~A -> ~A, not ~D~%" sym val i)))))) (call-with-output-file "test.scm" (lambda (p) (format p ""))) (let ((val (call-with-input-file "test.scm" (lambda (p) (read p))))) (if (not (eof-object? val)) (format *stderr* ";read empty file: ~A~%" val))) (call-with-output-file "test.scm" (lambda (p) (format p " ;") (do ((i 0 (+ i 1))) ((= i 3000)) (let ((c (integer->char (random 128)))) (if (char free cell, either lst in pair_to_port, or port in display (test (f) #t)) (let ((stdin-wrapper (open-input-function (lambda (choice) (case choice ((read peek-char) #\?) ((char-ready?) #f) ((read-char) #\a) ((read-line) "a line")))))) (test (port-filename stdin-wrapper) "") (test (port-line-number stdin-wrapper) 0) (let-temporarily (((current-input-port) stdin-wrapper)) (test (read-char) #\a) ;(test (read-byte) 65) (test (read-line) "a line") (test (char-ready?) #f) (test (read) #\?) (test (peek-char) #\?) (test (object->string (current-input-port)) "#") (test (object->string (object->let (current-input-port))) "(inlet 'function # 'value # 'type input-port? 'port-type function 'closed #f 'mutable? #t)") (test (input-port? (current-input-port)) #t) (test (reverse (current-input-port)) 'error) (test (fill! (current-input-port)) 'error) (test (length (current-input-port)) #f)) (test (port-closed? stdin-wrapper) #f) (close-input-port stdin-wrapper) (test (read-char stdin-wrapper) 'error) (test (port-closed? stdin-wrapper) #t)) (let ((str ())) (let ((stdout-wrapper (open-output-function (lambda (c) (set! str (cons (integer->char c) str)))))) (write-string "a line" stdout-wrapper) (test (list->string (reverse str)) "a line") (close-output-port stdout-wrapper))) (let ((str ())) (let ((stdout-wrapper (open-output-function (lambda (c) (values c (set! str (cons (integer->char c) str))))))) (test (write-char #\a stdout-wrapper) 'error) ;"function-port should not return multiple-values" (close-output-port stdout-wrapper))) (let ((str ()) (obj #f)) (let ((stdout-wrapper (open-output-function (lambda (c) (set! str (cons c str)))))) (let-temporarily (((current-output-port) stdout-wrapper)) (write-char #\a) (display #\b) (write-byte 123) (write-string "a line") (newline) (test (object->string (current-output-port)) "#") (set! obj (object->let (current-output-port))) (test (output-port? (current-output-port)) #t)) (test (reverse str) '(97 98 123 97 32 108 105 110 101 10)) (close-output-port stdout-wrapper) (test (write "a test" stdout-wrapper) 'error) (test (object->string obj) "(inlet 'function # 'value # 'type output-port? 'port-type function 'closed #f 'mutable? #t)"))) (test (read-char (open-input-function vector)) 'error) ;; (write-char #\a (open-output-function list)) -> a?? but string: error: string argument 1, 97, is an integer but should be a character (test (peek-char (open-input-function cons)) 'error) (test (write-char #\a (open-output-function cons)) 'error) (test (open-input-function (vector)) 'error) (test (open-output-function (vector)) 'error) (unless pure-s7 (test ((lambda (w) 1) (char-ready? (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) 'error)) (test ((lambda (w) 1) (read-char (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) 'error) (test ((lambda (w) 1) (read-line (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) 'error) (test ((lambda (w) 1) (read (open-input-function (lambda (x) (values 1 2 3 4 5 6 7))))) 'error) (test (reverse *stdin*) 'error) (test (fill! (current-output-port)) 'error) (test (length *stderr*) #f) (test (output-port? (current-input-port)) #f) (test (output-port? *stdin*) #f) (test (output-port? (current-output-port)) #t) (test (output-port? *stdout*) #t) (test (output-port? (current-error-port)) #t) (test (output-port? *stderr*) #t) ;(write-char #\space (current-output-port)) ;(write " " (current-output-port)) (newline (current-output-port)) (for-each (lambda (p) (test (write-char #\a p) 'error) (test (write-byte 0 p) 'error) (test (write-string "a" p) 'error) (test (write "a" p) 'error) (test (display "a" p) 'error) (test (format p "~a" 2) 'error)) (list *stdin* (current-input-port) (call-with-output-string (lambda (p) p)))) (for-each (lambda (p) (test (read-char p) 'error) (test (read-byte p) 'error) (test (read-line p) 'error) (test (read-string 5 p) 'error) (test (read p) 'error)) (list *stdout* #f (current-output-port) (call-with-input-file "s7test.scm" (lambda (p) p)) (call-with-input-string "0123456" (lambda (p) p)))) (call-with-output-string (lambda (p) (test (read-char p) 'error) (test (read-byte p) 'error) (test (read-line p) 'error) (test (read-string 5 p) 'error) (test (read p) 'error))) (call-with-input-string "asdf" (lambda (p) (test (write-char #\a p) 'error) (test (write-byte 0 p) 'error) (test (write-string "a" p) 'error) (test (write "a" p) 'error) (test (display "a" p) 'error) (test (format p "~a" 2) 'error))) (test (write #\1 *stdin*) 'error) (test (write-char #\1 *stdin*) 'error) (test (write-byte 1 *stdin*) 'error) (test (write-string "123" *stdin*) 'error) (test (display #\1 *stdin*) 'error) (for-each (lambda (p) (test (write-char #\a p) 'error) (test (write-byte 0 p) 'error) (test (write-string "a" p) 'error) (test (write "a" p) 'error) (test (display "a" p) 'error) (test (format p "~a" 2) 'error) (test (read-char p) 'error) (test (read-byte p) 'error) (test (read-line p) 'error) (test (read-string p) 'error) (test (read p) 'error)) (list (let ((p (open-output-string))) (close-output-port p) p) (let ((p (open-input-string "123"))) (close-input-port p) p))) (for-each (lambda (arg) (if (output-port? arg) (format #t ";(output-port? ~A) -> #t?~%" arg))) (list "hi" #f () 'hi (integer->char 65) 1 (list 1 2) _ht_ _undef_ _null_ _c_obj_ '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f)) (for-each (lambda (arg) (test (read-line () arg) 'error) (test (read-line arg) 'error)) (list "hi" (integer->char 65) 1 #f _ht_ _undef_ _null_ _c_obj_ (list) (cons 1 2) (list 1 2) (make-vector 3) 3.14 3/4 1.0+1.0i #\f)) (test (call-with-output-file tmp-output-file output-port?) #t) (if (not (eq? start-output-port (current-output-port))) (format #t "call-with-output-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port))) (test (let ((this-file (open-output-file tmp-output-file))) (let ((res (output-port? this-file))) (close-output-port this-file) res)) #t) (if (not (eq? start-output-port (current-output-port))) (format #t "open-output-file clobbered current-output-port? ~A from ~A~%" start-output-port (current-output-port))) (let () ; write_string_p_pp (define (string-join2 lst delimiter) (call-with-output-string (lambda (out) (for-each (lambda (item) (write-string delimiter out) (write-string item out)) lst) (get-output-string out)))) (test (string-join2 '("foo" "bar") ":") ":foo:bar")) (test (let ((val #f)) (call-with-output-string (lambda (p) (set! val (output-port? p)))) val) #t) (test (let ((res #f)) (let ((this-file (open-output-string))) (set! res (output-port? this-file)) (close-output-port this-file) res)) #t) (test (with-output-to-string (lambda () (display _undef_))) "#_asdf") (test (with-output-to-string (lambda () (write _undef_))) "#_asdf") (test (with-output-to-string (lambda () (make-string (+ (*s7* 'max-string-length) 10)))) 'error) (test (open-input-file "tools") 'error) (when (file-exists? "/home/bil/cl/tools/dup.scm") ; check "~" handling in file name, shouldn't file-exists? accept these names? (let ((p (open-input-file "~/cl/tools/dup.scm"))) (test (read-line p) ";;; dup.scm") (close-input-port p))) (let () (call-with-output-file "tmp.r5rs" (lambda (p) (format p "(values 2 3 4)"))) (test (+ 1 (load "tmp.r5rs") 5) 15)) (for-each (lambda (arg) (if (eof-object? arg) (format #t ";(eof-object? ~A) -> #t?~%" arg))) (list "hi" () '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t (if #f #f) # (lambda (a) (+ a 1)))) (for-each (lambda (arg) (let ((val (catch #t (lambda () (port-closed? arg)) (lambda args 'error)))) (if (not (eq? val 'error)) (format #t ";(port-closed? ~A) -> ~S?~%" arg val)))) (list "hi" '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t (if #f #f) # # (lambda (a) (+ a 1)))) (test (port-closed?) 'error) (test (port-closed? (current-input-port) (current-output-port)) 'error) (test (let-temporarily (((current-output-port) #f)) (port-closed? (current-output-port))) #f) ;;; port-string (test (port-string) 'error) (let ((P (open-input-string "asdf"))) (test (port-string P) "asdf") (test (port-string P #f) 'error) (close-input-port P)) (for-each (lambda (arg) (test (port-string arg) 'error)) (list "hi" () '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t (if #f #f) # (lambda (a) (+ a 1)))) (test (call-with-input-string "0123456789" (lambda (p) (port-string p))) "0123456789") (let ((P (open-input-string "asdf"))) (test (port-string P) "asdf") (set! (port-string P) "123") (test (port-string P) "123") (test (read-char P) #\1) (test (read-char P) #\2) (test (read-char P) #\3) (test (read-char P) #) (set! (port-string P) "0123456789") (test (port-string P) "0123456789") (test (read-char P) #\0) (close-input-port P)) (let ((P (open-output-string))) (test (port-string P) "") (display "asdf" P) (test (port-string P) "asdf") (set! (port-string P) "12345") (test (get-output-string P) "12345") (set! (port-string P) (make-string 512 #\a)) (test (string=? (get-output-string P) (make-string 512 #\a)) #t) ; force reallocate? (close-output-port P)) (let ((ssize 3)) (define (call-wis1) (let ((p (open-input-string "asdf"))) (do ((i 0 (+ i 1))) ((= i ssize)) (set! (port-string p) "asdf") (unless (char=? (read-char p) #\a) (format *stderr* "read-char trouble 1\n")) (set! p 123)) (close-input-port p))) (test (call-wis1) 'error) ; set! port-string first argument, 123, is an integer but should be an input or output port (define (call-wis2) (let ((p (open-input-string "asdf"))) (do ((i 0 (+ i 1))) ((= i ssize)) (set! (port-string p) "asdf") (unless (char=? (read-char p) #\a) (format *stderr* "read-char trouble 4\n")) (set! p (open-output-string))) (close-output-port p))) (test (call-wis2) 'error) ; read-char argument, #, is an output port but should be an input port (define (call-wis21) ; this is dangerous! if error check is omitted in set_port_string, the file will be clobbered (let ((p (open-input-string "asdf"))) (do ((i 0 (+ i 1))) ((= i ssize)) (set! (port-string p) "asdf") (unless (char=? (read-char p) #\a) (format *stderr* "read-char trouble 4\n")) (set! p (open-output-file tmp-output-file))) (close-output-port p))) (test (call-wis21) 'error) (define (call-wis3) (let ((p (open-input-string "asdf"))) (do ((i 0 (+ i 1))) ((= i ssize)) (set! (port-string p) "asdf") (unless (char=? (read-char p) #\a) (format *stderr* "read-char trouble 7\n")) (close-input-port p)))) (test (call-wis3) 'error) ; set! port-string first argument, #, is an input port but should be an open port (define (call-wis4) (let ((str "asdf")) (let ((p (open-input-string str))) (do ((i 0 (+ i 1))) ((= i ssize) str) (set! (port-string p) "asdf") (unless (char=? (read-char p) #\a) (format *stderr* "read-char trouble 13\n"))) (close-input-port p)))) (test (call-wis4) #) ; from close-input-port (define (call-wis5) (let ((str "asdf")) (let ((p (open-input-string str))) (do ((i 0 (+ i 1))) ((= i ssize)) (set! (port-string p) str) (unless (char=? (read-char p) #\a) (format *stderr* "read-char trouble 16\n")) (set! str 123)) (close-input-port p)))) (test (call-wis5) 'error) ; set! port-string second argument, 123, is an integer but should be a string (define (call-wis7) (let ((str "asdf")) (let ((p (open-input-string str))) (do ((i 0 (+ i 1))) ((= i ssize)) (set! (port-string p) str) (unless (char=? (read-char p) #\a) (format *stderr* "read-char trouble 19\n")) (set! p (open-input-function (lambda (choice) #\a)))) (close-input-port p)))) (test (call-wis6) 'error) ; set! port-string first argument, #, is an input port but should be a string port ) ;;; port-position (test (port-position) 'error) (test (port-position (current-output-port)) 'error) (test (port-position (current-error-port)) 'error) (test (integer? (port-position (current-input-port))) #t) (test (port-position (current-input-port) #f) 'error) (test (call-with-output-file "asdf" (lambda (p) (port-position p))) 'error) (test (call-with-output-string (lambda (p) (port-position p))) 'error) (for-each (lambda (arg) (test (port-position arg) 'error)) (list "hi" () '(1 2) -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t (if #f #f) # (lambda (a) (+ a 1)))) (test (call-with-input-string "0123456789" (lambda (p) (set! (port-position p) 3) (list (read-char p) (port-position p)))) '(#\3 4)) (test (call-with-input-file "s7test.scm" (lambda (p) (set! (port-position p) 88) (list (read-string 10 p) (port-position p)))) '(";; Paul " 98)) (test (call-with-input-string "0123456789" (lambda (p) (set! (port-position p) -3))) 'error) (test (port-position (call-with-input-file (string #\c #\null #\b) quasiquote)) 'error) ; closed port (test (call-with-input-string "" (lambda (p) (set! (port-position p) 2) (port-position p))) 0) (test (call-with-input-string "123" (lambda (p) (set! (port-position p) 12) (port-position p))) 3) (let () (define (pos1) (let* ((in (open-input-string "#xff")) (val (read in)) (pos (port-position in))) (close-input-port in) pos)) (test (pos1) 4) (define (pos2) (let* ((in (open-input-string "#xff ")) (val (read in)) (pos (port-position in))) (close-input-port in) pos)) (test (pos2) 4) (define (pos3) (let* ((in (open-input-string "(+ 1 xyz)")) (val (read in)) (pos (port-position in))) (close-input-port in) pos)) (test (pos3) 9) (define (pos4) (let* ((in (open-input-string "(+ 1 xyz) ; a comment")) (val (read in)) (pos (port-position in))) (close-input-port in) pos)) (test (pos4) 9) (define (pos5) (let* ((in (open-input-string " xyz")) (val (read in)) (pos (port-position in))) (close-input-port in) pos)) (test (pos5) 4) (define (pos6) (let* ((in (open-input-string " xyz ")) (val (read in)) (pos (port-position in))) (close-input-port in) pos)) (test (pos6) 4) (define (pos7) (let* ((in (open-input-string (format #f "1234~%5678"))) (val1 (read-line in)) (pos1 (port-position in)) (val2 (read-line in)) (pos2 (port-position in))) (close-input-port in) (list pos1 pos2))) (test (pos7) '(5 9)) (define (pos8) (let* ((in (open-input-string "12345678")) (val1 (read-string 4 in)) (pos1 (port-position in)) (val11 (read-string 0 in)) (pos11 (port-position in)) (val2 (read-string 5 in)) (pos2 (port-position in)) (val3 (read-string 1 in)) (pos3 (port-position in))) (close-input-port in) (list pos1 pos11 pos2 pos3))) (test (pos8) '(4 4 8 8)) (define (pos9) (let* ((in (open-input-string "123456789")) (vals ())) (do ((i 0 (+ i 3)) (k 1 (+ k 2))) ((>= i 9)) (set! vals (cons (read-string 3 in) vals)) (set! (port-position in) k) (test (port-position in) k)) (close-input-port in) (reverse vals))) (test (pos9) '("123" "234" "456")) (define (pos10) (let ((f (open-output-file "hi"))) (display "1234567879" f) (flush-output-port f) (close-output-port f) (let* ((in (open-input-file "hi")) (vals ())) (do ((i 0 (+ i 3)) (k 1 (+ k 2))) ((>= i 9)) (set! vals (cons (read-string 3 in) vals)) (set! (port-position in) k) (test (port-position in) k)) (close-input-port in) (reverse vals)))) (test (pos10) '("123" "234" "456"))) (test (call-with-input-file "s7test.scm" (lambda (p) (c-pointer? (port-file p)))) #t) (call-with-output-file tmp-output-file (lambda (p) (display "3.14" p))) (test (call-with-input-file tmp-output-file (lambda (p) (read p) (let ((val (read p))) (eof-object? val)))) #t) (test (call-with-input-file tmp-output-file (lambda (p) (read-char p))) #\3) (test (call-with-input-file tmp-output-file (lambda (p) (peek-char p))) #\3) (test (call-with-input-file tmp-output-file (lambda (p) (peek-char p) (read-char p))) #\3) (test (call-with-input-file tmp-output-file (lambda (p) (list->string (list (read-char p) (read-char p) (read-char p) (read-char p))))) "3.14") (test (call-with-input-file tmp-output-file (lambda (p) (list->string (list (read-char p) (peek-char p) (read-char p) (read-char p) (peek-char p) (read-char p))))) "3..144") (for-each (lambda (arg) (call-with-output-file tmp-output-file (lambda (p) (write arg p))) (if (not (equivalent? (call-with-input-file tmp-output-file (lambda (p) (read p))) arg)) (format *stderr* "~A different after write~%" arg))) (list "hi" -1 #\a 1 'a-symbol (make-vector 3 0) 3.14 3/4 .6 1.0+1.0i #f #t (list 1 2 3) (cons 1 2) '(1 2 . 3) () '((1 2) (3 . 4)) '(()) (list (list 'a "hi") #\b 3/4) ''a (string #\a #\null #\b) "" "\"hi\"" (integer->char 128) (integer->char 127) (integer->char 255) #\space #\null #\newline #\tab #() #2d((1 2) (3 4)) #3d() :hi # # # most-negative-fixnum (if with-bignums 1239223372036854775808 123) (if with-bignums 144580536300674537151081081515762353325831/229154728370723013560448485454219755525522 11/10) (if with-bignums 221529797579218180403518826416685087012.0 1000.1) (if with-bignums 1239223372036854775808+1239223372036854775808i 1000.1-1234i))) (for-each (lambda (arg) (call-with-output-file tmp-output-file (lambda (p) (write arg p))) (test (call-with-input-file tmp-output-file (lambda (p) (eval (read p)))) arg)) ; so read -> symbol? (list *stdout* *stdin* *stderr* abs + quasiquote ; (hash-table 'a 1 'b 2) (hash-table) ; 0/0 (real-part (log 0)) ;;; for these we need nan? and infinite? since equal? might be #f ; (lambda (a) (+ a 1)) ; pws? ; (current-output-port) ; (random-state 1234) ; (symbol ":\"") ; (let () (define-macro (hi1 a) `(+ ,a 1)) hi1) ;;; and how could a continuation work in general? )) ;;; (call-with-input-file tmp-output-file (lambda (p) (read p))) got (symbol ":\"") but expected (symbol ":\"") ;;; r4rstest (let* ((write-test-obj '(#t #f a () 9739 -3 . #((test) "te \" \" st" "" test #() b c))) (load-test-obj (list 'define 'foo (list '#_quote write-test-obj)))) (define (check-test-file name) (let ((val (call-with-input-file name (lambda (test-file) (test (read test-file) load-test-obj) (test (eof-object? (peek-char test-file)) #t) (test (eof-object? (read-char test-file)) #t) (input-port? test-file))))) (if (not (eq? val #t)) (format #t "input-port? in call-with-input-file? returned ~A from ~A~%" val name)))) (test (call-with-output-file tmp-output-file (lambda (test-file) (write-char #\; test-file) (display #\; test-file) (display ";" test-file) (write write-test-obj test-file) (newline test-file) (write load-test-obj test-file) (output-port? test-file))) #t) (check-test-file tmp-output-file) (let ((test-file (open-output-file "tmp2.r5rs"))) (test (port-closed? test-file) #f) (write-char #\; test-file) (display #\; test-file) (display ";" test-file) (write write-test-obj test-file) (newline test-file) (write load-test-obj test-file) (test (output-port? test-file) #t) (close-output-port test-file) (check-test-file "tmp2.r5rs"))) (test (with-input-from-string "" read) #) ; ? (call-with-output-file tmp-output-file (lambda (p) (display "3.14" p))) (test (with-input-from-file tmp-output-file read) 3.14) (if (not (eq? start-input-port (current-input-port))) (format #t "with-input-from-file did not restore current-input-port? ~A from ~A~%" start-input-port (current-input-port))) (test (with-input-from-file tmp-output-file (lambda () (eq? (current-input-port) start-input-port))) #f) (test (char->integer ((with-input-from-string (string (integer->char 255))(lambda () (read-string 1))) 0)) 255) (test (with-output-to-file tmp-output-file (lambda () (eq? (current-output-port) start-output-port))) #f) (if (not (eq? start-output-port (current-output-port))) (format #t "with-output-to-file did not restore current-output-port? ~A from ~A~%" start-output-port (current-output-port))) (let ((newly-found-sonnet-probably-by-shakespeare "This is the story, a sad tale but true \ Of a programmer who had far too little to do.\ One day as he sat in his hut swilling stew, \ He cried \"CLM takes forever, it's stuck in a slough!,\ Its C code is slow, too slow by a few.\ Why, with just a small effort, say one line or two,\ It could outpace a no-op, you could scarcely say 'boo'\"!\ So he sat in his kitchen and worked like a dog.\ He typed and he typed 'til his mind was a fog. \ Now 6000 lines later, what wonders we see! \ CLM is much faster, and faster still it will be!\ In fact, for most cases, C beats the DSP! \ But bummed is our coder; he grumbles at night. \ That DSP code took him a year to write. \ He was paid many dollars, and spent them with glee,\ But his employer might mutter, this result were he to see.")) (call-with-output-file tmp-output-file (lambda (p) (write newly-found-sonnet-probably-by-shakespeare p))) (let ((sonnet (with-input-from-file tmp-output-file (lambda () (read))))) (if (or (not (string? sonnet)) (not (string=? sonnet newly-found-sonnet-probably-by-shakespeare))) (format #t "write/read long string returned: ~A~%" sonnet))) (let ((file (open-output-file tmp-output-file))) (let ((len (string-length newly-found-sonnet-probably-by-shakespeare))) (write-char #\" file) (do ((i 0 (+ i 1))) ((= i len)) (let ((chr (string-ref newly-found-sonnet-probably-by-shakespeare i))) (if (char=? chr #\") (write-char #\\ file)) (write-char chr file))) (write-char #\" file) (close-output-port file))) (let ((file (open-input-file tmp-output-file))) (let ((sonnet (read file))) (close-input-port file) (if (or (not (string? sonnet)) (not (string=? sonnet newly-found-sonnet-probably-by-shakespeare))) (format #t "write-char/read long string returned: ~A~%" sonnet))))) (test (let () (define (func) (vector (call-with-output-file "/dev/null" quasiquote))) (define (hi) (func)) (vector? (hi))) #t) (let ((file (open-output-file tmp-output-file))) (for-each (lambda (arg) (write arg file) (write-char #\space file)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))) (close-output-port file)) (let ((file (open-input-file tmp-output-file))) (for-each (lambda (arg) (let ((val (read file))) (if (not (equal? val arg)) (format #t "read/write ~A returned ~A~%" arg val)))) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))) (close-input-port file)) (with-output-to-file tmp-output-file (lambda () (write lists))) (let ((val (with-input-from-file tmp-output-file (lambda () (read))))) (if (not (equal? val lists)) (format #t "read/write lists returned ~A~%" val))) (if (not (string=? "" (with-output-to-string (lambda () (display ""))))) (format #t "with-output-to-string null string?")) (let ((str (with-output-to-string (lambda () (with-input-from-string "hiho123" (lambda () (do ((c (read-char) (read-char))) ((eof-object? c)) (display c)))))))) (if (not (string=? str "hiho123")) (format #t "with string ports 0: ~S?~%" str))) (let ((str1 (let ((x #f)) (with-output-to-string (lambda () (display `(+ x 1)) (display (object->string '(1 2 3) #f 1))))))) (let ((str2 (let ((x #f)) (with-output-to-string (lambda () (display `(+ x 1)) (display (object->string '(1 2 3) #f 1))))))) (test str1 str2))) ; both "(+ x 1)..." (let ((p1 (open-input-string "123")) (p2 (open-input-string "123"))) (test (equivalent? p1 p2) #t) (read-char p1) (test (equivalent? p1 p2) #f) (read-char p2) (test (equivalent? p1 p2) #t) (close-input-port p1) (close-input-port p2)) (let ((p1 (open-input-string "1234")) (p2 (open-input-string "123"))) (test (equivalent? p1 p2) #f) (read-char p1) (test (equivalent? p1 p2) #f) (close-input-port p1) (close-input-port p2)) (let ((p1 (open-output-string)) (p2 (open-output-string))) (test (equivalent? p1 p2) #t) (write-char #\a p1) (test (equivalent? p1 p2) #f) (close-output-port p1) (close-output-port p2)) (let () (define* (f1 (b 123)) (display b)) (test (with-output-to-string f1) "123") (define (f2) (display "123")) (test (with-output-to-string f2) "123") (define (f3 . args) (display 123)) (test (with-output-to-string f3) "123") (define-macro (m1) `(write 123)) (test (with-output-to-string m1) "123") (define-macro (m2) (write 123)) (test (with-output-to-string m2) "123") (define (f4 a b) (display 123)) (test (with-output-to-string f4) 'error) (test (with-output-to-string (lambda () (*s7* 'version))) "")) ; the output is a string -- not written to stdout or whatever (let () (define* (f1 a (b 123)) (display b a)) (test (call-with-output-string f1) "123") (define (f2 a) (display "123" a)) (test (call-with-output-string f2) "123") (define (f3 . args) (display 123 (car args))) (test (call-with-output-string f3) "123") (define-macro (m1 p) `(write 123 ,p)) (test (call-with-output-string m1) "123") (define-macro* (m2 (p #f)) (write 123 p)) (test (call-with-output-string m2) "123") (define (f4 a b) (display 123 a)) (test (call-with-output-string f4) 'error) (test (call-with-output-string (lambda () (*s7* 'version))) 'error)) (let () (define* (f1 (a #f)) (read)) (test (with-input-from-string "(+ 1 2 3)" f1) '(+ 1 2 3)) (define* (f2 . args) (read)) (test (with-input-from-string "(+ 1 2 3)" f2) '(+ 1 2 3)) (define f3 read) (test (with-input-from-string "(+ 1 2 3)" f3) '(+ 1 2 3)) (define (f4) (read)) (test (with-input-from-string "(+ 1 2 3)" f4) '(+ 1 2 3)) (define-macro (m1) `(read)) (test (with-input-from-string "(+ 1 2 3)" m1) '(+ 1 2 3)) (define-macro (m2) (read)) (test (with-input-from-string "(+ 1 2 3)" m2) 6) (define (f5 a) (read a)) (test (with-input-from-string "(+ 1 2 3)" f5) 'error) (test (with-input-from-string "(+ 1 2 3)" (lambda () (*s7* 'version))) (*s7* 'version))) (let () (define* (f1 (a #f)) (read a)) (test (call-with-input-string "(+ 1 2 3)" f1) '(+ 1 2 3)) (define* (f2 . args) (read (car args))) (test (call-with-input-string "(+ 1 2 3)" f2) '(+ 1 2 3)) (define f3 read) (test (call-with-input-string "(+ 1 2 3)" f3) '(+ 1 2 3)) (define-macro (m1 p) `(read ,p)) (test (call-with-input-string "(+ 1 2 3)" m1) '(+ 1 2 3)) (define-macro* (m2 (p #f)) (read p)) (test (call-with-input-string "(+ 1 2 3)" m2) 6) (define (f4) (read)) (test (call-with-input-string "(+ 1 2 3)" f4) 'error) (test (call-with-input-string "(+ 1 2 3)" (lambda () (*s7* 'version))) 'error)) (let () (with-output-to-file tmp-output-file (lambda () (display "(+ 1 2 3)"))) (define* (f1 (a #f)) (read)) (test (with-input-from-file tmp-output-file f1) '(+ 1 2 3)) (define* (f2 . args) (read)) (test (with-input-from-file tmp-output-file f2) '(+ 1 2 3)) (define f3 read) (test (with-input-from-file tmp-output-file f3) '(+ 1 2 3)) (define (f4) (read)) (test (with-input-from-file tmp-output-file f4) '(+ 1 2 3)) (define-macro (m1) `(read)) (test (with-input-from-file tmp-output-file m1) '(+ 1 2 3)) (define-macro (m2) (read)) (test (with-input-from-file tmp-output-file m2) 6) (define (f5 a) (read a)) (test (with-input-from-file tmp-output-file f5) 'error) (test (with-input-from-file tmp-output-file (lambda () (*s7* 'version))) (*s7* 'version))) (let () (define (eval-from-string-1 str) (define-macro (m) (read)) (with-input-from-string str m)) (test (eval-from-string-1 "(+ 1 2 3)") 6) (define (eval-from-string str) (with-input-from-string str (define-macro (m) (read)))) (test (eval-from-string "(+ 1 2 3)") 6)) (let () (define* (f1 (a #f)) (read a)) (test (call-with-input-file tmp-output-file f1) '(+ 1 2 3)) (define* (f2 . args) (read (car args))) (test (call-with-input-file tmp-output-file f2) '(+ 1 2 3)) (define f3 read) (test (call-with-input-file tmp-output-file f3) '(+ 1 2 3)) (define-macro (m1 p) `(read ,p)) (test (call-with-input-file tmp-output-file m1) '(+ 1 2 3)) (define-macro* (m2 (p #f)) (read p)) (test (call-with-input-file tmp-output-file m2) 6) (define (f4) (read)) (test (call-with-input-file tmp-output-file f4) 'error) (test (call-with-input-file tmp-output-file (lambda () (*s7* 'version))) 'error)) (let ((ofile tmp-output-file)) (define (get-file-contents) (with-input-from-file ofile read-line)) (define* (f1 (b 123)) (display b)) (test (let () (with-output-to-file ofile f1) (get-file-contents)) "123") (define (f2) (display "123")) (test (let () (with-output-to-file ofile f2) (get-file-contents)) "123") (define (f3 . args) (display 123)) (test (let () (with-output-to-file ofile f3) (get-file-contents)) "123") (define-macro (m1) `(write 123)) (test (let () (with-output-to-file ofile m1) (get-file-contents)) "123") (define-macro (m2) (write 123)) (test (let () (with-output-to-file ofile m2) (get-file-contents)) "123") (define (f4 a b) (display 123)) (test (let () (with-output-to-file ofile f4) (get-file-contents)) 'error) (test (let () (with-output-to-file ofile (lambda () (*s7* 'version))) (get-file-contents)) #) (define* (f11 a (b 123)) (display b a)) (test (let () (call-with-output-file ofile f11) (get-file-contents)) "123") (define (f21 a) (display "123" a)) (test (let () (call-with-output-file ofile f21) (get-file-contents)) "123") (define (f31 . args) (display 123 (car args))) (test (let () (call-with-output-file ofile f31) (get-file-contents)) "123") (define-macro (m3 p) `(write 123 ,p)) (test (let () (call-with-output-file ofile m3) (get-file-contents)) "123") (define-bacro* (m2 (p 123)) `(write 123 ,p)) (test (let () (call-with-output-file ofile m2) (get-file-contents)) "123") (define (f41 a b) (display 123 a)) (test (let () (call-with-output-file ofile f41) (get-file-contents)) 'error) (test (let () (call-with-output-file ofile (lambda () (*s7* 'version))) (get-file-contents)) 'error)) (if (not (eof-object? (with-input-from-string "" (lambda () (read-char))))) (format #t ";input from null string not #?~%") (let ((EOF (with-input-from-string "" (lambda () (read-char))))) (if (not (eq? (with-input-from-string "" (lambda () (read-char))) (with-input-from-string "" (lambda () (read-char))))) (format #t "# is not eq? to itself?~%")) (if (char? EOF) (do ((c 0 (+ c 1))) ((= c 256)) (if (char=? EOF (integer->char c)) (format #t "# is char=? to ~C~%" (integer->char c))))))) (test (+ 100 (call-with-output-file "tmp.r5rs" (lambda (p) (write "1" p) (values 1 2)))) 103) (test (+ 100 (with-output-to-file "tmp.r5rs" (lambda () (write "2") (values 1 2)))) 103) (if (not pure-s7) (let ((str (with-output-to-string (lambda () (with-input-from-string "hiho123" (lambda () (do ((c (read-char) (read-char))) ((or (not (char-ready?)) (eof-object? c))) (display c)))))))) (if (not (string=? str "hiho123")) (format #t "with string ports 1: ~S?~%" str)))) (let ((str (with-output-to-string (lambda () (with-input-from-string "" (lambda () (do ((c (read-char) (read-char))) ((eof-object? c)) (display c)))))))) (if (not (string=? str "")) (format #t "with string ports and null string: ~S?~%" str))) (let ((str (with-output-to-string ; this is from the guile-user mailing list, I think -- don't know who wrote it (lambda () (with-input-from-string "A2B5E3426FG0ZYW3210PQ89R." (lambda () (call/cc (lambda (hlt) (define (nextchar) (let ((c (read-char))) (if (eq? c #\space) (nextchar) c))) (define inx (lambda() (let in1 () (let ((c (nextchar))) (if (char-numeric? c) (let ((r (nextchar))) (let out*n ((n (- (char->integer c) (char->integer #\0)))) (out r) (if (not (zero? n)) (out*n (- n 1))))) (out c)) (in1))))) (define (move-char c) (write-char c) (if (char=? c #\.) (begin (hlt)))) (define outx (lambda() (let out1 () (let h1 ((n 16)) (move-char (in)) (move-char (in)) (move-char (in)) (if (= n 1) (begin (out1)) (begin (write-char #\space) (h1 (- n 1))) ))))) (define (in) (call/cc (lambda(return) (set! outx return) (inx)))) (define (out c) (call/cc (lambda(return) (set! inx return) (outx c)))) (outx))))))))) (if (not (string=? str "ABB BEE EEE E44 446 66F GZY W22 220 0PQ 999 999 999 R.")) (format #t "call/cc with-input-from-string str: ~A~%" str))) (let ((badfile tmp-output-file)) (let ((p (open-output-file badfile))) (close-output-port p)) (load badfile)) (test (let ((str1 (let ((port #f)) (dynamic-wind (lambda () (set! port (open-input-string (format #f "~S" (call-with-input-string "" and))))) (lambda () (read port)) (lambda () (close-input-port port))))) (str2 (with-input-from-string (object->string (call-with-input-string "" and)) read))) (equivalent? str1 str2)) #t) (for-each (lambda (str) ;;(test (eval-string str) 'error) ;; eval-string is confused somehow (test (with-input-from-string str read) 'error)) (list "\"\\x" "\"\\x0" "`(+ ," "`(+ ,@" "#2d(")) (let ((loadit tmp-output-file)) (let ((p1 (open-output-file loadit))) (display "(define s7test-var 314) (define (s7test-func) 314) (define-macro (s7test-mac a) `(+ ,a 2))" p1) (newline p1) (close-output-port p1) (load loadit) (test (= s7test-var 314) #t) (test (s7test-func) 314) (test (s7test-mac 1) 3) (let ((p2 (open-output-file loadit))) ; hopefully this starts a new file (display "(define s7test-var 3) (define (s7test-func) 3) (define-macro (s7test-mac a) `(+ ,a 1))" p2) (newline p2) (close-output-port p2) (load loadit) (test (= s7test-var 3) #t) (test (s7test-func) 3) (test (s7test-mac 1) 2) (test (equivalent? p1 p2) #t)))) ; undefined constants (test (+ 100 (with-input-from-string "123" (lambda () (values (read) 1)))) 224) (for-each (lambda (op) (for-each (lambda (arg) ;(format #t ";(~A ~A)~%" op arg) (test (op arg) 'error)) (list (integer->char 65) 1 0 -1 (list 1) (cons 1 2) 'a-symbol (make-vector 3) abs lambda with-let _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list char-ready? set-current-output-port set-current-input-port set-current-error-port close-input-port close-output-port open-input-file open-output-file read-char peek-char read (lambda (arg) (write-char #\a arg)) (lambda (arg) (write "hi" arg)) (lambda (arg) (display "hi" arg)) call-with-input-file with-input-from-file call-with-output-file with-output-to-file)) (unless pure-s7 (test (char-ready? (open-input-string "")) #t)) ; humph (with-output-to-file tmp-output-file (lambda () (display "this is a test") (newline))) (test (call-with-input-file tmp-output-file (lambda (p) (integer->char (read-byte p)))) #\t) (test (with-input-from-string "123" (lambda () (read-byte))) 49) (test (nan? (with-input-from-string "1/0" read)) #t) (let ((bytes (vector #o000 #o000 #o000 #o034 #o000 #o001 #o215 #o030 #o000 #o000 #o000 #o022 #o000 #o000 #o126 #o042 #o000 #o000 #o000 #o001 #o000 #o000 #o000 #o000 #o000 #o001))) (with-output-to-file tmp-output-file (lambda () (for-each (lambda (b) (write-byte b)) bytes))) (let ((ctr 0)) (call-with-input-file tmp-output-file (lambda (p) (if (not (string=? (port-filename p) tmp-output-file)) (display (port-filename p))) (let loop ((val (read-byte p))) (if (eof-object? val) (if (not (= ctr 26)) (format #t "read-byte done at ~A~%" ctr)) (begin (if (not (= (bytes ctr) val)) (format #t "read-byte bytes[~D]: ~A ~A~%" ctr (bytes ctr) val)) (set! ctr (+ 1 ctr)) (loop (read-byte p)))))))) (let ((ctr 0)) (call-with-input-file tmp-output-file (lambda (p) (let loop ((val (read-char p))) (if (eof-object? val) (if (not (= ctr 26)) (format #t "read-char done at ~A~%" ctr)) (begin (if (not (= (bytes ctr) (char->integer val))) (format #t "read-char bytes[~D]: ~A ~A~%" ctr (bytes ctr) (char->integer val))) (set! ctr (+ 1 ctr)) (loop (read-char p)))))))) ) (with-output-to-file tmp-output-file (lambda () (if (not (string=? (port-filename (current-output-port)) tmp-output-file)) (display (port-filename (current-output-port)))) (display "(+ 1 2) 32") (newline) (display "#\\a -1"))) (with-input-from-file tmp-output-file (lambda () (if (not (string=? (port-filename (current-input-port)) tmp-output-file)) (display (port-filename (current-input-port)))) (let ((val (read))) (if (not (equal? val (list '+ 1 2))) (format #t ";file read +: ~A~%" val))) (let ((val (read))) (if (not (equal? val 32)) (format #t "file read 32: ~A~%" val))) (let ((val (read))) (if (not (equal? val #\a)) (format #t "file read a: ~A~%" val))) (let ((val (read))) (if (not (equal? val -1)) (format #t "file read -1: ~A~%" val))) (let ((val (read))) (if (not (eof-object? val)) (format #t "file read #: ~A~%" val))) (let ((val (read))) (if (not (eof-object? val)) (format #t "file read # again: ~A~%" val))))) (let () (call-with-input-string "012" (lambda (p) (do ((i 0 (+ i 1))) ((= i 4)) (let ((c (peek-char p))) (let ((r (read-char p))) (if (not (equal? c r)) (format #t ";peek-char: ~A ~A~%" c r)))))))) (let ((port #f)) (call-with-exit (lambda (go) (call-with-input-string "0123456789" (lambda (p) (set! port p) (if (not (char=? (peek-char p) #\0)) (format #t ";peek-char input-string: ~A~%" (peek-char p))) (go))))) (if (not (input-port? port)) (format #t ";c/e-> c/is -> port? ~A~%" port) (if (not (port-closed? port)) (begin (format #t ";c/e -> c/is -> closed? ~A~%" port) (close-input-port port))))) (call-with-output-file tmp-output-file (lambda (p) (display "0123456789" p))) (let ((port #f)) (call-with-exit (lambda (go) (call-with-input-file tmp-output-file (lambda (p) (set! port p) (if (not (char=? (peek-char p) #\0)) (format #t ";peek-char input-file: ~A~%" (peek-char p))) (go))))) (if (not (input-port? port)) (format #t ";c/e -> c/if -> port? ~A~%" port) (if (not (port-closed? port)) (begin (format #t ";c/e -> c/if -> closed? ~A~%" port) (close-input-port port))))) (let ((port #f)) (call-with-exit (lambda (go) (dynamic-wind (lambda () #f) (lambda () (call-with-input-string "0123456789" (lambda (p) (set! port p) (if (not (char=? (peek-char p) #\0)) (format #t ";peek-char input-string 1: ~A~%" (peek-char p))) (go)))) (lambda () (close-input-port port))))) (if (not (input-port? port)) (format #t ";c/e -> dw -> c/is -> port? ~A~%" port) (if (not (port-closed? port)) (begin (format #t ";c/e -> dw -> c/is -> closed? ~A~%" port) (close-input-port port))))) (let ((port #f)) (call-with-exit (lambda (go) (dynamic-wind (lambda () #f) (lambda () (call-with-input-file tmp-output-file (lambda (p) (set! port p) (if (not (char=? (peek-char p) #\0)) (format #t ";peek-char input-file: ~A~%" (peek-char p))) (go)))) (lambda () (close-input-port port))))) (if (not (input-port? port)) (format #t ";c/e -> dw -> c/if -> port? ~A~%" port) (if (not (port-closed? port)) (begin (format #t ";c/e -> dw -> c/if -> closed? ~A~%" port) (close-input-port port))))) (let ((port #f)) (catch #t (lambda () (call-with-input-string "0123456789" (lambda (p) (set! port p) (if (not (char=? (peek-char p) #\0)) (format #t ";peek-char input-string: ~A~%" (peek-char p))) (error 'oops)))) (lambda args #f)) (if (not (input-port? port)) (format #t ";catch -> c/is -> error -> port? ~A~%" port) (if (not (port-closed? port)) (begin (format #t ";catch -> c/is -> error -> closed? ~A~%" port) (close-input-port port))))) (let ((port #f)) (catch #t (lambda () (call-with-input-file tmp-output-file (lambda (p) (set! port p) (if (not (char=? (peek-char p) #\0)) (format #t ";peek-char input-file: ~A~%" (peek-char p))) (error 'oops)))) (lambda args #f)) (if (not (input-port? port)) (format #t ";catch -> c/if -> error -> port? ~A~%" port) (if (not (port-closed? port)) (begin (format #t ";catch -> c/if -> error -> closed? ~A~%" port) (close-input-port port))))) (test (with-output-to-string (lambda () (write (string (integer->char 4) (integer->char 8) (integer->char 20) (integer->char 30))))) "\"\\x04;\\b\\x14;\\x1e;\"") (test (string-length "\x04;\x08;\x14;\x1e;") 4) (test (char->integer (string-ref "\x0;" 0)) 0) (test (char->integer (string-ref "\x0e;" 0)) 14) (test (char->integer (string-ref "\x1e;" 0)) 30) (test (char->integer (string-ref "\xff;" 0)) 255) (test (string=? "\x61;\x42;\x63;" "aBc") #t) (test (string=? "\"\\x01;\\x02;\\x03;\\x04;\\x05;\\x06;\\x07;\\x08;\\x09;x\\x0b;\\x0c;\\x0d;\\x0e;\\x0f;\\x10;\\x11;\\x12;\\x13;\\x14;\\x15;\\x16;\\x17;\\x18;\\x19;\\x1a;\\x1b;\\x1c;\\x1d;\\x1e;\\x1f; !\\\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\\x7f;\\x80;\\x81;\\x82;\\x83;\\x84;\\x85;\\x86;\\x87;\\x88;\\x89;\\x8a;\\x8b;\\x8c;\\x8d;\\x8e;\\x8f;\\x90;\\x91;\\x92;\\x93;\\x94;\\x95;\\x96;\\x97;\\x98;\\x99;\\x9a;\\x9b;\\x9c;\\x9d;\\x9e;\\x9f;\\xa0¡¢£¤¥¦§¨©ª«¬\\xad®¯°±²³´µ¶·¸¹º»¼½¾¿Ã\x80;Ã\x81;Ã\x82;Ã\x83;Ã\x84;Ã\x85;Ã\x86;Ã\x87;Ã\x88;Ã\x89;Ã\x8a;Ã\x8b;Ã\x8c;Ã\x8d;Ã\x8e;Ã\x8f;Ã\x90;Ã\x91;Ã\x92;Ã\x93;Ã\x94;Ã\x95;Ã\x96;Ã\x97;Ã\x98;Ã\x99;Ã\x9a;Ã\x9b;Ã\x9c;Ã\x9d;Ã\x9e;Ã\x9f;àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ\"" "\"\\x01;\\x02;\\x03;\\x04;\\x05;\\x06;\\x07;\\x08;\\x09;x\\x0b;\\x0c;\\x0d;\\x0e;\\x0f;\\x10;\\x11;\\x12;\\x13;\\x14;\\x15;\\x16;\\x17;\\x18;\\x19;\\x1a;\\x1b;\\x1c;\\x1d;\\x1e;\\x1f; !\\\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\\x7f;\\x80;\\x81;\\x82;\\x83;\\x84;\\x85;\\x86;\\x87;\\x88;\\x89;\\x8a;\\x8b;\\x8c;\\x8d;\\x8e;\\x8f;\\x90;\\x91;\\x92;\\x93;\\x94;\\x95;\\x96;\\x97;\\x98;\\x99;\\x9a;\\x9b;\\x9c;\\x9d;\\x9e;\\x9f;\\xa0¡¢£¤¥¦§¨©ª«¬\\xad®¯°±²³´µ¶·¸¹º»¼½¾¿Ã\x80;Ã\x81;Ã\x82;Ã\x83;Ã\x84;Ã\x85;Ã\x86;Ã\x87;Ã\x88;Ã\x89;Ã\x8a;Ã\x8b;Ã\x8c;Ã\x8d;Ã\x8e;Ã\x8f;Ã\x90;Ã\x91;Ã\x92;Ã\x93;Ã\x94;Ã\x95;Ã\x96;Ã\x97;Ã\x98;Ã\x99;Ã\x9a;Ã\x9b;Ã\x9c;Ã\x9d;Ã\x9e;Ã\x9f;àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ\"") #t) (test (let (({ 3)) (+ { 1)) 4) ; from bug-guile (test (display #\{ #f) #\{) (test (display '{ #f) '{) ; returns arg (test (with-output-to-string (lambda () (display '{))) "{") (test (with-output-to-string (lambda () (write '{))) "{") (test (let (([ 3)) (+ [ 1)) 4) (test (with-output-to-string (lambda () (display '[))) "[") (when (provided? 'system-extras) ;; directory? (test (directory? tmp-output-file) #f) (test (directory? ".") #t) (test (directory?) 'error) (test (directory? "." 0) 'error) (test (directory? "~/cl") #t) (test (directory? "~") #f) (test (directory? "~/") #t) (for-each (lambda (arg) (test (directory? arg) 'error)) (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;; file-exists? (test (file-exists? tmp-output-file) #t) (test (file-exists? "not-a-file-I-hope") #f) (test (file-exists? "~/cl/s7.c") #t) (test (file-exists?) 'error) (test (file-exists? tmp-output-file 0) 'error) (for-each (lambda (arg) (test (file-exists? arg) 'error)) (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;; delete-file (test (delete-file tmp-output-file) 0) (test (file-exists? tmp-output-file) #f) (test (delete-file "not-a-file-I-hope") -1) (test (delete-file) 'error) (test (delete-file tmp-output-file 0) 'error) (when (file-exists? "~/cl/dsp.scm") (system (string-append "touch ~/cl/" tmp-output-file)) (test (file-exists? (string-append "~/cl/" tmp-output-file)) #t) (test (delete-file (string-append "~/cl/" tmp-output-file)) 0) (test (file-exists? (string-append "~/cl/" tmp-output-file)) #f)) (for-each (lambda (arg) (test (delete-file arg) 'error)) (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;; getenv (test (pair? (member (getenv "HOME") (list (append "/usr/home/" username) (append "/Users/" username) (append "/home/" username)) string=?)) #t) (test (getenv "NO-ENV") #f) ; was "" (test (getenv) 'error) (test (getenv "HOME" #t) 'error) (for-each (lambda (arg) (test (getenv arg) 'error)) (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) ;; directory->list (test (directory->list) 'error) (test (directory->list "." 0) 'error) (for-each (lambda (arg) (test (directory->list arg) 'error)) (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (pair? (directory->list "tools")) #t) (test (pair? (directory->list "~/cl/tools")) #t) ;; file-mtime (test (integer? (file-mtime "s7test.scm")) #t) (test (integer? (file-mtime "~/cl/s7test.scm")) #t) (test (file-mtime "asdf.data") 'error) (test (file-mtime #\a) 'error) (test (file-mtime) 'error) (test (file-mtime "asdf" "a") 'error) ;; system (test (system "test -f s7test.scm") 0) (test (system) 'error) (test (let ((str (system "man grep" #t))) (and (string? str) (> (length str) 10000))) ; osx: 14479, linux: 40761 #t) (for-each (lambda (arg) (test (system arg) 'error)) (list -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (if (not pure-s7) (for-each (lambda (arg) (test (char-ready? arg) 'error)) (list "hi" -1 #\a 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #f #t :hi (if #f #f) (lambda (a) (+ a 1))))) ;;; newline (test (newline 0) 'error) (test (newline *stdout* 0) 'error) (test (newline #f) #\newline) (test (with-output-to-string (lambda () (newline))) "\n") (test (with-output-to-string (lambda () (newline #f))) "") (test (call-with-output-string (lambda (p) (newline p))) "\n") (test (newline *stdin*) 'error) (test (display 0 0) 'error) (test (write 0 0) 'error) (test (write-char 0 0) 'error) (test (write-string 0 0) 'error) (test (write-line 0 0) 'error) (test (read-char 0) 'error) (test (read 0) 'error) (test (read-string 1 0) 'error) (test (read-line 0) 'error) ;;; -------- format -------- ;;; format (test (format #f "hiho") "hiho") (test (format #f "") "") (test (format #f "" 1) 'error) (test (format #f "a") "a") ;(test (format #f "a\x00;b") "a") (test (format #f "~~") "~") ; guile returns this, but clisp thinks it's an error (test (format #f "~~~~") "~~") (test (format #f "a~~") "a~") (test (format #f "~~a") "~a") (test (format #f "~A" "") "") (test (format #f "~{~^~A~}" ()) "") (test (format #f "~{~^~{~^~A~}~}" '(())) "") (test (format #f "~P" 1) "") (test (format #f "~P" #\a) 'error) (test (format #f "~0T") "") (test (format #f "") "") (test (format #f "~*~*" 1 2) "") (test (format #f "~20,'~D" 3) "~~~~~~~~~~~~~~~~~~~3") (test (format #f "~0D" 123) "123") (test (format #f "~{~S~}" ()) "") (test (format #f "~-1D" 123) 'error) (test (format #f "~+1D" 123) 'error) (test (format #f "~1.D" 123) 'error) (test (format #f "~1+iD" 123) 'error) (test (format #f "~1/2D" 123) 'error) (test (format #f "~1/1D" 123) 'error) (test (format #f "~20,'-1D" 123) 'error) (for-each (lambda (arg) (test (format arg "~D" 1) 'error)) (list "hi" #\a 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (directive) (for-each (lambda (arg) (test (format #f directive arg) 'error) (test (format #f directive) 'error)) (list "hi" #\a 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand #f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list "~D" "~F" "~G" "~X" "~B" "~O" "~E" "~P")) (test (format #f "~,1" 123) 'error) ;format "~,1" 123: numeric argument, but no directive! ; (format #f "~,1" 123) (test (format #f "~,123456789123456789123456789d" 1) 'error) ;format "~,123456789123456789123456789d" 1: numeric argument too large ; (format #t "~,123456789123456789123456789d" 1) (test (format #f "~969424987x" 12) 'error) (test (format #f "~D" 1 2) 'error) ;format: "~D" 1 2 ; ^: too many arguments ; (format #f "~D" 1 2) (test (format #f "~D~" 1) 'error) ;format: "~D~" 1 ; ^: control string ends in tilde ; (format #f "~D~" 1) (test (format #f "~") 'error) (test (format #f " ~") 'error) (test (format #f "~~~") 'error) (test (format #f " ~~~") 'error) (test (format #f "~@D" 1) 'error) ;format "~@D" 1: unknown '@' directive ; (format #f "~@D" 1) (test (format #f "~@p" #\a) 'error) ;format "~@p" #\a: '@P' directive argument is not an integer ; (format #f "~@p" #\a) (test (format #f "~@p") 'error) ;format "~@p": '@' directive argument missing (test (format #f "~P" 1+i) 'error) ;format "~P" 1+1i: 'P' directive argument is not a real number ; (format #f "~P" 1+1i) (test (format #f "~P" (real-part (log 0))) "s") (test (format #f "~@p" 0+i) 'error) ;format "~@p" 0+1i: '@P' directive argument is not a real number ; (format #f "~@p" 0+1i) (test (format #f "~{~}") 'error) ;format "~{~}": missing argument ; (format #f "~{~}") (test (format #f "~{~a" '(1 2 3)) 'error) ;format "~{~a" (1 2 3): '{' directive, but no matching '}' ; (format #f "~{~a" '(1 2 3)) (test (format #f "~{~a~}" '(1 . 2)) 'error) ; changed 28-Nov-18, then again 11-Dec-18 ;format "~{~a~}" (1 . 2): '{' directive argument should be a proper list or something we can turn into a list ; (format #f "~{~a~}" '(1 . 2)) (test (let ((lst (cons 1 2))) (set-cdr! lst lst) (format #f "~{~A~}" lst)) "1") ;format "~{~A~}" #1=(1 . #1#): '{' directive argument should be a proper list or something we can turn into a list ; (format #f "~{~A~}" lst) (test (format #f "~{~a~}" 'asdf) 'error) ;format "~{~a~}" asdf: '{' directive argument should be a proper list or something we can turn into a list ; (format #f "~{~a~}" 'asdf) (test (format #f "~{~a~}" ()) "") (test (format #f "~{asd~}" '(1 2 3)) 'error) ;format: "~{asd~}" (1 2 3) ; ^: '{...}' doesn't consume any arguments! ; (format #f "~{asd~}" '(1 2 3)) (test (format #f "~}" '(1 2 3)) 'error) ;format "~}" (1 2 3): unmatched '}' ; (format #f "~}" '(1 2 3)) (test (format #f "~C") 'error) ;format "~C": ~C: missing argument ; (format #f "~C") (test (format #f "~A ~C" #\a) 'error) ;format: "~A ~C" #\a ; ^: ~C: missing argument ; (format #f "~A ~C" #\a) (test (format #f "~C" 1) 'error) ;format "~C" 1: 'C' directive requires a character argument ; (format #f "~C" 1) (test (format #f "~C" #) 'error) ;format "~C" #: 'C' directive requires a character argument ; (format #f "~C" #) (test (format #f "~1,9223372036854775807f" 1) 'error) ;format "~1,9223372036854775807f" 1: numeric argument too large ; (format #f "~1,9223372036854775807f" 1) (test (format #f "~1,2A" 1) 'error) ;format "~1,2A" 1: extra numeric argument ; (format #f "~1,2A" 1) (test (format #f "~F" #\a) 'error) ;format "~F" #\a: ~F: numeric argument required ; (format #f "~F" #\a) (test (format #f "~1,") 'error) ;format "~1,": format directive does not take a numeric argument ; (format #f "~1,") (test (format #f "~-1,") 'error) ;format "~-1,": unimplemented format directive ; (format #f "~-1,") (test (format #f "~L" 1) 'error) ;format "~L" 1: unimplemented format directive ; (format #f "~L" 1) (test (format #f "~*") 'error) ;format "~*": can't skip argument! (test (format #f "~*~A") 'error) (test (format #f "~*~*" 1) 'error) (test (format #f "~N") 'error) (test (format #f "~N" 2) 'error) (test (format #f "~N." 2) 'error) (test (format #f "~NT" 2.1) 'error) (test (format #f "~NT" #\a) 'error) (test (format #f "~N," 1) 'error) (test (format #f "~N,N" 1 2) 'error) (test (format #f "~N,N." 1 2) 'error) (test (format #f "~,N" 1) 'error) (test (format #f "~,N." 1) 'error) (test (format #f "~ND" 123456789) 'error) (test (format #f "~ND" -1) 'error) (test (format #f "~{~a~e~}" (cons 1 2)) 'error) ;format: "~{~a~e~}" (1 . 2): ~{} argument is a dotted list (for-each (lambda (c) (test (apply format #f (string-append "~" (string c)) '(a)) 'error)) (list #\H #\I #\J #\K #\L #\M #\Q #\R #\U #\V #\Y #\Z #\[ #\\ #\] #\_ #\` #\# #\! #\" #\' #\( #\) #\+ #\, #\- #\. #\/ #\< #\= #\> #\? #\h #\i #\j #\k #\l #\m #\q #\r #\u #\v #\y #\z)) (test (format #f "~A" 1 2) 'error) ;format: "~A" 1 2 ; ^: too many arguments ; (format #f "~A" 1 2) (test (format #f "hiho~%ha") (string-append "hiho" (string #\newline) "ha")) (test (format #f "~%") (string #\newline)) (test (format #f "~%ha") (string-append (string #\newline) "ha")) (test (format #f "hiho~%") (string-append "hiho" (string #\newline))) (test (eq? #\tab ((format #f "\t") 0)) #t) (test (eq? #\newline ((format #f "\n") 0)) #t) (test (eq? #\\ ((format #f "\\") 0)) #t) (test (eq? #\" ((format #f "\"") 0)) #t) (for-each (lambda (arg res) (let ((val (catch #t (lambda () (format #f "~A" arg)) (lambda args 'error)))) (if (or (not (string? val)) (not (string=? val res))) (begin (display "(format #f \"~A\" ") (display arg) (display " returned \"") (display val) (display "\" but expected \"") (display res) (display "\"") (newline))))) (list "hiho" -1 #\a 1 #f #t #(1 2 3) 3.14 3/4 1.5+1.5i () #(()) (list 1 2 3) '(1 . 2) 'hi) (list "hiho" "-1" "a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i" "()" "#(())" "(1 2 3)" "(1 . 2)" "hi")) (test (format #f "hi ~A ho" 1) "hi 1 ho") (test (format #f "hi ~a ho" 1) "hi 1 ho") (test (format #f "~a~A~a" 1 2 3) "123") (test (format #f "~a~~~a" 1 3) "1~3") (test (format #f "~a~%~a" 1 3) (string-append "1" (string #\newline) "3")) (for-each (lambda (arg res) (let ((val (catch #t (lambda () (format #f "~S" arg)) (lambda args 'error)))) (if (or (not (string? val)) (not (string=? val res))) (begin (display "(format #f \"~S\" ") (display arg) (display " returned \"") (display val) (display "\" but expected \"") (display res) (display "\"") (newline))))) (list "hiho" -1 #\a 1 #f #t #(1 2 3) 3.14 3/4 1.5+1.5i () #(()) (list 1 2 3) '(1 . 2) 'hi) (list "\"hiho\"" "-1" "#\\a" "1" "#f" "#t" "#(1 2 3)" "3.14" "3/4" "1.5+1.5i" "()" "#(())" "(1 2 3)" "(1 . 2)" "hi")) (test (format #f "hi ~S ho" 1) "hi 1 ho") (test (format #f "hi ~S ho" "abc") "hi \"abc\" ho") (test (format #f "~s~a" #\a #\b) "#\\ab") (test (format #f "~C~c~C" #\a #\b #\c) "abc") ;(test (format #f "1 2~C 3 4" #\null) "1 2") ; ?? everyone does something different here ;; s7 used to return "1 2 3 4" because it treated ~C as a string (empty in this case) (test (format #f "1 2~C 3 4" #\null) "1 2\x00; 3 4") (test (format #f "~nc" 3 #\a) "aaa") (test (format #f "~nc" 0 #\a) "") (test (format #f "~0c" #\a) "") (test (format #f "~01c" #\a) "a") (test (format #f "~002c" #\a) "aa") (test (format #f "~nc" -1 #\a) 'error) (test (format #f "~nc" most-positive-fixnum #\a) 'error) (test (format #f "~nc" 1.0 #\a) 'error) (test (format #f "~n~nc" 1 2 #\a) 'error) (test (format #f "~na" 1 #\a) 'error) (test (format #f "[~NC]" 0 #\a) "[]") (test (format #f "[~NC]" -1 #\a) 'error) (test (format #f "[~NC]" 1 #\a) "[a]") (test (format #f "~{~A~}" '(1 2 3)) "123") (test (format #f "asb~{~A ~}asb" '(1 2 3 4)) "asb1 2 3 4 asb") (test (format #f "asb~{~A ~A.~}asb" '(1 2 3 4)) "asb1 2.3 4.asb") (test (format #f ".~{~A~}." ()) "..") (test (format #f "~{~A ~A ~}" '(1 "hi" 2 "ho")) "1 hi 2 ho ") (test (format #f "~{.~{+~A+~}.~}" (list (list 1 2 3) (list 4 5 6))) ".+1++2++3+..+4++5++6+.") (test (format #f "~{~s ~}" '(fred jerry jill)) "fred jerry jill ") (test (format #f "~{~s~^ ~}" '(fred jerry jill)) "fred jerry jill") (test (format #f "~{~s~^~^ ~}" '(fred jerry jill)) "fred jerry jill") (test (format #f "~{.~{~A~}+~{~A~}~}" '((1 2) (3 4 5) (6 7 8) (9))) ".12+345.678+9") (test (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)))) ".+-1-2+-3-4-5") (test (format #f "~{.~{+~{-~A~}~}~}" '(((1 2) (3 4 5)) ((6) (7 8 9)))) ".+-1-2+-3-4-5.+-6+-7-8-9") (test (format #f "~A ~* ~A" 1 2 3) "1 3") (test (format #f "~*" 1) "") (test (format #f "~{~* ~}" '(1 2 3)) " ") (test (format #f "~A" catch) "catch") (test (format #f "this is a ~ sentence") "this is a sentence") (test (format #f "~{~C~}" "hi") "hi") (test (format #f "~{~C~}" #(#\h #\i)) "hi") (test (format #f "~S" #(a b)) "#(a b)") (test (format #f "~S" #(a 'b)) "#(a 'b)") (test (format #f "~{.~{~C+~}~}" '((#\h #\i) (#\h #\o))) ".h+i+.h+o+") (test (format #f "~{.~{~C+~}~}" '("hi" "ho")) ".h+i+.h+o+") (test (format #f "~{.~{~C+~}~}" #("hi" "ho")) ".h+i+.h+o+") (test (format #f "~{.~{~C+~}~}" #(#(#\h #\i) #(#\h #\o))) ".h+i+.h+o+") ; (format #f "~{.~{~C~+~}~}" #2d((#\h #\i) (#\h #\o))) error?? -- this is documented... (test (format #f "~{~A~}" #2d((1 2) (3 4))) "1234") ; this seems inconsistent with: (test (format #f "~{~A~}" '((1 2) (3 4))) "(1 2)(3 4)") (test (format #f "~{~A ~}" #2d((1 2) (3 4))) "1 2 3 4 ") (test (format #f "1~\ a2" 3) "132") (test (format #f "1~ ~a2" 3) "132") (test (format #f "~{~{~C~^ ~}~^...~}" (list "hiho" "test")) "h i h o...t e s t") ;; ~nT handling is a mess -- what are the defaults? which is column 1? do we space up to or up to and including? (test (format #f "~A:~8T~A" 100 'a) "100: a") (test (format #f "~A:~nT~A" 100 8 'a) "100: a") (test (format #f "~A:~8T~A" 0 'a) "0: a") (test (format #f "~A:~8T~A" 10000 'a) "10000: a") (test (format #f "~8T~A" 'a) " a") (test (format #f "1212:~8T~A" 'a) "1212: a") (test (format #f "~D:~8T~A" 100 'a) "100: a") (test (format #f "~D:~8T~A" 0 'a) "0: a") (test (format #f "~D:~8T~A" 10000 'a) "10000: a") (test (format #f "~a~10,7Tb" 1) "1 b") (test (format #f "~a~10,7Tb" 10000) "10000 b") (test (format #f "~a~10,12Tb" 1) "1 b") (test (format #f "~a~10,12Tb" 10000) "10000 b") (test (format #f "~a~n,nTb" 10000 10 12) "10000 b") (test (format #f "~n,'xT" 8) "xxxxxxx") (test (format #f "~n,' T" 8) " ") (test (string=? (format #f "~NTa test\n~NTanother test\n" 4 8) (format #f "~NTa test~%~NTanother test\n" 4 8)) #f) ;; \n does not reset the column to 0 -- perhaps a bug? The same problem appears if (display "\n") is interspersed with formats. (when full-s7test (let-temporarily (((*s7* 'max-format-length) 1000000)) (with-input-from-string (format #f "~NC\nline 2\n" 100000 #\a) ; if default, format-error (100000 #\a) "~~N value is too big") (lambda () (read-line) (let ((nstr (read-line))) (if (not (string=? nstr "line 2")) (format *stderr* "read-line big line: ~D~%" nstr))))))) (test (length (format #f "~{~A~}~40T." '(1 2 3))) 40) (test (length (format #f "~{~A ~}~40T." '(1 2 3))) 40) (test (length (format #f "~{~,3F ~}~40T." '(1.0 2.0 3.0))) 40) (test (length (format #f "~S~40T." pi)) (if with-bignums 44 40)) (test (format #f "asdh~20Thiho") "asdh hiho") (test (format #f "asdh~2Thiho") "asdhhiho") (test (format #f "a~Tb") "ab") (test (format #f "0123456~4,8Tb") "0123456 b") (test (format #f "0123456~0,8Tb") "0123456b") (test (format #f "0123456~10,8Tb") "0123456 b") (test (format #f "0123456~1,0Tb") "0123456b") (test (format #f "0123456~1,Tb") "0123456b") (test (format #f "0123456~1,Tb") "0123456b") (test (format #f "0123456~,Tb") "0123456b") (test (format #f "0123456~7,10Tb") "0123456 b") (test (format #f "0123456~8,10tb") "0123456 b") (test (format #f "0123456~3,12tb") "0123456 b") (test (format #f "~40TX") " X") (test (format #f "X~,8TX~,8TX") "X X X") (test (format #f "X~8,TX~8,TX") "X XX") (test (format #f "X~8,10TX~8,10TX") "X X X") (test (format #f "X~8,0TX~8,0TX") "X XX") (test (format #f "X~0,8TX~0,8TX") "X X X") (test (format #f "X~1,8TX~1,8TX") "X X X") (test (format #f "X~,8TX~,8TX") "X X X") ; ?? (test (format #f "X~TX~TX") "XXX") ; clisp and sbcl say "X X X" here and similar differences elsewhere -- is it colnum or colinc as default if no comma? (test (format #f "X~2TX~4TX") "XX X") (test (format #f "X~0,0TX~0,0TX") "XXX") (test (format #f "X~0,TX~0,TX") "XXX") (test (format #f "X~,0TX~,0TX") "XXX") (test (format #f "~0D" 123) "123") (test (format #f "~0F" 123.123) "123.123000") (test (format #f "~,0D" 123) "123") (test (format #f "~,0F" 123.123) "123.0") (test (format #f "~,D" 123) "123") (test (format #f "~,F" 123.123) "123.123000") (test (format #f "~0,D" 123) "123") (test (format #f "~0,F" 123.123) "123.123000") (test (format #f "~0,0D" 123) "123") (test (format #f "~n,nD" 0 0 123) "123") (test (format #f "~0,0F" 123.123) "123.0") (test (format #f "~0,0,D" 123) 'error) (test (format #f "~n,n,D" 0 0 123) 'error) (test (format #f "~0,0,F" 123.123) 'error) (test (format #f "~,3F" 1+i) "1.000+1.000i") (test (format #f "~,nF" 3 1+i) "1.000+1.000i") (test (format #f "~,3G" 1+i) "1.0+1.0i") (test (format #f "~,3E" 1+i) "1.000e+00+1.000e+00i") (test (format #f "~,3F" 1-i) "1.000-1.000i") (test (format #f "~,3G" 1-i) "1.0-1.0i") (test (format #f "~,3E" 1-i) "1.000e+00-1.000e+00i") ;; not sure about these: (test (format #f "~X" 1-i) "1.0-1.0i") (test (format #f "~,3D" 1-i) "1.000e+00-1.000e+00i") (test (format #f "~A" 1-i) "1.0-1.0i") (test (format #f "~W" 3) "3") (test (format #f "~W" 3/4) "3/4") (test (format #f "~W" 3.4) "3.4") (test (format #f "~W" 3+4i) "3.0+4.0i") (test (format #f "~W" 3-4i) "3.0-4.0i") (if with-bignums (test (format #f "~W" pi) "3.141592653589793238462643383279502884195E0") (test (format #f "~W" pi) "pi")) (unless with-bignums (test (format #f "~W" (complex 1/0 0)) "+nan.0") (test (format #f "~W" (complex 1/0 1)) "+nan.0+1.0i") (test (format #f "~W" (complex +inf.0 1/0)) "+inf.0+nan.0i") (test (format #f "~W" (log 0)) "-inf.0+3.141592653589793i")) (test (catch #t (lambda () (let () (define (c1 a b) (+ a b)) (c1 1))) (lambda (t i) (apply format #f i))) "c1: not enough arguments: ((lambda (a b) ...) 1)") (test (catch #t (lambda () (let () (define (c1 a b) (+ a b)) (c1 1 2 3))) (lambda (t i) (apply format #f i))) "c1: too many arguments: ((lambda (a b) ...) 1 2 3)") (test (catch #t (lambda () (let () (define-macro (m1 a b) (+ a b)) (m1 1))) (lambda (t i) (apply format #f i))) "m1: not enough arguments: ((macro (a b) ...) 1)") (test (catch #t (lambda () (let () (define-macro (m1 a b) (+ a b)) (m1 1 2 3))) (lambda (t i) (apply format #f i))) "m1: too many arguments: ((macro (a b) ...) 1 2 3)") (test (catch #t (lambda () (let () (define-bacro (m2 a b) (+ a b)) (m2 1))) (lambda (t i) (apply format #f i))) "m2: not enough arguments: ((bacro (a b) ...) 1)") (test (catch #t (lambda () (let () (define-bacro (m2 a b) (+ a b)) (m2 1 2 3))) (lambda (t i) (apply format #f i))) "m2: too many arguments: ((bacro (a b) ...) 1 2 3)") ;; see also object->string with :readable (test (format #f "~000000000000000000000000000000000000000000003F" 123.123456789) "123.123457") (test (format #f "~922337203685477580F" 123.123) 'error) ; numeric argument too large (test (format #f "~,922337203685477580F" 123.123) 'error) (test (format #f "~1,922337203685477580F" 123.123) 'error) (test (format #f "~1 ,2F" 123.456789) 'error) (test (format #f "~1, 2F" 123.456789) 'error) (test (format #f "~1, F" 123.456789) 'error) (if with-bignums (begin (test (format #f "~o" 1e19) "1.053071060221172E21") (test (format #f "~o" -1e19) "-1.053071060221172E21") (test (format #f "~x" 1e19) "8.ac7230489e8@15") (test (format #f "~b" 1e19) "1.00010101100011100100011000001001000100111101E63") (test (format #f "~o" 1e308) "1.071474702753621177617256074117252375235444E341") (test (format #f "~o" -1e308) "-1.071474702753621177617256074117252375235444E341") (test (format #f "~x" 1e308) "8.e679c2f5e44ff8f570f09eaa7ea7648@255") (test (format #f "~x" 9.22e18) "7.ff405267d1a@15") (test (format #f "~b" 1e308) "1.0001110011001111001110000101111010111100100010011111111100011110101011100001111000010011110101010100111111010100111011001001E1023") (test (format #f "~,791o" 1e308) "1.071474702753621177617256074117252375235444E341") (test (format #f "~1200,2g" 1e308) " 9.999999999999999999999999999999999999982E307") (test (format #f "~o" 1e19-1e20i) "1.053071060221172E21-1.2657072742654304E22i") (test (format #f "~x" 1e308+1e300i) "8.e679c2f5e44ff8f570f09eaa7ea7648@255+1.7e43c8800759ba59c08e14c7cd7aad86@249i")) (begin (test (format #f "~o" 1e19) "1.053071e21") (test (format #f "~o" -1e19) "-1.053071e21") (test (format #f "~x" 1e19) "8.ac723@15") (test (format #f "~b" 1e19) "1.000101e63") (test (format #f "~o" 1e308) "1.071474e341") (test (format #f "~o" -1e308) "-1.071474e341") (test (format #f "~x" 1e308) "8.e679c2@255") (test (or (string=? (format #f "~x" 9.22e18) "7ff405267d1a0000.0") (string=? (format #f "~x" 9.22e18) "7.ff4052@15")) #t) ; this depends on a cutoff point in s7.c, L8850, number_to_string_with_radix (test (format #f "~b" 1e308) "1.000111e1023") (test (format #f "~,791o" 1e308) "1.0714747027536212e341") (test (format #f "~1200,2g" 1e308) " 1e+308") (test (format #f "~o" 1e19-1e20i) "1.053071e21-1.265707e22i") (test (format #f "~x" 1e308+1e300i) "8.e679c2@255+1.7e43c8@249i"))) (test (= (length (substring (format #f "~%~10T.") 1)) (length (format #f "~10T."))) #t) (test (= (length (substring (format #f "~%-~10T.~%") 1)) (length (format #f "-~10T.~%"))) #t) (test (string=? (format #f "~%|0 1 2|~21T|5 8 3 2|~%~ |1 2 3| |0 1 2 3|~21T|8 14 8 6|~%~ |2 3 0| |1 2 3 0| = ~21T|3 8 13 6|~%~ |3 0 1| |2 3 0 1|~21T|2 6 6 10|~%") " |0 1 2| |5 8 3 2| |1 2 3| |0 1 2 3| |8 14 8 6| |2 3 0| |1 2 3 0| = |3 8 13 6| |3 0 1| |2 3 0 1| |2 6 6 10| ") #t) (unless (or with-windows with-bignums) (test (format #f "~S" '(+ 1/0 1/0)) "(+ +nan.0 +nan.0)") (test (format #f "~S" '(+ '1/0 1/0)) "(+ '+nan.0 +nan.0)")) (test (format #f "~S" '(+ 1/0 1.0/0.0)) (format #f "~S" (list '+ '1/0 '1.0/0.0))) (test (format #f "~S" (quote (+ '1 1))) "(+ '1 1)") (test (format #f "~12,''D" 1) "'''''''''''1") (test (let ((str "~12,'xD")) (set! (str 5) #\space) (format #f str 1)) " 1") (test (format #f "~12,' D" 1) " 1") (test (format #f "~12,'\\D" 1) "\\\\\\\\\\\\\\\\\\\\\\1") (test (format #f "~12,'\"D" 1) "\"\"\"\"\"\"\"\"\"\"\"1") (test (format #f "~12,'~D" 1) "~~~~~~~~~~~1") (test (format #f "~12,',d" 1) ",,,,,,,,,,,1") (test (format #f "~12,',,d" 1) 'error) (test (format #f "~12,,d" 1) 'error) (test (format #f "~n,,d" 12 1) 'error) (test (format #f "hiho~\n") "hiho") (test (string=? (format #f "~%~&" ) (string #\newline)) #t) (test (string=? (format #f "~%a~&" ) (string #\newline #\a #\newline)) #t) (test (string=? (format #f "~%~%") (string #\newline #\newline)) #t) (test (string=? (format #f "~10T~%~&~10T.") (format #f "~10T~&~&~10T.")) #t) (test (string=? (format #f "~10T~&~10T.") (format #f "~10T~%~&~&~&~&~10T.")) #t) (test (length (format #f "~%~&~%")) 2) (test (length (format #f "~%~&~&~&~&~%")) 2) (test (length (format #f "~&~%")) 1) (test (format #f "~2,1F" 0.5) "0.5") (test (format #f "~:2T") 'error) (test (format #f "~2,1,3F" 0.5) 'error) (test (format #f "~<~W~>" 'foo) 'error) (test (format #f "~{12") 'error) (test (format #f "~{}") 'error) (test (format #f "~{}" '(1 2)) 'error) (test (format #f "{~}" '(1 2)) 'error) (test (format #f "~{~{~}}" '(1 2)) 'error) (test (format #f "~}" ) 'error) ;(test (format #f "#|~|#|") 'error) ; ~| is ~^+ now (test (format #f "~1.5F" 1.5) 'error) (test (format #f "~1+iF" 1.5) 'error) (test (format #f "~1,1iF" 1.5) 'error) (test (format #f "~0" 1) 'error) (test (format #f "~1") 'error) (test (format #f "~^" 1) 'error) (test (format #f "~.0F" 1.0) 'error) (test (format #f "~1.0F" 1.0) 'error) (test (format #f "~-1F" 1.0) 'error) (test (format #f "~^") "") (test (format #f "~A ~A~|this is not printed" 1 2) "1 2") (test (format #f "~^~A~^~A~^this is not printed" 1 2) "12") (test (format #f "~|") "") (test (format #f "~D~" 9) 'error) (test (format #f "~&" 9) 'error) (test (format #f "~D~100T~D" 1 1) "1 1") (test (format #f ".~P." 1) "..") (test (format #f ".~P." 1.0) "..") (test (format #f ".~P." 1.2) ".s.") (test (format #f ".~P." 2/3) ".s.") (test (format #f ".~P." 2) ".s.") (test (format #f ".~p." 1) "..") (test (format #f ".~p." 1.0) "..") (test (format #f ".~p." 1.2) ".s.") (test (format #f ".~p." 2) ".s.") (test (format #f ".~@P." 1) ".y.") (test (format #f ".~@P." 1.0) ".y.") (test (format #f ".~@P." 1.2) ".ies.") (test (format #f ".~@P." 2) ".ies.") (test (format #f ".~@p." 1) ".y.") (test (format #f ".~@p." 1.0) ".y.") (test (format #f ".~@p." 1.2) ".ies.") (test (format #f ".~@p." 2) ".ies.") (test (format #f ".~P." 1.0+i) 'error) (test (format #f ".~P." 1/0) ".s.") (test (format #f "~P" 1) "") ; Clisp does this (if (not with-windows) (test (format #f ".~P." (real-part (log 0))) ".s.")) (test (format #f (string #\~ #\a) 1) "1") (test (format #f (format #f "~~a") 1) "1") (test (format #f (format #f "~~a") (format #f "~D" 1)) "1") (test (format #f "~A" (quasiquote quote)) "quote") (test (format #f "~f" (/ 1 3)) "1/3") ; hmmm -- should it call exact->inexact? (test (format #f "~f" 1) "1") (test (format #f "~F" most-positive-fixnum) "9223372036854775807") (test (format () "") "") ; changed 18-Mar-24, was #f (test (with-output-to-string (lambda () (display (format () "")))) "") (test (with-output-to-string (lambda () (display #f))) "#f") (unless with-bignums (test (format #f "~,20F" 1e-20) "0.00000000000000000001") (test (format #f "~,40F" 1e-40) "0.0000000000000000000000000000000000000001")) ;; if with bignums, these needs more bits ;;; the usual troubles here with big floats: ;;; (format #f "~F" 922337203685477580.9) -> "922337203685477632.000000" ;;; (format #f "~F" 9223372036854775.9) -> "9223372036854776.000000" ;;; (format #f "~F" 1e25) -> "10000000000000000905969664.000000" ;;; or small: ;;; (format #f "~,30F" 1e-1) -> "0.100000000000000005551115123126" (when with-bignums (test (format #f "~A" -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601) "-7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601") (test (format #f "~D" -7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601) "-7043009959286724629649270926654940933664689003233793014518979272497911394287216967075767325693021717277238746020477538876750544587281879084559996466844417586093291189295867052594478662802691926547232838591510540917276694295393715934079679531035912244103731582711556740654671309980075069010778644542022/670550434139267031632063192770201289106737062379324644110801846820471752716238484923370056920388400273070254958650831435834503195629325418985020030706879602898158806736813101434594805676212779217311897830937606064579213895527844045511878668289820732425014254579493444623868748969110751636786165152601")) (unless with-bignums (test (format #f "~,1024F" pi) "3.1415926535897931159979634685441851615905761718750000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")) (test (format #f "~100,30000F" pi) 'error) (test (format #f "~N,1F" most-positive-fixnum pi) 'error) ; "~N value is too big" (test (format #f "~N,1F" (- most-positive-fixnum 1) pi) 'error) ; "~N value is too big" (test (format #f "~N,1F" most-negative-fixnum pi) 'error) ; "~N value is negative" (test (format #f "~NC" (ash 1 32) #\c) 'error) ; "~N value is too big" (test (format #f "~,9223272036854775807F" pi) 'error) ; "precision is too big" (test (format #f "~@F" 1.23) 'error) (test (format #f "~{testing ~D ~C ~}" (list 0 #\( 1 #\) 2 #\* 3 #\+ 4 #\, 5 #\- 6 #\. 7 #\/ 8 #\0 9 #\1 10 #\2 11 #\3 12 #\4 13 #\5 14 #\6 15 #\7 16 #\8 17 #\9 18 #\: 19 #\; 20 #\< 21 #\= 22 #\> 23 #\? 24 #\@ 25 #\A 26 #\B 27 #\C 28 #\D 29 #\E 30 #\F 31 #\G 32 #\H 33 #\I 34 #\J 35 #\K 36 #\L 37 #\M 38 #\N 39 #\O 40 #\P 41 #\Q 42 #\R 43 #\S 44 #\T 45 #\U 46 #\V 47 #\W 48 #\X 49 #\Y 50 #\( 51 #\) 52 #\* 53 #\+ 54 #\, 55 #\- 56 #\. 57 #\/ 58 #\0 59 #\1 60 #\2 61 #\3 62 #\4 63 #\5 64 #\6 65 #\7 66 #\8 67 #\9 68 #\: 69 #\; 70 #\< 71 #\= 72 #\> 73 #\? 74 #\@ 75 #\A 76 #\B 77 #\C 78 #\D 79 #\E 80 #\F 81 #\G 82 #\H 83 #\I 84 #\J 85 #\K 86 #\L 87 #\M 88 #\N 89 #\O 90 #\P 91 #\Q 92 #\R 93 #\S 94 #\T 95 #\U 96 #\V 97 #\W 98 #\X 99 #\Y)) "testing 0 ( testing 1 ) testing 2 * testing 3 + testing 4 , testing 5 - testing 6 . testing 7 / testing 8 0 testing 9 1 testing 10 2 testing 11 3 testing 12 4 testing 13 5 testing 14 6 testing 15 7 testing 16 8 testing 17 9 testing 18 : testing 19 ; testing 20 < testing 21 = testing 22 > testing 23 ? testing 24 @ testing 25 A testing 26 B testing 27 C testing 28 D testing 29 E testing 30 F testing 31 G testing 32 H testing 33 I testing 34 J testing 35 K testing 36 L testing 37 M testing 38 N testing 39 O testing 40 P testing 41 Q testing 42 R testing 43 S testing 44 T testing 45 U testing 46 V testing 47 W testing 48 X testing 49 Y testing 50 ( testing 51 ) testing 52 * testing 53 + testing 54 , testing 55 - testing 56 . testing 57 / testing 58 0 testing 59 1 testing 60 2 testing 61 3 testing 62 4 testing 63 5 testing 64 6 testing 65 7 testing 66 8 testing 67 9 testing 68 : testing 69 ; testing 70 < testing 71 = testing 72 > testing 73 ? testing 74 @ testing 75 A testing 76 B testing 77 C testing 78 D testing 79 E testing 80 F testing 81 G testing 82 H testing 83 I testing 84 J testing 85 K testing 86 L testing 87 M testing 88 N testing 89 O testing 90 P testing 91 Q testing 92 R testing 93 S testing 94 T testing 95 U testing 96 V testing 97 W testing 98 X testing 99 Y ") (let ((vect1 #3d(((1 2 3) (3 4 5)) ((5 6 1) (7 8 2)))) (vect2 #2d((1 2 3 4 5 6) (7 8 9 10 11 12))) (vect3 #(1 2 3 4 5 6 7 8 9 10 11 12 13 14)) (vect4 #3d(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12))))) (do ((i 0 (+ i 2))) ((>= i 10)) (set! (*s7* 'print-length) i) (test (object->string vect1) (format #f "~A" vect1)) (test (object->string vect2) (format #f "~A" vect2)) (test (object->string vect3) (format #f "~A" vect3)) (test (object->string vect4) (format #f "~A" vect4)))) (set! (*s7* 'print-length) 40) (let-temporarily (((*s7* 'print-length) 0)) (test (format #f "~A" #()) "#()") (test (format #f "~S" (list (cons 1 1))) "((...))")) (let-temporarily (((*s7* 'print-length) 3)) (let ((lst (list 1))) (set-car! lst lst) (let ((v (vector 1 1 1 1 1 1 1 1 1 lst))) (let ((str (format #f "~A" v))) (test (string=? str "#(1 1 1 ...)") #t))))) (let () (catch #t (lambda () (object->string (make-iterator "1234") :readable 3)) (lambda args #f)) (test (format #f "~S" (list (cons 1 1))) "((1 . 1))")) ; check that bogus object->string truncation doesn't affect subsequent output (test (format #f "~D" 123) "123") (test (format #f "~X" 123) "7b") (test (format #f "~B" 123) "1111011") (test (format #f "~O" 123) "173") (test (format #f "~10D" 123) " 123") (test (format #f "~nD" 10 123) " 123") (test (format #f "~10X" 123) " 7b") (test (format #f "~10B" 123) " 1111011") (test (format #f "~10O" 123) " 173") (test (format #f "~D" -123) "-123") (test (format #f "~X" -123) "-7b") (test (format #f "~B" -123) "-1111011") (test (format #f "~O" -123) "-173") (test (format #f "~10D" -123) " -123") (test (format #f "~10X" -123) " -7b") (test (format #f "~10B" -123) " -1111011") (test (format #f "~10O" -123) " -173") (test (format #f "~d" 123) "123") (test (format #f "~x" 123) "7b") (test (format #f "~b" 123) "1111011") (test (format #f "~o" 123) "173") (test (format #f "~10d" 123) " 123") (test (format #f "~10x" 123) " 7b") (test (format #f "~10b" 123) " 1111011") (test (format #f "~10o" 123) " 173") (test (format #f "~d" -123) "-123") (test (format #f "~x" -123) "-7b") (test (format #f "~b" -123) "-1111011") (test (format #f "~o" -123) "-173") (test (format #f "~10d" -123) " -123") (test (format #f "~10x" -123) " -7b") (test (format #f "~10b" -123) " -1111011") (test (format #f "~10o" -123) " -173") (test (format #f "~D" most-positive-fixnum) "9223372036854775807") (test (format #f "~D" (+ 1 most-negative-fixnum)) "-9223372036854775807") (test (format #f "~X" most-positive-fixnum) "7fffffffffffffff") (test (format #f "~X" (+ 1 most-negative-fixnum)) "-7fffffffffffffff") (test (format #f "~O" most-positive-fixnum) "777777777777777777777") (test (format #f "~O" (+ 1 most-negative-fixnum)) "-777777777777777777777") (test (format #f "~B" most-positive-fixnum) "111111111111111111111111111111111111111111111111111111111111111") (test (format #f "~B" (+ 1 most-negative-fixnum)) "-111111111111111111111111111111111111111111111111111111111111111") (num-test (inexact->exact most-positive-fixnum) most-positive-fixnum) (test (format #f "~0D" 123) "123") (test (format #f "~0X" 123) "7b") (test (format #f "~0B" 123) "1111011") (test (format #f "~0O" 123) "173") (test (format #f "" 1) 'error) (test (format #f "hiho" 1) 'error) (test (format #f "a~%" 1) 'error) ; some just ignore extra args (for-each (lambda (arg) (let ((result (catch #t (lambda () (format arg "hiho")) (lambda args 'error)))) (if (not (eq? result 'error)) (begin (display "(format ") (display arg) (display " \"hiho\")") (display " returned ") (display result) (display " but expected 'error") (newline))))) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i 'hi :hi # abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (let ((result (catch #t (lambda () (format #f arg)) (lambda args 'error)))) (if (not (eq? result 'error)) (begin (display "(format #f ") (display arg) (display ")") (display " returned ") (display result) (display " but expected 'error") (newline))))) (list -1 #\a 1 #f #t #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2))) (test (format #f "hi ~A ho" 1 2) 'error) (test (format #f "hi ~A ho") 'error) (test (format #f "hi ~S ho") 'error) (test (format #f "hi ~S ho" 1 2) 'error) (test (format #f "~C" 1) 'error) (test (format #f "123 ~R 321" 1) 'error) (test (format #f "123 ~,3R 321" 1) 'error) (test (format #f "~,2,3,4D" 123) 'error) (test (format #f "hi ~Z ho") 'error) (test (format #f "hi ~+ ho") 'error) (test (format #f "hi ~# ho") 'error) (test (format #f "hi ~, ho") 'error) (test (format #f "hi ~} ho") 'error) (test (format #f "hi {ho~}") 'error) (test (format #f "asb~{~A asd" '(1 2 3)) 'error) (test (format #f "~{~A~}" 1 2 3) 'error) (test (format #f "asb~{~}asd" '(1 2 3)) 'error) (test (format #f "asb~{ ~}asd" '(1 2 3)) 'error) (test (format #f "asb~{ . ~}asd" '(1 2 3)) 'error) (test (format #f "asb~{ hiho~~~}asd" '(1 2 3)) 'error) (test (format #f "~12C" #\a) "aaaaaaaaaaaa") (test (format #f ".~0C." #\a) "..") (test (format #f "~10C" #\space) " ") (test (format #f "~12P" #\a) 'error) (test (format #f "~12*" #\a) 'error) (test (format #f "~12%" #\a) 'error) (test (format #f "~12^" #\a) 'error) (test (format #f "~12{" #\a) 'error) (test (format #f "~12,2A" #\a) 'error) (test (format #f "~12,A" #\a) 'error) ; s7 misses padding errors such as (format #f "~12,' A" #\a) (for-each (lambda (arg) (test (format #f "~F" arg) 'error)) (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (format #f "~D" arg) 'error)) (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (format #f "~P" arg) 'error)) (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (format #f "~X" arg) 'error)) (list "hi" #\a 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (format #f "~C" arg) 'error)) (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (test (format #f arg 123) 'error)) (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (format #f "~{~A ~A ~}" '(1 "hi" 2)) 'error) (for-each (lambda (arg) (let ((result (catch #t (lambda () (format #f "~F" arg)) (lambda args 'error)))) (if (not (eq? result 'error)) (begin (display "(format #f \"~F\" ") (display arg) (display ") returned ") (display result) (display " but expected 'error") (newline))))) (list #\a #(1 2 3) "hi" () 'hi abs (lambda () 1) #(()) (list 1 2 3) '(1 . 2))) (test (format #f "~D") 'error) (test (format () "hi") "") ; not an error now -- will print "hi" also (test (format #f "~F" "hi") 'error) (test (format #f "~D" #\x) 'error) (test (format #f "~C" (list 1 2 3)) 'error) (test (format #f "~1/4F" 1.4) 'error) (test (format #f "~1.4F" 1.4) 'error) (test (format #f "~F" (real-part (log 0.0))) "-inf.0") (test (let ((val (format #f "~F" (/ (real-part (log 0.0)) (real-part (log 0.0)))))) (string=? val "+nan.0")) #t) (test (format #f "~1/4T~A" 1) 'error) (test (format #f "~T") "") (test (format #f "~@P~S" 1 '(1)) "y(1)") (test (format #f ".~A~*" 1 '(1)) ".1") (test (format #f "~*~*~T" 1 '(1)) "") (test (format #f "~A" 'AB\c) "(symbol \"AB\\\\c\")") (test (format #f "~S" 'AB\c) "(symbol \"AB\\\\c\")") (test (format #f "~A" '(AB\c () xyz)) "((symbol \"AB\\\\c\") () xyz)") (test (format #f "~,2f" 1234567.1234) "1234567.12") (test (format #f "~5D" 3) " 3") (test (format #f "~5,'0D" 3) "00003") (test (format #f "++~{-=~s=-~}++" (quote (1 2 3))) "++-=1=--=2=--=3=-++") (test (format) 'error) (for-each (lambda (arg) (test (format arg) 'error)) (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (format "hi") 'error) (test (format "~A ~D" 1/3 2) 'error) (test (format "") 'error) (test (format #f "~:D" 23) "23rd") (test (format #f "~:D" 101) "101st") (test (format #f "~:D" 11) "11th") (test (format #f "~:D" 1) "first") (test (format #f "~:D" 8) "eighth") (test (format #f "~:D" 42) "42nd") (test (format #f "~:D" 2) "second") (test (format #f "~:D" -2) 'error) (test (format #f "~:D" #()) 'error) (test (format #f "~:F" pi) 'error) (test (format #f "~:" pi) 'error) ;; from slib/formatst.scm (test (string=? (format #f "abc") "abc") #t) (test (string=? (format #f "~a" 10) "10") #t) (test (string=? (format #f "~a" -1.2) "-1.2") #t) (test (string=? (format #f "~a" 'a) "a") #t) (test (string=? (format #f "~a" #t) "#t") #t) (test (string=? (format #f "~a" #f) "#f") #t) (test (string=? (format #f "~a" "abc") "abc") #t) (test (string=? (format #f "~a" #(1 2 3)) "#(1 2 3)") #t) (test (string=? (format #f "~a" ()) "()") #t) (test (string=? (format #f "~a" '(a)) "(a)") #t) (test (string=? (format #f "~a" '(a b)) "(a b)") #t) (test (string=? (format #f "~a" '(a (b c) d)) "(a (b c) d)") #t) (test (string=? (format #f "~a" '(a . b)) "(a . b)") #t) (test (string=? (format #f "~a ~a" 10 20) "10 20") #t) (test (string=? (format #f "~a abc ~a def" 10 20) "10 abc 20 def") #t) (test (string=? (format #f "~d" 100) "100") #t) (test (string=? (format #f "~x" 100) "64") #t) (test (string=? (format #f "~o" 100) "144") #t) (test (string=? (format #f "~b" 100) "1100100") #t) (test (string=? (format #f "~10d" 100) " 100") #t) (test (string=? (format #f "~10,'*d" 100) "*******100") #t) (test (string=? (format #f "~c" #\a) "a") #t) (test (string=? (format #f "~c" #\space) " ") #t) (test (string=? (format #f "~C" #\x91) "\x91;") #t) (test (string=? (format #f "~C" #\x9) "\x09;") #t) (test (string=? (format #f "~C" #\~) "~") #t) (test (string=? (format #f "~A" #\x91) "\x91;") #t) (test (string=? (format #f "~S" #\x91) "#\\x91") #t) (test (string=? (format #f "~A" (string->symbol "hi")) "hi") #t) (test (string=? (format #f "~S" (string->symbol "hi")) "hi") #t) (test (string=? (format #f "~A" (string->symbol ";\\\";")) "(symbol \";\\\\\\\";\")") #t) (test (string=? (format #f "~S" (string->symbol ";\\\";")) "(symbol \";\\\\\\\";\")") #t) (test (string=? (format #f "~A" (string->symbol (string #\, #\. #\# #\; #\" #\\ #\' #\`))) "(symbol \",.#;\\\"\\\\'`\")") #t) (test (string=? (format #f "~~~~") "~~") #t) (test (string=? (format #f "~s" "abc") "\"abc\"") #t) (test (string=? (format #f "~s" "abc \\ abc") "\"abc \\\\ abc\"") #t) (test (string=? (format #f "~a" "abc \\ abc") "abc \\ abc") #t) (test (string=? (format #f "~s" "abc \" abc") "\"abc \\\" abc\"") #t) (test (string=? (format #f "~a" "abc \" abc") "abc \" abc") #t) (test (string=? (format #f "~s" #\space) "#\\space") #t) (test (string=? (format #f "~s" #\newline) "#\\newline") #t) (test (string=? (format #f "~s" #\a) "#\\a") #t) (test (string=? (format #f "~a" '(a "b" c)) "(a \"b\" c)") #t) (test (string=? (format #f "abc~ 123") "abc123") #t) (test (string=? (format #f "abc~ 123") "abc123") #t) (test (string=? (format #f "abc~ ") "abc") #t) (test (string=? (format #f "~{ ~a ~}" '(a b c)) " a b c ") #t) (test (string=? (format #f "~{ ~a ~}" ()) "") #t) (test (string=? (format #f "~{ ~a ~}" "") "") #t) (test (string=? (format #f "~{ ~a ~}" #()) "") #t) (test (string=? (format #f "~{ ~a,~a ~}" '(a 1 b 2 c 3)) " a,1 b,2 c,3 ") #t) (test (string=? (format #f "abc ~^ xyz") "abc ") #t) (test (format (values #f "~A ~D" 1 2)) "1 2") (test (format #f "~A~^" 1) "1") ; clisp agrees here (test (format #f "~A~*~* ~A" (values 1 2 3 4)) "1 4") (test (format #f "~^~A~^~*~*~^ ~^~A~^" (values 1 2 3 4)) "1 4") (test (string=? (format #f "~B" 123) "1111011") #t) (test (string=? (format #f "~B" 123/25) "1111011/11001") #t) (test (string=? (format #f "~B" 123.25) "1111011.01") #t) (test (string=? (format #f "~B" 123+i) "1111011.0+1.0i") #t) (test (string=? (format #f "~D" 123) "123") #t) (test (string=? (format #f "~D" 123/25) "123/25") #t) (test (string=? (format #f "~D" 2.5) "2.500000e+00") #t) ; ? (defaults to ~E) (test (string=? (format #f "~F" 123) "123") #t) ; ? (test (string=? (format #f "~E" 1.0) "1.000000e+00") #t) ; ? (test (string=? (format #f "~O" 123) "173") #t) (test (string=? (format #f "~O" 123/25) "173/31") #t) (test (string=? (format #f "~O" 123.25) "173.2") #t) (test (string=? (format #f "~O" 123+i) "173.0+1.0i") #t) (test (string=? (format #f "~X" 123) "7b") #t) (test (string=? (format #f "~X" 123/25) "7b/19") #t) (test (string=? (format #f "~X" 123.25) "7b.4") #t) (test (string=? (format #f "~X" 123+i) "7b.0+1.0i") #t) (test (string=? (format #f "~A" "hi") (format #f "~S" "hi")) #f) (test (string=? (format #f "~A" #\a) (format #f "~S" #\a)) #f) (for-each (lambda (arg) (test (string=? (format #f "~A" arg) (format #f "~S" arg)) #t)) (list 1 1.0 #(1 2 3) '(1 2 3) '(1 . 2) () #f #t abs # # 'hi '\a)) (test (length (format #f "~S" (string #\\))) 4) ; "\"\\\\\"" (test (length (format #f "~S" (string #\a))) 3) ; "\"a\"" (test (length (format #f "~S" (string #\null))) 7) ; "\"\\x00;\"" (test (length (format #f "~S" (string (integer->char #xf0)))) 3) ; "\"ð\"" (test (length (format #f "~S" (string #\"))) 4) ; "\"" (test (format #f "~F" 3.0) "3.000000") (test (format #f "~G" 3.0) "3.0") (test (format #f "~E" 3.0) (if (not with-windows) "3.000000e+00" "3.000000e+000")) (test (format #f "~F" 3.14159) "3.141590") (test (format #f "~G" 3.14159) "3.14159") (test (format #f "~E" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000")) (test (format #f "~,2F" 3.14159) "3.14") (test (format #f "~,2G" 3.14159) "3.1") (test (format #f "~,2E" 3.14159) (if (not with-windows) "3.14e+00" "3.14e+000")) (test (format #f "~12F" 3.14159) " 3.141590") (test (format #f "~12G" 3.14159) " 3.14159") (test (format #f "~12E" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000")) (test (format #f "~12,3F" 3.14159) " 3.142") (test (format #f "~n,nF" 12 3 3.14159) " 3.142") (test (format #f "~12,nF" 3 3.14159) " 3.142") (test (format #f "~12,3G" 3.14159) " 3.14") (test (format #f "~12,3E" 3.14159) (if (not with-windows) " 3.142e+00" " 3.142e+000")) (test (format #f "~12,'xD" 1) "xxxxxxxxxxx1") (test (format #f "~12,'xF" 3.14159) "xxxx3.141590") (test (format #f "~12,'xG" 3.14159) "xxxxx3.14159") (test (format #f "~12,'xE" 3.14159) (if (not with-windows) "3.141590e+00" "3.141590e+000")) (test (format #f "~12,'\\F" 3.14159) "\\\\\\\\3.141590") (test (format #f "~20,20G" 3.0) " 3.0") (test (format #f "~20,20F" 3.0) "3.00000000000000000000") (test (format #f "~20,20E" 3.0) (if (not with-windows) "3.00000000000000000000e+00" "3.00000000000000000000e+000")) (test (format #f "~,3B" 0.99999) "0.111") (test (format #f "~,3O" 0.99999) "0.777") (test (format #f "~,3F" 0.99999) "1.000") (test (format #f "~,3X" 0.99999) "0.fff") (test (format #f "~-2F" 0.0) 'error) (test (format #f "~,-2F" 0.0) 'error) (test (format #f "~2/3F" 0.0) 'error) (test (format #f "~2.3F" 0.0) 'error) (test (format #f "~2,1,3,4F" 0.0) 'error) (test (format #f "~'xF" 0.0) 'error) (test (format #f "~3,3" pi) 'error) (test (format #f "~3," pi) 'error) (test (format #f "~3" pi) 'error) (test (format #f "~," pi) 'error) (test (format #f "~'," pi) 'error) (test (format #f "~'" pi) 'error) (test (format #f "~*" 1.0) "") (test (format #f "~D" 1.0) (if (not with-windows) "1.000000e+00" "1.000000e+000")) (test (format #f "~O" 1.0) "1.0") (test (format #f "~P" 1.0) "") (test (format #f "~P" '(1 2 3)) 'error) (test (format #f "~\x00;T") 'error) (test (format #f "~9,'(T") "((((((((") (test (format #f "~0F" 1+1i) "1.000000+1.000000i") (test (format #f "~9F" 1) " 1") (test (format #f "~,0F" 3.14) "3.0") (test (format #f "~,0F" 1+1i) "1.0+1.0i") (test (format #f "~,0X" 1+1i) "1.0+1.0i") (test (format #f "~,9g" 1+1i) "1.0+1.0i") (test (format #f "~,1e" 3.14) (if (not with-windows) "3.1e+00" "3.1e+000")) (test (format #f "~9,0F" 3.14) " 3.0") (test (format #f "~9,1F" 3.14) " 3.1") (test (format #f "~9,2F" 3.14) " 3.14") (test (format #f "~9,3F" 3.14) " 3.140") (test (format #f "~9,4F" 3.14) " 3.1400") (test (format #f "~n,4F" 9 3.14) " 3.1400") (test (format #f "~9,nF" 4 3.14) " 3.1400") (test (format #f "~n,nF" 9 4 3.14) " 3.1400") (test (format #f "~9,5F" 3.14) " 3.14000") (test (format #f "~9,6F" 3.14) " 3.140000") (test (format #f "~9,7F" 3.14) "3.1400000") (test (format #f "~9,8F" 3.14) "3.14000000") (test (format #f "~9,9F" 3.14) "3.140000000") (test (format #f "~9,9G" 1+1i) " 1.0+1.0i") (if (not with-windows) (begin (test (format #f "~9,0e" 1+1i) "1e+00+1e+00i") (test (format #f "~9,1e" 1+1i) "1.0e+00+1.0e+00i") (test (format #f "~9,2e" 1+1i) "1.00e+00+1.00e+00i") (test (format #f "~9,3e" 1+1i) "1.000e+00+1.000e+00i") (test (format #f "~9,4e" 1+1i) "1.0000e+00+1.0000e+00i") (test (format #f "~9,5e" 1+1i) "1.00000e+00+1.00000e+00i") (test (format #f "~9,6e" 1+1i) "1.000000e+00+1.000000e+00i") (test (format #f "~9,7e" 1+1i) "1.0000000e+00+1.0000000e+00i") (test (format #f "~9,8e" 1+1i) "1.00000000e+00+1.00000000e+00i") (test (format #f "~9,9e" 1+1i) "1.000000000e+00+1.000000000e+00i")) (begin (test (format #f "~9,0e" 1+1i) "1e+000+1e+000i") (test (format #f "~9,1e" 1+1i) "1.0e+000+1.0e+000i") (test (format #f "~9,2e" 1+1i) "1.00e+000+1.00e+000i") (test (format #f "~9,3e" 1+1i) "1.000e+000+1.000e+000i") (test (format #f "~9,4e" 1+1i) "1.0000e+000+1.0000e+000i") (test (format #f "~9,5e" 1+1i) "1.00000e+000+1.00000e+000i") (test (format #f "~9,6e" 1+1i) "1.000000e+000+1.000000e+000i") (test (format #f "~9,7e" 1+1i) "1.0000000e+000+1.0000000e+000i") (test (format #f "~9,8e" 1+1i) "1.00000000e+000+1.00000000e+000i") (test (format #f "~9,9e" 1+1i) "1.000000000e+000+1.000000000e+000i"))) (test (format #f "~9,0x" 3.14) " 3.0") (test (format #f "~9,1x" 3.14) " 3.2") (test (format #f "~9,2x" 3.14) " 3.23") (test (format #f "~9,3x" 3.14) " 3.23d") (test (format #f "~9,4x" 3.14) " 3.23d7") (test (format #f "~9,5x" 3.14) " 3.23d7") (test (format #f "~9,6x" 3.14) " 3.23d70a") (test (format #f "~9,7x" 3.14) "3.23d70a3") (test (format #f "~9,8x" 3.14) "3.23d70a3d") (test (format #f "~9,9x" 3.14) "3.23d70a3d7") (test (format #f "~9,0b" 3.14) " 11.0") (test (format #f "~9,1b" 3.14) " 11.0") (test (format #f "~9,2b" 3.14) " 11.0") (test (format #f "~9,3b" 3.14) " 11.001") (test (format #f "~9,4b" 3.14) " 11.001") (test (format #f "~9,5b" 3.14) " 11.001") (test (format #f "~9,6b" 3.14) " 11.001") (test (format #f "~9,7b" 3.14) "11.0010001") (test (format #f "~9,8b" 3.14) "11.00100011") (test (format #f "~9,9b" 3.14) "11.001000111") (test (format #f "~0,'xf" 1) "1") (test (format #f "~1,'xf" 1) "1") (test (format #f "~2,'xf" 1) "x1") (test (format #f "~3,'xf" 1) "xx1") (test (format #f "~4,'xf" 1) "xxx1") (test (format #f "~5,'xf" 1) "xxxx1") (test (format #f "~6,'xf" 1) "xxxxx1") (test (format #f "~7,'xf" 1) "xxxxxx1") (test (format #f "~8,'xf" 1) "xxxxxxx1") (test (format #f "~9,'xf" 1) "xxxxxxxx1") (test (format #f "~11,'xf" 3.14) "xxx3.140000") (test (format #f "~12,'xf" 3.14) "xxxx3.140000") (test (format #f "~13,'xf" 3.14) "xxxxx3.140000") (test (format #f "~14,'xf" 3.14) "xxxxxx3.140000") (test (format #f "~15,'xf" 3.14) "xxxxxxx3.140000") (test (format #f "~16,'xf" 3.14) "xxxxxxxx3.140000") (test (format #f "~17,'xf" 3.14) "xxxxxxxxx3.140000") (test (format #f "~18,'xf" 3.14) "xxxxxxxxxx3.140000") (test (format #f "~19,'xf" 3.14) "xxxxxxxxxxx3.140000") (test (format #f "~,f" 1.0) "1.000000") (test (format #f "~,,f" 1.0) 'error) (test (format #f "~p" '(1 2 3)) 'error) ; these are not errors in CL (test (format #f "~p" #(())) 'error) (test (format #f "~p" 'hi) 'error) (test (format #f "~p" abs) 'error) (test (format #f "~p" 1+i) 'error) (test (format #f "~@p" '(1 2 3)) 'error) (test (format #f "~@p" #(())) 'error) (test (format #f "~@p" 'hi) 'error) (test (format #f "~@p" abs) 'error) (let-temporarily (((*s7* 'print-length) 3)) (test (format #f "~{~A~| ~}" '(1 2 3 4 5 6)) "1 2 3 ...") (test (format #f "~{~A~| ~}" #(1 2 3 4 5 6)) "1 2 3 ...") (test (format #f "~{~A~| ~}" #(1 2)) "1 2") (test (format #f "~{~A~| ~}" #(1 2 3)) "1 2 3") (test (format #f "~{~A~| ~}" #(1 2 3 4)) "1 2 3 ...") (test (format #f "~{~A~| ~}" (inlet 'a 1 'b 2 'c 3 'd 4 'e 5)) "(a . 1) (b . 2) (c . 3) ...") (test (format #f "~{~{~A~| ~}~}" '((1 2 3 4 5 6))) "1 2 3 ...") (test (format #f "~{~{~A~| ~}~|~}" '((1 2) (3 4 5 6 7 8) (15) (16) ())) "1 23 4 5 ...15 ...") (test (format #f "~{~|~|~|~A ~}" '(1 2 3 4 5)) "1 2 3 ...") (test (format #f "~{~C~| ~}" "1234567") "1 2 3 ...") (test (format #f "~{~{~A~|~} ~}" '((1 2) (3 4))) "12 34 ") (test (format #f "~C ~^" #\a) "a ") (test (format #f "~{~{~{~A~| ~}~| ~}~}" '(((1 2) (3 4)))) "1 2 3 4") (test (format #f "~{~{~{~A~| ~}~| ~}~}" '((#(1 2) #(3 4)))) "1 2 3 4") (test (format #f "~{~{~{~A~| ~}~| ~}~}" #(((1 2) (3 4)))) "1 2 3 4") (test (format #f "~{~{~{~A~| ~}~| ~}~}" #(#((1 2) (3 4)))) "1 2 3 4") (test (format #f "~{~{~C~| ~}~| ~}" (list "hiho" "xxx")) "h i h ... x x x")) (test (format #f "~{~{~A~^~} ~}" '((hi 1))) "hi1 ") (test (format #f "~{~{~A~^~} ~}" '((1 2) (3 4))) "12 34 ") (test (format #f "~{~{~A~} ~}" '((1 2) (3 4))) "12 34 ") (test (format #f "~{~{~A~} ~}" '(())) " ") (test (format #f "~{~{~A~} ~}" '((()))) "() ") (test (format #f "~{~{~F~} ~}" '(())) " ") (test (format #f "~{~{~C~} ~}" '(())) " ") (test (format #f "~{~C ~}" ()) "") (test (format #f "~C ~^" #\a) "a ") ; CL ignores pointless ~^ (test (format #f "~^~A" #f) "#f") (test (format #f "~^~^~A" #f) "#f") (test (format #f "~*~*~A~*" 1 2 3 4) "3") (test (format #f "~{~*~A~}" '(1 2 3 4)) "24") (test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (format #f "~A" lst)) "#1=(1 2 3 . #1#)") (test (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (format #f "~{~A~}" lst)) "12312") (test (format #f "~{~A~}" (cons 1 2)) 'error) (test (format #f "~{~A~}" '(1 2 3 . 4)) 'error) (test (format #f "~20,vF" 3.14) 'error) (test (format #f "~{~C~^ ~}" "hiho") "h i h o") (test (format #f "~{~{~C~^ ~}~}" (list "hiho")) "h i h o") (test (format #f "~{~A ~}" #(1 2 3 4)) "1 2 3 4 ") (test (let ((v (vector 1))) (set! (v 0) v) (format #f "~A" v)) "#1=#(#1#)") (test (let ((v (vector 1))) (set! (v 0) v) (format #f "~{~A~}" v)) "#1=#(#1#)") (test (format #f "~{~{~{~A~^ ~}~^ ~}~}" '(((1 2) (3 4)))) "1 2 3 4") (test (format #f "~{~{~{~A~^ ~}~^ ~}~}" '((#(1 2) #(3 4)))) "1 2 3 4") (test (format #f "~{~{~{~A~^ ~}~^ ~}~}" #(((1 2) (3 4)))) "1 2 3 4") (test (format #f "~{~{~{~A~^ ~}~^ ~}~}" #(#((1 2) (3 4)))) "1 2 3 4") (test (format #f "~{~{~{~A~^ ~}~^ ~}~}" #(#(#(1 2) (3 4)))) "1 2 3 4") (test (format #f "~{~{~{~A~^ ~}~^ ~}~}" #(#(#(1 2) #(3 4)))) "1 2 3 4") (test (format #f "~{~{~C~^ ~}~^ ~}" (list "hiho" "xxx")) "h i h o x x x") (test (format #f "~{~{~A~}~}" '((1 . 2) (3 . 4))) 'error) (test (format #f "~{~A~^ ~}" '((1 . 2) (3 . 4))) "(1 . 2) (3 . 4)") (test (format #f "~{~A ~}" (hash-table)) "") (test (format #f "~{~^~S ~}" (make-iterator '(1 2 3))) "1 2 3 ") (test (format #f "~{~^~S ~}" (make-iterator (let ((lst (list 1))) (set-cdr! lst lst)))) "1 ") (test (format #f "~{~^~S ~}" (make-iterator "")) "") (test (format #f "~{~^~S ~}" (make-iterator #(1 2 3))) "1 2 3 ") (test (format #f "~{~{~{~{~{~A~^ ~}~^ ~}~}~}~}" '(((((1 2) (3 4)))))) "1 2 3 4") (test (format #f "~{~{~{~{~{~{~{~{~A~^ ~}~^ ~}~}~}~}~}~}~}" '((((((((1 2) (3 4))))))))) "1 2 3 4") (test (format #f "~{~{~{~{~{~{~{~{~{~{~{~A~^ ~}~^ ~}~}~}~}~}~}~}~}~}~}" '(((((((((((1 2) (3 4)))))))))))) "1 2 3 4") (test (format #f "~10,'-T") "---------") (test (format #f "~10,'\\T") "\\\\\\\\\\\\\\\\\\") (test (format #f "~10,'\"T") "\"\"\"\"\"\"\"\"\"") (test (format #f "~10,'-T12345~20,'-T") "---------12345-----") (test (format #f "~10,')T") ")))))))))") (test (format #f "~,0F" 1.4) "1.0") (test (format #f "~,0F" 1.5) "2.0") (test (format #f "~,0F" 1.6) "2.0") (test (format #f "~,0F" 0.4) "0.0") (test (format #f "~,0F" 0.5) (if (not with-windows) "0.0" "1.0")) ; !! (test (format #f "~,0F" 0.6) "1.0") (test (format #f "~,-0F" 1.4) 'error) (test (format #f "~, 0F" 1.4) 'error) (test (format #f "~*1~*" 1) 'error) (test (format #f "~*1~A" 1) 'error) (test (format #f #u()) 'error) (test (format #f #u(65 90)) 'error) ;; optimizer bug (test (let () (define (func) (format `((x)) "")) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (format (make-iterator #(10 20)) #u())) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (format (list 1 2) "")) (define (hi) (func)) (hi)) 'error) (test (format :rest "") 'error) (let* ((str1 #t) (str2 (with-output-to-string (lambda () (set! str1 (format () "~D" 1)))))) (test (and (equal? str1 "") (equal? str2 "1")) #t)) (test (format #f "~,'") 'error) (if with-bignums (begin (test (format #f "~F" 1e300) "9.999999999999999999999999999999999999987E299") (test (format #f "~F" 1e308) "9.999999999999999999999999999999999999982E307") (test (format #f "~G" 1e308) "9.999999999999999999999999999999999999982E307") (test (format #f "~E" 1e308) "9.999999999999999999999999999999999999982E307") (test (format #f "~E" 1e308+1e308i) "9.999999999999999999999999999999999999982E307+9.999999999999999999999999999999999999982E307i") (test (format #f "~F" 1e308+1e308i) "9.999999999999999999999999999999999999982E307+9.999999999999999999999999999999999999982E307i") (test (format #f "~F" -1e308-1e308i) "-9.999999999999999999999999999999999999982E307-9.999999999999999999999999999999999999982E307i") (test (format #f "~,32f" (/ 1.0 most-positive-fixnum)) "1.084202172485504434125002235952170462235E-19") (test (format #f "~{~^~f ~}" (vector 1e308)) "9.999999999999999999999999999999999999982E307 ") (test (object->string (vector 1e308)) "#(9.999999999999999999999999999999999999982E307)")) (begin (test (format #f "~F" 1e300) "1000000000000000052504760255204420248704468581108159154915854115511802457988908195786371375080447864043704443832883878176942523235360430575644792184786706982848387200926575803737830233794788090059368953234970799945081119038967640880074652742780142494579258788820056842838115669472196386865459400540160.000000") (test (format #f "~F" 1e308) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000") (test (format #f "~G" 1e308) "1e+308") (test (format #f "~E" 1e308) "1.000000e+308") (test (format #f "~E" 1e308+1e308i) "1.000000e+308+1.000000e+308i") (test (format #f "~F" 1e308+1e308i) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000+100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000i") (test (format #f "~F" -1e308-1e308i) "-100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000-100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000i") (test (format #f "~,32f" (/ 1.0 most-positive-fixnum)) "0.00000000000000000010842021724855") (test (format #f "~{~^~f ~}" (vector 1e308)) "100000000000000001097906362944045541740492309677311846336810682903157585404911491537163328978494688899061249669721172515611590283743140088328307009198146046031271664502933027185697489699588559043338384466165001178426897626212945177628091195786707458122783970171784415105291802893207873272974885715430223118336.000000 ") (test (object->string (vector 1e308)) "#(1e+308)"))) (when full-s7test (let () (define ctrl-chars (vector ;#\A #\S #\C #\F #\E #\G #\O #\D #\B #\X #\W #\, #\{ #\} #\@ #\P #\* #\< #\> #\a #\s #\c #\f #\e #\g #\o #\d #\b #\x #\p #\n #\w #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\~ #\T #\& #\% #\^ #\| #\~ #\~ #\~ #\~ #\, #\, #\, #\, #\" #\" #\\ #\' #\+ #\- #\@ #\. #\/ #\; #\: )) (define ctrl-chars-len (length ctrl-chars)) (define (test-chars) (do ((size 1 (+ size 1))) ((= size 7)) (let ((tries (* size size 10000))) (format *stderr* "~D " size) (let ((ctrl-str (make-string (+ size 1))) (x 12) (y '(1 2)) (z #\a)) (string-set! ctrl-str 0 #\~) (do ((i 0 (+ i 1))) ((= i tries)) (do ((j 1 (+ j 1))) ((> j size)) (string-set! ctrl-str j (vector-ref ctrl-chars (random ctrl-chars-len)))) ;(format *stderr* "~S " ctrl-str) ;(catch #t (lambda () (format *stderr* "~S: ~A~%" ctrl-str (format #f ctrl-str))) (lambda arg 'error)) ;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str x (format #f ctrl-str x))) (lambda arg 'error)) ;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str y (format #f ctrl-str y))) (lambda arg 'error)) ;(catch #t (lambda () (format *stderr* "~S ~A: ~A~%" ctrl-str z (format #f ctrl-str z))) (lambda arg 'error))))) (catch #t (lambda () (format #f ctrl-str)) (lambda arg 'error)) (catch #t (lambda () (format #f ctrl-str x)) (lambda arg 'error)) (catch #t (lambda () (format #f ctrl-str y)) (lambda arg 'error)) (catch #t (lambda () (format #f ctrl-str z)) (lambda arg 'error)) (catch #t (lambda () (format #f ctrl-str x x)) (lambda arg 'error)) (catch #t (lambda () (format #f ctrl-str x y)) (lambda arg 'error)) (catch #t (lambda () (format #f ctrl-str y z)) (lambda arg 'error)) (catch #t (lambda () (format #f ctrl-str x y z)) (lambda arg 'error))))) )) (test-chars))) (test (reverse (format #f "~{~A~}" '((1 2) (3 4)))) ")4 3()2 1(") (test (string->symbol (format #f "~A" '(1 2))) (symbol "(1 2)")) (test (string->number (format #f "~A" -1)) -1) (test (string->number (format #f "~S" -1)) -1) (test (string->number (format #f "~F" -1)) -1) (test (string->number (format #f "~D" -1)) -1) (test (string->number (format #f "~G" -1)) -1) (test (string->number (format #f "~E" -1)) -1) (test (string->number (format #f "~B" -1)) -1) (test (string->number (format #f "~X" -1)) -1) (test (string->number (format #f "~O" -1)) -1) (num-test (string->number (format #f "~A" 1.5)) 1.5) (num-test (string->number (format #f "~S" 1.5)) 1.5) (num-test (string->number (format #f "~F" 1.5)) 1.5) (num-test (string->number (format #f "~D" 1.5)) 1.5) (num-test (string->number (format #f "~G" 1.5)) 1.5) (num-test (string->number (format #f "~E" 1.5)) 1.5) (num-test (string->number (format #f "~B" 1.5)) 1.1) (num-test (string->number (format #f "~X" 1.5)) 1.8) (num-test (string->number (format #f "~O" 1.5)) 1.4) (num-test (string->number (format #f "~A" 1+1i)) 1+1i) (num-test (string->number (format #f "~S" 1+1i)) 1+1i) (num-test (string->number (format #f "~F" 1+1i)) 1+1i) (num-test (string->number (format #f "~D" 1+1i)) 1+1i) (num-test (string->number (format #f "~G" 1+1i)) 1+1i) (num-test (string->number (format #f "~E" 1+1i)) 1+1i) (num-test (string->number (format #f "~B" 1+1i)) 1+1i) (num-test (string->number (format #f "~X" 1+1i)) 1+1i) (num-test (string->number (format #f "~O" 1+1i)) 1+1i) (test (string->number (format #f "~A" 3/4)) 3/4) (test (string->number (format #f "~S" 3/4)) 3/4) (test (string->number (format #f "~F" 3/4)) 3/4) (test (string->number (format #f "~D" 3/4)) 3/4) (test (string->number (format #f "~G" 3/4)) 3/4) (test (string->number (format #f "~E" 3/4)) 3/4) (test (string->number (format #f "~B" 3/4)) 11/100) (test (string->number (format #f "~X" 3/4)) 3/4) (test (string->number (format #f "~O" 3/4)) 3/4) (num-test (string->number (format #f "~A" 0+1i)) 0+1i) (num-test (string->number (format #f "~S" 0+1i)) 0+1i) (num-test (string->number (format #f "~F" 0+1i)) 0+1i) (num-test (string->number (format #f "~D" 0+1i)) 0+1i) (num-test (string->number (format #f "~G" 0+1i)) 0+1i) (num-test (string->number (format #f "~E" 0+1i)) 0+1i) (num-test (string->number (format #f "~B" 0+1i)) 0+1i) (num-test (string->number (format #f "~X" 0+1i)) 0+1i) (num-test (string->number (format #f "~O" 0+1i)) 0+1i) (test (format #f "~P{T}'" 1) "{T}'") (test (format #f "~") 'error) (test (format #f "~B&B~X" 1.5 1.5) "1.1&B1.8") (test (format #f ",~~~A~*1" 1 1) ",~11") (test (format #f "~D~20B" 0 0) "0 0") (test (format #f "~D~20B" 1 1) "1 1") (test (format #f "~10B" 1) " 1") (test (format #f "~10B" 0) " 0") (test (format #f "~100B" 1) " 1") (test (length (format #f "~1000B" 1)) 1000) (test (format #f "~D~20D" 3/4 3/4) "3/4 3/4") (test (length (format #f "~20D" 3/4)) 20) (test (format #f "~20B" 3/4) " 11/100") (test (length (format #f "~20B" 3/4)) 20) (test (format #f "~D~20B" 3/4 3/4) "3/4 11/100") (test (format #f "~X~20X" 21/33 21/33) "7/b 7/b") (test (format #f "~D~20,'.B" 3/4 3/4) "3/4..............11/100") (test (format #f "~20g" 1+i) " 1.0+1.0i") (test (length (format #f "~20g" 1+i)) 20) (test (format #f "~20f" 1+i) " 1.000000+1.000000i") (test (length (format #f "~20f" 1+i)) 20) (test (format #f "~20x" 17+23i) " 11.0+17.0i") (test (length (format #f "~20x" 17+23i)) 20) (test (format #f "~{~{~A~^~} ~}" (hash-table '(a . 1) '((b . 2)))) "(a . 1)(b . 2) ") (test (format #f "~{~{~A~^~}~^~}" (hash-table '(a . 1) '((b . 2)))) "(a . 1)(b . 2)") (test (format #f "~{~{~A~^ ~}~^~}" (hash-table '(a . 1) '((b . 2)))) "(a . 1) (b . 2)") (test (format #f "~{~{~{~A~^~} ~}~}" #(())) "") (test (format #f "~{~{~{~P~^~} ~}~}" '((()))) " ") (test (format #f "~{~{~{~P~^~}~}~}" '(((2 3 4)))) "sss") (test (apply format #f "~T~~{~{~{~*~~0~1~*~}~@~}" '(())) "~{") (test (format #f "~{~S}%~}" '(a b c)) "a}%b}%c}%") (test (format #f "~&~^%~F." 0) "%0.") (test (format #f "1~^2") "1") (test (apply format #f "~P~d~B~~" '(1 2 3)) "211~") (test (format #f "~T1~~^~P" 0) "1~^s") (test (format #f "~S~^~{~^" '(+ x 1)) "(+ x 1)") (test (format #f "1~^~{2") "1") (test (format #f "~A~{~0~g~@~B~}" () ()) "()") (test (format #f "1~^~^~^2") "1") (test (format #f "~{~{~~}~~,~}~*" '(()) '(())) "~,") (test (format #f "~~S~S~T~~C~g~~" 0 0) "~S0~C0~") (test (format #f "~{~~e~}~~{~*~~" "" "") "~{~") (let () (define* (clean-string e (precision 3)) (format #f (format #f "(~~{~~,~DF~~^ ~~})" precision) e)) (test (clean-string '(1.123123 -2.31231323 3.141592653589 4/3) 1) "(1.1 -2.3 3.1 4/3)") (test (clean-string '(1.123123 -2.31231323 3.141592653589 4/3)) "(1.123 -2.312 3.142 4/3)") (test (clean-string '(1.123123 -2.31231323 3.141592653589 4/3) 6) "(1.123123 -2.312313 3.141593 4/3)")) (when with-bignums (test (format #f "~P" (bignum "1")) "") (test (format #f "~P" (bignum "1.0")) "") (test (format #f "~P" (bignum "2")) "s") (test (format #f "~P" (bignum "2.0")) "s") (test (format #f "~10,' D" (bignum "1")) " 1") (test (format #f "~10,' D" (bignum "3/4")) " 3/4") (test (format #f "~10,'.D" (bignum "3/4")) ".......3/4") (test (format #f "~10D" (bignum "3/4")) " 3/4") (test (length (format #f "~100D" (bignum "34"))) 100) (test (format #f "~50F" (bignum "12345678.7654321")) " 1.23456787654321E7")) (test (format #f "~W" (float-vector +nan.0)) "#r(+nan.0)") (test (format #f "~W" (float-vector -3/4 +nan.0)) "#r(-0.75 +nan.0)") (test (format #f "~W" (float-vector -nan.0 +nan.0)) "#r(+nan.0 +nan.0)") (test (format #f "~W" (float-vector +nan.0 +inf.0)) "#r(+nan.0 +inf.0)") (test (format #f "~W" (float-vector +nan.0 -3/4)) "#r(+nan.0 -0.75)") (test (format #f "~W" (float-vector -inf.0 +inf.0)) "#r(-inf.0 +inf.0)") (call-with-output-file tmp-output-file (lambda (p) (format p "this ~A ~C test ~D" "is" #\a 3))) (let ((res (call-with-input-file tmp-output-file (lambda (p) (read-line p))))) (if (not (string=? res "this is a test 3")) (begin (display "call-with-input-file + format to \"tmp1.r5rs\" ... expected \"this is a test 3\", but got \"") (display res) (display "\"?") (newline)))) (let ((val (format #f "line 1~%line 2~%line 3"))) (with-input-from-string val (lambda () (let ((line1 (read-line))) (test (string=? line1 "line 1") #t)) (let ((line2 (read-line))) (test (string=? line2 "line 2") #t)) (let ((line3 (read-line))) (test (string=? line3 "line 3") #t)) (let ((eof (read-line))) (test (eof-object? eof) #t)) (let ((eof (read-line))) (test (eof-object? eof) #t))))) (test (display 3 #f) 3) (test (write 3 #f) 3) (let ((val (format #f "line 1~%line 2~%line 3"))) (call-with-input-string val (lambda (p) (let ((line1 (read-line p #t))) (test (string=? line1 (string-append "line 1" (string #\newline))) #t)) (let ((line2 (read-line p #t))) (test (string=? line2 (string-append "line 2" (string #\newline))) #t)) (let ((line3 (read-line p #t))) (test (string=? line3 "line 3") #t)) (let ((eof (read-line p #t))) (test (eof-object? eof) #t)) (let ((eof (read-line p #t))) (test (eof-object? eof) #t))))) (let ((res1 #f) (res2 #f)) (let ((this-file (open-output-string))) (format this-file "this ~A ~C test ~D" "is" #\a 3) (set! res1 (get-output-string this-file)) (set! res2 (port-string this-file)) (close-output-port this-file)) (unless (string=? res1 "this is a test 3") (format #t "open-output-string + format + get-output-string expected ~S but got ~S\n" "this is a test 3" res1)) (unless (string=? res2 "this is a test 3") (format #t "open-output-string + format + port-string expected ~S but got ~S\n" "this is a test 3" res2))) (test (with-output-to-string (lambda () (display 123) (flush-output-port))) "123") (test (with-output-to-string (lambda () (display 123) (flush-output-port) (display 124))) "123124") (when (provided? 'linux) ; gets "operation not permitted" in osx (test (catch #t (lambda () (call-with-output-file "/dev/full" (lambda (p) (display 123 p) (flush-output-port p)))) (lambda (typ info) (apply format #f info))) "flush-output-port: No space left on device \"/dev/full\"")) (test (call-with-output-string (lambda (p) (write 1 p) (display 2 p) (format p "~D" 3) (write-byte (char->integer #\4) p) (write-char #\5 p) (write-string "6" p) (write 1 #f) (display 2 #f) (format #f "~D" 3) (write-byte (char->integer #\4) #f) (write-char #\5 #f) (write-string "6" #f))) "123456") (test (write-byte most-positive-fixnum #f) 'error) (test (write-byte -1 #f) 'error) (test (write-byte 256 #f) 'error) (let ((res #f)) (let ((this-file (open-output-string))) (format this-file "this is a test") (set! res (get-output-string this-file)) (if (not (string=? res "this is a test")) (format #t "open-output-string + format expected \"this is a test\", but got ~S~%" res)) (flush-output-port this-file) (set! res (get-output-string this-file)) (if (not (string=? res "this is a test")) (format #t "flush-output-port of string port expected \"this is a test\", but got ~S~%" res)) (format this-file "this is a test") (set! res (get-output-string this-file)) (if (not (string=? res "this is a testthis is a test")) (format #t "open-output-string after flush expected \"this is a testthis is a test\", but got ~S~%" res)) (close-output-port this-file) (test (flush-output-port this-file) this-file))) (test (flush-output-port "hiho") 'error) (test (flush-output-port *stdin*) 'error) (call-with-output-file tmp-output-file (lambda (p) (format p "123456~%") (format p "67890~%") (flush-output-port p) (test (call-with-input-file tmp-output-file (lambda (p) (read-line p))) "123456") (close-output-port p))) (let ((res1 #f) (res2 #f) (res3 #f)) (let ((p1 (open-output-string))) (format p1 "~D" 0) (let ((p2 (open-output-string))) (format p2 "~D" 1) (let ((p3 (open-output-string))) (if (not (string=? (get-output-string p1) "0")) (format #t ";format to nested ports, p1: ~S~%" (get-output-string p1))) (if (not (string=? (get-output-string p2) "1")) (format #t ";format to nested ports, p2: ~S~%" (get-output-string p2))) (format p3 "~D" 2) (format p2 "~D" 3) (format p1 "~D" 4) (format p3 "~D" 5) (set! res3 (get-output-string p3)) (close-output-port p3) (if (not (string=? (get-output-string p1) "04")) (format #t ";format to nested ports after close, p1: ~S~%" (get-output-string p1))) (if (not (string=? (get-output-string p2) "13")) (format #t ";format to nested ports after close, p2: ~S~%" (get-output-string p2)))) (format (or p1 p3) "~D" 6) (format (and p1 p2) "~D" 7) (set! res1 (get-output-string p1)) (close-output-port p1) (if (not (string=? (get-output-string p2) "137")) (format #t ";format to nested ports after 2nd close, p2: ~S~%" (get-output-string p2))) (format p2 "~D" 8) (set! res2 (get-output-string p2)) (test (get-output-string p1) 'error) (test (get-output-string p2 "hi") 'error) (close-output-port p2))) (if (not (string=? res1 "046")) (format #t ";format to nested ports, res1: ~S~%" res1)) (if (not (string=? res2 "1378")) (format #t ";format to nested ports, res2: ~S~%" res2)) (if (not (string=? res3 "25")) (format #t ";format to nested ports, res3: ~S~%" res3))) (test (call/cc (lambda (return) (let ((val (format #f "line 1~%line 2~%line 3"))) (call-with-input-string val (lambda (p) (return "oops")))))) "oops") (test (get-output-string #f 64) 'error) ;(format #t "format #t: ~D" 1) ;(format (current-output-port) " output-port: ~D! (this is testing output ports)~%" 2) (call-with-output-file tmp-output-file (lambda (p) (display 1 p) (write 2 p) (write-char #\3 p) (format p "~D" 4) (write-byte (char->integer #\5) p) (call-with-output-file "tmp2.r5rs" (lambda (p) (display 6 p) (write 7 p) (write-char #\8 p) (format p "~D" 9) (write-byte (char->integer #\0) p) (newline p))) (call-with-input-file "tmp2.r5rs" (lambda (pin) (display (read-line pin) p))) (newline p))) (test (call-with-input-file tmp-output-file (lambda (p) (read-line p))) "1234567890") (call-with-output-file tmp-output-file (lambda (p) (format p "12345~%") (format p "67890~%"))) (call-with-input-file tmp-output-file (lambda (p) (test (read-char p) #\1) (test (read-byte p) (char->integer #\2)) (test (peek-char p) #\3) (if (not pure-s7) (test (char-ready? p) #t)) (test (read-line p) "345") (test (read-line p) "67890"))) (call-with-output-file tmp-output-file (lambda (p) (write-string "123" p) (write-string "" p) (write-string "456\n789" p))) (call-with-input-file tmp-output-file (lambda (p) (test (read-line p) "123456") (test (read-char p) #\7) (test (read-char p) #\8) (test (read-char p) #\9) (test (eof-object? (read-char p)) #t))) (test (with-output-to-string (lambda () (write-string "123") (write-string "") (write-string "456"))) "123456") (test (with-output-to-string (lambda () (write-string "123" (current-output-port)) (write-string "" (current-output-port)) (write-string "456" (current-output-port)) (write-string "678" (current-output-port) 1) (write-string "679" (current-output-port) 2 3) (write-string "079" (current-output-port) 0 1) (write-string "123" (current-output-port) 0 3) (write-string "123" (current-output-port) 3 3) (write-string "" (current-output-port) 0 0) (write-string "1423" (current-output-port) 1 1) ; 1.3.3: end is exclusive, if start=end, empty result (write-string "1423" (current-output-port) 1 4/2) (write-string "5423" (current-output-port) -0 1))) "123456789012345") (test (write-string "12345" -1) 'error) (test (write-string "12345" 0 -1) 'error) (test (write-string "12345" 0 18) 'error) (test (write-string "12345" 18) 'error) (test (write-string "12345" 2 1) 'error) (test (write-string "12345" 5 5) 'error) (test (write-string "12345" 0.0 2) 'error) (test (write-string "12345" 0 2.0) 'error) (test (write-string "12345" 0 1+i) 'error) (test (write-string "12345" 0 2/3) 'error) (test (write-string "12345" 0 #\a) 'error) (test (write-string "12345" #\null) 'error) (test (write-string "12345" most-negative-fixnum) 'error) (test (write-string "12345" 0 most-positive-fixnum) 'error) (test (write-string "12345" 0 4294967296) 'error) (test (write-string "a" #f 1) "") (test (write-string "abc" #f 3) "") (test (write-string "ab" #f 1) "b") (test (write-string "ab" #f 2) "") (test (write-string "abc" #f 1 2) "b") (test (write-string "abc" #f 1 3) "bc") (test (with-input-from-string "12345" (lambda () (read-string 3))) "123") (test (with-input-from-string "" (lambda () (read-string 3))) #) (test (with-input-from-string "" (lambda () (read-string 0))) "") (test (with-input-from-string "1" (lambda () (read-string 0))) "") (test (with-input-from-string "1" (lambda () (read-string -1))) 'error) (test (with-input-from-string "1" (lambda () (read-string #f))) 'error) (test (with-input-from-string "123" (lambda () (read-string 10))) "123") (test (call-with-input-string "123" (lambda (p) (read-string 2 p))) "12") (test (call-with-input-string "123" (lambda (p) (read-string 2 #f))) 'error) (test (call-with-input-string "123" (lambda (p) (read-string 2 (current-output-port)))) 'error) (test (call-with-input-string "123" (lambda (p) (read-string 0 #))) 'error) (test (call-with-input-string "123" (lambda (p) (read-string 0 123))) 'error) (test (read-string most-positive-fixnum) 'error) (test (read-string -1) 'error) (test (read-string most-negative-fixnum) 'error) ;(test (read-string 0) "") ; (test (read-string 123) "") ; s7 considers this file (during load) to be the current-input-file, so the above read-string ruins the load ; the other choice is to hang (waiting for stdin) ; perhaps this choice should be documented since it is specifically contrary to r7rs (test (write 1 (current-input-port)) 'error) (test (write-char #\a (current-input-port)) 'error) (test (write-byte 0 (current-input-port)) 'error) (test (read (current-output-port)) 'error) (test (read-char (current-output-port)) 'error) (test (read-byte (current-output-port)) 'error) (test (read-line (current-output-port)) 'error) (test (display 3) 3) (test (display 3 #f) 3) (unless pure-s7 (let ((op1 (set-current-output-port (open-output-file tmp-output-file)))) (display 1) (write 2) (write-char #\3) (format #t "~D" 4) ; #t -> output port (write-byte (char->integer #\5)) (let ((op2 (set-current-output-port (open-output-file "tmp2.r5rs")))) (display 6) (write 7) (write-char #\8) (format #t "~D" 9) (write-byte (char->integer #\0)) (newline) (close-output-port (current-output-port)) (set-current-output-port op2) (let ((ip1 (set-current-input-port (open-input-file "tmp2.r5rs")))) (display (read-line)) (close-input-port (current-input-port)) (set-current-input-port ip1)) (newline) (close-output-port (current-output-port))) (set-current-output-port #f) (test (string? (format #t "~%")) #t) (write "write: should not appear" #f) (newline #f) (display "display: should not appear" #f) (newline #f) (format #f "format: should not appear") (newline #f) (write-string "write-string: should not appear" #f) (newline #f) (write-char #\! #f) (write-byte 123 #f) (write "write: should not appear" (current-output-port)) (newline (current-output-port)) (display "display: should not appear" (current-output-port)) (newline (current-output-port)) (format (current-output-port) "format: should not appear") (newline (current-output-port)) (write-string "write-string: should not appear" (current-output-port)) (newline (current-output-port)) (write-char #\! (current-output-port)) (write-byte 123 (current-output-port)) (write "write: should not appear") (newline) (display "display: should not appear") (newline) (format #t "format: should not appear") (newline) (write-string "write-string: should not appear") (newline) (write-char #\!) (write-byte 123) (set-current-output-port op1)) (let ((op1 (open-output-file tmp-output-file))) (let-temporarily (((current-output-port) op1)) (display 1) (write 2) (write-char #\3) (format #t "~D" 4) ; #t -> output port (write-byte (char->integer #\5)) (let ((op2 (open-output-file "tmp2.r5rs"))) (let-temporarily (((current-output-port) op2)) (display 6) (write 7) (write-char #\8) (format #t "~D" 9) (write-byte (char->integer #\0)) (newline) (close-output-port (current-output-port))) (let ((ip1 (open-input-file "tmp2.r5rs"))) (let-temporarily (((current-input-port) ip1)) (display (read-line)) (close-input-port (current-input-port)))) (newline) (close-output-port (current-output-port))))) (test (call-with-input-file tmp-output-file (lambda (p) (read-line p))) "1234567890")) (for-each (lambda (op) (for-each (lambda (arg) (test (op arg display) 'error)) (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list call-with-output-file call-with-input-file call-with-output-string call-with-input-string with-input-from-string with-input-from-file with-output-to-file)) (for-each (lambda (op) (for-each (lambda (arg) (test (op arg) 'error)) (list 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #f #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list open-output-file open-input-file open-input-string)) (for-each (lambda (op) (for-each (lambda (arg) (test (op "hi" arg) 'error)) (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1))))) (list write display write-byte newline write-char read read-char read-byte peek-char char-ready? read-line)) (for-each (lambda (arg) (test (write-char arg) 'error) (test (write-byte arg) 'error) (test (read-char arg) 'error) (test (read-byte arg) 'error) (test (peek-char arg) 'error) (test (write-char #\a arg) 'error) (test (write-byte 1 arg) 'error)) (list "hi" 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (write-byte -1) 'error) (test (write-byte most-positive-fixnum) 'error) (test (write-byte 300) 'error) (for-each (lambda (arg) (test (write-string arg) 'error) (test (write-string "hi" arg) 'error)) (list 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs #t :hi (if #f #f) (lambda (a) (+ a 1)))) (test (with-output-to-string (lambda () (newline #f))) "") (test (with-output-to-string (lambda () (write-byte 95 #f))) "") (test (with-output-to-string (lambda () (write-char #\a #f))) "") (test (with-output-to-string (lambda () (write-string "a" #f))) "") (test (with-output-to-string (lambda () (write "hiho" #f))) "") (test (with-output-to-string (lambda () (display "hiho" #f))) "") (test (with-output-to-string (lambda () (format #f "hiho"))) "") (unless pure-s7 (test (with-output-to-string (lambda () (set! (current-output-port) #f) (newline (current-output-port)) (write-byte 95 (current-output-port)) (write-char #\a (current-output-port)) (write-string "a" (current-output-port)) (write "hiho" (current-output-port)) (display "hiho" (current-output-port)) (format (current-output-port) "hiho"))) "") (set! (current-output-port) *stdout*)) (let-temporarily (((current-output-port) #f) ((*s7* 'max-string-length) 32)) (catch #t (lambda () (with-output-to-string (lambda () (display (symbol (make-string (*s7* 'max-string-length))))))) (lambda args 'error)) (when (current-output-port) (format *stderr* "current-output-port is ~S~%" (current-output-port)))) (for-each (lambda (op) (for-each (lambda (arg) (test (op arg) 'error)) (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs :hi (if #f #f) (lambda (a) (+ a 1))))) (list set-current-input-port set-current-error-port set-current-output-port close-input-port close-output-port)) (let ((hi (open-output-string))) (test (get-output-string hi) "") (close-output-port hi) (test (get-output-string hi) 'error)) (test (open-output-string "hiho") 'error) (test (with-output-to-string "hi") 'error) (test (call-with-output-string "hi") 'error) (test (get-output-string 1 2) 'error) (test (get-output-string) 'error) (for-each (lambda (arg) (test (get-output-string arg) 'error)) (list "hi" 1 1.0 1+i 2/3 'a-symbol (make-vector 3) '(1 2) (cons 1 2) abs :hi (if #f #f) (lambda (a) (+ a 1)))) (let ((p (open-output-string))) (write 123 p) (test (get-output-string p) "123") (write 124 p) (test (get-output-string p #t) "123124") (test (get-output-string p #t) "") (write 123 p) (test (get-output-string p) "123")) ;; since read of closed port will generate garbage, it needs to be an error, ;; so I guess write of closed port should also be an error (let ((hi (open-output-string))) (close-output-port hi) (for-each (lambda (op) (test-e (op hi) (object->string op) 'closed-port)) (list (lambda (p) (display 1 p)) (lambda (p) (write 1 p)) (lambda (p) (write-char #\a p)) (lambda (p) (write-byte 0 p)) (lambda (p) (format p "hiho")) (if pure-s7 newline set-current-output-port) (if pure-s7 newline set-current-input-port) set-current-error-port newline))) (let ((hi (open-input-string "hiho"))) (test (get-output-string hi) 'error) (close-input-port hi) (for-each (lambda (op) (test-e (op hi) (object->string op) 'closed-port)) (list read read-char read-byte peek-char read-line port-filename port-line-number (if pure-s7 read-line char-ready?) (if pure-s7 read-line set-current-output-port) (if pure-s7 read-line set-current-input-port) set-current-error-port ))) (test (close-output-port (open-input-string "hiho")) 'error) (test (close-input-port (open-output-string)) 'error) (test (set! (port-filename) "hiho") 'error) (test (set! (port-closed? (current-output-port)) "hiho") 'error) (test (begin (close-output-port *stderr*) (port-closed? *stderr*)) #f) (test (begin (close-output-port *stdout*) (port-closed? *stdout*)) #f) (test (begin (close-input-port *stdin*) (port-closed? *stdin*)) #f) (test (call-with-output-file "test.data" port-filename) "test.data") (test (call-with-input-file "s7test.scm" port-filename) "s7test.scm") (if (provided? 'linux) (test (with-input-from-file "/proc/cpuinfo" port-filename) "/proc/cpuinfo")) (test (call-with-output-file "/dev/null" port-filename) "/dev/null") (test (port-filename (open-output-string)) "") ; malloc garbage if not cleared in open_output_string (test (let ((str "")) (with-input-from-string "1234567890" (lambda () (with-input-from-string "1234567890" (lambda () (with-input-from-string "1234567890" (lambda () (with-input-from-string "1234567890" (lambda () (with-input-from-string "1234567890" (lambda () (with-input-from-string "1234567890" (lambda () (with-input-from-string "1234567890" (lambda () (set! str (string-append str (string (read-char)))))) (set! str (string-append str (string (read-char) (read-char)))))) (set! str (string-append str (string (read-char) (read-char) (read-char)))))) (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char)))))) (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char)))))) (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char) (read-char)))))) (set! str (string-append str (string (read-char) (read-char) (read-char) (read-char) (read-char) (read-char) (read-char)))))) str) "1121231234123451234561234567") (let* ((new-error-port (open-output-string)) (old-error-port (set-current-error-port new-error-port))) (catch #t (lambda () (format #f "~R" 123)) (lambda args (format (current-error-port) "oops"))) (let ((str (get-output-string new-error-port))) (set-current-error-port old-error-port) (test str "oops"))) (let ((hi (open-input-string "hiho"))) (for-each (lambda (op) (test-e (op hi) (object->string op) 'input-port)) (list (lambda (p) (display 1 p)) (lambda (p) (write 1 p)) (lambda (p) (write-char #\a p)) (lambda (p) (write-byte 0 p)) (lambda (p) (format p "hiho")) newline)) (close-input-port hi)) (let ((hi (open-output-file tmp-output-file))) (write-byte 1 hi) (close-output-port hi) (test (write-byte 1 hi) 'error)) (let ((hi (open-output-string))) (for-each (lambda (op) (test-e (op hi) (object->string op) 'output-port)) (list read read-char read-byte peek-char char-ready? read-line)) (close-output-port hi)) (test (output-port? (current-error-port)) #t) (test (and (not (null? (current-error-port))) (input-port? (current-error-port))) #f) (call-with-output-file tmp-output-file (lambda (p) (test (get-output-string p) 'error) (do ((i 0 (+ i 1))) ((= i 256)) (write-byte i p)))) (call-with-input-file tmp-output-file (lambda (p) (test (get-output-string p) 'error) (call-with-exit (lambda (quit) (do ((i 0 (+ i 1))) ((= i 256)) (let ((b (read-byte p))) (if (or (not (number? b)) (not (= b i))) (begin (format #t "read-byte got ~A, expected ~A~%" b i) (quit))))))) (let ((eof (read-byte p))) (if (not (eof-object? eof)) (format #t "read-byte at end: ~A~%" eof))) (let ((eof (read-byte p))) (if (not (eof-object? eof)) (format #t "read-byte at end: ~A~%" eof))))) (call-with-output-file tmp-output-file (lambda (p) (do ((i 0 (+ i 1))) ((= i 256)) (write-char (integer->char i) p)))) (define our-eof #f) (call-with-input-file tmp-output-file (lambda (p) (call-with-exit (lambda (quit) (do ((i 0 (+ i 1))) ((= i 256)) (let ((b (read-char p))) (if (or (not (char? b)) (not (char=? b (integer->char i)))) (begin (format #t "read-char got ~A, expected ~A (~D: char? ~A)~%" b (integer->char i) i (char? (integer->char i))) (quit))))))) (let ((eof (read-char p))) (if (not (eof-object? eof)) (format #t "read-char at end: ~A~%" eof)) (set! our-eof eof)) (let ((eof (read-char p))) (if (not (eof-object? eof)) (format #t "read-char again at end: ~A~%" eof))))) (test (eof-object? (integer->char 255)) #f) (test (eof-object? our-eof) #t) (test (char->integer our-eof) 'error) (test (char? our-eof) #f) (test (eof-object? ((lambda () our-eof))) #t) (for-each (lambda (op) (test (op *stdout*) 'error) (test (op *stderr*) 'error) (test (op (current-output-port)) 'error) (test (op (current-error-port)) 'error) (test (op ()) 'error)) (list read read-line read-char read-byte peek-char char-ready?)) (for-each (lambda (op) (test (op #\a *stdin*) 'error) (test (op #\a (current-input-port)) 'error) (test (op #\a ()) 'error)) (list write display write-char)) (test (write-byte 0 *stdin*) 'error) (test (write-byte (char->integer #\space) *stdout*) (char->integer #\space)) (test (write-byte (char->integer #\space) *stderr*) (char->integer #\space)) (test (newline *stdin*) 'error) (test (format *stdin* "hiho") 'error) (test (port-filename *stdin*) "*stdin*") (test (port-filename *stdout*) "*stdout*") (test (port-filename *stderr*) "*stderr*") (test (input-port? *stdin*) #t) (test (output-port? *stdin*) #f) (test (port-closed? *stdin*) #f) (test (input-port? *stdout*) #f) (test (output-port? *stdout*) #t) (test (port-closed? *stdout*) #f) (test (input-port? *stderr*) #f) (test (output-port? *stderr*) #t) (test (port-closed? *stderr*) #f) (test (port-line-number *stdin*) 0) (test (port-line-number *stdout*) 'error) (test (port-line-number *stderr*) 'error) (test (port-line-number ()) 'error) ; this used to be *stdin*? (test (open-input-file "[*not-a-file!*]-") 'error) (test (call-with-input-file "[*not-a-file!*]-" (lambda (p) p)) 'error) (test (with-input-from-file "[*not-a-file!*]-" (lambda () #f)) 'error) (test (open-input-file "") 'error) (test (call-with-input-file "" (lambda (p) p)) 'error) (test (with-input-from-file "" (lambda () #f)) 'error) ;(test (open-output-file "/bad-dir/badness/[*not-a-file!*]-") 'error) ;(test (call-with-output-file "/bad-dir/badness/[*not-a-file!*]-" (lambda (p) p)) 'error) ;(test (with-output-to-file "/bad-dir/badness/[*not-a-file!*]-" (lambda () #f)) 'error) (with-output-to-file "tmp.r5rs" (lambda () (write-char #\a) (with-output-to-file tmp-output-file (lambda () (format #t "~C" #\b) (with-output-to-file "tmp2.r5rs" (lambda () (display #\c))) (display (with-input-from-file "tmp2.r5rs" (lambda () (read-char)))))) (with-input-from-file tmp-output-file (lambda () (write-byte (read-byte)) (write-char (read-char)))))) (with-input-from-file "tmp.r5rs" (lambda () (test (read-line) "abc"))) (with-input-from-file "tmp.r5rs" ; this assumes tmp.r5rs has "abc" as above (lambda () (test (read-char) #\a) (test (eval-string "(+ 1 2)") 3) (test (read-char) #\b) (with-input-from-string "(+ 3 4)" (lambda () (test (read) '(+ 3 4)))) (test (read-char) #\c))) (test (eval-string (object->string (with-input-from-string "(+ 1 2)" read))) 3) (test (eval (eval-string "(with-input-from-string \"(+ 1 2)\" read)")) 3) (test (eval-string "(eval (with-input-from-string \"(+ 1 2)\" read))") 3) (test (eval-string (object->string (eval-string (format #f "(+ 1 2)")))) 3) (let-temporarily (((*s7* 'safety) 1)) ;; closure with quoted circular list in body (test (object->string (list (apply lambda '(x) (let ((cp (list 1))) (set-cdr! cp cp) (list (list cp))))) :readable) 'error) ;; apply #_lambda: body is circular: ((x) (#1=(1 . #1#))) (test (format #f "~W" (list (apply lambda '(x) (let ((cp (list 1))) (set-cdr! cp cp) (list (list 'quote cp)))))) "(list (lambda (x) (quote #1=(1 . #1#))))") (test (format #f "~W" (list (apply lambda* '(x) (let ((cp (list 1 2))) (set-cdr! (cdr cp) cp) (list (list 'quote cp)))))) "(list (lambda* (x) (quote #1=(1 2 . #1#))))") (test (format #f "~W" (list (apply macro '(x) (let ((cp (list 1 2))) (set-cdr! (cdr cp) cp) (list (list quote cp)))))) "(list (macro (x) '#1=(1 2 . #1#)))") (test (format #f "~W" (list (apply lambda '(x) (let ((cp (list 1))) (set-cdr! cp cp) (list 'quote cp))))) 'error) ;;apply #_lambda: body is circular: ((x) quote #1=(1 . #1#)) (test (format #f "~W" (make-hook (let ((cp (list 1))) (set-cdr! cp cp) (list 'quote cp)))) "#")) ;;; -------- test that we can plow past errors -------- (if (and (defined? 'file-exists?) ; (ifdef name ...)? (file-exists? "tests.data")) (delete-file "tests.data")) (call-with-output-file "tests.data" (lambda (p) (format p "start ") (catch #t (lambda () (format p "next ") (abs "hi") (format p "oops ")) (lambda args 'error)) (format p "done\n"))) (let ((str (call-with-input-file "tests.data" (lambda (p) (read-line p))))) (if (or (not (string? str)) (not (string=? str "start next done"))) (format #t ";call-with-output-file + error -> ~S~%" str))) (let ((str (call-with-input-file "tests.data" (lambda (p) (catch #t (lambda () (read-char p) (abs "hi") (read-char p)) (lambda args "s")))))) (if (or (not (string? str)) (not (string=? str "s"))) (format #t ";call-with-input-file + error -> ~S~%" str))) (if (and (defined? 'file-exists?) (file-exists? "tests.data")) (delete-file "tests.data")) (with-output-to-file "tests.data" (lambda () (format #t "start ") (catch #t (lambda () (format #t "next ") (abs "hi") (format #t "oops ")) (lambda args 'error)) (format #t "done\n"))) (let ((str (with-input-from-file "tests.data" (lambda () (read-line))))) (if (or (not (string? str)) (not (string=? str "start next done"))) (format #t ";with-output-to-file + error -> ~S~%" str))) (let ((str (with-input-from-file "tests.data" (lambda () (catch #t (lambda () (read-char) (abs "hi") (read-char)) (lambda args "s")))))) (if (or (not (string? str)) (not (string=? str "s"))) (format #t ";with-input-from-file + error -> ~S~%" str))) (test (call-with-output-string newline) (string #\newline)) (test (call-with-output-string append) "") (let ((str (call-with-output-string (lambda (p) (format p "start ") (catch #t (lambda () (format p "next ") (abs "hi") (format p "oops ")) (lambda args 'error)) (format p "done"))))) (if (or (not (string? str)) (not (string=? str "start next done"))) (format #t ";call-with-output-string + error -> ~S~%" str))) (let ((str (with-output-to-string (lambda () (format #t "start ") (catch #t (lambda () (format #t "next ") (abs "hi") (format #t "oops ")) (lambda args 'error)) (format #t "done"))))) (if (or (not (string? str)) (not (string=? str "start next done"))) (format #t ";with-output-to-string + error -> ~S~%" str))) (test (with-output-to-string (lambda () (format (current-output-port) "a test ~D" 123))) "a test 123") ;(test (with-output-to-string (lambda () (format *stdout* "a test ~D" 1234))) "a test 1234") (test (string=? (with-output-to-string (lambda () (write #\null))) "#\\null") #t) (test (string=? (with-output-to-string (lambda () (write #\space))) "#\\space") #t) (test (string=? (with-output-to-string (lambda () (write #\return))) "#\\return") #t) (test (string=? (with-output-to-string (lambda () (write #\escape))) "#\\escape") #t) (test (string=? (with-output-to-string (lambda () (write #\tab))) "#\\tab") #t) (test (string=? (with-output-to-string (lambda () (write #\newline))) "#\\newline") #t) (test (string=? (with-output-to-string (lambda () (write #\backspace))) "#\\backspace") #t) (test (string=? (with-output-to-string (lambda () (write #\alarm))) "#\\alarm") #t) (test (string=? (with-output-to-string (lambda () (write #\delete))) "#\\delete") #t) (test (string=? (with-output-to-string (lambda () (write-char #\space))) " ") #t) ; weird -- the name is backwards (test (string=? (with-output-to-string (lambda () (display #\space))) " ") #t) (let ((str (call-with-input-string "12345" (lambda (p) (catch #t (lambda () (read-char p) (abs "hi") (read-char p)) (lambda args "s")))))) (if (or (not (string? str)) (not (string=? str "s"))) (format #t ";call-with-input-string + error -> ~S~%" str))) (let ((str (with-input-from-string "12345" (lambda () (catch #t (lambda () (read-char) (abs "hi") (read-char)) (lambda args "s")))))) (if (or (not (string? str)) (not (string=? str "s"))) (format #t ";with-input-from-string + error -> ~S~%" str))) (for-each (lambda (arg) (test (port-line-number arg) 'error) (test (port-filename arg) 'error)) (list "hi" -1 0 #\a 'a-symbol #(1 2 3) '(1 . 2) '(1 2 3) 3.14 3/4 1.0+1.0i #t abs # # (lambda () 1))) (test (string? (port-filename)) #t) (test (symbol? (string->symbol (port-filename))) #t) (for-each (lambda (arg) (test (with-input-from-string (format #f "~A" arg) (lambda () (read))) arg)) (list 1 3/4 '(1 2) #(1 2) :hi #f #t)) (num-test (with-input-from-string "3.14" read) 3.14) (num-test (with-input-from-string "3.14+2i" read) 3.14+2i) (num-test (with-input-from-string "#x2.1" read) 2.0625) (test (with-input-from-string "'hi" read) ''hi) (test (with-input-from-string "'(1 . 2)" read) ''(1 . 2)) (test (let ((cin #f) (cerr #f)) (catch #t (lambda () (with-input-from-string "123" (lambda () (set! cin (current-input-port)) (error 'testing "jump out")))) (lambda args (set! cerr #t))) (format #f "~A ~A" cin cerr)) "# #t") ;;; old form: " #t") (test (let ((cp (current-output-port)) (cout #f) (cerr #f)) (catch #t (lambda () (with-output-to-string (lambda () (set! cout (current-output-port)) (error 'testing "jump out")))) (lambda args (set! cerr #t))) (format #f "~A ~A" cout cerr)) "# #t") (if (not (eq? *stdout* old-stdout)) (format *stderr* ";~D: stdout clobbered~%" (port-line-number))) ;;; old form: " #t") (test (open-input-file #u(115 55 116 101 115 116 46 115 99 109 0) #u(114 0 98)) 'error) ; "s7test.scm" "r\x00b" (call-with-output-file tmp-output-file (lambda (p) (display "1" p) (newline p) (newline p) (display "2345" p) (newline p))) (call-with-input-file tmp-output-file (lambda (p) (test (read-line p) "1") (test (read-line p) "") (test (read-line p) "2345") (test (eof-object? (read-line p)) #t))) (let ((p (open-output-file tmp-output-file "a"))) (display "678" p) (newline p) (close-output-port p)) (if (not with-windows) ; "xyzzy" is legit in windows?? (begin (test (let ((p (open-output-file tmp-output-file "xyzzy"))) (close-output-port p)) 'error) (test (let ((p (open-input-file tmp-output-file "xyzzy"))) (close-input-port p)) 'error))) (call-with-input-file tmp-output-file (lambda (p) (test (read-line p) "1") (test (read-line p) "") (test (read-line p) "2345") (test (read-line p) "678") (test (eof-object? (read-line p)) #t))) (test (let ((a 1)) (define-macro (m1) `(set! a (read))) (with-input-from-string "123" m1) a) 123) (test (let ((a 1)) (define-macro (m3 p) `(set! a (read ,p))) (call-with-input-string "123" m3) a) 123) (test (let () (define-macro (m1) `(define a (read))) (with-input-from-string "123" m1) a) 123) (test (let () (define-macro (m3 p) `(define a (read ,p))) (call-with-input-string "123" m3) a) 123) (for-each (lambda (arg) (test (open-input-file "s7test.scm" arg) 'error) (test (open-output-file tmp-data-file arg) 'error)) (list -1 #\a 1 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t () (list 1 2 3) '(1 . 2))) (test (current-input-port ()) 'error) (test (current-output-port ()) 'error) (test (current-error-port ()) 'error) (for-each (lambda (op) (let ((tag (catch #t (lambda () (op)) (lambda args 'error)))) (if (not (eq? tag 'error)) (format #t ";(~A) -> ~A (expected 'error)~%" op tag)))) (list set-current-input-port set-current-error-port set-current-output-port close-input-port close-output-port write display write-byte write-char format ; newline ;read read-char read-byte peek-char char-ready? read-line ; these can default to current input call-with-output-file call-with-input-file call-with-output-string call-with-input-string with-input-from-string with-input-from-file with-output-to-file open-output-file open-input-file open-input-string)) (for-each (lambda (op) (let ((tag (catch #t (lambda () (op 1 2 3 4 5)) (lambda args 'error)))) (if (not (eq? tag 'error)) (format #t ";(~A 1 2 3 4 5) -> ~A (expected 'error)~%" op tag)))) (list set-current-input-port set-current-error-port set-current-output-port close-input-port close-output-port write display write-byte write-char format newline read read-char read-byte peek-char char-ready? read-line call-with-output-file call-with-input-file call-with-output-string call-with-input-string with-input-from-string with-input-from-file with-output-to-file open-output-file open-input-file open-input-string)) ;;; (string-set! (with-input-from-string "\"1234\"" read) 1 #\a) (test (with-input-from-string "(+ 1 2)" read) '(+ 1 2)) (when (and (provided? 'system-extras) (file-exists? "gad1.data")) ; file too big to treat as in-core string (let ((p (catch #t (lambda () (open-input-file "gad1.data")) (lambda (type info) #f)))) (when p (test (port-filename p) "gad1.data") (test (string? (read-line p)) #t) (test (char? (read-char p)) #t) (test (integer? (read-byte p)) #t) (read p) ; could be symbol, number etc (test (string? (read-string 10 p)) #t) (close-input-port p)))) (test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\tab))))) 512) #t) (test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\newline))))) 512) #t) (test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\"))))) 512) #t) (test (>= (length (with-output-to-string (lambda () (write (make-string 512 #\x65))))) 512) #t) (if (and (defined? 'file-exists?) (file-exists? (append "/home/" username "/test"))) (let-temporarily ((*load-path* (cons (append "/home/" username "/test") *load-path*))) (with-output-to-file (append "/home/" username "/test/load-path-test.scm") (lambda () (format #t "(define (load-path-test) *load-path*)~%"))) (load "load-path-test.scm") (if (or (not (defined? 'load-path-test)) (not (equal? *load-path* (load-path-test)))) (format #t ";*load-path*: ~S, but ~S~%" *load-path* (load-path-test))))) ;;; function ports (when with-block (let ((p (function-open-output))) (write-char #\a p) (let ((val (function-get-output p))) (function-close-output p) (if (not (string=? val "a")) (format *stderr* ";function port write #\\a: ~S (~D, ~A)~%" val (length val) (string->vector val))))) (let ((p (function-open-output))) (display "123" p) (format p "4~D6" 5) (write-string "789" p) (write-byte (char->integer #\0) p) (newline p) (let ((val (function-get-output p))) (function-close-output p) (close-output-port p) (if (not (string=? val "1234567890\n")) (format *stderr* ";function port outputs: ~S (~D, ~A)~%" val (length val) (string->vector val))))) (let ((str "0123")) (let ((p (function-open-input str))) (let ((val (read-char p))) (if (not (char=? val #\0)) (format *stderr* ";function port read #\\0: ~S~%" val))))) (let ((str "0123\n45678")) (let ((p (function-open-input str))) (let ((val (read-line p))) (if (not (string=? val "0123")) (format *stderr* ";function port read-line: ~S~%" val)) (set! val (read-byte p)) (if (not (= val (char->integer #\4))) (format *stderr* ";function port read-byte: ~S~%" val)) (set! val (peek-char p)) (if (not (char=? val #\5)) (format *stderr* ";function port peek-char: ~S~%" val)) (set! val (read-string 2 p)) (if (not (string=? val "56")) (format *stderr* ";function port read-string: ~S~%" val)) (if (and (not pure-s7) (not (char-ready? p))) (format *stderr* ";function port has no char ready?~%")) (close-input-port p))))) ;;; run integer? code before integer? is localized below (test (let ((x 1)) ((if (integer? x) + -) 1 1/2 1234)) 2471/2) (test (let () (define (func) (let ((x 1)) ((if (integer? x) + -) 1 1/2 1234))) (func) (func)) 2471/2) (test (let ((x 1)) ((if (integer? x) + *))) 0) (test (let () (define (func) (let ((x 1)) ((if (integer? x) + *)))) (func) (func)) 0) ;;; -------- poke at the reader -------- (test (cdr '(1 ."a")) "a") (test '(1 .(2 3)) '(1 2 3)) (test '(1 .(2 3)) '(1 . (2 3))) (test (+ .(2 .(3))) 5) (test (cadr '(1 '0,)) ''0,) (test (equal? 3 ' 3) #t) (test (equal? ' 3 3) #t) (test (equal? '"hi" ' "hi") #t) (test (equal? '#\a ' #\a) #t) (test (let ((nam()e 1)) 1) 'error) (test (let ((nam""e 1)) nam""e) 'error) ; this was 1 originally (test (cadr '(1 ']x)) '']x) (test `1 1) (test (equal? '(1 .(1 .())) '(1 1)) #t) (test (equal? '("hi"."ho") ' ("hi" . "ho")) #t) (test (equal? '("hi""ho") '("hi" "ho")) #t) (test '("""""") '("" "" "")) (test '(#|;"();|#) ()) (test '(#||##\# #||##b1) '(#\# 1)) (test (#|s'!'|#*) 1) (test (#|==|#) ()) (test -#|==|#1 'error) ; unbound variable (test '((). '()) '(() #_quote ())) (test '(1. . .2) '(1.0 . 0.2)) (test (equal? '(().()) '(())) #t) (test (equal? '(()()) '(() ())) #t) (test (equal? '(()..()) '(() .. ())) #t) (test '((().()).()) '((()))) (test '(((().()).()).()) '(((())))) (test '((().(().())).()) '((() ()))) (test '((()().(().()))) '((() () ()))) (test '(1 .; 2) '(1 . 2)) (test (vector .(1 .(2))) #(1 2)) (test (vector 0. .(.1)) #(0.0 0.1)) (test '(a #|foo||# b) '(a b)) ; from bug-guile (test '(a #|foo|||# b) '(a b)) (test '(a #|foo||||# b) '(a b)) (test '(a #|foo|||||# b) '(a b)) (test (let () (define (f' x) (+ x x)) (f' 10)) 20) ; from /r/scheme (test (let () (define (f'' a'b) (+ a'b a'b)) (f'' 10)) 20) (test (symbol? 'a'b) #t) (test (char? #\#) #t) (test (type-of (eval-string "'#")) 'undefined?) (test (type-of (eval-string "'(#)")) 'pair?) (test (car `(,.1e0)) .1) (test (car `(,.1E0)) .1) (test (let ((x "hi")) (set! x"asdf") x) "asdf") (test (let* ((x "hi") (y x)) (set! x "asdf") y) "hi") (test (let ((x 1)) (set! x(list 1 2)) x) '(1 2)) (num-test (let ((x 1)) (set!;" x;) 12.;( );#| x) 12.0) (test (let ((\x00}< 1) (@:\t{ 2)) (+ \x00}< @:\t{)) 3) (test (let ((| 1) (|| 2) (||| 3)) (+ || | |||)) 6) (test (let ((|a#||#b| 1)) |a#||#b|) 1) (test (let ((@,@'[1] 1) (\,| 2)) (+ @,@'[1] \,|)) 3) (test (list"0"0()#()#\a"""1"'x(list)+(cons"""")#f) (list "0" 0 () #() #\a "" "1" 'x (list) + '("" . "") #f)) (test (let ((x, 1)) x,) 1) (test (length (eval-string (string #\' #\( #\1 #\space #\. (integer->char 200) #\2 #\)))) 2) ; will be -1 if dot is for improper list, 3 if dot is a symbol (test (+ `,0(angle ```,`11)) 0) (test (map . (char->integer "123")) '(49 50 51)) (test (map .(values "0'1")) '(#\0 #\' #\1)) (test (map /""'(123)) ()) (num-test (+ 1 .()) 1) (test (let () (define (x .()) (list .())) (x)) ()) (test '(1 . ()) '(1)) (test '(1 . (2)) '(1 2)) (test '(1 . (2) 3) '(1 2 3)) ; Guile says "missing close paren", sbcl says "More than one object follows . in list.", clisp: "illegal end of dotted list" (test '(1 . (2 3) 4 5) '(1 2 3 4 5)) (test '(1 . (2) (3)) '(1 2 (3))) (test '(1 2 . 'x 3) '(1 2 #_quote x 3)) (test (eval-string "'(1 . 2 3)") 'error) ; eval-string here wraps up the read-error (test '(1 . (2 . 3)) '(1 2 . 3)) (test (eval-string "'(1 . . ((2 3)))") 'error) (test '((1 . 2) . (3 . 4)) '((1 . 2) 3 . 4)) (test (eval-string "'(1 . () 2)") 'error) (test '(1 . (2) . (3)) '(1 2 3)) (test '(1 . (2 . (3))) '(1 2 3)) ;; how is ...#(... parsed? ;(test (eval-string "'(# (1))") 'error) (test (let ((lst (eval-string "'(#(1))"))) (and (= (length lst) 1) (vector? (car lst)))) #t) ; '(#(1)) (test (let ((lst (eval-string "'(-#(1))"))) (and (= (length lst) 2) (symbol? (car lst)) (pair? (cadr lst)))) #t) ; '(-# (1)) (test (let ((lst (eval-string "'(1#(1))"))) (and (= (length lst) 2) (symbol? (car lst)) (pair? (cadr lst)))) #t) ; '(1# (1)) (test (let ((lst (eval-string "'('#(1))"))) (and (= (length lst) 1) (vector? (cadar lst)))) #t) ; '((quote #(1))) (test (let ((lst (eval-string "'(()#())"))) (and (= (length lst) 2) (null? (car lst)) (vector? (cadr lst)))) #t) ; '(() #()) (test (let ((lst (eval-string "'(().())"))) (and (= (length lst) 1) (null? (car lst)))) #t) ; '(()) (test (let ((lst (eval-string "'(()-())"))) (and (= (length lst) 3) (null? (car lst)) (null? (caddr lst)))) #t) ; '(() - ()) (test (let ((lst (eval-string "'(().#())"))) (and (= (length lst) 3) (null? (car lst)) (null? (caddr lst)))) #t) ; '(() .# ()) (test (let ((lst (eval-string "'((). #())"))) (and (= (length lst) -1) (null? (car lst)) (vector? (cdr lst)))) #t) ; '(() . #()) (test (let ((lst (eval-string "'(\"\"#())"))) (and (= (length lst) 2) (string? (car lst)) (vector? (cadr lst)))) #t) ; '("" #()) (test (length (car '("#\\("))) 3) (test (length (car '("#\\\""))) 3) (test (char=? ((car '("#\\\"")) 2) #\") #t) (test (length '(()#\(())) 3) (test (length (eval-string "'(()#\\(())")) 3) (test (char=? ((eval-string "'(()#\\#())") 1) #\#) #t) (test (length (list""#t())) 3) (test (length (list""#())) 2) (test (length (eval-string "'(#xA(1))")) 2) (test (length '(#xA""#(1))) 3) (test (length (eval-string "'(#xA\"\"#(1))")) 3) (test (length (eval-string "'(1#f)")) 1) ;(test (eval-string "'(#f#())") 'error) (test (length '(#f())) 2) (test (length '(#f"")) 2) (test (eq? #f (eval-string "#F")) #f) ;(test (eval-string "'(##)") 'error) ;(test (eval-string "'(##())") 'error) (test (equal? '('#()) '(#())) #f) (test (equal? (list #()) '(#())) #t) (test (equal? '(#()) '(#())) #t) (test (equal? '('#()) '(`#())) #f) ; [guile agrees] (test (equal? '('()) '(`())) #f) ; '('()) -> ('()) but '(`()) -> (()) (test (equal? '('(1)) '(`(1))) #t) (test (equal? '('#(1)) '(`#(1))) #f) ; [guile agrees] (test (equal? '('#()) '(#())) #f) (test (equal? '(`#()) '(`#())) #t) (test (equal? #() `#()) #t) (test (equal? (list #()) (list `#())) #t) (test (equal? (list #()) '(`#())) #t) (test (equal? '(`#()) '(#())) #t) (test (equal? `#() #()) #t) ; and also (1) () #(1) etc (test (equal? `#() '#()) #t) ; " (test (equal? '`#() ''#()) #f) ; it equals #() -- this is consistent -- see below (test (equal? '`#() ``#()) #t) (test (catch #t (lambda () (with-input-from-string "#0d()" read)) (lambda (type info) (apply format #f info))) "#nD(...) dimensions, 0, should be 1 or more") (test (catch #t (lambda () (with-input-from-string "#1230d()" read)) (lambda (type info) (apply format #f info))) "reading #1230...: 1230 is too large, (*s7* 'max-vector-dimensions): 512") (test (equal? (quote ()) '()) #t) (test (equal? '() (quote ())) #t) (test (equal? (quote ()) (quote ())) #t) (test (equal? `(1) '(1)) #t) (test (equal? (quasiquote (1)) '(1)) #t) (test (equal? `(1) (quote (1))) #t) (test (equal? (quasiquote (1)) (quote (1))) #t) (test (equal? ``''1 '``'1) #t) (test (equal? (quasiquote `(quote (quote 1))) '``'1) #f) (test (equal? ``''1 (quote ``(quote 1))) #f) (test (equal? (quasiquote `(quote (quote 1))) (quote ``(quote 1))) #f) (test (equal? '``'#f ```'#f) #t) (test (equal? (quote ``(quote #f)) ```'#f) #f) (test (equal? '``'#f (quasiquote ``(quote #f))) #f) (test (equal? (quote ``(quote #f)) (quasiquote ``(quote #f))) #t) ;;; etc: #| (equal? (quote `1) (quote (quasiquote 1))) -> #f the reader sees `1 and turns it into 1 in the first case, but does not collapse the 2nd case to 1 (who knows, quasiquote might have been redefined in context... but ` can't be redefined): :(define (` a) a) ;define: define a non-symbol? 'a ; (define ('a) a) this is different from guile which does not handle ` at read time except to expand it: guile> (quote `1) (quasiquote 1) :(quote `1) 1 so anything that quotes ` is not going to equal quote quasiquote (define (check-strs str1 str2) (for-each (lambda (arg) (let ((expr (format #f "(equal? ~A~A ~A~A)" str1 arg str2 arg))) (let ((val (catch #t (lambda () (eval-string expr)) (lambda args 'error)))) (format #t "--------~%~S -> ~S" expr val) (let* ((parens3 0) (parens4 0) (str3 (apply string-append (map (lambda (c) (if (char=? c #\`) (if (= parens3 0) (begin (set! parens3 (+ parens3 1)) "(quasiquote ") "`") (if (char=? c #\') (begin (set! parens3 (+ parens3 1)) "(quote ") (string c)))) str1))) (str4 (apply string-append (map (lambda (c) (if (char=? c #\`) (if (= parens4 0) (begin (set! parens4 (+ parens4 1)) "(quasiquote ") "`") (if (char=? c #\') (begin (set! parens4 (+ parens4 1)) "(quote ") (string c)))) str2)))) (let ((expr (format #f "(equal? ~A~A~A ~A~A)" str3 arg (make-string parens3 #\)) str2 arg))) (let* ((val1 (catch #t (lambda () (eval-string expr)) (lambda args 'error))) (trouble (and (not (eq? val1 'error)) (not (eq? val1 val))))) (if trouble (format #t "~%~8T~A~S -> ~S~A" bold-text expr val1 unbold-text) (format #t "~%~8T~S -> ~S" expr val1)))) (let ((expr (format #f "(equal? ~A~A ~A~A~A)" str1 arg str4 arg (make-string parens4 #\))))) (let* ((val1 (catch #t (lambda () (eval-string expr)) (lambda args 'error))) (trouble (and (not (eq? val1 'error)) (not (eq? val1 val))))) (if trouble (format #t "~%~8T~A~S -> ~S~A" bold-text expr val1 unbold-text) (format #t "~%~8T~S -> ~S" expr val1)))) (let ((expr (format #f "(equal? ~A~A~A ~A~A~A)" str3 arg (make-string parens3 #\)) str4 arg (make-string parens4 #\))))) (let* ((val1 (catch #t (lambda () (eval-string expr)) (lambda args 'error))) (trouble (and (not (eq? val1 'error)) (not (eq? val1 val))))) (if trouble (format #t "~%~8T~A~S -> ~S~A~%" bold-text expr val1 unbold-text) (format #t "~%~8T~S -> ~S~%" expr val1)))) )))) (list "()" "(1)" "#()" "#(1)" "1" "#f"))) ;; (list ",(+ 1 2)" "\"\"" "(())" "#\\1" "3/4" ",1") (check-strs "'" "'") (check-strs "`" "'") (check-strs "'" "`") (check-strs "`" "`") (let ((strs ())) (do ((i 0 (+ i 1))) ((= i 4)) (let ((c1 ((vector #\' #\` #\' #\`) i)) (c2 ((vector #\' #\' #\` #\`) i))) (do ((k 0 (+ k 1))) ((= k 4)) (let ((d1 ((vector #\' #\` #\' #\`) k)) (d2 ((vector #\' #\' #\` #\`) k))) (let ((str1 (string c1 c2)) (str2 (string d1 d2))) (if (not (member (list str1 str2) strs)) (begin (check-strs str1 str2) (set! strs (cons (list str1 str2) strs)) (set! strs (cons (list str2 str1) strs)))))))))) (let ((strs ())) (do ((i 0 (+ i 1))) ((= i 8)) (let ((c1 ((vector #\' #\` #\' #\` #\' #\` #\' #\`) i)) (c2 ((vector #\' #\' #\` #\` #\' #\' #\` #\`) i)) (c3 ((vector #\' #\' #\' #\' #\` #\` #\` #\`) i))) (do ((k 0 (+ k 1))) ((= k 8)) (let ((d1 ((vector #\' #\` #\' #\` #\' #\` #\' #\`) k)) (d2 ((vector #\' #\' #\` #\` #\' #\' #\` #\`) k)) (d3 ((vector #\' #\' #\' #\' #\` #\` #\` #\`) k))) (let ((str1 (string c1 c2 c3)) (str2 (string d1 d2 d3))) (if (not (member (list str1 str2) strs)) (begin (check-strs str1 str2) (set! strs (cons (list str1 str2) strs)) (set! strs (cons (list str2 str1) strs)))))))))) ;;; -------------------------------- (do ((i 0 (+ i 1))) ((= i 256)) (if (and (not (= i (char->integer #\)))) (not (= i (char->integer #\")))) (let ((str (string #\' #\( #\1 #\space #\. (integer->char i) #\2 #\)))) (catch #t (lambda () (let ((val (eval-string str))) (format #t "[~D] ~A -> ~S (~S ~S)~%" i str val (car val) (cdr val)))) (lambda args (format #t "[~D] ~A -> ~A~%" i str args)))))) (let ((chars (vector (integer->char 0) #\newline #\space #\tab #\. #\, #\@ #\= #\x #\b #\' #\` #\# #\] #\[ #\} #\{ #\( #\) #\1 #\i #\+ #\- #\e #\_ #\\ #\" #\: #\; #\> #\<))) (let ((nchars (vector-length chars))) (do ((len 2 (+ len 1))) ((= len 3)) (let ((str (make-string len)) (ctrs (make-vector len 0))) (do ((i 0 (+ i 1))) ((= i (expt nchars len))) (let ((carry #t)) (do ((k 0 (+ k 1))) ((or (= k len) (not carry))) (vector-set! ctrs k (+ 1 (vector-ref ctrs k))) (if (= (vector-ref ctrs k) nchars) (vector-set! ctrs k 0) (set! carry #f))) (do ((k 0 (+ k 1))) ((= k len)) (string-set! str k (vector-ref chars (vector-ref ctrs k))))) (format #t "~A -> " str) (catch #t (lambda () (let ((val (eval-string str))) (format #t " ~S -> ~S~%" str val))) (lambda args ;(format #t " ~A~%" args) #f ))))))) |# (let ((äåæéîå define) (ìåîçôè length) (äï do) (ìåô* let*) (éæ if) (áâó abs) (ìïç log) (óåô! set!)) (äåæéîå (óòã-äõòáôéïî å) (ìåô* ((ìåî (ìåîçôè å)) (åø0 (å 0)) (åø1 (å (- ìåî 2))) (áìì-ø (- åø1 åø0)) (äõò 0.0)) (äï ((é 0 (+ é 2))) ((>= é (- ìåî 2)) äõò) (ìåô* ((ø0 (å é)) (ø1 (å (+ é 2))) (ù0 (å (+ é 1))) ; 1/ø ø ðïéîôó (ù1 (å (+ é 3))) (áòåá (éæ (< (áâó (- ù0 ù1)) .0001) (/ (- ø1 ø0) (* ù0 áìì-ø)) (* (/ (- (ìïç ù1) (ìïç ù0)) (- ù1 ù0)) (/ (- ø1 ø0) áìì-ø))))) (óåô! äõò (+ äõò (áâó áòåá))))))) (num-test (óòã-äõòáôéïî (list 0 1 1 2)) 0.69314718055995) (num-test (óòã-äõòáôéïî (vector 0 1 1 2)) 0.69314718055995)) (test (let ((ÿa 1)) ÿa) 1) (test (+ (let ((!a 1)) !a) (let (($a 1)) $a) (let ((%a 1)) %a) (let ((&a 1)) &a) (let ((*a 1)) *a) (let ((+a 1)) +a) (let ((-a 1)) -a) (let ((.a 1)) .a) (let ((/a 1)) /a) (let ((0a 1)) 0a) (let ((1a 1)) 1a) (let ((2a 1)) 2a) (let ((3a 1)) 3a) (let ((4a 1)) 4a) (let ((5a 1)) 5a) (let ((6a 1)) 6a) (let ((7a 1)) 7a) (let ((8a 1)) 8a) (let ((9a 1)) 9a) (let ((a 1)) >a) (let ((?a 1)) ?a) (let ((@a 1)) @a) (let ((Aa 1)) Aa) (let ((Ba 1)) Ba) (let ((Ca 1)) Ca) (let ((Da 1)) Da) (let ((Ea 1)) Ea) (let ((Fa 1)) Fa) (let ((Ga 1)) Ga) (let ((Ha 1)) Ha) (let ((Ia 1)) Ia) (let ((Ja 1)) Ja) (let ((Ka 1)) Ka) (let ((La 1)) La) (let ((Ma 1)) Ma) (let ((Na 1)) Na) (let ((Oa 1)) Oa) (let ((Pa 1)) Pa) (let ((Qa 1)) Qa) (let ((Ra 1)) Ra) (let ((Sa 1)) Sa) (let ((Ta 1)) Ta) (let ((Ua 1)) Ua) (let ((Va 1)) Va) (let ((Wa 1)) Wa) (let ((Xa 1)) Xa) (let ((Ya 1)) Ya) (let ((Za 1)) Za) (let (([a 1)) [a) (let ((\a 1)) \a) (let ((]a 1)) ]a) (let ((^a 1)) ^a) (let ((_a 1)) _a) (let ((aa 1)) aa) (let ((ba 1)) ba) (let ((ca 1)) ca) (let ((da 1)) da) (let ((ea 1)) ea) (let ((fa 1)) fa) (let ((ga 1)) ga) (let ((ha 1)) ha) (let ((ia 1)) ia) (let ((ja 1)) ja) (let ((ka 1)) ka) (let ((la 1)) la) (let ((ma 1)) ma) (let ((na 1)) na) (let ((oa 1)) oa) (let ((pa 1)) pa) (let ((qa 1)) qa) (let ((ra 1)) ra) (let ((sa 1)) sa) (let ((ta 1)) ta) (let ((ua 1)) ua) (let ((va 1)) va) (let ((wa 1)) wa) (let ((xa 1)) xa) (let ((ya 1)) ya) (let ((za 1)) za) (let (({a 1)) {a) (let ((|a 1)) |a) (let ((}a 1)) }a) (let ((~a 1)) ~a) (let (( a 1))  a) (let ((¡a 1)) ¡a) (let ((¢a 1)) ¢a) (let ((£a 1)) £a) (let ((¤a 1)) ¤a) (let ((¥a 1)) ¥a) (let ((¦a 1)) ¦a) (let ((§a 1)) §a) (let ((¨a 1)) ¨a) (let ((©a 1)) ©a) (let ((ªa 1)) ªa) (let ((«a 1)) «a) (let ((¬a 1)) ¬a) (let ((­a 1)) ­a) (let ((®a 1)) ®a) (let ((¯a 1)) ¯a) (let ((°a 1)) °a) (let ((±a 1)) ±a) (let ((²a 1)) ²a) (let ((³a 1)) ³a) (let ((´a 1)) ´a) (let ((µa 1)) µa) (let ((¶a 1)) ¶a) (let ((·a 1)) ·a) (let ((¸a 1)) ¸a) (let ((¹a 1)) ¹a) (let ((ºa 1)) ºa) (let ((»a 1)) »a) (let ((¼a 1)) ¼a) (let ((½a 1)) ½a) (let ((¾a 1)) ¾a) (let ((¿a 1)) ¿a) (let ((Àa 1)) Àa) (let ((Áa 1)) Áa) (let ((Âa 1)) Âa) (let ((Ãa 1)) Ãa) (let ((Äa 1)) Äa) (let ((Åa 1)) Åa) (let ((Æa 1)) Æa) (let ((Ça 1)) Ça) (let ((Èa 1)) Èa) (let ((Éa 1)) Éa) (let ((Êa 1)) Êa) (let ((Ëa 1)) Ëa) (let ((Ìa 1)) Ìa) (let ((Ía 1)) Ía) (let ((Îa 1)) Îa) (let ((Ïa 1)) Ïa) (let ((Ða 1)) Ða) (let ((Ña 1)) Ña) (let ((Òa 1)) Òa) (let ((Óa 1)) Óa) (let ((Ôa 1)) Ôa) (let ((Õa 1)) Õa) (let ((Öa 1)) Öa) (let ((×a 1)) ×a) (let ((Øa 1)) Øa) (let ((Ùa 1)) Ùa) (let ((Úa 1)) Úa) (let ((Ûa 1)) Ûa) (let ((Üa 1)) Üa) (let ((Ýa 1)) Ýa) (let ((Þa 1)) Þa) (let ((ßa 1)) ßa) (let ((àa 1)) àa) (let ((áa 1)) áa) (let ((âa 1)) âa) (let ((ãa 1)) ãa) (let ((äa 1)) äa) (let ((åa 1)) åa) (let ((æa 1)) æa) (let ((ça 1)) ça) (let ((èa 1)) èa) (let ((éa 1)) éa) (let ((êa 1)) êa) (let ((ëa 1)) ëa) (let ((ìa 1)) ìa) (let ((ía 1)) ía) (let ((îa 1)) îa) (let ((ïa 1)) ïa) (let ((ða 1)) ða) (let ((ña 1)) ña) (let ((òa 1)) òa) (let ((óa 1)) óa) (let ((ôa 1)) ôa) (let ((õa 1)) õa) (let ((öa 1)) öa) (let ((÷a 1)) ÷a) (let ((øa 1)) øa) (let ((ùa 1)) ùa) (let ((úa 1)) úa) (let ((ûa 1)) ûa) (let ((üa 1)) üa) (let ((ýa 1)) ýa) (let ((þa 1)) þa) (let ((ÿa 1)) ÿa)) 181) ;;; there are about 50 non-printing chars, some of which would probably work as well ;; (eval-string "(eval-string ...)") is not what it appears to be -- the outer call ;; still sees the full string when it evaluates, not the string that results from ;; the inner call. (let () ; from scheme bboard (define (maxlist list) (define (maxlist' l max) (if (null? l) max (if (> (car l) max) (maxlist' (cdr l) (car l)) (maxlist' (cdr l) max)))) (if (null? list) 'undef (maxlist' list (car list)))) (test (maxlist '(1 2 3)) 3) ; quote is ok in s7 if not the initial char (sort of like a number) (let ((h'a 3)) (test h'a 3)) (let ((1'2 32)) (test 1'2 32)) (let ((1'`'2 32)) (test 1'`'2 32)) (let ((1'`,@2 32)) (test 1'`,@2 32)) ; (test (define '3 32) 'error) ;define quote: syntactic keywords tend to behave badly if redefined ) (let ((|,``:,*|',## 1) (0,,&:@'>>.<# 2) (@.*0`#||\<,, 3) (*&:`&'>#,*<` 4) (*0,,`&|#*:`> 5) (>:|<*.<@:\|` 6) (*',>>:.'@,** 7) (0|.'@<<:,##< 8) (<>,\',\.>>#` 9) (@#.>|&#&,\0* 10) (0'.`&<','<<. 11) (&@@*<*\'&|., 12) (|0*&,':|0\** 13) (<:'*@<>*,<&` 14) (>@<@<|>,`&'. 15) (@#,00:<:@*.\ 16) (*&.`\>#&,&., 17) (0|0|`,,..<@, 18) (0@,'>\,,&.@# 19) (>@@>,000`\#< 20) (|>*'',<:&@., 21) (|>,0>0|,@'|. 22) (0,`'|'`,:`@` 23) (<>#'>,,\'.'& 24) (*..,|,.,&&@0 25)) (test (+ |,``:,*|',## 0,,&:@'>>.<# @.*0`#||\<,, *&:`&'>#,*<` *0,,`&|#*:`> >:|<*.<@:\|` *',>>:.'@,** 0|.'@<<:,##< <>,\',\.>>#` @#.>|&#&,\0* 0'.`&<','<<. &@@*<*\'&|., |0*&,':|0\** <:'*@<>*,<&` >@<@<|>,`&'. @#,00:<:@*.\ *&.`\>#&,&., 0|0|`,,..<@, 0@,'>\,,&.@# >@@>,000`\#< |>*'',<:&@., |>,0>0|,@'|. 0,`'|'`,:`@` <>#'>,,\'.'& *..,|,.,&&@0) 325)) (when full-s7test (let ((first-chars (list #\. #\0 #\@ #\! #\& #\| #\* #\< #\>)) (rest-chars (list #\. #\0 #\@ #\! #\| #\, #\# #\' #\\ #\` #\, #\: #\& #\* #\< #\>))) (let ((first-len (length first-chars)) (rest-len (length rest-chars))) (let ((n 100) (size 12)) (let ((str (make-string size #\space))) (do ((i 0 (+ i 1))) ((= i n)) (set! (str 0) (first-chars (random first-len))) (do ((k 1 (+ 1 k))) ((= k size)) (set! (str k) (rest-chars (random rest-len)))) (catch #t (lambda () (let ((val (eval-string (format #f "(let () (define ~A 3) ~A)" str str)))) (format #f "~A -> ~A~%" str val))) (lambda args (format #f "~A error: ~A~%" str args))))))))) (let ((List 1) (LIST 2) (lIsT 3) (-list 4) (_list 5) (+list 6)) (test (apply + (list List LIST lIsT -list _list +list)) 21)) (let () (define (\ arg) (+ arg 1)) (test (+ 1 (\ 2)) 4) (define (@\ arg) (+ arg 1)) (test (+ 1 (@\ 2)) 4) (define (@,\ arg) (+ arg 1)) (test (+ 1 (@,\ 2)) 4) (define (\,@\ arg) (+ arg 1)) (test (+ 1 (\,@\ 2)) 4) ) ;;; these are from the r7rs discussions (test (let ((a'b 3)) a'b) 3) ; allow variable names like "can't-go-on" or "don't-ask" (test (symbol? 'a'b'c) #t) ; these two from HN (test (let ((a 1)) (list #\)a)) (list #\) 1)) (test (let () (define (f x y) (+ x y)) (let ((a 3) (b 4)) (f a, b))) 'error) ; unbound variable a, (test (let () (define (f x y) (+ x y)) (let ((a 3) (b 4)) (f a ,b))) 'error) ; unquote outside quasiquote (test (vector? (owlet 0. 3/4 #(reader-cond))) 'error) (test (vector? #(reader-cond)) #t) ;;; -------- object->string ;;; object->string (test (string=? (object->string 32) "32") #t) (test (string=? (object->string 32.5) "32.5") #t) (test (string=? (object->string 32/5) "32/5") #t) (test (object->string 1+i) "1.0+1.0i") (test (string=? (object->string "hiho") "\"hiho\"") #t) (test (string=? (object->string 'symb) "symb") #t) (test (string=? (object->string (list 1 2 3)) "(1 2 3)") #t) (test (string=? (object->string (cons 1 2)) "(1 . 2)") #t) (test (string=? (object->string #(1 2 3)) "#(1 2 3)") #t) (test (string=? (object->string +) "+") #t) (test (object->string (object->string (object->string "123"))) "\"\\\"\\\\\\\"123\\\\\\\"\\\"\"") (test (object->string #) "#") (test (object->string (if #f #f)) "#") (test (object->string #) "#") (test (object->string _undef_) "#_asdf") (test (object->string #f) "#f") (test (object->string #t) "#t") (test (object->string ()) "()") (test (object->string #()) "#()") (test (object->string "") "\"\"") (test (object->string abs) "abs") (test (object->string :asdf) ":asdf") (test (object->string asdf:) "asdf:") (test (object->string lambda) "#_lambda") (test (object->string (lambda () a)) "#") (test (object->string (lambda a a)) "#") (test (object->string (lambda (a) a)) "#") (test (object->string (lambda (a . b) a)) "#") (test (object->string (lambda (a b) a)) "#") (test (object->string (lambda (a b c) a)) "#") (test (object->string (lambda (a b . c) a)) "#") (test (object->string (lambda* (a :rest b) a)) "#") (test (object->string (lambda* (:rest a) a)) "#") (test (object->string (lambda* (a b :rest c) a)) "#") (let () (define-macro (mac a) a) (test (object->string mac) "mac")) (let ((m (macro (a) a))) (test (object->string m) "#")) (let ((m (macro* (a) a))) (test (object->string m) "#")) (let ((m (bacro (a) a))) (test (object->string m) "#")) (let ((m (bacro* (a) a))) (test (object->string m) "#")) (let ((_?_m (define-expansion (_?_mac a) a))) (test (object->string _?_m) "_?_mac")) (let ((_?_m1 (define-expansion* (_?_mac (a 0)) a))) (test (object->string _?_m1) "_?_mac")) (test (object->string +) "+") (test (object->string +) "+") (test (object->string '''2) "''2") (test (object->string (lambda () #f)) "#") ;"#" (test (call-with-exit (lambda (return) (object->string return))) "#") (test (call/cc (lambda (return) (object->string return))) "#") (test (let () (define-macro (hi a) `(+ 1 ,a)) (object->string hi)) "hi") (test (let () (define (hi a) (+ 1 a)) (object->string hi)) "hi") (test (let () (define* (hi a) (+ 1 a)) (object->string hi)) "hi") (test (object->string dynamic-wind) "dynamic-wind") (test (object->string (dilambda (lambda () 1) (lambda (val) val))) "#") ;"#" (test (object->string object->string) "object->string") (test (object->string 'if) "if") (test (object->string begin) "#_begin") (test (object->string let) "#_let") (test (object->string #\n #f) "n") (test (object->string #\n) "#\\n") (test (object->string #\r) "#\\r") (test (object->string #\r #f) "r") (test (object->string #\t #f) "t") (test (object->string #\t) "#\\t") (test (object->string #\a) "#\\a") (test (object->string #\a #t) "#\\a") (test (object->string #\a :write) "#\\a") (test (object->string #\a #f) "a") (test (object->string #\a :display) "a") (test (object->string "a\x00;b" #t) "\"a\\x00;b\"") (test (object->string "a\x00;b" #f) "a\x00;b") (let-temporarily (((*s7* 'print-length) 3)) (test (object->string (inlet :a 1 :b 2 :c 3 :d 4)) "(inlet 'a 1 'b 2 'c 3 ...)") (test (object->string (vector 1 2 3 4)) "#(1 2 3 ...)") (test (object->string #r(1 2 3 4)) "#r(1.0 2.0 3.0 ...)") (test (object->string #i(1 2 3 4)) "#i(1 2 3 ...)") (test (object->string (list 1 2 3 4)) "(1 2 3 ...)") (test (object->string (list (list 1 2 3 4 5 6) (list 1 2 3 4 5 6) (list 1 2 3 4 5 6) (list 1 2 3 4 5 6) (list 1 2 3 4 5 6))) "((1 2 3 ...) (1 2 3 ...) (1 2 3 ...) ...)")) ;;; hash-tables with entries>1 are hard to check -- order of entries is not known (test (object->string (hash-table 'a 1) :readable) "(hash-table 'a 1)") (test (object->string (hash-table) :readable) "(hash-table)") (test (let ((h (object->string (hash-table 'a 1 'b 2) :readable))) (or (string=? h "(hash-table 'a 1 'b 2)") (string=? h "(hash-table 'b 2 'a 1)"))) #t) (test (object->string (make-float-vector '(2 3) 1)) "#r2d((1.0 1.0 1.0) (1.0 1.0 1.0))") (test (object->string (immutable! #r(0.0)) :readable) "(immutable! #r(0.0))") (test (object->string (immutable! #i(0 1)) :readable) "(immutable! #i(0 1))") (test (object->string (immutable! #u(0)) :readable) "(immutable! #u(0))") (test (let-temporarily (((*s7* 'print-length) 0)) (object->string #u(1 2 3))) "#u(...)") (test (object->string (immutable! (make-string 1001 #\space)) :readable) "(immutable! (make-string 1001 #\\space))") (test (object->string #r(1 2 3 4) :readable 4) 'error) (test (object->string #r(1 2 3 4) :readable -4) 'error) (test (object->string #r(1 2 3 4) :readable most-negative-fixnum) 'error) (test (object->string #r(1 2 3 4) :readable 40) "#r(1.0 2.0 3.0 4.0)") (test (object->string #r(1 2 3 4) :readable most-positive-fixnum) "#r(1.0 2.0 3.0 4.0)") (test (object->string #r(1 2 3 4) :readable "hi") 'error) (test (let ((s (immutable! "abc"))) (define (f) (object->string (string-append (substring s 3)) :readable)) (f)) "\"\"") #| (do ((i 0 (+ i 1))) ((= i 256)) (let ((c (integer->char i))) (let ((str (object->string c))) (if (and (not (= (length str) 3)) ; "#\\a" (or (not (char=? (str 2) #\x)) (not (= (length str) 5)))) ; "#\\xee" (format #t "(#t) ~C: ~S~%" c str)) (set! str (object->string c #f)) (if (not (= (length str) 1)) (format #t "(#f) ~C: ~S~%" c str))))) this prints: (#t) : "#\\null" (#f) : "" (#t) : "#\\x1" (#t) : "#\\x2" (#t) : "#\\x3" (#t) : "#\\x4" (#t) : "#\\x5" (#t) : "#\\x6" (#t) : "#\\x7" (#t): "#\\x8" (#t) : "#\\tab" (#t) : "#\\newline" (#t) : "#\\xb" (#t) : "#\\xc" : "#\\return" (#t) : "#\\xe" (#t) : "#\\xf" (#t) : "#\\space" |# (test (object->string #\x30) "#\\0") (test (object->string #\x91) "#\\x91") (test (object->string #\x10) "#\\x10") (test (object->string #\xff) "#\\xff") (test (object->string #\x55) "#\\U") (test (object->string #\x7e) "#\\~") (test (object->string #\newline) "#\\newline") (test (object->string #\return) "#\\return") (test (object->string #\tab) "#\\tab") (test (object->string #\null) "#\\null") (test (object->string #\space) "#\\space") (test (object->string (integer->char 8)) "#\\backspace") (test (object->string ''#\a) "'#\\a") (test (object->string (list 1 '.' 2)) "(1 .' 2)") (test (object->string (quote (quote))) "(quote)") (test (object->string (quote quote)) "quote") (test (object->string (quote (quote (quote)))) "(quote (quote))") (test (object->string) 'error) (test (object->string 1 2) 'error) (test (object->string 1 #f #t) 'error) ;(test (object->string 1 #t -123) 'error) (test (object->string 1 #t pi) 'error) (test (object->string abs) "abs") (test(let ((val 0)) (cond (else (set! val (object->string else)) 1)) val) "else") (test (cond (else (object->string else))) "else") (test (object->string (string->symbol (string #\; #\" #\)))) "(symbol \";\\\")\")") (test (object->string "hi" #f) "hi") (test (object->string "h\\i" #f) "h\\i") (test (object->string -1.(list? -1e0)) "-1.0") (test (object->string catch) "catch") (test (object->string lambda) "#_lambda") (test (object->string dynamic-wind) "dynamic-wind") (test (object->string quasiquote) "#_quasiquote") ;(test (object->string else) "else") ; this depends on previous code (test (object->string do) "#_do") (for-each (lambda (arg) (test (object->string 1 arg) 'error) (test (object->string arg) (with-output-to-string (lambda () (write arg)))) (test (object->string arg #t) (with-output-to-string (lambda () (write arg)))) (test (object->string arg #f) (with-output-to-string (lambda () (display arg))))) (list "hi" -1 #\a 1 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i () (list 1 2 3) '(1 . 2))) (test (string->symbol (object->string #(1 #\a (3)) #f)) (symbol "#(1 #\\a (3))")) (test (string->list (object->string #(1 2) #f)) '(#\# #\( #\1 #\space #\2 #\))) (test (string->list (object->string #(1 #\a (3)) #f)) '(#\# #\( #\1 #\space #\# #\\ #\a #\space #\( #\3 #\) #\))) (test (reverse (object->string #2d((1 2) (3 4)) #f)) "))4 3( )2 1((d2#") ;; write readably (this affects ~W in format as well) ;; :readable special things (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (not (eq? n obj)) (format *stderr* "~A not eq? ~A (~S)~%" n obj str))))) (list # # # #t #f #true #false else () lambda lambda* begin case if do quote set! let let* letrec cond and or define define* define-constant define-macro define-macro* define-bacro define-bacro* with-baffle *stdin* *stdout* *stderr*)) ;; :readable characters (do ((i 0 (+ i 1))) ((= i 256)) (let ((c (integer->char i))) (let ((str (object->string c :readable))) (let ((nc (with-input-from-string str (lambda () (eval (read)))))) ; no need for eval here or in some other cases, but might as well be consistent (if (not (eq? c nc)) (format *stderr* "~C (~D) != ~C (~S)~%" c i nc str)))))) ;; :readable integers (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((nn (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (integer? n)) (not (integer? nn)) (not (= n nn))) (format *stderr* "~D != ~D (~S)~%" n nn str))))) (list 0 1 3 most-positive-fixnum -0 -1 -3 most-negative-fixnum -9223372036854775808 9223372036854775807)) ;; but unless gmp at read end we'll fail with most-positive-fixnum+1 ;; -> check *features* at start of read ;; :readable ratios (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((nn (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (rational? n)) (not (rational? nn)) (not (= n nn))) (format *stderr* "~A != ~A (~S)~%" n nn str))))) (list 1/2 -1/2 123456789/2 -2/123456789 2147483647/2147483646 312689/99532 -9223372036854775808/3 9223372036854775807/2 1/1428571428571429 1/1152921504606846976)) (unless (provided? 'solaris) ;; :readable reals (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((nn (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (real? n)) (not (real? nn)) (not (equivalent? n nn))) (format *stderr* "~A != ~A (~S)~%" n nn str))))) (list 1.0 0.0 -0.0 pi 0.1 -0.1 0.9999999995 9007199254740993.1 (sqrt 2) 1/100000000000 1.5e-16 1.5e16 3.141592653589793238462643383279502884197169399375105820 1e-300 8.673617379884e-19 1/0 (- 1/0) (real-part (log 0)) (- (real-part (log 0))))) ;; :readable complex (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((nn (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (complex? n)) (not (complex? nn)) (not (equivalent? n nn))) (format *stderr* "~A != ~A (~S)~%" n nn str))))) (list 0+i 0-i 1+i 1.4+i 3.0+1.5i ; (log 0) (- (log 0)) ; (complex 1/0 1.0) (complex 1/0 1/0) (complex 1.0 1/0) ; default: nan+1i nannani 1nani! ; (complex 1/0 (real-part (log 0))) (complex (real-part (log 0)) 1/0) 1e-14+1e14i 0+1e-16i (complex pi pi)))) ;; :readable strings/byte-vectors (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (string? n)) (not (string? obj)) (not (string=? n obj))) (format *stderr* "~S not string=? ~S (~S)~%" n obj str))))) (list "" "abc" (string #\newline) "#" "a\"b\"c" "a\\b\nc" "aBc" (let ((s (make-string 4 #\space))) (set! (s 3) #\null) s) ; writes as " \x00" "ab c" (string #\a #\b #\null #\c #\escape #\newline) (string #\x (integer->char #xf0) #\x) (string #\null) ;#u() #u(0 1 2 3) (let ((str (make-string 256 #\null))) (do ((i 0 (+ i 1))) ((= i 256) str) (set! (str i) (integer->char i)))))) ;; :readable symbols/keywords (catch #t (lambda() (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (symbol? n)) (not (symbol? obj)) (not (eq? n obj))) (format *stderr* "~A not eq? ~A (~S)~%" n obj str))))) (list 'abc :abc abc: (symbol "a") (symbol "#<>") (gensym "|") (gensym "#<>") (gensym "}") ':: ':abc (gensym "\\")))) (lambda (type info) (format *stderr* "readable symbols: ~A ~A~%" type info))) ;; :readable environments (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (let? n)) (not (let? obj)) (not (equal? n obj))) (format *stderr* "~A not equal?~%~A~% (~S)~%" n obj str))))) (list (inlet '(a . 1)) (inlet) (rootlet) (inlet (cons 't12 "12") (cons (symbol "#<") 12)) (inlet 'a 1 'a 2))) ;(test (object->string (list (owlet)) :readable) "(list (owlet))") ;; :readable hash-tables (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (hash-table? n)) (not (hash-table? obj)) (not (equal? n obj))) (format *stderr* ";readable hash-tables, ~A not equal? ~A (~S)~%" n obj str))))) (list (hash-table 'a 1) (hash-table 'a 1 'b "hi") (let ((ht (make-hash-table 31))) (set! (ht 1) 321) (set! (ht 2) 123) ht) (let ((ht (make-hash-table))) (set! (ht 'b) 1) (set! (ht 'a) ht) ht) ;(let ((ht (make-hash-table))) (set! (ht ht) 123) ht) ;(let ((ht (make-hash-table))) (set! (ht ht) ht) ht) (hash-table))) ;; :readable vectors (let-temporarily (((*s7* 'print-length) 8)) (for-each (lambda (p) (set! (*s7* 'print-length) p) (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (vector? n)) (not (vector? obj)) (not (equal? n obj))) (format *stderr* ";readable vectors, ~A not equal? ~A (~S)~%" n obj str))))) (list #() #(1) #(1 #(2)) #2d((1 2) (3 4)) #3d(((1 2 3) (4 5 6) (7 8 9)) ((9 8 7) (6 5 4) (3 2 1))) #2d() #(1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0) (let ((v (vector 1 2 3))) (set! (v 1) v) v) (let ((v (vector 1 #(2) 3))) (set! ((v 1) 0) v) v) (let ((v #2d((1 2 3) (4 5 6)))) (set! (v 1 1) v) v) (make-int-vector 3 0) (make-float-vector 3 0.0) (make-int-vector '(2 3) 1)))) (list 8 2 1))) (test (object->string (vector 1 2 3) :readable) "(vector 1 2 3)") (let ((v (make-vector '(2 3) #f))) (set! (v 1 0) (v 0)) (test (object->string v) "#2d((#f #f #f) (#(#f #f #f) #f #f))") (set! (v 0 1) 3) (test (object->string v) "#2d((#f 3 #f) (#(#f 3 #f) #f #f))")) ;; :readable lists (circular, dotted) (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (pair? n)) (not (pair? obj)) (not (equal? n obj))) (format *stderr* ";readable lists, ~A not equal? ~A (~S)~%" n obj str))))) (list '(1) '(1 . 2) '((1 ()) 3) '((1 2) (3 4)) '(1 2 . 3) '(1 2 3 . 4) '(()) (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst) (let ((lst (list 1 2 3))) (set-car! (cddr lst) lst) lst) )) ;; :readable macros (let () (define-macro (mac1) `(+ 1 2)) (test ((eval-string (object->string mac1 :readable))) 3) (define-macro (mac2 a) `(+ ,a 2)) (test ((eval-string (object->string mac2 :readable)) 1) 3) (define-macro* (mac3 (a 1)) `(+ ,a 2)) (test ((eval-string (object->string mac3 :readable))) 3) (define-macro (mac4 . a) `(+ ,@a 2)) (test ((eval-string (object->string mac4 :readable)) 1 3) 6) (define-macro (mac5 a b . c) `(+ ,a ,b ,@c 2)) (test ((eval-string (object->string mac5 :readable)) 1 5 3 4) 15) (define-macro (mac7 a) (let ((b (+ a 1))) `(+ ,b ,a))) (test ((eval-string (object->string mac7 :readable)) 2) 5) ) ;; :readable closures/functions/built-in (C) functions + the setters thereof (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (procedure? n)) (not (procedure? obj)) (not (equal? (procedure-source n) (procedure-source obj)))) (format *stderr* "'~A not equal? '~A (~S)~%" n obj str))))) (list abs (lambda () 1) (lambda (a) (+ a 1)) (lambda args (display args) (cdr args)) (lambda* (a b) (or a b)) (let ((a 1)) (lambda (b) (+ a b))) (let ((b 2)) (let ((a 1)) (lambda* (c . d) (display (+ a b c) *stdout*) d))) (lambda* (:rest b) b) )) (for-each (lambda (n) (let ((str (object->string n :readable))) (test ((eval-string str) 21) (n 21)))) (list (lambda (a) (+ a 1)) (lambda args (cdr args)) (lambda* (a b) (or a b)) (let ((a 1)) (lambda (b) (+ a b))) (let ((b 2)) (let ((a 1)) (lambda* (c . d) (+ a b c)))) (lambda* (:rest b) b) )) (catch #t (lambda () (let () (define* (f1 a :allow-other-keys) (+ a 1)) (let ((str (object->string f1 :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (test (f1 2 :b 3) 3) (test (obj 2) 3) (test (obj 2 :b 3) 3))))) ; too many args (lambda (type info) (format *stderr* "f1 readable write: ~A ~A~%" type info))) (when (zero? (*s7* 'debug)) (test (format #f "~W" (lambda args args)) "(lambda args args)") (test (format #f "~W" (lambda (a . b) a)) "(lambda (a . b) a)") (test (format #f "~W" (lambda* (a b :rest c) a)) "(lambda* (a b :rest c) a)") (test (format #f "~W" (lambda (a b . c) a)) "(lambda (a b . c) a)") (test (format #f "~W" (lambda* (a . b) a)) "(lambda* (a . b) a)") (test (format #f "~W" (dilambda (lambda () 1) (lambda (x) x))) "(dilambda (lambda () 1) (lambda (x) x))") (test (format #f "~W" (dilambda (lambda (a . b) 1) (lambda (x) x))) "(dilambda (lambda (a . b) 1) (lambda (x) x))") (test (let () (define (func args) args) (format #f "~W" func)) "(lambda (args) args)") (test (let () (define func (lambda (a . b) a)) (format #f "~W" func)) "(lambda (a . b) a)") (test (let () (define func (lambda args args)) (format #f "~W" func)) "(lambda args args)") (test (format #f "~W" (define _definee_ (lambda args args))) "(lambda args args)") (test (format #f "~W" (define _definee_ (dilambda (lambda args args) (lambda args args)))) "(dilambda (lambda args args) (lambda args args))") (test (format #f "~W" (let () (define (func) (define _definee_ (dilambda (lambda args args) (lambda c c)))) (func))) "(dilambda (lambda args args) (lambda c c))")) (let () (define (f) (display #_:ho)) ; :hi initval set to abs somewhere earlier (test (object->string f :readable) "(lambda () (display #_:ho))")) (let () (define f (apply lambda (list () (list 'let (list (list (symbol "a b") 3)) (symbol "a b"))))) (test (f) 3) (test (object->string f :readable) "(lambda () (let (((symbol \"a b\") 3)) (symbol \"a b\")))")) ; which is not readable! (let () (apply define (list (symbol "a bc") 34)) (test (symbol->value (symbol "a bc")) 34)) ;; :readable ports (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (input-port? n)) (not (input-port? obj)) (not (equal? (port-closed? n) (port-closed? obj)))) (format *stderr* "~A not equal? ~A (~S)~%" n obj str) (if (and (not (port-closed? n)) (not (eq? n *stdin*)) (not (eq? n (current-input-port)))) (let ((c1 (read-char n)) (c2 (read-char obj))) (if (not (equal? c1 c2)) (format *stderr* "read-char results ~A not equal? ~A (~S)~%" c1 c2 str))))) (if (and (not (eq? n *stdin*)) (not (eq? n (current-input-port)))) (begin (close-input-port n) (close-input-port obj)))))) (list *stdin* (open-input-string "a test") (call-with-input-string "a test" (lambda (p) p)) (let ((p (open-input-string "a test"))) (read-char p) p) (call-with-input-file "s7test.scm" (lambda (p) p)) (open-input-file "write.scm") (let ((p (open-input-file "write.scm"))) (read-char p) p))) ;; :readable environments (catch #t (lambda () (for-each (lambda (n) (let ((str (object->string n :readable))) (let ((obj (with-input-from-string str (lambda () (eval (read)))))) (if (or (not (let? n)) (not (let? obj)) (not (equal? n obj))) (format *stderr* "~A not equal? ~A (~S)~%" n obj str))))) (list (rootlet) (let ((a 1)) (curlet)) (let ((a 1) (b 2)) (curlet))))) (lambda (type info) (format *stderr* "readable envs: ~A ~A~%" type info))) (when with-block (let ((b (block 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0))) (let-temporarily (((*s7* 'print-length) 2)) (test (format #f "~W" b) "(block 1 2 3 4 5 6 7 8)") (test (format #f "~A" b) "(block 1.000 2.000 ...)")))) (when (zero? (*s7* 'debug)) (test (object->string (define (ex1 a b) (+ a b)) :readable) "(lambda (a b) (+ a b))") (test (object->string (let ((c 3)) (define (ex1 a b) (+ a c b))) :readable) "(let ((c 3)) (lambda (a b) (+ a c b)))") (test (object->string (let ((c 3)) (define (ex1) (+ c 1))) :readable) "(let ((c 3)) (lambda () (+ c 1)))") (test (object->string (define* (ex1 a (b 0)) (+ a b)) :readable) "(lambda* (a (b 0)) (+ a b))") ;(test (object->string (define (ex1 a . b) (+ a b)) :readable) "(lambda (a . b) (+ a b))") (let-temporarily (((*s7* 'print-length) 4)) (define (f1) (vector-ref #(0 1 2 3 4 5 6 7 8) 2)) (test (object->string f1 :readable) "(lambda () (vector-ref #(0 1 2 3 4 5 6 7 8) 2))"))) (test (object->string (make-iterator #u(12 41 2)) :readable) "(make-iterator #u(12 41 2))") (test (object->string (let ((iter (make-iterator #u(12)))) (iter) (iter) iter) :readable) "(make-iterator #u())") (test (object->string (let ((iter (make-iterator "h"))) (iter) (iter) iter) :readable) "(make-iterator \"\")") (test (object->string (let ((iter (make-iterator #r(1)))) (iter) (iter) iter) :readable) "(make-iterator #r())") (test (object->string (let ((iter (make-iterator #i(1)))) (iter) (iter) iter) :readable) "(make-iterator #i())") (test (object->string (let ((iter (make-iterator #(1)))) (iter) (iter) iter) :readable) "(make-iterator #())") (test (object->string (let ((iter (make-iterator (hash-table)))) (iter) iter) :readable) "(make-iterator (hash-table))") (test (object->string (inlet) :readable) "(inlet)") (test (object->string (inlet 'a 1) :readable) "(inlet :a 1)") (test (object->string (inlet 'a 1 'b 2) :readable) "(inlet :a 1 :b 2)") (test (object->string (inlet 'a #\1) :readable) "(inlet :a #\\1)") (test (object->string (inlet 'a #\newline) :readable) "(inlet :a #\\newline)") (test (object->string (inlet 'a #\null) :readable) "(inlet :a #\\null)") (test (object->string (inlet 'a 3.0) :readable) "(inlet :a 3.0)") (test (object->string (inlet 'a 1/2) :readable) "(inlet :a 1/2)") (test (object->string (inlet 'a 1+i) :readable) "(inlet :a 1.0+1.0i)") (test (object->string (inlet 'a (log 0)) :readable) "(inlet :a -inf.0+3.141592653589793i)") (unless with-bignums (test (object->string (inlet 'a 1/0) :readable) "(inlet :a +nan.0)")) (test (object->string (inlet 'a "1") :readable) "(inlet :a \"1\")") (test (object->string (inlet 'a "") :readable) "(inlet :a \"\")") (test (object->string (inlet 'a #) :readable) "(inlet :a #)") (test (object->string (inlet 'a #) :readable) "(inlet :a #)") (test (object->string (inlet 'a #) :readable) "(inlet :a (begin #))") (test (object->string (inlet 'a lambda) :readable) "(inlet :a #_lambda)") (test (object->string (inlet 'a 'b) :readable) "(inlet :a 'b)") (test (object->string (inlet 'a (symbol "( a b c )")) :readable) "(inlet :a (symbol \"( a b c )\"))") (test (object->string (inlet 'a else) :readable) "(inlet :a 'else)") (test (object->string (inlet 'a (cons 1 2)) :readable) "(inlet :a (cons 1 2))") (test (object->string (inlet 'a (list 1 2)) :readable) "(inlet :a (list 1 2))") (test (object->string (inlet 'a (list "hi")) :readable) "(inlet :a (list \"hi\"))") (test (object->string (inlet 'a ()) :readable) "(inlet :a ())") (test (object->string (inlet 'a '(1 2 . 3)) :readable) "(inlet :a (cons 1 (cons 2 3)))") (test (object->string (inlet 'a #t) :readable) "(inlet :a #t)") (test (object->string (inlet 'a #f) :readable) "(inlet :a #f)") (test (object->string (inlet 'a :b) :readable) "(inlet :a :b)") (test (object->string (inlet 'a (hash-table)) :readable) "(inlet :a (hash-table))") (test (object->string (inlet 'a (hash-table 'b 1)) :readable) "(inlet :a (hash-table 'b 1))") (test (object->string (inlet 'a (hash-table 'b "hi")) :readable) "(inlet :a (hash-table 'b \"hi\"))") (test (object->string (inlet 'a (hash-table 'b "h\"i")) :readable) "(inlet :a (hash-table 'b \"h\\\"i\"))") (test (object->string (inlet 'a #()) :readable) "(inlet :a #())") (test (object->string (inlet 'a #(1 2 3)) :readable) "(inlet :a (vector 1 2 3))") (test (object->string (inlet 'a (vector "hi" #\a 'b)) :readable) "(inlet :a (vector \"hi\" #\\a 'b))") (test (object->string (inlet 'a (float-vector 1 2 3)) :readable) "(inlet :a #r(1.0 2.0 3.0))") (test (object->string (inlet 'a (int-vector 1 2 3)) :readable) "(inlet :a #i(1 2 3))") (test (object->string (inlet 'a #2d((1 2 3) (4 5 6))) :readable) "(inlet :a (subvector (vector 1 2 3 4 5 6) 0 6 '(2 3)))") (test (or (equal? (object->string (inlet 'a abs) :readable) "(inlet :a abs)") (equal? (object->string (inlet 'a abs) :readable) "(inlet :a #_abs)")) #t) (when (zero? (*s7* 'debug)) (test (object->string (inlet 'a (lambda (b) (+ b 1))) :readable) "(inlet :a (lambda (b) (+ b 1)))") (test (object->string (inlet 'a (lambda b (list b 1))) :readable) "(inlet :a (lambda b (list b 1)))") (test (object->string (inlet 'a (lambda (a . b) (list a b))) :readable) "(inlet :a (lambda (a . b) (list a b)))") (test (object->string (inlet 'a (define-macro (_m_ b) `(+ ,b 1))) :readable) "(inlet :a (macro (b) (list-values '+ b 1)))") (test (object->string (inlet 'a (define-bacro (_m_ b) `(+ ,b 1))) :readable) "(inlet :a (bacro (b) (list-values '+ b 1)))") (test (object->string (inlet 'a (macro () `(+ ,b 1))) :readable) "(inlet :a (macro () (list-values '+ b 1)))") (test (object->string (inlet 'a (bacro () `(+ ,b 1))) :readable) "(inlet :a (bacro () (list-values '+ b 1)))") (test (object->string (inlet 'a (lambda* ((b 1)) (+ b 1))) :readable) "(inlet :a (lambda* ((b 1)) (+ b 1)))") (test (object->string (inlet 'a (lambda* a (list a))) :readable) "(inlet :a (lambda a (list a)))") ; lambda* until 22-Jan-19 (test (object->string (inlet 'a (lambda* (a (b 1) c) (list a b c))) :readable) "(inlet :a (lambda* (a (b 1) c) (list a b c)))") (test (object->string (inlet 'a (define-macro* (_m_ (b 1)) `(+ ,b 1))) :readable) "(inlet :a (macro* ((b 1)) (list-values '+ b 1)))") (test (object->string (inlet 'a (define-bacro* (_m_ (b 1)) `(+ ,b 1))) :readable) "(inlet :a (bacro* ((b 1)) (list-values '+ b 1)))") (test (object->string (inlet 'a (macro (x . y) `(+ ,x ,@y))) :readable) "(inlet :a (macro (x . y) (list-values '+ x (apply-values y))))") (test (object->string (inlet 'a (bacro* (b :rest c) `(+ ,b ,@c))) :readable) "(inlet :a (bacro* (b :rest c) (list-values '+ b (apply-values c))))")) (when with-block (test (object->string (inlet 'a (block)) :readable) "(inlet :a (block))") (test (object->string (inlet 'a blocks) :readable) "(inlet :a blocks)") (test (object->string (inlet 'a (block 1 2 3)) :readable) "(inlet :a (block 1 2 3))")) (test (object->string (inlet 'a (c-pointer 0)) :readable) "(inlet :a (c-pointer 0))") (test (object->string (inlet 'a (c-pointer 1)) :readable) "(inlet :a (c-pointer 1))") (test (object->string (inlet 'a quasiquote) :readable) "(inlet :a #_quasiquote)") (when (zero? (*s7* 'debug)) (test (object->string (inlet 'a (let ((b 1)) (lambda () b))) :readable) "(inlet :a (let ((b 1)) (lambda () b)))") (test (object->string (inlet 'a (dilambda (lambda () 1) (lambda (x) x))) :readable) "(inlet :a (dilambda (lambda () 1) (lambda (x) x)))") (test (object->string (inlet 'a (let ((y 1)) (dilambda (lambda () y) (lambda (x) (set! y x))))) :readable) "(inlet :a (let ((y 1)) (dilambda (lambda () y) (lambda (x) (set! y x)))))")) (test (object->string (inlet 'a (inlet 'b 1)) :readable) "(inlet :a (inlet :b 1))") (test (object->string (inlet 'a (open-input-string "123456")) :readable) "(inlet :a (open-input-string \"123456\"))") (test (object->string (inlet 'a (let ((p (open-input-string "123456"))) (read-char p) p)) :readable) "(inlet :a (open-input-string \"23456\"))") (test (object->string (inlet 'a (let ((p (open-input-string "1"))) (read-char p) p)) :readable) "(inlet :a (open-input-string \"\"))") (test (object->string (inlet 'a (let ((p (open-input-string "1"))) (read-char p) (read-char p) p)) :readable) "(inlet :a (open-input-string \"\"))") (test (object->string (inlet 'a (call-with-input-string "1" (lambda (p) p))) :readable) "(inlet :a (call-with-input-string \"\" (lambda (p) p)))") (test (object->string (inlet 'a (let ((p (open-input-string "1"))) (close-input-port p) p)) :readable) "(inlet :a (call-with-input-string \"\" (lambda (p) p)))") (test (object->string (inlet 'a *stdin*) :readable) "(inlet :a *stdin*)") (test (object->string (inlet 'a *stdout*) :readable) "(inlet :a *stdout*)") (test (object->string (inlet 'a *stderr*) :readable) "(inlet :a *stderr*)") (test (object->string (inlet 'a (let ((p (open-output-string))) (close-output-port p) p)) :readable) "(inlet :a (let ((p (open-output-string))) (close-output-port p) p))") (test (object->string (inlet 'a (open-output-string)) :readable) "(inlet :a (let ((p (open-output-string))) p))") (test (object->string (inlet 'a (let ((p (open-output-string))) (display 32 p) p)) :readable) "(inlet :a (let ((p (open-output-string))) (display \"32\" p) p))") (test (object->string (inlet 'a (open-output-file "test.test")) :readable) "(inlet :a (open-output-file \"test.test\" \"a\"))") (test (object->string (inlet 'a (open-input-file "test.test")) :readable) "(inlet :a (open-input-file \"test.test\"))") (test (object->string (inlet 'a (make-iterator "123")) :readable) "(inlet :a (make-iterator \"123\"))") (test (object->string (inlet 'a (let ((iter (make-iterator "123"))) (iter) iter)) :readable) "(inlet :a (make-iterator \"23\"))") (test (object->string (inlet 'a (make-iterator #(1 2 3))) :readable) "(inlet :a (make-iterator (vector 1 2 3)))") (test (object->string (inlet 'a (make-iterator '(1 2 3))) :readable) "(inlet :a (make-iterator (list 1 2 3)))") (test (object->string (inlet 'a (let ((iter (make-iterator (float-vector 1 2 3)))) (iter) iter)) :readable) "(inlet :a (let ((iter (make-iterator #r(1.0 2.0 3.0)))) (iter) iter))") (let ((ok #f)) (test (begin (set! ok (eq? (rootlet) (outlet (outlet (curlet))))) #f) #f) (when (and ok (zero? (*s7* 'debug))) ; other test macros add layers here making these tests unhappy (test (object->string (let () (define (f1) (+ a 1)) (curlet)) :readable) "(sublet (sublet (inlet :ok #t)) :f1 (lambda () (+ a 1)))") (test (object->string (let () (define (f1) 1) (let () (define f2 f1) (curlet))) :readable) "(sublet (sublet (sublet (inlet :ok #t)) :f1 (lambda () 1)) :f2 (lambda () 1))") (test (object->string (let ((a 1)) (define d (let ((b 1)) (lambda (c) (+ a b c)))) (curlet)) :readable) "(sublet (sublet (inlet :ok #t)) :d (let ((b 1) (a 1)) (lambda (c) (+ a b c))) :a 1)") (test (object->string (let () (define a (let ((b 1) (c 2)) (lambda (d) (+ b c d)))) (curlet)) :readable) "(sublet (sublet (inlet :ok #t)) :a (let ((c 2) (b 1)) (lambda (d) (+ b c d))))") (test (object->string (let ((a 1)) (define d (let ((b 1)) (let ((c b)) (lambda (e) (+ a b c e))))) (curlet)) :readable) "(sublet (sublet (inlet :ok #t)) :d (let ((c 1) (b 1) (a 1)) (lambda (e) (+ a b c e))) :a 1)") (test (object->string (inlet 'a (let ((b 1)) (lambda () (+ b c)))) :readable) "(inlet :a (let ((b 1)) (lambda () (+ b c))))") (test (object->string (inlet 'a (let ((b 1)) (lambda () (+ b pi)))) :readable) "(inlet :a (let ((b 1)) (lambda () (+ b pi))))") (test (object->string (let* ((a 1) (b a)) (curlet)) :readable) ;; "(sublet (sublet (sublet (inlet :ok #t)) :a 1) :b 1)" "(sublet (sublet (inlet :ok #t)) :a 1 :b 1)") ; depends on op_let_star1 (test (object->string (let ((a 1)) (define (b c) (+ c a)) (curlet)) :readable) "(sublet (sublet (inlet :ok #t)) :b (let ((a 1)) (lambda (c) (+ c a))) :a 1)"))) (test (string? (object->string (let ((lst (list 1))) (set-cdr! lst lst) (make-iterator lst)) :readable)) #t) ;;; these are not readable: (test (object->string (inlet 'a (call-with-exit (lambda (return) return))) :readable) "(inlet :a #)") (test (object->string (inlet 'a (call/cc (lambda (return) return))) :readable) "(inlet :a #)") ;;; these are incorrect: ;(test (object->string (let () (define-constant a 32) (curlet)) :readable) "(inlet :a 32)") ;(test (object->string #('1)) "(vector '1)") ;(test (object->string (inlet 'a ''()) :readable) "(inlet :a '())") (test (object->string (c-pointer 1234) :readable) "(c-pointer 1234)") (test (string? (catch 'out-of-range (lambda () (object->string (*s7* 'gc-protected-objects) :readable)) (lambda (type info) ""))) #t) (test (object->string (*s7* 'c-objects) :readable) "#") (test (string? (object->string (*s7* 'file-names) :readable)) #t) (test (string? (object->string (*s7* 'c-types) :readable)) #t) (test (string? (object->string (*s7* 'cpu-time) :readable)) #t) (test (string? (object->string (*s7* 'catches) :readable)) #t) (test (object->string (let ((car 1)) (list #_car (list 'car))) :readable) "(list #_car (list 'car))") (let ((ht (hash-table 'a 1)) (lt (inlet :b 1)) (lst (list 1))) (set! (ht 'a) lst) (set! (lst 0) lt) (set! (lt 'b) ht) (test (object->string ht) "#1=(hash-table 'a ((inlet 'b #1#)))")) (let ((ht (hash-table 'a 1))) (fill! ht ht) (test (object->string ht) "#1=(hash-table 'a #1#)")) (let ((ht (hash-table 'a 1))) (set! (ht 'a) ht) (fill! ht (list ht)) (test (object->string ht) "#1=(hash-table 'a (#1#))")) (let ((ht (hash-table 'a 1))) (let ((lt (curlet))) (set! (ht 'a) ht) (fill! ht (list lt)) (test (object->string ht) "#1=(hash-table 'a ((inlet 'ht #1#)))"))) (if (not with-bignums) (begin (test (object->string (random-state 123 321)) "#") (test (object->string (random-state 9223372036854775807 9223372036854775807)) "#") (test (object->string (random-state 123 321) :readable) "(random-state 123 321)") (test (object->string (random-state 9223372036854775807 9223372036854775807) :readable) "(random-state 9223372036854775807 9223372036854775807)")) (begin (test (object->string (rootlet) #f (bignum "80")) "(rootlet)") (test (substring (object->string (random-state 9223372036854775807)) 0 6) "#string (random-state 9223372036854775807) :readable) "#"))) (let ((str (object->string ; "stack smashing" bug if vector_to_port buf/indices are too small (subvector (let ((<3> (vector #f #f #f)) (<1> #f) (<2> (list #f #f #f))) (set! <1> (make-iterator <2>)) (set! (<3> 0) <1>) (set! (<2> 2) <1>) <3>) 0 1 (make-list 256 1)) :readable))) (test (string-wi=? str "(let ((<3> (subvector (vector #f) 0 1 '(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1))) (<1> #f) (<2> (list #f #f #f))) (set! <1> (make-iterator <2>)) (set! (<3> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0) <1>) (set! (<2> 2) <1>) <3>)\n") #t)) (when (and with-bignums (file-exists? "libarb_s7.c")) (system "gcc -fPIC -c libarb_s7.c") (system "gcc libarb_s7.o -shared -o libarb_s7.so -lflint -larb") (load "libarb_s7.so" (inlet 'init_func 'libarb_s7_init)) (test (= (acb_bessel_j 0 1.0) 7.651976865579665514497175261026632209096E-1) #t) (test (length *arb*) 86)) (when full-s7test (let () (define (testlet e) (let ((data (cons #f #f))) (let ((iter (make-iterator e data))) (do ((val (iterate iter) (iterate iter))) ((iterator-at-end? iter)) (let ((sym (car val)) (fnc (cdr val))) (if (procedure? fnc) (let ((sig (catch #t (lambda () (signature fnc)) (lambda args #f))) (doc (catch #t (lambda () (documentation fnc)) (lambda args #f))) (src (catch #t (lambda () (procedure-source fnc)) (lambda args #f))) (ari (catch #t (lambda () (arity fnc)) (lambda args #f)))) (let ((lst (list sym fnc sig doc src ari))) (object->string lst) (object->string lst :readable))) (begin (object->string val) (object->string val :readable)))))))) (testlet (rootlet)) (require libc.scm) (testlet *libc*) (require libm.scm) (when (defined? '*libm*) (testlet *libm*)) (test (load (append "/home/" username "/cl/libm_s7.so") (inlet 'init_func 'libm_s7_init)) #f) ; check full-filename with absolute path (require libgsl.scm) (when (defined? '*libgsl*) (testlet *libgsl*)) (require libgdbm.scm) (when (defined? '*libgdbm*) (testlet *libgdbm*)) (require libdl.scm) (when (defined? '*libdl*) (testlet *libdl*)) (unless (provided? 'osx) (require libutf8proc.scm) (when (defined? '*libutf8proc*) (testlet *libutf8proc*))))) (let ((len 5)) (test (object->string (make-list 20) #f len) "(#...") (test (object->string (list 1 (list 2 3 4 (list 5 6 7))) #f len) "(1...") (test (object->string (make-string 20 #\a) #t len) "\"a...") (test (object->string (make-string 20 #\space) #t len) "\" ...") (test (object->string "0123456789" #f len) "01...") (test (object->string (make-string 20 #\f) #f len) "ff...") (test (object->string (make-byte-vector 20) #f len) "#u...") (test (object->string (make-vector 20 #f) #f len) "#(...") (test (object->string #2d((1 2 3) (4 5 6) (7 8 9) (10 11 12)) #f len) "#2...") (test (object->string (make-int-vector 20) #f len) "#i...") (test (object->string (make-float-vector 20) #f len) "#r...") (test (object->string (hash-table 'a 1 'b 2 'c 3 'd 4 'e 5) #f len) "(h...") (test (object->string (inlet 'a 1 'b 2 'c 3 'd 4 'e 5) #f len) "(i...")) (let ((len 0)) (test (object->string (make-list 20) #f len) "...") (test (object->string (make-string 20 #\space) #t len) "...") (test (object->string (make-byte-vector 20) #f len) "...") (test (object->string (make-vector 20 #f) #f len) "...") (test (object->string (hash-table 'a 1 'b 2 'c 3 'd 4 'e 5) #f len) "...") (test (object->string (inlet 'a 1 'b 2 'c 3 'd 4 'e 5) #f len) "...")) (test (object->string (values) :readable) (if (provided? 'debugging) "#" "#")) (test (object->string pi :readable) (if with-bignums "3.141592653589793238462643383279502884195E0" "pi")) (test (object->string +inf.0 :readable) "+inf.0") (test (object->string -inf.0 :readable) "-inf.0") (test (object->string +nan.0 :readable) "+nan.0") (if with-block (test (object->string (block pi) :readable) "(block 3.141592653589793)")) (test (object->string (log 0) :readable) "-inf.0+3.141592653589793i") (unless with-bignums (test (object->string 1/0 :readable) "+nan.0") (test (object->string 1+1/0i :readable) "1.0+nan.0i") (test (object->string -1/0-1/0i :readable) "+nan.0-nan.0i") (test (object->string 0+0/0i :readable) "0.0+nan.0i") (test (object->string (complex 1/0 (- (real-part (log 0))))) "+nan.0+inf.0i")) (test (object->string (* (log 0) (log 0)) :readable) "+inf.0-inf.0i") (test (object->string (make-iterator ()) :readable) "(make-iterator ())") (test (object->string (make-iterator (float-vector)) :readable) "(make-iterator #r())") (test (object->string (make-iterator (inlet)) :readable) "(let ((iter (make-iterator (inlet)))) iter)") (test (object->string (make-iterator (hash-table)) :readable) "(make-iterator (hash-table))") (let ((iter (make-iterator #(1)))) (iter) (test (object->string iter :readable) "(let ((iter (make-iterator (vector 1)))) (iter) iter)")) (let ((iter (make-iterator "1"))) (iter) (test (object->string iter :readable) "(make-iterator \"\")")) (let ((iter (make-iterator (inlet)))) (iter) (test (object->string iter :readable) "(make-iterator (inlet))")) (test (object->string (make-iterator (inlet 'a 1 'b 2)) :readable) "(let ((iter (make-iterator (inlet :a 1 :b 2)))) iter)") (test (let ((iter (make-iterator (inlet 'a 1 'b 2)))) (iter) (object->string iter :readable)) "(let ((iter (make-iterator (inlet :a 1 :b 2)))) (iter) iter)") (test (object->string (make-iterator (immutable! (inlet 'a 1 'b 1))) :readable) "(let ((iter (make-iterator (immutable! (inlet :a 1 :b 1))))) iter)") (test (let ((iter (make-iterator (byte-vector 1 2 3)))) (object->string iter :readable)) "(make-iterator #u(1 2 3))") (test (let ((iter (make-iterator (byte-vector 1 2 3)))) (iter) (object->string iter :readable)) "(let ((iter (make-iterator #u(1 2 3)))) (iter) iter)") (test (equivalent? (make-iterator (object->string #\newline)) (eval-string (object->string (make-iterator (object->string #\newline)) :readable))) #t) (test (equivalent? (make-iterator (format #f "~S" #\xff)) (eval-string (object->string (make-iterator (format #f "~S" #\xff)) :readable))) #t) (test (equivalent? (make-iterator "1234") (eval-string (object->string (make-iterator "1234") :readable))) #t) (when (zero? (*s7* 'debug)) (test (let ((vect (vector (lambda (a) (+ a 1))))) (object->string vect :readable)) "(vector (lambda (a) (+ a 1)))") (test (object->string (list (sublet (openlet (inlet 'abs (lambda (x) (- x)))) :allow-other-keys 1)) :readable) "(list (openlet (sublet (openlet (inlet :abs (lambda (x) (- x)))) :allow-other-keys 1)))")) (test (> (length (object->string (copy '(x) (make-vector 1024 0)) :readable)) 1000) #t) (test (object->string (float-vector +nan.0) :readable) "#r(+nan.0)") (test (> (length (let ((fv (make-float-vector 1024))) (set! (fv 2) 1.0) (object->string fv :readable))) 1000) #t) (test (object->string (openlet (immutable! (inlet 'a 1))) :readable) "(openlet (immutable! (inlet :a 1)))") (test (object->string (sublet (inlet 'a 1)) :readable) "(sublet (inlet :a 1))") (test (object->string (sublet (inlet 'a 1) 'b 2) :readable) "(sublet (inlet :a 1) :b 2)") (test (object->string (sublet (sublet (inlet 'a 1) 'b 2) 'c 3) :readable) "(sublet (sublet (inlet :a 1) :b 2) :c 3)") (test (object->string (quasiquote '2) :readable) "(list #_quote 2)") (test (object->string (quasiquote ''2) :readable) "(list #_quote (list #_quote 2))") (test (object->string (quasiquote (symbol->string 'x)) :readable) "(list 'symbol->string (list #_quote 'x))") (test (object->string (quasiquote (openlet? (list-ref -123 '#() (expt 2 32)))) :readable) "(list 'openlet? (list 'list-ref -123 (list #_quote #()) (list 'expt 2 32)))") (test (format #f "~W" (list (list 'quote 2))) "(list (list 'quote 2))") (test (format #f "~W" (list 'quote 2)) "(list 'quote 2)") (test (format #f "~S" (list 'quote 2)) "(quote 2)") (test (format #f "~{~A ~}" (list 'quote 2)) "quote 2 ") (test (equal? ''2 (list #_quote 2)) #t) (test (equivalent? ''(vector #f) (list 'quote (vector #f))) #f) (when (zero? (*s7* 'debug)) (test (format #f "~W" (map (lambda (a b) (vector a b)) (quote (quote)) (inlet 'integer? (lambda (f) #f)))) "(list (vector 'quote (cons 'integer? (lambda (f) #f))))") (test (format #f "~W" (list (list 'quote (cons 'integer? (lambda (y) #f))))) "(list (list 'quote (cons 'integer? (lambda (y) #f))))") (test (let ((lst (list (lambda (y) #f)))) (format #f "~W" (list 'quote lst))) "(list 'quote (list (lambda (y) #f)))") (test (let ((lst (list (lambda (y) #f)))) (format #f "~S" (list 'quote lst))) "(quote (#))") (test (format #f "~W" (list 'quote (lambda () #f))) "(list 'quote (lambda () #f))") (test (format #f "~W" (list 'quote 1 (lambda () #f))) "(list 'quote 1 (lambda () #f))") (test (object->string (list (let ((local 1)) (lambda (x) (+ x local)))) :readable) "(list (let ((local 1)) (lambda (x) (+ x local))))")) (test (equivalent? ''(lambda () #f) (list 'quote (lambda () #f))) #f) (test (let ((lst (list 'quote (vector #f)))) (let ((nlst (eval-string (object->string lst :readable)))) (equivalent? lst nlst))) #t) (test (let ((lst (list 'quote (lambda () #f)))) (let ((nlst (eval-string (object->string lst :readable)))) (equivalent? lst nlst))) #t) (test (object->string (symbol "12") :readable) "(symbol \"12\")") (test (object->string (symbol "-1") :readable) "(symbol \"-1\")") (test (object->string (symbol "1.0") :readable) "(symbol \"1.0\")") (test (object->string (symbol "1+i") :readable) "(symbol \"1+i\")") (test (object->string (symbol "1+") :readable) "'1+") (test (object->string (symbol "1-") :readable) "'1-") (test (object->string (symbol (object->string ''2)) :readable) "(symbol \"'2\")") (test (object->string (symbol ",x") :readable) "(symbol \",x\")") (test (string-ref (eval-string (object->string (make-string 14766 (integer->char 255)) :readable)) 0) (integer->char 255)) (test (string-ref (eval-string (object->string (make-string 14766 (integer->char 8)) :readable)) 0) (integer->char 8)) (test (string-ref (eval-string (object->string (make-string 14766 (integer->char #x7f)) :readable)) 0) (integer->char #x7f)) (test-wi (object->string (c-pointer 1 (signature +)) :readable) "(let ((<1> (list 'number?))) (set-cdr! <1> <1>) (c-pointer 1 <1> #f))") (test (equivalent? (make-iterator (sublet (openlet (inlet 'abs (lambda (x) (- x)))))) (eval-string (object->string (make-iterator (sublet (openlet (inlet 'abs (lambda (x) (- x)))))) :readable))) #t) (test (equivalent? (inlet 'allow-other-keys #u(0 1)) (eval-string (object->string (inlet 'allow-other-keys #u(0 1)) :readable))) #t) (when (zero? (*s7* 'debug)) (let () (define f1 (let ((+documentation+ "doc") (+signature+ '(#t pair?))) (lambda (a) (car a)))) (test (object->string f1 :readable) "(let ((+documentation+ \"doc\") (+signature+ (list #t 'pair?))) (lambda (a) (car a)))") (define f2 (let ((+iterator+ #t) (+setter+ 'set-car!)) (lambda (a) (car a)))) (test (object->string f2 :readable) "(let ((+iterator+ #t) (+setter+ 'set-car!)) (lambda (a) (car a)))"))) #| ;;; replace built-in object->string: (define (object->string . args) (let ((obj (car args))) (if (not (byte-vector? obj)) (apply #_object->string args) (let ((len (length obj))) (if (zero? len) "#u()" (with-output-to-string (lambda () (display "#u(") (do ((i 0 (+ i 1))) ((= i (- len 1))) (format () "#o~O " (obj i))) (format () "#o~O)" (obj (- len 1)))))))))) (display (object->string (byte-vector 10 14 18))) (newline) ;; "#u(#o12 #o16 #o22)" ;; but internal uses do not reflect this new definition |# (let ((v3 (make-vector '(2 2)))) (fill! v3 v3) (test (object->string v3) "#1=#2d((#1# #1#) (#1# #1#))") (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (display (vector-ref v3 0)))) ; -> subvector (define (hi) (func) (write-char #\space)) (with-output-to-string (lambda () (hi) (hi)))) "#(#1=#2d((#1# #1#) (#1# #1#)) #1#) #(#1=#2d((#1# #1#) (#1# #1#)) #1#) ")) (test (string? (object->string (make-list 100 (let ((<1> (list 1 #f))) (set! (<1> 1) (let (( (list #f 3))) (set-car! <1>) )) <1>)) :readable)) #t) ;;; check a pair_to_port bug (subsequent read = missing close paren) (with-input-from-string (object->string (car (list (cons (apply + (make-list 2 3)) (let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>)))) :readable) read) (with-input-from-string (object->string (car (list (cons (bignum -inf.0) (let ((<1> (inlet :a #f))) (set! (<1> :a) <1>) <1>)))) :readable) read) ;;; ---------------- readable object->string of cyclic structures ---------------- ;;; ---------------- vectors ---------------- (test-wi (let ((v (vector 1))) (set! (v 0) v) (object->string v :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>)") (test-wi (let ((v (vector 1 2 3))) (set! (v 1) v) (object->string v :readable)) "(let ((<1> (vector 1 #f 3))) (set! (<1> 1) <1>) <1>)") (test-wi (let ((v (vector 1 2 3))) (set! (v 0) v) (set! (v 2) v) (object->string v :readable)) "(let ((<1> (vector #f 2 #f))) (set! (<1> 0) <1>) (set! (<1> 2) <1>) <1>)") (test-wi (let ((v (vector 1))) (set! (v 0) v) (object->string (vector v) :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) <1>) (vector <1>))") (test-wi (let ((v (vector 1 2 3))) (set! (v 1) v) (object->string (vector 1 2 v) :readable)) "(let ((<1> (vector 1 #f 3))) (set! (<1> 1) <1>) (vector 1 2 <1>))") (test-wi (let ((v1 (vector 1)) (v2 (vector 2))) (set! (v2 0) v1) (set! (v1 0) v2) (object->string v1 :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (vector <1>)) <1>)") (test-wi (let ((v (vector #f))) (set! (v 0) (vector v)) (object->string (vector 1 v 2) :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (vector <1>)) (vector 1 <1> 2))") (test-wi (let ((v (vector #f))) (set! (v 0) (vector 1 (vector v) 2)) (object->string v :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (vector 1 (vector <1>) 2)) <1>)") (test-wi (let ((v (vector 1))) (set! (v 0) v) (object->string (immutable! v) :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) <1>) (immutable! <1>))") (test-wi (let ((v (vector #f))) (set! (v 0) (immutable! (vector v))) (object->string (vector 1 v 2) :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (immutable! (vector <1>))) (vector 1 <1> 2))") (test-wi (let ((v1 (vector #f)) (v2 (vector #f))) (set! (v1 0) v2) (set! (v2 0) v1) (object->string (vector v1 v2) :readable)) "(let ((<1> (vector #f)) (<2> (vector #f))) (set! (<1> 0) <2>) (set! (<2> 0) <1>) (vector <1> <2>))") (test-wi (let ((v1 (vector #f)) (v2 (vector #f))) (set! (v1 0) v2) (set! (v2 0) v1) (object->string v1 :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (vector <1>)) <1>)") (test-wi (let ((v (vector 1 (vector 2)))) (set! (v 0) v) (object->string v :readable)) "(let ((<1> (vector #f #f))) (set! (<1> 0) <1>) (set! (<1> 1) (vector 2)) <1>)") (test-wi (object->string (vector 1 (vector 2) 3) :readable) "(vector 1 (vector 2) 3)") (test-wi (let ((v (make-vector '(2 3) 1))) (set! (v 0 1) v) (object->string v :readable)) "(let ((<1> (subvector (vector 1 #f 1 1 1 1) 0 6 '(2 3)))) (set! (<1> 0 1) <1>) <1>)") ;;; ---------------- lets ---------------- (test-wi (let ((lt (inlet 'a 1))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (inlet :a #f))) (set! (<1> :a) <1>) <1>)") (test-wi (let ((lt (inlet 'a 1 'b 2))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (inlet :a #f :b 2))) (set! (<1> :a) <1>) <1>)") (test-wi (let ((lt (inlet 'a 1 'b 2))) (set! (lt 'a) lt) (object->string (vector lt) :readable)) "(let ((<1> (inlet :a #f :b 2))) (set! (<1> :a) <1>) (vector <1>))") (test-wi (let ((lt (inlet 'a 1 'b 2))) (set! (lt 'a) lt) (object->string (inlet 'c lt) :readable)) "(let ((<1> (inlet :a #f :b 2))) (set! (<1> :a) <1>) (inlet :c <1>))") (test-wi (let ((v (vector 1))) (set! (v 0) (inlet 'a v)) (object->string v :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (inlet :a <1>)) <1>)") (test-wi (let ((v (vector 1 2))) (set! (v 0) (inlet 'a v)) (object->string (inlet 'c v 'd 4) :readable)) "(let ((<1> (vector #f 2))) (set! (<1> 0) (inlet :a <1>)) (inlet :c <1> :d 4))") (test-wi (let ((lt (inlet 'a 1))) (set! (lt 'a) lt) (object->string (sublet lt) :readable)) "(let ((<1> (inlet :a #f))) (set! (<1> :a) <1>) (sublet <1>))") (test-wi (let ((lt (sublet (inlet 'b 2) 'a 1))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (inlet :a #f))) (set! (outlet <1>) (inlet :b 2)) (set! (<1> :a) <1>) <1>)") (test-wi (let ((lt (openlet (inlet 'a 1)))) (set! (lt 'a) lt) (object->string (immutable! lt) :readable)) "(let ((<1> (openlet (inlet :a #f)))) (set! (<1> :a) <1>) (immutable! <1>) <1>)") (test-wi (let ((lt1 (inlet 'a 1)) (lt2 (inlet 'b 1))) (set! (lt1 'a) lt2) (set! (lt2 'b) lt1) (object->string (vector lt1 lt2) :readable)) "(let ((<1> (inlet :a #f)) (<2> (inlet :b #f))) (set! (<1> :a) <2>) (set! (<2> :b) <1>) (vector <1> <2>))") (test-wi (object->string (inlet 'a (inlet 'b 1) 'b 2) :readable) "(inlet :a (inlet :b 1) :b 2)") (test-wi (object->string (inlet (symbol "(\")") 1) :readable) "(inlet (symbol \"(\\\")\") 1)") (test-wi (object->string (hash-table (symbol "(\")") 1) :readable) "(hash-table (symbol \"(\\\")\") 1)") (test-wi (object->string (vector (symbol "(\")") 1) :readable) "(vector (symbol \"(\\\")\") 1)") (test-wi (object->string (inlet (symbol "(\")") (symbol "(\")")) :readable) "(inlet (symbol \"(\\\")\") (symbol \"(\\\")\"))") (test-wi (object->string (let ((<1> (inlet :a #f))) (set! (<1> :a) (hash-table 'b <1>)) <1>) :readable) "(let ((<1> (inlet :a #f))) (set! (<1> :a) (hash-table 'b <1>)) <1>)") (test-wi (object->string (let ((lt (inlet (symbol "(\")") 1))) (set! (lt (symbol "(\")")) lt) lt) :readable) "(let ((<1> (inlet (symbol \"(\\\")\") #f))) (set! (<1> (symbol \"(\\\")\")) <1>) <1>)") (test-wi (object->string (let ((<1> (inlet (symbol "(\")") #f))) (set! (<1> (symbol "(\")")) (hash-table 'b <1>)) <1>) :readable) "(let ((<1> (inlet (symbol \"(\\\")\") #f))) (set! (<1> (symbol \"(\\\")\")) (hash-table 'b <1>)) <1>)") (test (object->string (inlet 'a 1) :readable) "(inlet :a 1)") (test (object->string (inlet 'a 1 'b 2) :readable) "(inlet :a 1 :b 2)") (let ((I1 (let ((a 1)) (immutable! 'a) (curlet)))) (test (object->string I1 :readable) "(let ((a 1)) (immutable! 'a) (curlet))")) (test (object->string (with-let (inlet 'a 1) (immutable! 'a) (curlet)) :readable) "(let ((a 1)) (immutable! 'a) (curlet))") (test (object->string (with-let (inlet 'a 1 'b 2) (immutable! 'a) (immutable! 'b) (curlet)) :readable) "(let ((a 1) (b 2)) (immutable! 'a) (immutable! 'b) (curlet))") (let ((I1 (openlet (immutable! (let ((a 1) (b 0)) (immutable! 'a) (set! (setter 'b) (lambda (s v) (abs v))) (curlet)))))) (test (object->string I1 :readable) "(openlet (immutable! (let ((a 1) (b 0)) (set! (setter 'b) (lambda (s v) (abs v))) (immutable! 'a) (curlet))))")) (let ((I1 (let ((a 1) (b 0)) (set! (setter 'a) (lambda (s v) (abs v))) (set! (setter 'b) (lambda (s v) (abs v))) (curlet)))) (test (object->string I1 :readable) "(let ((a 1) (b 0)) (set! (setter 'a) (lambda (s v) (abs v))) (set! (setter 'b) (lambda (s v) (abs v))) (curlet))")) (let ((I1 (let ((a (let ((L (list 1))) (set-cdr! L L)))) (immutable! 'a) (curlet)))) (test-wi (object->string I1 :readable) "(let ((<1> (list 1))) (set-cdr! <1> <1>) (let ((a <1>)) (immutable! 'a) (curlet)))")) (test-wi (let ((lt (inlet 'a 1))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (inlet :a #f))) (set! (<1> :a) <1>) <1>)") (test-wi (let ((lt (inlet 'a 1 'b 0))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (inlet :a #f :b 0))) (set! (<1> :a) <1>) <1>)") (test-wi (let ((lt (let ((a 1) (b 0)) (immutable! 'b) (curlet)))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (let ((a #f) (b 0)) (immutable! 'b) (curlet)))) (set! (<1> :a) <1>) <1>)") (test-wi (let ((lt (let ((a 1) (b 0)) (set! (setter 'a) let?) (immutable! 'b) (curlet)))) (set! (lt 'a) lt) (object->string lt :readable)) "(let ((<1> (let ((a #f) (b 0)) (set! (setter 'a) let?) (immutable! 'b) (curlet)))) (set! (<1> :a) <1>) <1>)") (let* ((H (hash-table)) (I (openlet (inlet 'a H))) (V (make-vector 4 I))) (set! (H (subvector V 0 4 '(2 2))) I) (test-wi (format #f "~W~%" H) "(let ((<1> (hash-table)) (<2> (openlet (inlet :a #f)))) (set! (<1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2))) <2>) (set! (<2> :a) <1>) <1>)")) (let* ((H (hash-table)) (I (immutable! (openlet (inlet 'a H)))) (V (make-vector 4 I))) (set! (H (subvector V 0 4 '(2 2))) I) (test-wi (format #f "~W~%" H) "(let ((<1> (hash-table)) (<2> (openlet (inlet :a #f)))) (set! (<1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2))) <2>) (set! (<2> :a) <1>) (immutable! <2>) <1>)") (test (format #f "~S" (eval-string (format #f "~W" H))) (format #f "~S" H)) (test H (eval-string (format #f "~W" H)))) (let* ((H (hash-table)) (I (immutable! (inlet 'a H))) (V (make-vector 4 I))) (set! (H (subvector V 0 4 '(2 2))) I) (test-wi (format #f "~W~%" H) "(let ((<1> (hash-table)) (<2> (inlet :a #f))) (set! (<1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2))) <2>) (set! (<2> :a) <1>) (immutable! <2>) <1>)")) (let* ((P (list 1)) (I (inlet 'a P)) (V (make-vector 4 I))) (set-car! P (subvector V 0 4 '(2 2))) (test-wi (format #f "~W~%" P) "(let ((<1> (list #f)) (<2> (inlet :a #f))) (set-car! <1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2))) (set! (<2> :a) <1>) <1>)")) (let* ((P (list 1)) (I (openlet (inlet 'a P))) (V (make-vector 4 I))) (set-car! P (subvector V 0 4 '(2 2))) (test-wi (format #f "~W~%" P) "(let ((<1> (list #f)) (<2> (openlet (inlet :a #f)))) (set-car! <1> (subvector (vector <2> <2> <2> <2>) 0 4 '(2 2))) (set! (<2> :a) <1>) <1>)")) (let* ((P (list 1)) (I (immutable! (openlet (inlet 'a P)))) (V (immutable! (make-vector 4 I)))) (set-car! P (subvector V 0 4 '(2 2))) (test-wi (format #f "~W~%" P) "(let ((<1> (list #f)) (<2> (openlet (inlet :a #f)))) (set-car! <1> (subvector (immutable! (vector <2> <2> <2> <2>)) 0 4 '(2 2))) (set! (<2> :a) <1>) (immutable! <2>) <1>)")) (when (zero? (*s7* 'debug)) (test-wi (object->string (let ((i 0)) (set! (setter 'i) integer?) (curlet)) :readable) "(let ((i 0)) (set! (setter 'i) #_integer?) (curlet))")) (let ((lt (let ((i 0) (inner #f)) (set! (setter 'i) integer?) (curlet)))) (set! (lt 'inner) lt) (test-wi (object->string lt :readable) "(let ((<1> (let ((i 0) (inner #f)) (set! (setter 'i) #_integer?) (curlet)))) (set! (<1> :inner) <1>) <1>)")) (let ((lt (let ((i 0) (inner #f)) (curlet)))) (set! (lt 'inner) lt) (test-wi (object->string lt :readable) "(let ((<1> (inlet :i 0 :inner #f))) (set! (<1> :inner) <1>) <1>)")) (test-wi (object->string (let ((i 0) (inner #f)) (set! inner 32) (curlet)) :readable) "(inlet :i 0 :inner 32)") ;;; ---------------- c-pointers ---------------- (test-wi (let ((v (vector 1))) (let ((p (c-pointer 1 v))) (set! (v 0) p) (object->string p :readable))) "(let ((<1> #f) (<2> (vector #f))) (set! <1> (c-pointer 1 <2> #f)) (set! (<2> 0) <1>) <1>)") (test-wi (let ((v (vector 1))) (let ((p (c-pointer 1 #f v))) (set! (v 0) p) (object->string p :readable))) "(let ((<1> #f) (<2> (vector #f))) (set! <1> (c-pointer 1 #f <2>)) (set! (<2> 0) <1>) <1>)") (test-wi (let ((v (vector 1))) (let ((p (c-pointer 1 v v))) (set! (v 0) p) (object->string p :readable))) "(let ((<1> #f) (<2> (vector #f))) (set! <1> (c-pointer 1 <2> <2>)) (set! (<2> 0) <1>) <1>)") (test-wi (object->string (c-pointer 1 (c-pointer 2)) :readable) "(c-pointer 1 (c-pointer 2) #f)") (test-wi (let ((v (vector 1)) (i (inlet 'a 1))) (let ((p (c-pointer 0 v i))) (set! (v 0) p) (set! (i :a) p) (object->string p :readable))) "(let ((<1> #f) (<2> (vector #f)) (<3> (inlet :a #f))) (set! <1> (c-pointer 0 <2> <3>)) (set! (<2> 0) <1>) (set! (<3> :a) <1>) <1>)") (test-wi (let ((v (vector 1)) (i (inlet 'a 1))) (set! (v 0) i) (set! (i :a) v) (object->string (c-pointer 0 v i) :readable)) "(let ((<1> (vector #f)) (<2> (inlet :a #f))) (set! (<1> 0) <2>) (set! (<2> :a) <1>) (c-pointer 0 <1> <2>))") ;;; ---------------- hash-tables ---------------- (test-wi (let ((ht (hash-table 'a 1))) (set! (ht 'a) ht) (object->string ht :readable)) "(let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>)") (test-wi (let ((ht1 (hash-table 'a 1)) (ht2 (hash-table 'b 1))) (set! (ht1 'a) ht2) (set! (ht2 'b) ht1) (object->string ht1 :readable)) "(let ((<1> (hash-table))) (set! (<1> 'a) (hash-table 'b <1>)) <1>)") (test-wi (object->string (hash-table 'a (hash-table 'b 2)) :readable) "(hash-table 'a (hash-table 'b 2))") (test-wi (let ((ht (hash-table 'a (vector 1)))) (set! ((ht 'a) 0) ht) (object->string ht :readable)) "(let ((<1> (hash-table))) (set! (<1> 'a) (vector <1>)) <1>)") (test-wi (let ((v (vector (hash-table 'a 1)))) (set! ((v 0) 'a) v) (object->string v :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (hash-table 'a <1>)) <1>)") (test-wi (let ((h (hash-table 'a 1)) (v (vector 1))) (set! (v 0) h) (set! (h 'a) v) (object->string h :readable)) "(let ((<1> (hash-table))) (set! (<1> 'a) (vector <1>)) <1>)") (test-wi (let ((h (hash-table 'a 1)) (v (vector 1))) (set! (v 0) h) (set! (h 'a) v) (object->string v :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (hash-table 'a <1>)) <1>)") (test-wi (let ((h1 (hash-table 'a 1)) (h2 (hash-table 'b 2)) (v (vector 1))) (set! (v 0) h1) (set! (h1 'a) h2) (set! (h2 'b) v) (object->string v :readable)) "(let ((<1> (vector #f))) (set! (<1> 0) (hash-table 'a (hash-table 'b <1>))) <1>)") (test-wi (let ((h1 (hash-table 'a 1)) (h2 (hash-table 'b 2)) (v (vector 1 2 3))) (set! (h1 'a) v) (set! (h2 'b) v) (set! (v 0) h1) (set! (v 1) h2) (set! (v 2) v) (object->string v :readable)) "(let ((<1> (vector #f #f #f))) (set! (<1> 0) (hash-table 'a <1>)) (set! (<1> 1) (hash-table 'b <1>)) (set! (<1> 2) <1>) <1>)") (test-wi (let ((v (vector 1))) (let ((h (hash-table v 1))) (set! (v 0) h) (object->string h :readable))) "(let ((<1> (hash-table))) (set! (<1> (vector <1>)) 1) <1>)") ;;; ---------------- iterators ---------------- (test-wi (let ((v (vector 1))) (let ((p (make-iterator v))) (set! (v 0) p) (object->string p :readable))) "(let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>)") (test-wi (let ((v (vector 1))) (let ((p (make-iterator v))) (set! (v 0) v) (object->string p :readable))) "(let ((<1> (vector #f))) (set! (<1> 0) <1>) (make-iterator <1>))") (test-wi (object->string (make-iterator (vector 1 2)) :readable) "(make-iterator (vector 1 2))") ;;; ---------------- pairs ---------------- (test-wi (let ((L (list 1))) (set-cdr! L L) (object->string L :readable)) "(let ((<1> (list 1))) (set-cdr! <1> <1>) <1>)") (test-wi (let ((L (list 1 2))) (set-cdr! (cdr L) L) (object->string L :readable)) "(let ((<1> (list 1 2))) (set-cdr! (cdr <1>) <1>) <1>)") (test-wi (let ((L (list 1))) (set-car! L L) (object->string L :readable)) "(let ((<1> (list #f))) (set-car! <1> <1>) <1>)") (test-wi (let ((L (list 1))) (set-car! L L) (set-cdr! L L) (object->string L :readable)) "(let ((<1> (list #f))) (set-car! <1> <1>) (set-cdr! <1> <1>) <1>)") (test-wi (let ((L (list 1 (vector 2) 3))) (set-cdr! (cddr L) L) (object->string L :readable)) "(let ((<1> (list 1 (vector 2) 3))) (set-cdr! (list-tail <1> 2) <1>) <1>)") (test-wi (let ((L (list (vector 1)))) (set! (L 0 0) L) (object->string L :readable)) "(let ((<1> (list #f))) (set-car! <1> (vector <1>)) <1>)") (test-wi (let ((lst (list 1 2))) (set! (cdr (cdr lst)) (cdr lst)) (object->string lst :readable)) "(let ((<1> (list 2))) (set-cdr! <1> <1>) (let (( (list 1))) (set-cdr! <1>) ))") (test-wi (let ((L (list 1 2 3))) (set-cdr! (cddr L) (cdr L)) (object->string L :readable)) "(let ((<1> (list 2 3))) (set-cdr! (cdr <1>) <1>) (let (( (list 1))) (set-cdr! <1>) ))") (test-wi (let ((L (list 1 (list 2 3)))) (set-car! L L) (object->string L :readable)) "(let ((<1> (list #f (list 2 3)))) (set-car! <1> <1>) <1>)") (test-wi (let ((L (list 1 (list 2 3)))) (set-car! (cadr L) L) (object->string L :readable)) "(let ((<1> (list 1 #f))) (set! (<1> 1) (let (( (list #f 3))) (set-car! <1>) )) <1>)") (test-wi (let ((L (cons 1 (cons 2 3)))) (set-car! L L) (object->string L :readable)) "(let ((<1> (list #f 2))) (set-car! <1> <1>) (set-cdr! (cdr <1>) 3) <1>)") (test-wi (let ((L (cons 1 (cons 2 (cons 3 (cons 4 5)))))) ; #1=(#1# 2 3 4 . 5) (set-car! L L) (object->string L :readable)) "(let ((<1> (list #f 2 3 4))) (set-car! <1> <1>) (set-cdr! (list-tail <1> 3) 5) <1>)") (test-wi (let ((L (list 1 (list 2 (list 3 4))))) ; #1=(1 (#1# (#1# 4))) (set-car! (cadr L) L) (set-car! (cadadr L) L) (object->string L :readable)) "(let ((<1> (list 1 #f))) (set! (<1> 1) (let (( (list #f #f))) (set-car! <1>) (set! ( 1) (let (( (list #f 4))) (set-car! <1>) )) )) <1>)") (test-wi (let ((vect (vector 1 2 3))) (let ((lst (list 1 vect 3))) (set! (vect 1) lst) (object->string lst :readable))) "(let ((<1> (list 1 #f 3))) (set! (<1> 1) (vector 1 <1> 3)) <1>)") (test-wi (let ((L (list 1))) (set-cdr! L L) (object->string (immutable! L) :readable)) "(let ((<1> (list 1))) (set-cdr! <1> <1>) (immutable! <1>))") (test-wi (object->string (immutable! (list 1)) :readable) "(immutable! (cons 1 ()))") (test-wi (let ((lst (list 1 2 3)) (hash (hash-table 'a 1)) (lt (inlet 'a 1 'b 2))) (set! (lst 0) lt) (set! (lt 'a) hash) (set! (lt 'b) lst) (set! (hash 'a) lst) (object->string lst :readable)) "(let ((<1> (list #f 2 3))) (set-car! <1> (inlet :a (hash-table 'a <1>) :b <1>)) <1>)") ;;; ---------------- (test-wi (let ((v (vector 1 2 3)) (lt (inlet 'a 1 'c 2))) (set! (v 1) lt) (set! (v 2) v) (set! (lt 'c) lt) (object->string v :readable)) "(let ((<2> (vector 1 #f #f)) (<1> (inlet :a 1 :c #f))) (set! (<2> 1) <1>) (set! (<2> 2) <2>) (set! (<1> :c) <1>) <2>)") (test-wi (let ((L (list 1 2 3)) (V (vector 1 2 3))) (set-car! L L) (set! (V 1) V) (set! (L 2) V) (object->string L :readable)) "(let ((<1> (list #f 2 #f)) (<2> (vector 1 #f 3))) (set-car! <1> <1>) (set! (<1> 2) <2>) (set! (<2> 1) <2>) <1>)") (test-wi (let ((v (vector (hash-table 'a 1) (signature ''2)))) (object->string v :readable)) "(let ((<1> (list 'integer?))) (set-cdr! <1> <1>) (vector (hash-table 'a 1) (let (( (list #t 'pair?))) (set-cdr! (cdr ) <1>) )))") (when (zero? (*s7* 'debug)) (test-wi (object->string (list-values (lambda (a) (values a (+ a 1))) (signature #i(0))) :readable) ; (# (integer? int-vector? . #1=(integer? . #1#))) "(let ((<1> (list 'integer?))) (set-cdr! <1> <1>) (let (( (list (lambda (a) (values a (+ a 1))) #f))) (set! ( 1) (let (( (list 'integer? 'int-vector?))) (set-cdr! (cdr ) <1>) )) ))")) ; (# (integer? int-vector? . #1=(integer? . #1#))) (test-wi (object->string (list '((1 (2)) (((3) 4))) (signature (make-vector '(2 3)))) :readable) ; (((1 (2)) (((3) 4))) (#t vector? . #1=(integer? . #1#))) "(let ((<1> (list 'integer?))) (set-cdr! <1> <1>) (let (( (list (list (list 1 (list 2)) (list (list (list 3) 4))) #f))) (set! ( 1) (let (( (list #t 'vector?))) (set-cdr! (cdr ) <1>) )) ))") ; (((1 (2)) (((3) 4))) (#t vector? . #1=(integer? . #1#))) (let ((str (object->string (let ((v (make-vector 3 #f)) ; #1=#(#f (hash-table 'a 1 'c #2=(inlet 'a #1# 'b 2 'c 3) 'b #2#) #f) (h (hash-table 'b 2 'c 3)) (e (inlet 'a 1))) (set! (h 'b) e) (set! (v 1) h) (set! (e :a) v) (set! (h 'c) e) v) :readable))) (test (or (string-wi=? str "(let ((<1> (vector #f #f #f)) (<2> (inlet :a #f))) (set! (<1> 1) (hash-table 'c <2> 'b <2>)) (set! (<2> :a) <1>) <1>)") ; #1=#(#f (hash-table 'a 1 'c #2=(inlet 'a #1#) 'b #2#) #f) (string-wi=? str "(let ((<1> (vector #f #f #f)) (<2> (inlet :a #f))) (set! (<1> 1) (hash-table 'b <2> 'c <2>)) (set! (<2> :a) <1>) <1>)")) #t)) (let* ((obj (let ((v (make-vector 3 #f)) (h (hash-table 'a 1 'b 2 'c 3)) (e (inlet 'a 1 'b 2 'c 3))) (set! (e :c) h) (set! (e :a) v) (set! (v 0) e) (set! (h 'b) h) v)) (str (object->string obj :readable))) ; #2=#((inlet 'a #2# 'b 2 'c #1=(hash-table 'a 1 'c 3 'b #1#)) #f #f) (test obj (eval-string str))) (test-wi (object->string (list-values `(x . 1) (signature (int-vector 1))) :readable) ; ((x . 1) (integer? int-vector? . #1=(integer? . #1#))) "(let ((<1> (list 'integer?))) (set-cdr! <1> <1>) (let (( (list (cons 'x 1) #f))) (set! ( 1) (let (( (list 'integer? 'int-vector?))) (set-cdr! (cdr ) <1>) )) ))") ; ((x . 1) (integer? int-vector? . #1=(integer? . #1#))) (test-wi (object->string (let ((L (list (c-pointer 1) (vector 1) (inlet :a 1) (hash-table 'a 1) (make-iterator (list 1))))) (set-cdr! (list-tail L 4) L) L) :readable) "(let ((<1> (list (c-pointer 1) (vector 1) (inlet :a 1) (hash-table 'a 1) (make-iterator (list 1))))) (set-cdr! (list-tail <1> 4) <1>) <1>)") (let ((str (let ((p (make-list 3 #f)) (h (hash-table 'a 1 'b 2)) (it (make-iterator (make-list 3 #f))) (cp (c-pointer 1 (make-list 3 #f)))) (set! (h 'a) cp) (set! (((object->let cp) 'c-type) 1) cp) (set! ((iterator-sequence it) 0) h) (object->string it :readable)))) (test (or (string-wi=? str "(let ((<4> (list #f #f #f)) (<3> (hash-table)) (<1> #f) (<2> (list #f #f #f))) (set! <1> (c-pointer 1 <2> #f)) (set-car! <4> <3>) (set! (<3> 'a) <1>) (set! (<3> 'b) 2) (set! (<2> 1) <1>) (make-iterator <4>))") (string-wi=? str "(let ((<4> (list #f #f #f)) (<3> (hash-table)) (<1> #f) (<2> (list #f #f #f))) (set! <1> (c-pointer 1 <2> #f)) (set-car! <4> <3>) (set! (<3> 'b) 2) (set! (<3> 'a) <1>) (set! (<2> 1) <1>) (make-iterator <4>))")) #t)) (test-wi (let ((e (inlet 'a 1 'b 2 'c 3)) (it (make-iterator (make-list 3 #f))) (cp (c-pointer 1 (make-list 3 #f)))) (set! (((object->let cp) 'c-type) 1) cp) (set! (e :a) cp) (set! ((iterator-sequence it) 0) e) (object->string it :readable)) "(let ((<4> (list #f #f #f)) (<3> (inlet :a #f :b 2 :c 3)) (<1> #f) (<2> (list #f #f #f))) (set! <1> (c-pointer 1 <2> #f)) (set-car! <4> <3>) (set! (<3> :a) <1>) (set! (<2> 1) <1>) (make-iterator <4>))") (test-wi (let ((p (make-list 3 #f)) (v (make-vector 3 #f)) (h (hash-table 'a 1)) (e (inlet 'a 1 'b 2)) (it (make-iterator (make-list 3 #f))) (cp (c-pointer 1 (make-list 3 #f)))) (set! (((object->let cp) 'c-type) 0) it) (set! ((iterator-sequence it) 0) e) (set! (e :a) h) (set! (h 'a) v) (set! (v 0) p) (set! (p 0) cp) (object->string p :readable)) "(let ((<1> (list #f #f #f)) (<3> (list #f #f #f)) (<2> (list #f #f #f))) (set-car! <1> (c-pointer 1 <3> #f)) (set-car! <3> (make-iterator <2>)) (set-car! <2> (inlet :a (hash-table 'a (vector <1> #f #f)) :b 2)) <1>)") (when (zero? (*s7* 'debug)) (test-wi (object->string (list (lambda (f) #f) (let ((<1> (vector #f))) (set! (<1> 0) <1>) <1>)) :readable) "(let ((<1> (vector #f))) (set! (<1> 0) <1>) (let (( (list (lambda (f) #f) #f))) (set! ( 1) <1>) ))")) ;; dotted cyclic lists (let ((L (cons #f #f))) (let ((M (list L 2))) (set-cdr! (cdr M) L) (set-car! L M)) (test-wi (format #f "~W" L) "(let ((<1> (list #f))) (set-car! <1> (let (( (list #f 2))) (set-car! <1>) (set-cdr! (cdr ) <1>) (set-cdr! (list-tail 2) #f) )) (set-cdr! <1> #f) <1>)") (test (format #f "~S" L) (format #f "~S" (eval-string (format #f "~W" L))))) (let ((L (cons #f (cons #f #f)))) (let ((M (list L 2))) (set-cdr! (cdr M) L) (set-car! L M)) (test (format #f "~S" L) (format #f "~S" (eval-string (format #f "~W" L))))) (let ((L (cons #f (cons #f (cons #f #f))))) (let ((M (list L 2))) (set-cdr! (cdr M) L) (set-car! (cdr L) M)) (test (format #f "~S" L) (format #f "~S" (eval-string (format #f "~W" L))))) (let ((L (cons #f (cons #f (cons #f #f))))) (let ((M (list L 2))) (set-cdr! (cdr M) L) (set-car! L M) (set-car! (cdr L) M)) (test (format #f "~S" L) (format #f "~S" (eval-string (format #f "~W" L))))) (when (zero? (*s7* 'debug)) (test-wi (let ((v (vector #f))) (define (fv) (vector-ref v 0)) (set! (v 0) fv) (object->string fv :readable)) "(lambda () (vector-ref v 0))")) ; wrong but at least it doesn't loop -- should we try to handle this? (test (let ((v (vector #f))) (define (fv) (vector-ref v 0)) (define (fy) (vector-ref v 0)) (set! (v 0) fv) (equivalent? fv fy)) #t) (let () (define sf (let ((object->string (lambda (obj . arg) "#"))) (openlet (lambda (x) (+ x 1))))) (test (sf 1) 2) (test (object->string sf) "#")) (let () (define m1 (let ((object->string (lambda (obj . arg) "#"))) (openlet (macro (x) `(+ ,x 1))))) (test (m1 1) 2) (test (object->string m1) "#")) (let () (define lt (let ((a 1)) (set! a (curlet)) a)) (test (object->string lt) "#1=(inlet 'a #1#)") (test-wi (object->string lt :readable) ; the outlet set below is probably not needed "(let ((<1> (inlet :a #f))) (set! (outlet <1>) (inlet :lt <1>)) (set! (<1> :a) <1>) <1>)")) ;;; -------------------------------------------------------------------------------- ;;; CONTROL OPS ;;; -------------------------------------------------------------------------------- (define control-ops (list lambda define quote if begin set! let let* letrec cond case and or do call/cc eval apply for-each map values call-with-values dynamic-wind)) (for-each (lambda (op) (if (not (eq? op op)) (format #t "~A not eq? to itself?~%" op))) control-ops) (for-each (lambda (op) (if (not (eqv? op op)) (format #t "~A not eqv? to itself?~%" op))) control-ops) (for-each (lambda (op) (if (not (equal? op op)) (format #t "~A not equal? to itself?~%" op))) control-ops) (define question-ops (list boolean? eof-object? string? number? integer? real? rational? complex? char? list? vector? pair? null?)) (for-each (lambda (ques) (for-each (lambda (op) (if (ques op) (format #t ";(~A ~A) returned #t?~%" ques op))) control-ops)) question-ops) (let ((unspecified (if #f #f))) (for-each (lambda (op) (if (op unspecified) (format #t ";(~A #) returned #t?~%" op))) question-ops)) (for-each (lambda (s) (if (not (symbol? s)) (format #t ";(symbol? ~A returned #f?~%" s))) '(+ - ... !.. $.+ %.- &.! *.: /:. <-. =. >. ?. ~. _. ^.)) ;;; -------------------------------------------------------------------------------- ;;; if ;;; -------------------------------------------------------------------------------- (test ((if #f + *) 3 4) 12) (test (if (> 3 2) 'yes 'no) 'yes) (test (if (> 2 3) 'yes 'no) 'no) (test (if (> 3 2) (- 3 2) (+ 3 2)) 1) (test (if (> 3 2) 1) 1) (test (if '() 1 2) 1) (test (if 't 1 2) 1) (test (if #t 1 2) 1) (test (if #() 1 2) 1) (test (if 1 2 3) 2) (test (if 0 2 3) 2) (test (if (list) 2 3) 2) (test (if "" 2 3) 2) (test (eq? (if #f #f) (if #f #f)) #t) ; I assume there's only one #! (test (if . (1 2)) 2) (test (if (if #f #f) #f #t) #f) (test (if 1/0 0 1) 0) (test (let ((a #t) (b #f) (c #t) (d #f)) (if (if (if (if d d c) d b) d a) 'a 'd)) 'a) (test (let ((a #t) (b #f) (c #t) (d #f)) (if a (if b (if c (if d d c) c) 'b) 'a)) 'b) (test (let ((a #t) (b #f) (c #t) (d #f)) (if b (if a (if d 'gad) 'gad) (if d 'gad 'a))) 'a) (let ((a #t)) (for-each (lambda (arg) (test (if a arg 'gad) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))) (let ((a #t)) (for-each (lambda (arg) (test (if (not a) 'gad arg) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2)))) (test (let ((ctr 0) (a #t)) (if a (let ((b ctr)) (set! ctr (+ ctr 1)) (list b ctr)) (let ((c ctr)) (set! ctr (+ ctr 100)) (list c ctr)))) (list 0 1)) (test (if if if if) if) (test (((if if if) if if) if if 'gad) if) (test (if if (if if if) if) if) (test ((car (list if)) #t 0 1) 0) (test (symbol->string 'if) "if") (test (if (and if (if if if)) if 'gad) if) (test (let ((ctr 0)) (if (let () (set! ctr (+ ctr 1)) (= ctr 1)) 0 1)) 0) (test (let ((ctr 0)) (if (let () (set! ctr (+ ctr 1)) (if (= ctr 1) (> 3 2) (< 3 2))) 0 1)) 0) (test ( if (> 3 2) 1 2) 1) (test (let ((alist (list (list map 1) (list car 2) (list if 3) (list do 4)))) (assoc if alist)) (list if 3)) (test (let ((alist (list (list map 1) (list car 2) (list if 3) (list do 4)))) (assv if alist)) (list if 3)) (test (let ((alist (list (list map 1) (list car 2) (list if 3) (list do 4)))) (assq if alist)) (list if 3)) (test (let ((alist (list map car if do))) (member if alist)) (list if do)) (test (let ((alist (list map car if do))) (memv if alist)) (list if do)) (test (let ((alist (list map car if do))) (memq if alist)) (list if do)) (test ((vector-ref (vector if) 0) #t 1 2) 1) (test ((vector-ref (make-vector 1 if) 0) #t 1 2) 1) (test ((if #t + -) 3 4) 7) (test (list (if 0 1 2)) (list 1)) (test ((car (list if map)) #f 1 2) 2) (test (let ((ctr 0)) (if (= ctr 0) (let () (set! ctr (+ ctr 1)) (if (= ctr 1) 2 3)) (let () (set! ctr (+ ctr 1)) (if (= ctr 1) 4 5)))) 2) (test (let ((x (cons 1 2))) (set-cdr! x x) (if x 1 2)) 1) (test (let ((ctr 0)) (if (let ((ctr 123)) (set! ctr (+ ctr 1)) (= ctr 124)) (let () (set! ctr (+ ctr 100)) ctr) (let () (set! ctr (+ ctr 1000)) ctr)) ctr) 100) (test (let () (if #t (define (hi a) a)) (hi 1)) 1) (test (let () (if #f (define (hi a) (+ a 1)) (define (hi a) a)) (hi 1)) 1) (test (let ((oddp (lambda (a) (not (even? a))))) (define (hi a) (if (a 123) (a 321))) (hi oddp)) #t) (test (let ((ctr 0)) (call/cc (lambda (exit) (if (> 3 2) (let () (exit ctr) (set! ctr 100) ctr) #f)))) 0) (test (let ((ctr 0)) (call/cc (lambda (exit) (if (< 3 2) #f (let () (exit ctr) (set! ctr 100) ctr))))) 0) (test (let ((ctr 0)) (call/cc (lambda (exit) (if (let () (exit ctr) (set! ctr 100) ctr) 123 321)))) 0) (test (let ((ctr 0)) (if (> 3 2) (call/cc (lambda (exit) (set! ctr (+ ctr 1)) (exit ctr))) #f) ctr) 1) (test (let ((ctr 0)) (do ((x 0 (+ x 1))) ((= x 12)) (if (> x 0) (if (> x 1) (if (> x 2) (if (> x 3) (if (> x 4) (if (> x 5) (if (> x 6) (if (> x 7) (if (> x 8) (if (> x 9) (if (> x 10) (set! ctr (+ ctr 1000)) (set! ctr (- ctr 1))) (set! ctr (- ctr 2))) (set! ctr (- ctr 3))) (set! ctr (- ctr 4))) (set! ctr (- ctr 5))) (set! ctr (- ctr 6))) (set! ctr (- ctr 7))) (set! ctr (- ctr 8))) (set! ctr (- ctr 9))) (set! ctr (- ctr 10))) (set! ctr (- ctr 11)))) ctr) 934) (test (let ((ctr 0)) (do ((x 0 (+ x 1))) ((= x 12)) (if (> x 0) (if (> x 1) (if (> x 2) (if (> x 3) (if (> x 4) (if (> x 5) (if (> x 6) (if (> x 7) (if (> x 8) (if (> x 9) (if (> x 10) (set! ctr (+ ctr 1000)) (set! ctr (- ctr 1))) (set! ctr (- ctr 2))) (set! ctr (- ctr 3))) (set! ctr (- ctr 4)))))))) (set! ctr (- ctr 10))) (set! ctr (- ctr 11)))) ctr) 969) (test (if #f) 'error) (test (if (< 2 3)) 'error) (test (if #f 1 2 3) 'error) (test (if 1 2 3 4) 'error) (test (if #f 1 else 2) 'error) (test (if) 'error) (test ('+ '1 '2) 'error) (test (if 1 . 2) 'error) (test (if 1 2 . 3) 'error) (test (if . 1) 'error) (test (if _no_var_ 1) 'error) (test (if (values) (values) (values) 1) 'error) (num-test (+ 1 (if #t (values 3 4) (values 5 6)) 2) 10) (let () (define (bad a) (if a 1 2 3)) (test (bad #f) 'error) (test (bad #t) 'error)) ;;; when (test (when #f #f) #) (test (when #t #f) #f) (test (when) 'error) (test (when #t) 'error) (test (when . #t) 'error) (test (when #t . 1) 'error) (test (when when when) when) (test (symbol->string 'when) "when") (test (when #t 1 2 3) 3) (test (when #t (define a 1) (+ a 1)) 2) (test ((when #t +) 2 3) 5) (test (when #t (when #f #f)) #) (test (+ (when #t (values 2 3))) 5) (test (when (when #t #t) 2) 2) (test (apply when '(< 2 3) '((+ 2 1))) 3) (let ((x 0)) (define (t1 a) (when a (set! x (+ x 1)) x)) (test (t1 #t) 1) (test (t1 #f) #) (test (t1 #t) 2)) (test ((let () when) #t 32) 32) (test ((let () when) #f 32) #) ;;; unless (test (unless #t #f) #) (test (unless #f #f) #f) (test (unless) 'error) (test (unless #f) 'error) (test (unless . #t) 'error) (test (unless #f . 1) 'error) (test (unless (not unless) unless) unless) (test (symbol->string 'unless) "unless") (test (unless #f 1 2 3) 3) (test (unless #f (define a 1) (+ a 1)) 2) (test ((unless #f +) 2 3) 5) (test (unless #f (unless #t #f)) #) (test (+ (unless #f (values 2 3))) 5) (test (unless (unless #f #f) 2) 2) (test (apply unless '(= 2 3) '((+ 2 1))) 3) (test (unless x (display x) . 2) 'error) (let ((x 0)) (define (t1 a) (unless a (set! x (+ x 1)) x)) (test (t1 #f) 1) (test (t1 #t) #) (test (t1 #f) 2)) (test (when (unless (= 2 3) #t) 1) 1) (let () ; opt_if_bp_ii_fc (define (f) (let ((sum 0)) (do ((i 0 (+ i 1)) (j 0 (+ j 2))) ((= i 3) sum) (if (> (+ i j) 0) (set! sum (+ sum i j)))))) (test (f) 9)) (let () ; values in (not...) etc (define* (v3 x) (values x x)) (define* (sym6 a b :rest c) (list a b (copy c))) (test (let () (define (func) (catch #t (lambda () (let ((x (when (not (v3)) (number? (sym6))))) x)) (lambda (type info) (apply format #f info)))) (func) (func)) "too many arguments to not: (values #f #f)") (test (let () (define (func) (catch #t (lambda () (let ((x (unless (v3) (number? (sym6))))) x)) (lambda (type info) (apply format #f info)))) (func) (func)) #f)) ;;; -------------------------------------------------------------------------------- ;;; quote ;;; -------------------------------------------------------------------------------- (test (quote a) 'a) (test 'a (quote a)) (test '1 1) (test '1/4 1/4) (test '(+ 2 3) '(+ 2 3)) (test '"hi" "hi") (test '#\a #\a) (test '#f #f) (test '#t #t) (test '#b1 1) (test '() '()) (test '(1 . 2) (cons 1 2)) (test #(1 2) #(1 2)) (test (+ '1 '2) 3) (test (+ '1 '2) '3) (test (+ ' 1 ' 2) ' 3) (test (char? '#\a) #t) (test (string? '"hi") #t) (test (boolean? '#t) #t) (test (if '#f 2 3) 3) (test (if '#t 2 3) 2) (test (char? (quote #\a)) #t) (test (string? (quote "hi")) #t) (test (boolean? (quote #t)) #t) (test (if (quote #f) 2 3) 3) (test (if (quote #t) 2 3) 2) (test (vector? (quote #())) #t) (test (+ (quote 1) (quote 2)) (quote 3)) (test (list? (quote ())) #t) (test (pair? (quote (1 . 2))) #t) (test (+ '1.0 '2.0) 3.0) (test (+ '1/2 '3/2) 2) (test (+ '1.0+1.0i '-2.0) -1.0+1.0i) (test (let ((hi 2)) (equal? hi 'hi)) #f) (test ''1 '(#_quote 1)) (test ''a '(#_quote a)) (test (symbol? '#f) #f) (test (symbol? '.') #t) (test ''quote '(#_quote quote)) (test (+ (cadr ''3) (cadadr '''4) (cadr (cadr (cadr ''''5)))) 12) (test (+ (cadr ' ' 3) (cadadr ' ' ' 4)) 7) (test (+ '#| a comment |#2 3) 5) (test (+ ' #| a comment |# 2 3) 5) (test (eq? lambda 'lambda) #f) (test (equal? + '+) #f) (test (eq? '() ()) #t) ; s7 specific (test (quote) 'error) (test (quote . -1) 'error) (test (quote 1 1) 'error) (test (quote . 1) 'error) (test (quote . (1 2)) 'error) (test (quote 1 . 2) 'error) (test (symbol? '1'1) #t) (test (apply '+ (list 1 2)) 'error) (test ((quote . #\h) (2 . #\i)) 'error) (test ((quote "hi") 1) #\i) (test (equal? '(1 2 '(3 4)) '(1 2 (3 4))) #f) (test (equal? '(1 2 '(3 4)) (quote (list 1 2 (quote (list 3 4))))) #f) (test (equal? (list-ref '(1 2 '(3 4)) 2) '(3 4)) #f) (test (equal? '(1 2 '(3 4)) (list 1 2 (list quote (list 3 4)))) #t) (test (equal? '(1 2 ''(3 4)) (list 1 2 (list quote (list quote (list 3 4))))) #t) (test (equal? '('3 4) (list (list quote 3) 4)) #t) (test (equal? '('3 4) (list 3 4)) #f) (test (equal? '('() 4) (list (list quote ()) 4)) #t) (test (equal? '('('4)) (list (list quote (list (list quote 4))))) #t) (test (equal? '('('4)) (list (list quote (list (list 'quote 4))))) #f) (test (equal? '('('4)) '((#_quote ((#_quote 4))))) #t) (test (equal? '1 ''1) #f) (test (equal? ''1 ''1) #t) (test (equal? '(1 '(1 . 2)) (list 1 (cons 1 2))) #f) (test (equal? #(1 #(2 3)) '#(1 '#(2 3))) #f) (test (equal? #(1) #('1)) #f) (test (equal? #(()) #('())) #f) (test (equal? cons 'cons) #f) (test (eqv? #\a (quote #\a)) #t) (test (eqv? 1 (quote 1)) #t) (test (eqv? 0 (quote 0)) #t) (test (equal? #(1 2 3) (quote #(1 2 3))) #t) (test (eqv? 3.14 (quote 3.14)) #t) (test (eqv? 3/4 (quote 3/4)) #t) (test (eqv? 1+1i (quote 1+1i)) #t) (test (eq? #f (quote #f)) #t) (test (eq? #t (quote #t)) #t) (test (eq? '() (quote ())) #t) (test (equal? '(1 2 3) (quote (1 2 3))) #t) (test (equal? '(1 . 2) (quote (1 . 2))) #t) (test ('abs -1) 'error) (test ('"hi" 0) #\h) (test (''begin 1) 'begin) (test (''let ((x 1)) ('set! x 3) x) 'error) (test ('and #f) 'error) (test ('and 1 #f) 'error) (test ('#_and #f) #f) (test ('#_abs -1) 1) (test ('#_+ 1 2 3) 6) (test ('begin 1) 'error) (test ('cond ('define '#f)) 'error) (test ('let ((x 1)) ('set! x 3) x) 'error) (test ('let* () ('define x 3) x) 'error) (test ('or #f) 'error) (test ('quote 3) 'error) (test ((copy quote) 1) 1) (test ((copy quote) quote) 'quote) (test ((lambda (q) (let ((x 1)) (q x))) quote) 'x) (test ((lambda (s c) (s c)) quote #f) 'c) ;;; ((lambda (lambda) (lambda (else))) quote) -> '(else) (test ((quote and) #f) 'error) (test ((values quote) 1) 1) (test (for-each and ''2) #) (test (pair? (map or ''2)) #t) (test (for-each or '(+ x 1)) 'error) (test (do ((i 0 (+ i 1))) ((= i 1)) (string-downcase (for-each or ''2))) 'error) (test (let () (define-macro (m a) `(+ ,a 1)) (for-each m ''2)) 'error) (test (let () (define-macro (m a) `(+ ,a 1)) (for-each m '(1 2))) #) (test (let () (define-macro (m . a) `(+ ,a 1)) (for-each m ''2)) 'error) (test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote 1 1)))) 'error) (test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote 1 . 1)))) 'error) (test ((lambda () (define (_f_ $a$) $a$) (_f_ (quote . 1)))) 'error) (test (syntax? #_quote) #t) (test (syntax? 'quote) #f) ; the symbol quote (test (equal? 'quote quote) #f) ; quote is not self-evaluating (test (syntax? quote) #t) (test (equal? 'quote #_quote) #f) (test (equal? quote #_quote) #t) (test (equal? '#f (quote #f)) #t) (test (equal? '(quote #f) '(#_quote #f)) #f) ; symbol quote != #_quote (test (equal? (quote '#f) (quote (quote #f))) #f) ; (quote (quote #f)) -> (list 'quote #f) [the symbol quote], but s7 uses #_quote for '#f (test (equal? (quote '#f) (quote (#_quote #f))) #t) ; ' -> #_quote (test (let ((quote 32)) '1) 1) ; '1 ignores local 'quote (test (let ((quote 32)) (quote 1)) 'error) ; attempt to apply an integer 32 in (32 1)? ;; in Guile (let ((quote 32)) '1) -> ice-9/boot-9.scm:1685:16: In procedure raise-exception: Wrong type to apply: 32 ;; r7rs.pdf says '(quote a) -> (quote a), ''a -> (quote a), so s7 ignores the spec in this case (test (let ((quote -)) (quote 32)) -32) ;; see also quasiquote ;;; -------------------------------------------------------------------------------- ;;; for-each ;;; -------------------------------------------------------------------------------- (test (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) '(0 1 2 3 4)) v) #(0 1 4 9 16)) (test (let ((ctr 0) (v (make-vector 5))) (for-each (lambda (i) (vector-set! v ctr (* i i)) (set! ctr (+ ctr 1))) '(0 1 2 3 4)) v) #(0 1 4 9 16)) (for-each (lambda (x) (display "for-each should not have called this")) ()) (test (let ((ctr 0)) (for-each (lambda (x y) (if (= x y) (set! ctr (+ ctr 1)))) '(1 2 3 4 5 6) '(2 3 3 4 7 6)) ctr) 3) (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5)) ctr) 15) (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) '(5)) ctr) 9) (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) () () ()) ctr) 0) (test (let () (for-each abs '(1 2)) 1) 1) (test (let ((ctr 0)) (for-each (lambda (a) (for-each (lambda (b) (set! ctr (+ ctr 1))) '(0 1))) '(2 3 4)) ctr) 6) (test (let ((sum 0)) (for-each (lambda args (set! sum (+ sum (apply + args)))) '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) sum) 72) (test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) sum) 72) (test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2) '(2 1 0)) sum) 6) (test (let () (for-each + '(0 1 2) '(2 1 0)) 0) 0) (test (let () () ()) ()) (test (for-each + ()) #) (test (let ((sum 0)) (for-each (lambda a (set! sum (+ sum (apply + a)))) '(1 2 3)) sum) 6) (test (let ((sum 0)) (for-each (lambda* ((a 1)) (set! sum (+ sum a))) '(1 2 3)) sum) 6) (test (let ((sum 0)) (for-each (lambda (a . b) (set! sum (+ sum a))) '(1 2 3)) sum) 6) (test (let ((sum 0) (lst (list 1 2 3))) (for-each (lambda (a b c) (set! sum (+ sum a b c))) lst lst lst) sum) 18) (test (let ((sum 0) (lst (vector 1 2 3))) (for-each (lambda (a b c) (set! sum (+ sum a b c))) lst lst lst) sum) 18) (test (let ((v (vector 1 2 3))) (for-each vector-set! (list v v v) (list 0 1 2) (list 32 33 34)) v) #(32 33 34)) (test (let () (define (hi) (for-each (lambda (x) (+ x 1)) (list 1 2 3))) (hi) (hi)) #) (test (let () (define (func) (for-each (let ((x 4)) (lambda (y) (+ x y))) (make-float-vector 8 0))) (define (hi) (func)) (hi)) #) (let () (define (f L) (for-each display L)) (test (with-output-to-string (lambda () (f '(1 2 3 4)))) "1234")) (test (let ((d 0)) (for-each (let ((a 0)) (for-each (lambda (b) (set! a (+ a b))) (list 1 2)) (lambda (c) (set! d (+ d c a)))) (list 3 4 5)) d) 21) (test (let ((d 0)) (for-each (lambda (c) (let ((a 0)) (for-each (lambda (b) (set! a (+ a b))) (list 1 2)) (set! d (+ d a c)))) (list 3 4 5)) d) 21) (test (let ((ctr 0)) (let ((val (call/cc (lambda (exit) (for-each (lambda (a) (if (> a 3) (exit a)) (set! ctr (+ ctr 1))) (list 0 1 2 3 4 5)))))) (list ctr val))) (list 4 4)) (test (call-with-current-continuation (lambda (exit) (for-each (lambda (x) (if (negative? x) (exit x))) '(54 0 37 -3 245 19)) #t)) -3) (test (let ((ctr 0) (cont #f) (lst ())) (let ((val (call/cc (lambda (exit) (for-each (lambda (a) (if (and (not cont) (= a 2)) (exit a)) (if (and cont (= a 5)) (exit a)) (call/cc (lambda (c) (set! cont c))) (set! lst (cons ctr lst)) (set! ctr (+ ctr 1))) (list 0 1 2 3 4 5)))))) (if (< val 5) (cont)) (list ctr val lst))) (list 5 5 (list 4 3 2 1 0))) (test (let ((lst ())) (for-each (lambda (a) (set! lst (cons a lst))) (let ((lst ())) (for-each (lambda (b) (set! lst (cons b lst))) (list 1 2 3)) lst)) lst) (list 1 2 3)) (test (let ((v (vector 0 0 0)) (iv #i(1 2 3)) (ctr 0)) (for-each (lambda (i) (vector-set! v ctr i) (set! ctr (+ ctr 1))) iv) v) #(1 2 3)) ;;; this is an infinite loop? ; (let ((cont #f)) (call/cc (lambda (x) (set! cont x))) (for-each cont (list 1 2 3))) (test (call/cc (lambda (x) (for-each x (list 1 2 3)))) 1) ; map also gives 1 ... perhaps not actually legal? (let ((args (list 0 1 2)) (xx (list 4))) (define (it1) (for-each (lambda (x) (catch #t (lambda () (set-car! xx x)) (lambda any 'error))) (cdr args)) (car xx)) (test (it1) 2)) (let ((args (list 0 1 2)) (xx (list 4))) (define (it1) (for-each (lambda (x) (catch #t (lambda () (set-car! xx x)) (lambda any 'error)) (set-car! xx (+ (car xx) 32))) (cdr args)) (car xx)) (test (it1) 34)) (test (let ((ctr 0)) (for-each (lambda (x) (for-each (lambda (x y) (for-each (lambda (x y z) (set! ctr (+ x y z))) (list x (+ x 1)) (list y (+ y 2)) (list (+ x y) (- x y)))) (list (+ x 3) (+ x 4) (+ x 5)) (list (- x 3) (- x 4) (- x 5)))) (list 1 2 3 4 5)) ctr) 23) (for-each (lambda (a) (if (not (string=? a "hi")) (format #t "yow: ~S" a))) (list "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi" "hi")) ;; now some mixed cases (test (let ((sum 0)) (for-each (lambda (n m) (set! sum (+ sum n m))) (list 1 2) (vector 3 4)) sum) 10) (test (let ((sum 0)) (for-each (lambda (n m) (set! sum (+ sum n m))) (vector 1 2) (list 3 4)) sum) 10) (test (let ((sum 0)) (for-each (lambda (n m p) (set! sum (+ sum n m))) (vector 1 2) (list 3 4) (vector 5 6)) sum) 10) (test (let ((sum 0)) (for-each (lambda (n m p) (if (char=? p #\x) (set! sum (+ sum n m)))) (vector 1 2 3) (list 3 4 5) "xax") sum) 12) (test (let* ((x (list (list 1 2 3))) (y (apply for-each abs x))) x) '((1 2 3))) (test (for-each (lambda (x) (display "for-each should not have called this"))) 'error) (test (for-each (lambda () 1) ()) 'error) ; # (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(1) '(3) ()) ctr) 0) (test (let ((ctr 0)) (for-each (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6)) ctr) 15) (test (for-each (lambda (a b) (+ a b)) (list 1)) 'error) (test (for-each (lambda (a b) (+ a b)) (list 1) (list)) #) (test (for-each (lambda (a b) (+ a b)) (list 1)) 'error) (test (for-each (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error) (test (for-each (lambda (a b) (+ a b)) (list 1) (list 1 2)) #) (test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) #) (test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) #) (test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1)) #) (test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) 'error) ; # (test (for-each (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error) (test (for-each (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) #) (test (for-each (lambda (a b) (+ a b)) (cons 1 2) (list 1 2)) #) (test (for-each (lambda (a) (+ a 1)) (list 1) (list 2)) 'error) (test (for-each (lambda (a) (+ a 1)) #\a) 'error) (test (for-each (lambda (a) (+ a 1)) (cons 1 2)) #) (test (for-each (lambda (x) x) (openlet (inlet 'make-iterator (lambda (v) v)))) 'error) (test (for-each (lambda (x) x) (openlet (inlet 'make-iterator (let ((+iterator+ #t)) (lambda (v) v))))) 'error) (test (let ((sum 0)) (for-each (lambda (a b . args) (set! sum (+ sum a b (apply + args)))) '(0 1 2)) sum) 'error) (test (for-each (lambda (a) a) '(1 2 . 3)) #) (test (for-each #(0 1 2) #(2 1 0)) #) (for-each (lambda (arg) (test (for-each arg (list 1)) #)) (list (list 1 2 3) #(1 2 3) "hi")) (for-each (lambda (op) (test (for-each op ()) 'error) (test (for-each op "") 'error) (test (for-each op #(1 2 3) ()) 'error) (test (for-each op #() (list) (string)) 'error)) (list 0 () #f #t 'a-symbol :hi #\a # # # 0.0 1+i 1/2 1/0 0/0 *stdout* (current-input-port))) (for-each (lambda (arg) (test (for-each arg (list 1)) 'error)) (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t)) (for-each (lambda (arg) (test (for-each (lambda (n m) n) (list 1) arg) 'error)) (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t)) (for-each (lambda (arg) (test (for-each (lambda (a) a) arg) 'error)) (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t)) (test (for-each) 'error) (test (for-each #t) 'error) (test (for-each map #t) 'error) (test (for-each abs () abs) 'error) (test (for-each abs '(1) #(1)) 'error) (test (let ((vals ())) (for-each for-each (list (lambda (a) (set! vals (cons (abs a) vals)))) (list (list -1 -2))) vals) '(2 1)) (test (let ((c #f)) (for-each (lambda (x) (set! c x)) "a") c) #\a) (test (let ((c #f)) (for-each (lambda (x) (set! c x)) "") c) #f) (test (let ((c #f)) (for-each (lambda (x) (set! c x)) (string #\null)) c) #\null) (when full-s7test (test (for-each (lambda (x) x) (apply-values (make-list 10000))) 'error) (test (map (lambda (x) x) (apply-values (make-list 10000))) 'error)) (test (let ((L (list 1 2 3 4 5)) (sum 0)) (for-each (lambda (x) (set-cdr! (cddr L) 5) (set! sum (+ sum x))) L) sum) 6) ; map (below) has more tests along this line (test (let ((f #f)) (for-each (lambda (a) (if (eq? a 'a) (set! f (lambda () a)))) '(a b c)) (f)) 'a) (test (let ((i 0) (f (make-vector 3))) (for-each (lambda (b) (vector-set! f i b) (set! i (+ i 1))) '(a b c)) f) #(a b c)) (test (let ((i 0) (f (make-vector 3)) (lst '(a b c))) (define (hi) (for-each (lambda (b) (vector-set! f i b) (set! i (+ i 1))) lst)) (hi) f) #(a b c)) (test (let ((i 0) (f (make-vector 3)) (lst '(a b c))) (define (hi) (for-each (lambda (b) (let () (vector-set! f i b) (set! i (+ i 1)))) lst)) (hi) f) #(a b c)) (test (let ((i 0) (f (make-vector 3)) (lst (list 1 2 3))) (define (hi) (for-each (lambda (b) (vector-set! f i (let ((b (+ b 1))) b)) (set! i (+ i 1))) lst)) (hi) f) #(2 3 4)) (test (let ((i 0) (f (make-vector 3)) (lst (list 1 2 3))) (define (hi) (for-each (lambda (b) (let ((b (+ b 1))) (vector-set! f i (let ((b (+ b 1))) b)) (set! i (+ i 1)))) lst)) (hi) f) #(3 4 5)) (test (let ((f #f)) (define (hi) (for-each (lambda (a) (if (eq? a 'a) (set! f (lambda () (let () a))))) '(a b c))) (hi) (f)) 'a) (test (let ((lst '((a b c) (1 2 3)))) (define (hi) (for-each (lambda (a) a) (apply values lst))) (hi)) 'error) (test (let ((lst ())) (for-each (lambda args (set! lst (cons args lst))) (values (list 1 2 3) '(4 5 6) (list 7 8 9))) lst) '((3 6 9) (2 5 8) (1 4 7))) (test (for-each ="") 'error) ; # (test (for-each =""=) 'error) (test (for-each = "" 123) 'error) (test (for-each = () 123) 'error) (test (for-each =()=) 'error) (test (for-each abs "") #) (test (for-each null? () #() "") 'error) ; # (test (for-each null? () #() 0 "") 'error) (test (for-each define '(a) '(3)) #) (test (let () (for-each define '(a b c) '(1 2 3)) (list a b c)) '(1 2 3)) (test (let () (for-each define '(first second third fourth) '(car cadr caddr cadddr)) (third '(1 2 3 4 5))) 3) (test (for-each '(()) #()) #) (test (for-each '(1 2 . 3) '(1 . 2)) #) (test (for-each '(()) ()) #) (test (for-each #2d((1 2) (3 4)) '(1)) #) (test (for-each "a\x00;b" #(1 2)) #) (test (for-each #(1 (3)) '(1)) #) (test (for-each '((1 (2)) (((3) 4))) '(1)) #) (test (for-each "hi" '(1)) #) (test (for-each #() #()) 'error) ; # (test (for-each '(1 . 2) #()) #) (test (let ((ht (hash-table 'a 1 'b 2))) (for-each ht ht)) #) (test (let ((ht (hash-table 'a 1 'b 2))) (let ((sum 0)) (for-each (lambda (c) (set! sum (+ sum (cdr c)))) ht) sum)) 3) (test (let ((ht (hash-table 'a 1 'b 2))) (for-each ht '(a b))) #) (test (for-each ''2 '(1)) #) (let ((os (*s7* 'safety))) (set! (*s7* 'safety) 1) (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (for-each lst lst) #)) ; 'error (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (for-each #() lst) 'error)) (set! (*s7* 'safety) os)) (test (for-each 1 "hi" ()) 'error) (test (for-each 0 #() ()) 'error) (test (for-each #\a #(1 2) '(3 4) "") 'error) (test (for-each '2 ()) 'error) (test (let ((a 1) (b 2)) (for-each apply (list set! set!) '(a b) '((12) (32))) (list a b)) '(12 32)) (test (let ((a 1) (b 2) (c 3)) (for-each apply (make-list 3 set!) '(a b c) '((12) (32) (0))) (list a b c)) '(12 32 0)) (test (let ((a 1) (b 2) (c 3)) (for-each set! '(a b c) '(12 32 0)) (list a b c)) '(12 32 0)) (test (for-each (macro (a . b) `(cons ,a ,b)) "ho" (list (list quasiquote +) -1)) 'error) ; macro + dotted arg bug (affected also sort/map) (test (do ((i 0 (+ i 1))) ((= i 100)) (for-each (macro a `(copy ,a)) '(- 1) (vector 0 1 2))) 'error) (let () (define-macro (msym1 . a) `(copy ,a)) (define (_fnc_ x) (+ x 1)) (define (func) (let () (for-each display (list ((let () msym1) cond (_fnc_ (c-pointer-weak1 0+0/0i))))))) ; cruel and unusual! (test (func) 'error)) (test (for-each (macro* (a . b) `(cons ,a ,b)) #(0 1) (list `+ -1)) #) ; op_pair_sym initial (pair? (car code)) check (test (for-each (macro* (a . b) `(cons ,a ,b)) #(0 1) (list '(values +) -1)) #) ; op_pair_pair case (test (map (macro* (a . b) `(cons ,a ,b)) #(0 1) (list `+ -1)) 'error) ; attempt to apply an integer -1 in (-1) (test (map (lambda* (a . b) `(cons ,a ,b)) #(0 1) (list `+ -1)) '((cons 0 (+)) (cons 1 (-1)))) (let () (define (hi) (let ((lst '(1 2 3))) (for-each (lambda (x) (catch #t (lambda () (if (defined? 'local-x) (format #t ";for-each catch local env not cleared: ~A~%" local-x)) (define local-x x) local-x) (lambda args #f))) lst))) (hi) (hi)) ;; this caught me -- Guile returns 6 3 also (test (let ((fnc #f)) (for-each (let ((ctr 0)) (lambda (x) (if (= ctr 3) (set! fnc (lambda () ctr))) (set! ctr (+ ctr 1)))) '(1 2 3 4 5 6)) (fnc)) 6) (test (let ((fnc #f)) (for-each (let ((ctr 0)) (lambda (x) (if (= ctr 3) (set! fnc (let ((local-ctr ctr)) (lambda () local-ctr)))) (set! ctr (+ ctr 1)))) '(1 2 3 4 5 6)) (fnc)) 3) (let ((x 0)) (let ((p1 (dilambda (lambda (a) (set! x (+ x a))) (lambda (a b) (+ a b))))) (for-each p1 '(1 2 3)) (test x 6)) (set! x 0) (for-each (lambda args (set! x (+ x (car args)))) '(1 2 3)) (test x 6) (set! x 0) (for-each (lambda* (a (b 2)) (set! x (+ x a))) '(1 2 3)) (test x 6) (set! x 0) (for-each (lambda args (set! x (+ x (car args) (cadr args)))) '(1 2 3) '(3 2 1)) (test x 12) (set! x 0) (for-each (lambda* (a (b 2)) (set! x (+ x a b))) '(1 2 3) '(3 2 1)) (test x 12) (set! x 0) (for-each (lambda* (a (b 2)) (set! x (+ x a b))) '(1 2 3)) (test x 12)) (test (let ((lst '(1 2 3)) (sum 0)) (define-macro (hi a) `(set! sum (+ sum (+ 1 ,a)))) (for-each hi lst) sum) 9) (test (let ((lst '(1 2 3)) (sum 0)) (define-bacro (hi a) `(set! sum (+ sum (+ 1 ,a)))) (for-each hi lst) sum) 9) (let ((sum 0)) (define (and-for-each func . args) ;; apply func to first of each arg, stopping if func returns #f (call-with-exit (lambda (quit) (apply for-each (lambda arglist (if (not (apply func arglist)) (quit #))) args)))) (test (and-for-each (lambda (arg) (and (not (null? arg)) (set! sum (+ sum arg)))) (list 1 2 () 3 4)) #) (test sum 3) (set! sum 0) (and-for-each (lambda (arg) (and (not (null? arg)) (set! sum (+ sum arg)))) (list 1 2 3 4)) (test sum 10) (set! sum 0) (and-for-each (lambda (arg1 arg2) (and (not (null? arg1)) (not (null? arg2)) (set! sum (+ sum arg1 arg2)))) (list 1 2 3 4) (list 5 6 () 7 8)) (test sum 14)) (define (and-map func . args) ; see stuff.scm for a better version (call-with-exit (lambda (quit) (let ((result ())) (apply for-each (lambda arglist (let ((val (apply func arglist))) (if (not val) (quit (reverse result)) (set! result (cons val result))))) args) (reverse result))))) (test (and-map even? '(0 2 4 5 6)) '(#t #t #t)) (define (find-if f . args) (call-with-exit (lambda (return) (apply for-each (lambda main-args (if (apply f main-args) (apply return main-args))) args)))) (test (find-if even? #(1 3 5 2)) 2) (test (* (find-if > #(1 3 5 2) '(2 2 2 3))) 6) (define (position-if f . args) (let ((pos 0)) (call-with-exit (lambda (return) (apply for-each (lambda main-args (if (apply f main-args) (return pos)) (set! pos (+ pos 1))) args))))) (test (position-if even? #(1 3 5 2)) 3) (test (position-if > #(1 3 5 2) '(2 2 2 3)) 1) (let ((summer (lambda (v) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (set! sum (+ sum ((v i))))))))) (test (let ((saved-args (make-vector 10)) (i 0)) (for-each (lambda (arg) (set! (saved-args i) arg) (set! i (+ i 1))) (list 0 1 2 3 4 5 6 7 8 9)) (set! (saved-args 0) 32) saved-args) #(32 1 2 3 4 5 6 7 8 9)) (test (let ((f #f)) (for-each (lambda (i) (let () (define (x) i) (if (= i 1) (set! f x)))) (list 0 1 2 3)) (f)) 1) (test (let ((saved-args (make-vector 10)) (i 0)) (for-each (lambda (arg) (set! (saved-args i) (lambda () arg)) (set! i (+ i 1))) (list 0 1 2 3 4 5 6 7 8 9)) (summer saved-args)) 45) (test (let ((saved-args (make-list 10)) (i 0)) (for-each (lambda (arg) (list-set! saved-args i (lambda () arg)) (set! i (+ i 1))) (list 0 1 2 3 4 5 6 7 8 9)) (summer saved-args)) 45) ;;; these are the same but use map (test (let ((saved-args (make-vector 10)) (i 0)) (map (lambda (arg) (set! (saved-args i) arg) (set! i (+ i 1))) (list 0 1 2 3 4 5 6 7 8 9)) (set! (saved-args 0) 32) saved-args) #(32 1 2 3 4 5 6 7 8 9)) (test (let ((f #f)) (map (lambda (i) (let () (define (x) i) (if (= i 1) (set! f x)))) (list 0 1 2 3)) (f)) 1) (test (let ((saved-args (make-vector 10)) (i 0)) (map (lambda (arg) (set! (saved-args i) (lambda () arg)) (set! i (+ i 1))) (list 0 1 2 3 4 5 6 7 8 9)) (summer saved-args)) 45) ;; and again but with named let (test (let ((saved-args (make-vector 10))) (let runner ((arg 0)) (set! (saved-args arg) arg) (if (< arg 9) (runner (+ arg 1)))) (set! (saved-args 0) 32) saved-args) #(32 1 2 3 4 5 6 7 8 9)) (test (let ((f #f)) (let runner ((i 0)) (let () (define (x) i) (if (= i 1) (set! f x)) (if (< i 3) (runner (+ i 1))))) (f)) 1) (test (let ((saved-args (make-vector 10))) (let runner ((i 0)) (set! (saved-args i) (lambda () i)) (if (< i 9) (runner (+ i 1)))) (summer saved-args)) 45) ;;; and recursion (test (let ((saved-args (make-vector 10))) (define (runner arg) (set! (saved-args arg) arg) (if (< arg 9) (runner (+ arg 1)))) (runner 0) (set! (saved-args 0) 32) saved-args) #(32 1 2 3 4 5 6 7 8 9)) (test (let ((f #f)) (define (runner i) (let () (define (x) i) (if (= i 1) (set! f x)) (if (< i 3) (runner (+ i 1))))) (runner 0) (f)) 1) (test (let ((saved-args (make-vector 10))) (define (runner i) (set! (saved-args i) (lambda () i)) (if (< i 9) (runner (+ i 1)))) (runner 0) (summer saved-args)) 45) ;;; and member/assoc (test (let ((saved-args (make-vector 10))) (member 'a '(0 1 2 3 4 5 6 7 8 9) (lambda (a b) (set! (saved-args b) (lambda () b)) #f)) (summer saved-args)) 45) (test (let ((saved-args (make-vector 10))) (assoc 'a '((0 b) (1 b) (2 b) (3 b) (4 b) (5 b) (6 b) (7 b) (8 b) (9 b)) (lambda (a b) (set! (saved-args b) (lambda () b)) #f)) (summer saved-args)) 45) (test (let ((saved-args (make-vector 10 #f))) (sort! '(3 2 1 4 6 5 9 8 7 0) (lambda (a b) (if (not (saved-args b)) (set! (saved-args b) (lambda () b))) (< a b))) (summer saved-args)) 45) ;;; and do which has never worked in this way #| (test (let ((saved-args (make-vector 10))) (do ((i 0 (+ i 1))) ((= i 10)) (set! (saved-args i) (lambda () i))) (summer saved-args)) 45) |# ) ;; map/for-each + circular lists (let () (define L1 (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) lst)) (define L2 (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst)) (define V1 (make-vector 5 0)) (test (map cons L1 V1) '((1 . 0) (2 . 0))) ; perhaps it should be out to 5 (needs to be consistent with iterate) (test (map cons L1 L2) '((1 . 1) (2 . 2) (1 . 3))) (let ((L ())) (for-each (lambda (p q) (set! L (cons (cons p q) L))) L1 V1) (test L '((2 . 0) (1 . 0)))) (let ((L ())) (for-each (lambda (p q) (set! L (cons (cons p q) L))) L1 L2) (test L '((2 . 2) (1 . 1)))) ; depends on cycle detection point (test (map (let ((L1 (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) lst))) (lambda (p) (let ((result (cons (car L1) p))) (set! L1 (cdr L1)) result))) V1) '((1 . 0) (2 . 0) (3 . 0) (1 . 0) (2 . 0)))) ;;; originally for-each/map used old_frame_with_slot, but if the closure had ;;; a local define, the arg symbol was not updated (let_id), leading to segfaults ;;; if the optimizer thought checks were unneeded. So... (let () (define (f1) (for-each (lambda (f3) (let ((x 0)) (if (> f3 x) (abs f3)))) (list 1 2))) (f1) (define (f2) (for-each (lambda (f3) (define x 0) (if (> f3 x) (abs f3))) (list 1 2))) (f2) (let ((f (let flet ((x 1)) (if (> x 0) (flet (- x 1))) flet))) (map f (list 1 2))) (define (f4) (map (let flet ((x 1)) (if (> x 0) (flet (- x 1))) flet) (list 1 2))) (f4) (define (f4a) (for-each (let flet ((x 1)) (if (> x 0) (flet (- x 1))) flet) (list 1 2))) (f4a) (define (f4b) (for-each (let flet ((x 1)) (define y 0) (if (> x y) (flet (- x 1))) flet) (list 1 2))) (f4b) (define (f5) (for-each (let () (define (f x) (if (> x 0) (f (- x 1)))) f) (list 1 2))) (f5) (define (f5a) (for-each (let () (define (f x) (define y 0) (if (> x y) (f (- x 1)))) f) (list 1 2))) (f5a) (define (f5b) (for-each (lambda (x) (define z 2) (define y 0) (if (> z x y) (display (- x 1)))) (list 1 2))) (f5b) (define (f6) (map (let () (define (f x) (if (> x 0) (f (- x 1)) x)) f) (list 1 2))) (test (f6) '(0 0)) (define (f7) (map (let () (define (f x) (define y (+ x 1)) (if (> y 0) (f (- x 1)) x)) f) (list 1 2))) (test (f7) '(-1 -1)) ) ;;; another similar case (from Kjetil Matheussen): (let () (define (a-sub area data) (for-each (lambda (raw-mouse-cycle) (when (raw-mouse-cycle :is-active) (define data2 5))) (area :get-raw-mouse-cycles))) (define (g) (a-sub (lambda (x) (list (hash-table :is-active #t :data 123) (hash-table :is-active #t :data 123))) #t)) (test (g) #)) ;;; -------------------------------------------------------------------------------- ;;; map ;;; -------------------------------------------------------------------------------- (test (map cadr '((a b) (d e) (g h))) '(b e h)) (test (map (lambda (n) (expt n n)) '(1 2 3 4 5)) '(1 4 27 256 3125)) (test (map + '(1 2 3) '(4 5 6)) '(5 7 9)) (test (apply vector (map (lambda (i) (* i i)) '(0 1 2 3 4))) #(0 1 4 9 16)) (map (lambda (x) (display "map should not have called this")) ()) (test (let ((ctr 0)) (map (lambda (x y) (if (= x y) (set! ctr (+ ctr 1))) ctr) '(1 2 3 4 5 6) '(2 3 3 4 7 6))) (list 0 0 1 2 2 3)) (test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(0 1) '(2 3) '(4 5))) (list 6 15)) (test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) '(5))) (list 9)) (test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) () () ())) ()) (test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2)) (list 2 4)) (test (map abs '(1 -2)) (list 1 2)) (test (map + '(0 1 2) '(2 1 0) '(3 4 5) '(5 4 3) '(6 7 8) '(8 7 6)) (list 24 24 24)) (test (map (lambda (a) (cons a (map (lambda (b) (+ b 1)) (list 0 1 2)))) (list 3 4 5)) '((3 1 2 3) (4 1 2 3) (5 1 2 3))) (test (map (lambda (a) (+ a 1)) (map (lambda (b) (+ b 1)) (map (lambda (c) (+ c 1)) (list 0 1 2)))) '(3 4 5)) (test (map (lambda args (apply + args)) '(0 1 2) '(3 4 5) '(6 7 8) '(9 10 11) '(12 13 14)) '(30 35 40)) (test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2) '(3 4 5) '(6 7 8) '(9 10 11) '(12 13 14)) '(30 35 40)) (test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2) '(3 4 5)) '(3 5 7)) (test (map (lambda args args) '(1 2 3)) '((1) (2) (3))) (test (map + () ()) ()) (test (map + (#(#() #()) 1)) ()) (test (map + #(1) #(1) #(1)) '(3)) (test (map list '(a b c)) '((a) (b) (c))) (test (map (lambda (a b) (- a b)) (list 1 2) (vector 3 4)) '(-2 -2)) (test (map (lambda (a b c) (if (char=? a #\a) (+ b c) (- b c))) "axa" (list 1 2 3) (vector 4 5 6)) '(5 -3 9)) (test (map vector (memv 1 (list 1 2 3))) '(#(1) #(2) #(3))) (test (map append #(1 2 3)) '(1 2 3)) (test (map eval '((+ 1 2) (* 3 4))) '(3 12)) (test (map (map + (list 1 2 3)) (list 0 1 2)) '(1 2 3)) (test (let ((a #t) (b #f) (c #t)) (map when '(a b c) '(12 32 0))) '(12 # 0)) (test (let ((a #t) (b #f)) (map if '(a b) '(1 2) '(3 4))) '(1 4)) (test (let ((a #t) (b #f)) (map unless '(a b) '(1 2))) '(# 2)) (test (let ((a #t) (b #f)) (list (map set! '(a b) '(1 2)) a b)) '((1 2) 1 2)) (test (let ((a #t) (b #f)) (map begin '(a b))) '(#t #f)) (test (let () (map apply (map lambda '(a b) '((car a) (car b))) '((2) (3)))) '(2 3)) (test (let () (map apply (map lambda* '(((a 1)) ((b 2))) '(a b)) '((3) ()))) '(3 2)) (test (map + '(1 2 3) '(4 5 6) '(7 8 9)) '(12 15 18)) (test (map (lambda (x) (vector->list x)) (list #(1 2) #(3 4))) '((1 2) (3 4))) (test (let* ((x (list (list 1 2 3))) (y (apply map abs x))) (list x y)) '(((1 2 3)) (1 2 3))) (test (let* ((x (quote ((1 2) (3 4)))) (y (apply map ash x))) (list x y)) '(((1 2) (3 4)) (8 32))) (test (let* ((x (quote ((1 2 3) (4 5 6) (7 8 9)))) (y (apply map + x))) (list x y)) '(((1 2 3) (4 5 6) (7 8 9)) (12 15 18))) (test (map * (map + '(1 2 3) '(4 5 6)) '(1 2 3)) '(5 14 27)) (test (apply map * (apply map + '(1 2 3) '((4 5 6))) '((1 2 3))) '(5 14 27)) (test (let* ((x (lambda () '(1 2 3))) (y (apply map - (list (x))))) (x)) '(1 2 3)) ;(test (map car (list (list 0) (list (values)) (list 2))) (map (lambda (x) (car x)) (list (list 0) (list (values)) (list 2)))) (test (apply append (map list '((a . 1) (b . 2) #))) '((a . 1) (b . 2) #)) (test (apply append (map list '(a b # d))) '(a b # d)) (test (map values (vector 1 2 # 3)) '(1 2 # 3)) (test (map (lambda (x) (values)) '(1 2 3)) ()) ; :) (let () (define (f) (map (lambda x x) (list 1 2 3))) (define (g) (map (lambda (x . y) (cons x y)) (list 1 2 3))) (test (equal? (f) (g)) #t)) (let () (define (f lst) (apply map (lambda* (a (b 1)) (* a b)) lst)) (test (f '((2 3))) '(2 3)) (test (f '((2 3) (4 5))) '(8 15))) (let () (define (f lsts) (map (lambda* (a (b 1)) (* a b)) (apply values lsts))) (test (f '((2 3))) '(2 3)) (test (f '((2 3) (4 5))) '(8 15))) (test (map (lambda (x) (set! x (* 2 x)) 2) '(1 2 3)) '(2 2 2)) (test (map (lambda (x) x (set! x (* 2 x)) x) '(1 2 3)) '(2 4 6)) (test (map (lambda (x) 1) '(1 2 3)) '(1 1 1)) (test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '((x 1) (y . 2)))) (f)) 'error) (test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '(x 2))) (f)) 'error) (test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '(1 2))) (f)) '(4 5)) (test (let () (define (f) (map (let ((x 3)) (let ((y 0)) (lambda (y) (+ x y)))) '(1 2))) (f)) '(4 5)) (test (let () (define (func) (map (lambda (x) (if (>= x 0.0) x (- x))) (list (float-vector? (block))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (f1) (let ((!x! (map (lambda (!a!) (inlet 'pi 1)) '(0)))) (car !x!))) (f1)) 'error) (test (let () (define (func) (map (lambda (call/cc (lambda (r) 123)) 123) (make-iterator #r()) 3/4)) (func)) 'error) (test (map (make-hash-table) (hash-table 'b 2)) '(#f)) (test (let* ((H (make-hash-table)) (I (make-iterator H)) (R ())) (hash-table-set! H 'a 1) (for-each (lambda (obj) (set! R (cons obj R))) I) R) '((a . 1))) (let () (define (f1 a b c) (map + a b c)) (define (f2 a b c) (map (lambda (a b c) (* a b c)) a b c)) (test (f1 (make-float-vector 10 1.0) (make-float-vector 10 2.0) (make-float-vector 10 3.0)) (f2 (make-float-vector 10 1.0) (make-float-vector 10 2.0) (make-float-vector 10 3.0)))) (let () (define* (feclo (a 0) (b 1)) (+ a b)) (define (tfeclo) (map feclo '(1 :b 3 :a 5) '(2 3 4 5 6))) (test (tfeclo) '(3 3 7 6 11))) (let () ; testing lambda* arg to for_each_closure (define* (fe1 (a 0)) (unless (integer? a) (error 'wrong-type-arg "for-each arg: ~S" a))) (define (tfe1) (for-each fe1 '(1 2 3))) (tfe1) (define* (fe2 (a 0) (b 1)) (unless (= (+ a b) (+ a 1)) (error 'wrong-type-arg "for-each arg: ~S ~S" a b))) (define (tfe2) (for-each fe2 '(1 2 3))) (tfe2)) (test (let ((d 0)) (map (let ((a 0)) (map (lambda (b) (set! a (+ a b))) (list 1 2)) (lambda (c) (set! d (+ d c a)) d)) (list 3 4 5))) (list 6 13 21)) (test (let ((d 0)) (map (lambda (c) (let ((a 0)) (map (lambda (b) (set! a (+ a b))) (list 1 2)) (set! d (+ d a c)) d)) (list 3 4 5))) (list 6 13 21)) (test (let ((ctr 0)) (let ((val (call/cc (lambda (exit) (map (lambda (a) (if (> a 3) (exit a)) (set! ctr (+ ctr 1)) ctr) (list 0 1 2 3 4 5)))))) (list ctr val))) (list 4 4)) (test (call-with-current-continuation (lambda (exit) (map (lambda (x) (if (negative? x) (exit x)) x) '(54 0 37 -3 245 19)))) -3) (test (let ((ctr 0) (cont #f) (lst ())) (let ((val (call/cc (lambda (exit) (map (lambda (a) (if (and (not cont) (= a 2)) (exit a)) (if (and cont (= a 5)) (exit a)) (call/cc (lambda (c) (set! cont c))) (set! lst (cons ctr lst)) (set! ctr (+ ctr 1)) ctr) (list 0 1 2 3 4 5)))))) (if (< val 5) (cont)) (list ctr val lst))) (list 5 5 (list 4 3 2 1 0))) (let () (define (tree-add x lst) (define (tree-add-1 lst-1) (map (lambda (a) (if (pair? a) (tree-add-1 a) (+ a x))) lst-1)) (tree-add-1 lst)) (test (tree-add 12 '((1 2) ((3)) 4 5)) '((13 14) ((15)) 16 17))) (test (map (lambda (a) a) (map (lambda (b) b) (list 1 2 3))) (list 1 2 3)) (test (map cons '(a b c) '(() () ())) '((a) (b) (c))) (test (map (lambda a (list a)) '(1 2 3)) '(((1)) ((2)) ((3)))) (test (map (lambda* a (list a)) '(1 2 3)) '(((1)) ((2)) ((3)))) (test (map (lambda* (a) (list a)) '(1 2 3)) '((1) (2) (3))) (test (map (lambda* ((a 0)) (list a)) '(1 2 3)) '((1) (2) (3))) (test (map (lambda* ((a 0) (b 1)) (list a)) '(1 2 3)) '((1) (2) (3))) (test (map (lambda (a . b) (list a)) '(1 2 3)) '((1) (2) (3))) (test (map list '(1 2 3)) '((1) (2) (3))) (test (map (lambda a (apply list a)) '(1 2 3)) '((1) (2) (3))) (test (map (lambda a (apply values a)) '(1 2 3)) '(1 2 3)) (test (map (lambda a (values a)) '(1 2 3)) '((1) (2) (3))) (test (map (lambda a (append a)) '(1 2 3)) '((1) (2) (3))) (test (map values '(1 2 3)) '(1 2 3)) ;(test ((lambda* ('a) quote) 1) 1) (test (procedure? (car (map lambda '(()) '((1))))) #t) (test (procedure? (car (map lambda '((x)) '(((+ x 1)))))) #t) (test (map #(0 1 2) #(2 1 0)) '(2 1 0)) ;(test (map quasiquote '((quasiquote 1) (quasiquote 2))) '(1 2)) -- this has changed (12-May-14) (test (map (lambda (a b) (a b)) (map lambda '((x) (y) (z)) '((+ x x) (* y y) (expt z z))) (list 1 2 3)) '(2 4 27)) (test (map apply (map lambda '((x) (y) (z)) '((+ x x) (* y y) (expt z z))) '((1) (2) (3))) '(2 4 27)) (test (let () (define (add-some x) (define (add-some x) (+ x 2)) (+ x 1)) (map add-some '(1 2 3 4))) '(2 3 4 5)) ; from some CL website -- kinda ridiculous (test (map gcd #(1 2)) '(1 2)) (test (apply vector (map values #(1 2) #(3 4))) #(1 3 2 4)) (test (map values '(1 2 3) '(4 5 6) '(7 8 9)) '(1 4 7 2 5 8 3 6 9)) (test (map eval (list (+ 1 2) (+ 3 4))) '(3 7)) (test (map apply (list + - * /) (list 1 2 3 4) '((5) (6) (7) (8))) '(6 -4 21 1/2)) ;;; (let ((val ())) (list (map (lambda a (set! val (cons a val)) a) '(1 2 3)) val)) -> ((#3=(1) #2=(2) #1=(3)) (#1# #2# #3#)) (test (map if '(#f #f #t) '(0 1 2) '(3 4 5)) '(3 4 2)) (test (map apply (map lambda '(() (a) (a b)) '(1 (+ a 1) (+ a b 1))) '(() (2) (3 4))) '(1 3 8)) (test (map values (list 1 2 3) (list 4 5 6)) '(1 4 2 5 3 6)) (test (map map (list values) '((1 2)) '((3 4))) '((1 3 2 4))) (test (map values '((1 2)) '((3 4))) '((1 2) (3 4))) (test (map map (list map) (list (list values)) '(((1 2))) '(((3 4)))) '(((1 3 2 4)))) (test (map apply (list values) '(((1 2))) '(((3 4)))) (apply map values '(((1 2))) '(((3 4))))) ; ! (test (let ((x '((1 2)))) (eval `(apply apply values x)) (object->string x)) "((1 2))") ; not "((values 1 2))" -- 24-Aug-12 (test (map (lambda (x) x) #u(255)) (list 255)) (let () (define (f) (let ((x (map (lambda (a) (vector-ref (vector abs log) 0 -1)) '(0)))) (car x))) (test (f) 1)) (test (apply (list cons cons) '(1 2)) 'error) (test (apply (list cons cons) '(1 2 3)) '(2 . 3)) (let () (define (shuffle . args) (apply map values args)) (test (shuffle '(1 2 3) #(4 5 6) '(7 8 9)) '(1 4 7 2 5 8 3 6 9)) (test (shuffle '(1 2 3)) '(1 2 3)) (test (shuffle '(1 2 3) '(4)) '(1 4)) (test (shuffle '(1 2 3) ()) ()) ) (test (map list "hi") '((#\h) (#\i))) (test (map string "hi") '("h" "i")) (test (map vector "hi") '(#(#\h) #(#\i))) (test (map char-upcase "hi") '(#\H #\I)) (test (map append #(#() #())) '(#() #())) (test (map abs () abs) 'error) (test (map (lambda (x) (display "map should not have called this"))) 'error) (test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z)) ctr) '(1) '(3) ())) ()) (test (let ((ctr 0)) (map (lambda (x y z) (set! ctr (+ ctr x y z))) '(0 1) '(2 3) '(4 5 6))) '(6 15)) (test (map (lambda (a b) (+ a b)) (list 1)) 'error) (test (map (lambda (a b) (+ a b)) (list 1) (list)) ()) (test (map (lambda (a b) (+ a b)) (list 1) (list 2)) (list 3)) (test (map (lambda (a b) (+ a b)) (list 1)) 'error) (test (map (lambda (a b) (+ a b)) (list 1) (list 2) (list 3)) 'error) (test (map (lambda (a b) (+ a b)) (list 1) (list 1 2)) '(2)) (test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) '(2)) (test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2 3)) '(2 4)) (test (map (lambda (a b) (+ a b)) (list 1 2) (list 1)) '(2)) (test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list)) 'error) ; () (test (map (lambda (a b) (+ a b)) (list 1 2) (list 1 2) (list 1 2)) 'error) (test (map (lambda (a b) (+ a b)) (list 1 2) (cons 1 2)) '(2)) (test (map (lambda* (x . args) args) '(1 2 3)) '(() () ())) (test (map (lambda (x . args) args) '(1 2 3)) '(() () ())) (test (map (lambda* (x . args) (list x args)) '(1 2 3)) '((1 ()) (2 ()) (3 ()))) (test (map (lambda (x . args) (list x args)) '(1 2 3)) '((1 ()) (2 ()) (3 ()))) (test (map (lambda args args) '(1 2 3)) '((1) (2) (3))) (test (map (lambda* args args) '(1 2 3)) '((1) (2) (3))) (test (map (lambda (x y . args) args) '(1 2 3)) 'error) (test (map (lambda* (x y . args) args) '(1 2 3)) '(() () ())) ; all args are optional in lambda* (test (map (lambda (x y . args) args) '(1 2 3) '(4 5 6)) '(() () ())) (test (map (lambda* (x y . args) args) '(1 2 3) '(4 5 6)) '(() () ())) (test (map (lambda (x y . args) (list x y args)) '(1 2 3) '(4 5 6)) '((1 4 ()) (2 5 ()) (3 6 ()))) (test (map (lambda* (x y . args) (list x y args)) '(1 2 3) '(4 5 6)) '((1 4 ()) (2 5 ()) (3 6 ()))) (test (map (lambda (x y . args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9)))) (test (map (lambda* (x y . args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9)))) (test (map (lambda* (x y :rest args) (list x y args)) '(1 2 3) '(4 5 6) '(7 8 9)) '((1 4 (7)) (2 5 (8)) (3 6 (9)))) (test (map (lambda a a) (list 1 2 3)) '((1) (2) (3))) (test (map (lambda (a . b) (cons a b)) (list 1 2 3)) '((1) (2) (3))) (test (map (lambda a a) (list 1 2 3) (list 4 5 6)) '((1 4) (2 5) (3 6))) (test (map (lambda (a . b) (cons a b)) (list 1 2 3) (list 4 5 6)) '((1 4) (2 5) (3 6))) (test (map (lambda (a b) (cons a b)) (list 1 2 3) (list 4 5 6)) '((1 . 4) (2 . 5) (3 . 6))) (test (map (macro (a) a) (list 1 2 3)) '(1 2 3)) (let ((a 1) (b 2) (c 3)) (test (map (macro (a) a) '(a b c)) '(1 2 3))) (let ((a 1) (b 2) (c 3)) (test (map (lambda (a) a) '(a b c)) '(a b c))) (let ((a 1) (b 2) (c 3)) (test (map (macro a a) '(a b c)) 'error)) (let ((a 1) (b 2) (c 3)) (test (map (lambda a a) '(a b c)) '((a) (b) (c)))) (test (map (lambda . (x y z 8)) '(1 2 3)) 'error) ; (y unbound) but other schemes ignore unused args (test (map (lambda . (x 8)) '(1 2)) '(8 8)) (test (map (lambda (a) (+ a 1)) (list 1) (list 2)) 'error) (test (map (lambda (a) (+ a 1)) #\a) 'error) (test (map (lambda (a) (+ a 1)) (cons 1 2)) '(2)) (test (map (lambda (a b . args) (+ a b (apply + args))) '(0 1 2)) 'error) (test (map (lambda (a) a) '(1 2 . 3)) '(1 2)) (test (map) 'error) (test (map #t) 'error) (test (map set-cdr! '(1 2 3)) 'error) (test (map (lambda (a b) (set-cdr! a b) b) '((1) (2) (3)) '(4 5 6)) '(4 5 6)) (test (let ((str "0123")) (set! (str 2) #\null) (map append str)) '(#\0 #\1 #\null #\3)) (test (map ((lambda () abs)) '(-1 -2 -3)) '(1 2 3)) (test (apply map ((lambda () abs)) (list (list -1 -2 -3))) '(1 2 3)) (test (apply apply map ((lambda () abs)) (list (list (list -1 -2 -3)))) '(1 2 3)) (test (apply apply apply map ((lambda () abs)) '((((-1 -2 -3))))) '(1 2 3)) (test (apply apply apply (list (list map abs (list (list -1 -2 -3))))) '(1 2 3)) (test (apply apply list 1 '((1 2) (3 4))) '(1 (1 2) 3 4)) (test (apply + (apply apply apply (list (list map abs (list (list -1 -2 -3)))))) 6) (test (apply (apply apply lambda '(a) '(((+ a 1)))) '(14)) 15) (test (let ((a 14)) (apply apply quasiquote '(((+ ,a 1))))) '(+ 14 1)) (test (apply map vector (values (list (vector 1 2)))) '(#(1) #(2))) (test (apply map string (list "123")) '("1" "2" "3")) (test (apply map string '("123" "456")) '("14" "25" "36")) (test (apply map list '((1 2) (3 4))) '((1 3) (2 4))) ; matrix transpose ;;; Is (apply apply func arglist) the same as (apply func (apply values arglist)), ;;; or (leaving aside '(())), (func (apply values (apply values arglist)))? (test (apply apply + '((1 2 3))) (apply + (apply values '((1 2 3))))) (test (apply apply + '((1 2 3))) (+ (apply values (apply values '((1 2 3)))))) (test (map string "123") '("1" "2" "3")) (test (map "hi" '(0 1)) '(#\h #\i)) (test (map (list 2 3) '(0 1)) '(2 3)) (test (map #(2 3) '(1 0)) '(3 2)) (for-each (lambda (arg) (test (map arg (list 1)) 'error)) (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t)) (for-each (lambda (arg) (test (map (lambda (n m) n) (list 1) arg) 'error)) (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t)) (for-each (lambda (arg) (test (map (lambda (a) a) arg) 'error)) (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t)) (let () (define (concatenate . args) (apply append (map (lambda (arg) (map values arg)) args))) (test (concatenate "hi" #(#\h #\o)) '(#\h #\i #\h #\o)) (test (let ((lst (concatenate '(1 2) (let ((a 2) (b 3)) (curlet)) (hash-table 'c 4)))) (or (equal? lst '(1 2 (b . 3) (a . 2) (c . 4))) (equal? lst '(1 2 (a . 2) (b . 3) (c . 4))))) #t)) (test (map (lambda (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) (max a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)) (list 6 7 8 9 10) (list 21 22 23 24 25) (list 16 17 18 19 20) (list 11 12 13 14 15) (list 26 27 28 29 30) (list 1 2 3 4 5) (list 36 37 38 39 40) (list 41 42 43 44 45) (list 46 47 48 49 50) (list 31 32 33 34 35)) (list 46 47 48 49 50)) (test (map (lambda (a1 a2 a3 a4 a5 a6 a7 a8 a9 . a10) (apply max a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)) (list 6 7 8 9 10) (list 21 22 23 24 25) (list 16 17 18 19 20) (list 11 12 13 14 15) (list 26 27 28 29 30) (list 1 2 3 4 5) (list 36 37 38 39 40) (list 41 42 43 44 45) (list 46 47 48 49 50) (list 31 32 33 34 35)) (list 46 47 48 49 50)) (test (map (lambda* (a1 a2 a3 . a10) (apply max a1 a2 a3 a10)) (list 6 7 8 9 10) (list 21 22 23 24 25) (list 16 17 18 19 20) (list 11 12 13 14 15) (list 26 27 28 29 30) (list 1 2 3 4 5) (list 36 37 38 39 40) (list 41 42 43 44 45) (list 46 47 48 49 50) (list 31 32 33 34 35)) (list 46 47 48 49 50)) (test (map (lambda args (apply max args)) (list 6 7 8 9 10) (list 21 22 23 24 25) (list 16 17 18 19 20) (list 11 12 13 14 15) (list 26 27 28 29 30) (list 1 2 3 4 5) (list 36 37 38 39 40) (list 41 42 43 44 45) (list 46 47 48 49 50) (list 31 32 33 34 35)) (list 46 47 48 49 50)) (test (map map (list abs) (list (list -1))) '((1))) (test (map map (list map) (list (list abs)) (list (list (list -1)))) '(((1)))) (test (map map (list map) (list (list map)) (list (list (list abs))) (list (list (list (list -1 -3))))) '((((1 3))))) (test (map map (list lcm) (vector #(1 2))) '((1 2))) (test (map map (list integer?) (list (vector "hi" 1 2/3))) '((#f #t #f))) (test (map map (list char-lower-case?) (list "hAba")) '((#t #f #t #t))) (test (map map (list char-lower-case? char-upper-case?) (list "hAba" "HacDf")) '((#t #f #t #t) (#t #f #f #t #f))) (test (map map (list + -) (list (list 1 2) (list 3 4))) '((1 2) (-3 -4))) (test (map map (list map map) (list (list + -) (list - +)) '(((1 2) (3 4)) ((4 5) (6 7)))) '(((1 2) (-3 -4)) ((-4 -5) (6 7)))) (test (map member (list 1 2 3) (list (list 1 2 3) (list 1 3 4) (list 3 4 5))) '((1 2 3) #f (3 4 5))) (test (map - (list 1 2 3) (list 1 2 3) (list 1 3 4) (list 3 4 5)) '(-4 -7 -9)) (test (map - (list 1 2 3) (list 1 2 3 'hi) (list 1 3 4 #\a "hi") (list 3 4 5)) '(-4 -7 -9)) (test (let () (define (mrec a b) (if (<= b 0) (list a) (map mrec (list a) (list (- b 1))))) (mrec (list 1 2) 5)) '(((((((1 2)))))))) (test (map append '(3/4)) '(3/4)) (test (map list '(1.5)) '((1.5))) (test (map vector '("hi")) '(#("hi"))) (test (map object->string '(:hi (1 2) (()))) '(":hi" "(1 2)" "(())")) (test (map map (list for-each) (list (list abs)) (list (list (list 1 2 3)))) '((#))) (test (map map (list vector) '((#(1 #\a (3))))) '((#(#(1 #\a (3)))))) (test (apply map map (list cdr) '((((1 2) (3 4 5))))) '(((2) (4 5)))) (test (apply map map (list char-upcase) '(("hi"))) '((#\H #\I))) (test (apply map map (list *) '(((1 2)) ((3 4 5)))) '((3 8))) ; (* 1 3) (* 2 4) (test (map apply (list map) (list map) (list (list *)) '((((1 2)) ((3 4 5))))) '(((3 8)))) (test (map map (list magnitude) '((1 . 2))) '((1))) ; magnitude is called once with arg 1 (test (map magnitude '(1 . 2)) '(1)) (test (map call/cc (list (lambda (r1) 1) (lambda (r2) (r2 2 3)) (lambda (r3) (values 4 5)))) '(1 2 3 4 5)) (test (map call/cc (list number? continuation?)) '(#f #t)) ;; from scheme working group (test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! (cddr L) 5) x) L)) '(1 2 3)) (test (let ((L (list 1 2))) (map (lambda (x) (set! (cdr (cdr L)) L) x) L)) '(1 2)) (test (let ((L (list 1 2))) (object->string (map (lambda (x) (set! (car (cdr L)) L) x) L))) "(1 #1=(1 #1#))") ;;;(test (let ((L (list 1 2))) (map (lambda (x) (set-cdr! L L) x) L)) '(1 2)) ;?? this depends on when we cdr? infinite loop in Guile ;;;(let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! L ()) x) L)) ; another similar case -- s7 doesn't notice what happened ;;; I think not because the original list is held by map (eval) locals that are protected ;;; we simply stepped on something after looking at it, similar to: (test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-car! L 123) x) L)) '(1 2 3 4 5)) (test (let ((L (list 1 2 3 4 5))) (map (lambda (x) (set-cdr! (cddr L) (list 6 7 8)) x) L)) '(1 2 3 6 7 8)) ;;; we could do something similar with strings: (test (let ((S "12345")) (map (lambda (x) (set! (S 2) #\null) x) S)) '(#\1 #\2 #\null #\4 #\5)) ;;; (length S) is still 5 even with the embedded null (test (let ((L (list 1 2 3))) (map (lambda (x) (set! L (list 6 7 8)) x) L)) '(1 2 3)) (test (let ((L1 (list 1 2 3)) (L2 (list 4 5 6 7))) (map (lambda (x1 x2) (set-cdr! (cdr L1) ()) (cons x1 x2)) L1 L2)) '((1 . 4) (2 . 5))) (test (let ((L (list 1 2 3))) (map (lambda (x) (set-car! (cddr L) 32) x) L)) '(1 2 32)) ;;; should these notice the increased length?: (test (let ((L1 (list 1 2)) (L2 (list 6 7 8 9))) (map (lambda (x y) (set-cdr! (cdr L1) (list 10 11 12 13 14)) (cons x y)) L1 L2)) '((1 . 6) (2 . 7) (10 . 8) (11 . 9))) (test (let ((L1 (list 1)) (L2 (list 6 7 8))) (not (member (map (lambda (x y) (set-cdr! L1 (list 10 11 12)) (cons x y)) L1 L2) '(((1 . 6)) ((1 . 6) (10 . 7) (11 . 8)))))) #f) ;;; op_map checks iterator_at_end before calling the function, whereas op_map_closure_2 checks afterwards so we get inconsistent results (test (let ((L1 (list 1 2))) (map (lambda (x) (set-cdr! (cdr L1) (list 10 11 12)) x) L1)) '(1 2 10 11 12)) ;;; a similar case could be made from hash-tables (test (let ((H (hash-table 'a 3 'b 4))) (pair? (map (lambda (x) (set! (H 'c) 32) (cdr x)) H))) #t) (test (let ((H (hash-table 'a 3 'b 4))) (let ((L (map (lambda (x) (set! (H 'b) 32) (cdr x)) H))) (or (equal? L '(3 32)) (equal? L '(4 3))))) #t) ;; in that first example, the set-cdr! is not the problem (map supposedly can treat its args in any order), ;; any set! will do: (test (let ((x 0)) (map (lambda (y) (set! x (+ x y)) x) '(1 2 3 4))) '(1 3 6 10)) (test (map begin '(1 2 3)) '(1 2 3)) (let ((funcs (map (lambda (lst) (eval `(lambda ,@lst))) '((() #f) ((arg) (+ arg 1)))))) (test ((car funcs)) #f) (test ((cadr funcs) 2) 3)) (test (map = #() =) 'error) (test (map ="") 'error) (test (map abs ()) ()) (test (map abs "") ()) (test (map abs "123" "") 'error) (test (map abs "123" "" #f) 'error) (test (map null? () #() "") 'error) (test (map null? () #() 0 "") 'error) (test (map '(()) #()) ()) (test (map '(1 2 . 3) '(1 . 2)) '(2)) (test (map '(()) ()) ()) (test (map #2d((1 2) (3 4)) '(1)) '(#(3 4))) (test (map "a\x00;b" #(1 2)) '(#\null #\b)) (test (map #(1 (3)) '(1)) '((3))) (test (map '((1 (2)) (((3) 4))) '(1)) '((((3) 4)))) (test (map "hi" '(1)) '(#\i)) (test (map #() #()) 'error) (test (map '(1 . 2) #()) ()) (test (map ''2 '(1)) '(2)) (test (((map lambda '((x)) '(1 2 . 3)) 0) 0) 1) (test (((map lambda '(()) #(1 2)) 0)) 1) (test (((map lambda '((x)) '((+ x 1))) 0) 32) 33) (test (map #() ()) 'error) (test (map () ()) 'error) (test (map "" "") 'error) (test (map (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) lst) '(0)) '(1)) (let ((lst (list 1 2)) (os (*s7* 'safety))) (set! (*s7* 'safety) 1) (set! (cdr (cdr lst)) lst) (test (map lst lst) '(2 1)) (set! (*s7* 'safety) os)) (test (map 1 "hi" ()) 'error) (test (map 0 #() ()) 'error) (test (map #\a #(1 2) '(3 4) "") 'error) (test (map or '(1 2 . 3)) '(1 2)) (test (map or "a\x00;b") '(#\a #\null #\b)) (test (map cond '((1 2) (3 4))) '(2 4)) ; (cond (1 2)) -> 2 (test (map begin "hi") '(#\h #\i)) (test (map quote "hi") '(#\h #\i)) (test (map quote '(a b c)) '(a b c)) ; when are (map quote ...) and (map values ...) different? (test (map (begin #(1 (3))) '(1)) '((3))) (test (map (''2 0) ''2) ''2) ; we're mapping #_quote over ''2 (test (map (apply lambda 'a '(-1)) '((1 2))) '(-1)) (test (map (apply lambda 'a '(-1)) '(1 2)) '(-1 -1)) (test (map do '(()) '((1 2))) '(2)) ; (list 2) because it's map, not just do (test (map case '(1) '(((-1 1) 2) 3)) '(2)) (test (map let '(()) "a\x00;b") '(#\a)) (test (map "hi" '(0 1) '(0 1)) 'error) (test (map '((1 2) (3 4)) '(0 1) '(0 1)) '(1 4)) (test (map #2d((1 2) (3 4)) '(0 1) '(0 1)) '(1 4)) (test (map #2d((1 2) (3 4)) '(0 1)) '(#(1 2) #(3 4))) (let ((os (*s7* 'safety))) (set! (*s7* 'safety) 1) (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (let ((L (map (lambda (a) a) lst))) (or (equal? L '(1 2 1)) (equal? L '(1 2)))) #t)) (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst lst) 'error)) (set! (*s7* 'safety) os)) (test (map "hi" ('((1)) 0)) '(#\i)) (test (map "hi" ('((1 0)) 0)) '(#\i #\h)) (test (let ((ht (hash-table 'a 1 'b 2))) (map ht ht)) '(#f #f)) (test (let ((ht (hash-table 'a 1 'b 2))) (let ((lst (map (lambda (c) (cdr c)) ht))) (or (equal? lst '(1 2)) (equal? lst '(2 1))))) #t) (test (let ((ht (hash-table 'a 1 'b 2))) (map ht '(a b))) '(1 2)) (test (map '((1 2) (3 4)) #(1) #(1)) '(4)) (test (map (quasiquote ((1 2) (3 4))) #(1) #(1 2)) '(4)) (let ((pws (dilambda (lambda (a) a) (lambda (a b) b)))) (test (map append pws) 'error) (test (map pws '(1 2 3)) '(1 2 3))) (test (map abs '(1 2 . 3)) '(1 2)) ;; ?? Guile says wrong type arg here (test (map + '(1) '(1 2 . 3)) '(2)) (test (map abs '(1 . 2)) '(1)) ;; problematic because last thing is completely ignored: (test (map abs '(1 . "hi")) '(1)) (test (map floor '(1 . "hi")) '(1)) (for-each (lambda (op) (test (map op ()) 'error) (test (map op "") 'error) (test (map op #() (list) (string)) 'error)) (list 0 () #f #t 'a-symbol :hi #\a # # # 0.0 1+i 1/2 1/0 0/0 *stdout* (current-input-port))) (test (map append (make-vector (list 2 0))) ()) (let ((p1 (dilambda (lambda (a) (+ a 1)) (lambda (a b) (+ a b))))) (test (map p1 '(1 2 3)) '(2 3 4))) (test (map (lambda args (+ (car args) 1)) '(1 2 3)) '(2 3 4)) (test (map (lambda* (a (b 2)) (+ a 1)) '(1 2 3)) '(2 3 4)) (let ((p1 (dilambda (lambda (a b) (+ a b)) (lambda (a b c) (+ a b c))))) (test (map p1 '(1 2 3) '(3 2 1)) '(4 4 4))) (test (map (lambda args (+ (car args) (cadr args))) '(1 2 3) '(3 2 1)) '(4 4 4)) (test (map (lambda* (a (b 2)) (+ a b)) '(1 2 3) '(3 2 1)) '(4 4 4)) (test (map (lambda* (a (b 2)) (+ a b)) '(1 2 3)) '(3 4 5)) (test (map (lambda* ((a 1) (b (map (lambda (c) (+ c 1)) (list 1 2)))) (+ a (apply + b))) (list 4 5 6)) '(9 10 11)) (test (let ((lst (list 0 1 2))) (map (lambda* ((a 1) (b (for-each (lambda (c) (set! (lst c) (+ (lst c) 1))) (list 0 1 2)))) a) lst)) '(0 2 4)) (test (let ((lst '(1 2 3))) (define-macro (hiho a) `(+ 1 ,a)) (map hiho lst)) '(2 3 4)) (test (let ((lst '(1 2 3))) (define-bacro (hiho a) `(+ 1 ,a)) (map hiho lst)) '(2 3 4)) (test (let ((lst '(1 2 3))) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst lst)) '(4 7 10)) (test (let ((lst '(1 2 3))) (define-macro (hi1 a) `(+ 1 ,a)) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst (map hi1 lst))) '(6 9 12)) (test (let ((lst '(1 2 3))) (define-macro (hiho a b) `(+ 1 ,a (* 2 ,b))) (map hiho lst (map (define-macro (hi1 a) `(+ 1 ,a)) lst))) '(6 9 12)) (test (let ((lst '(1 2 3))) (define-macro (hi a) `(+ 1 ,a)) (define-macro (ho b) `(+ 1 (hi ,b))) (map ho lst)) '(3 4 5)) (test (let ((lst '(1 2 3))) (define-macro* (hi a (b 2)) `(+ 1 ,a (* 2 ,b))) (map hi lst)) '(6 7 8)) (test (let ((lst '(1 2 3))) (define-macro* (hi a (b 2)) `(+ 1 ,a (* 2 ,b))) (map hi lst (map hi lst))) '(14 17 20)) (let () (set! (setter for-each) map) ; op_set_opsaq_p unstack_gc_protect bug (test (let () (define (func) (set! (for-each (make-vector '(2 3 4) 1)) (vector-append))) (func) (func)) ()) (set! (setter for-each) #f)) (let () (define (hi) (map (lambda (a) (a 0)) (list (vector 1 2 3) (string #\a #\b #\c) (list 'e 'f 'g)))) (test (hi) '(1 #\a e))) (let ((ctr -1)) (apply begin (map (lambda (symbol) (set! ctr (+ ctr 1)) (list 'define symbol ctr)) '(_zero_ _one_ _two_))) (+ _zero_ _one_ _two_)) ;; test clo* + map + call/cc through dynamic-wind preserving setter! (let ((cc #f) (called #f) (hk (make-hook 'x))) (call/cc (lambda (g) (set! cc g))) (unless called (set! called #t) (dynamic-wind (lambda () #f) (lambda () (define (func) (map hk (list 0 6))) (set! (hook-functions hk) (list (lambda (hook) (cc 'oops)))) (set! (setter hk) (lambda (set) hk)) (test (procedure? (setter hk)) #t) (func)) (lambda () #f))) (test (procedure? (setter hk)) #t)) (let ((cc #f) (called #f) (hk (make-hook 'x))) (call/cc (lambda (g) (set! cc g))) (unless called (set! called #t) (dynamic-wind (lambda () #f) (lambda () (define (func) (for-each hk (list 0 1 2))) (set! (hook-functions hk) (list (lambda (hook) (cc 'oops)))) (set! (setter hk) (lambda (set) hk)) (test (procedure? (setter hk)) #t) (func)) (lambda () #f))) (test (procedure? (setter hk)) #t)) (let ((hk (define-macro* (m1 (a 0)) `(+ ,a 1)))) (dynamic-wind (lambda () #f) (lambda () (define (func) (map hk (list 0 1 2))) (set! (setter hk) (lambda (set) hk)) (test (procedure? (setter hk)) #t) (test (func) '(1 2 3))) (lambda () #f)) (test (procedure? (setter hk)) #t)) (let () (define (map-with-exit func . args) ;; func takes escape thunk, then args (let* ((result ()) (escape-tag (gensym)) (escape (lambda () (throw escape-tag)))) (catch escape-tag (lambda () (let ((len (apply max (map length args)))) (do ((ctr 0 (+ ctr 1))) ((= ctr len) (reverse result)) ; return the full result if no throw (let ((val (apply func escape (map (lambda (x) (x ctr)) args)))) (set! result (cons val result)))))) (lambda args (reverse result))))) ; if we catch escape-tag, return the partial result (define (truncate-if func lst) (map-with-exit (lambda (escape x) (if (func x) (escape) x)) lst)) (test (truncate-if even? #(1 3 5 -1 4 6 7 8)) '(1 3 5 -1)) (test (truncate-if negative? (truncate-if even? #(1 3 5 -1 4 6 7 8))) '(1 3 5)) ) (let () (define-macro (cwe f) ; call-with-exit via catch/throw (let* ((source (procedure-source (eval f))) (thrower (caadr source))) `(catch 'throw (lambda () (let ((,thrower (lambda vals (apply throw 'throw vals)))) ,@(cddr source))) (lambda (type info) (apply values info))))) (test (cwe (lambda (return) (return 2))) 2)) ;;; this is testing the one-liner unsafe closure optimizations (test (let () (define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (let ((x 0) (ctr -1)) (map (lambda (f) (let ((z 1)) (set! ctr (+ ctr 1)) (case ctr ((0 1 2 3) (f z)) ((4 5) (f z z)) ((6 7) (values (f (+ 1)) (f (+ 2))))))) (list (lambda (i) (set! x (list i))) (lambda (i) (set! x (list i)) (set! x (list (+ i 1)))) (vector 1 2 3) (list 3 2 1) (lambda (a b) (+ a b)) (lambda (a b) (+ a b) (+ a b a)) (lambda (a) (if (< a 2) a (+ (fib (- a 1)) (fib (- a 2))))) (lambda (a) (if (zero? a) a (list a)) (list (+ a 10))) )))) '((1) (2) 2 2 2 3 1 1 (11) (12))) ;;; more along the same lines (test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a)) (f1 12)) -12) (test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a 1)) (define (f2 a b) (- a b)) (f1 12)) 11) (test (let () (define (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define (f2 a) (- a 1)) (f1 12)) 11) (test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define* (f2 a) (- a)) (f1 12)) -12) (test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a 1)) (define* (f2 a b) (- a b)) (f1 12)) 11) (test (let () (define* (f2 a) (+ a 1)) (define (f1 a) (f2 a)) (define* (f2 a) (- a 1)) (f1 12)) 11) (let () (define* (f x (y 1)) (+ x y)) (test (map f (list 1 2 3)) '(2 3 4)) (test (map f (int-vector 1 2 3)) '(2 3 4)) (define* (g k) (symbol? k)) (test (map g (list :a :k)) '(#t #t)) ; probably should be: error: g: keyword argument's value is missing: (:x) in (:x) (define* (h k x y) (list x y)) (test (map h (list :x :y :x :y) (list 1 2 3 4)) '((1 #f) (#f 2) (3 #f) (#f 4)))) ;;; (test (map symbol->value (let ((lst (list 'integer? 'boolean?))) (set-cdr! (cdr lst) lst) lst)) (list integer?)) ;;; I think this depends on when the list iterator notices the cycle (let () (define (f0) (for-each (lambda (x y) (display x)) (list 1 2 3) (list 4 5 6))) (test (with-output-to-string f0) "123")) (let () (define (f1) (for-each (lambda (x y) (display x)) (vector 1 2 3) (vector 4 5 6))) (test (with-output-to-string f1) "123")) (let () (define (f2) (for-each (lambda (x y) (display x)) "123" "456")) (test (with-output-to-string f2) "123")) (let () (define (f01) (for-each (lambda (x y) (display y)) (list 1 2 3) (list 4 5 6))) (test (with-output-to-string f01) "456")) (let () (define (f11) (for-each (lambda (x y) (display y)) (vector 1 2 3) (vector 4 5 6))) (test (with-output-to-string f11) "456")) (let () (define (f21) (for-each (lambda (x y) (display y)) "123" "456")) (test (with-output-to-string f21) "456")) (let () (define (f02) (map (lambda (x y) (+ x y)) (list 1 2 3) (list 4 5 6))) (test (f02) (list 5 7 9))) (let () (define (f12) (map (lambda (x y) (+ x y)) (vector 1 2 3) (vector 4 5 6))) (test (f12) (list 5 7 9))) (let () (define (f22) (map (lambda (x y) (cons x y)) "123" "456")) (test (f22) '((#\1 . #\4) (#\2 . #\5) (#\3 . #\6)))) (let () (define (f03) (map (lambda (x y) (+ x y)) (list 1 2 3) (vector 4 5 6))) (test (f03) '(5 7 9))) (let () (define (f13) (map (lambda (x y) (+ x y)) (vector 1 2 3) (list 4 5 6))) (test (f13) '(5 7 9))) (let () (define (f23) (map (lambda (x y) (cons x y)) "123" (list 4 5 6))) (test (f23) '((#\1 . 4) (#\2 . 5) (#\3 . 6)))) #| ;;; this is from the r6rs comment site (let ((resume #f) (results ())) (set! results (cons (map (lambda (x) (call/cc (lambda (k) (if (not resume) (set! resume k)) 0))) '(#f #f)) results )) (display results) (newline) (if resume (let ((resume* resume)) (set! resume #f) (resume* 1)))) With a careful implementation of MAP, a new list is returned every time, so that the displayed results are ((0 0)) ((1 0) (0 0)) ((1 1) (1 0) (0 0)) in s7: ((0 0)) ((1 0) (0 0)) ((0 . #1=(1 1)) #1# (0 0)) |# ;; from Doug Hoyte, Let Over Lambda (let () (define (batcher n) (let* ((network ()) (tee (ceiling (log n 2))) (p (ash 1 (- tee 1)))) (do () ((= p 0) (reverse network)) (let ((q (ash 1 (- tee 1))) (r 0) (d p)) (do () ((= d 0)) (do ((i 0 (+ i 1))) ((= i (- n d))) (if (= (logand i p) r) (set! network (cons (list i (+ i d)) network)))) (set! d (- q p)) (set! q (ash q -1)) (set! r p))) (set! p (ash p -1))))) (define-macro (sortf comparator . places) (let ((tmp (gensym)) (net (batcher (length places)))) `(begin ,@(map (lambda (a b) `(if (,comparator ,a ,b) ; we're ignoring the fancy CL getf|setf business (let ((,tmp ,a)) ; I suppose if it's a list, get setter? (set! ,a ,b) (set! ,b ,tmp)))) (map (lambda (ab) (places (car ab))) net) (map (lambda (ab) (places (cadr ab))) net))))) (test (let ((a 1) (b 3) (c 0)) (sortf > a b c) (list a b c)) '(0 1 3)) (test (let ((a 1) (b 3) (c 0)) (sortf < a b c) (list a b c)) '(3 1 0)) (test (let ((v #(1 3 2))) (sortf > (v 0) (v 1) (v 2)) v) #(1 2 3))) ;;; fftf? (let () (define-macro (shiftf . places) (let ((tmp (gensym))) `(let ((,tmp ,(car places))) ,@(map (lambda (a b) `(set! ,a ,b)) places (cdr places)) ,tmp))) (define-macro (rotatef . places) (let ((tmp (gensym)) (last (car (list-tail places (- (length places) 1))))) `(let ((,tmp ,(car places))) ,@(map (lambda (a b) `(set! ,a ,b)) places (cdr places)) (set! ,last ,tmp)))) (test (let ((a 1) (b 2) (c 3)) (rotatef a b c) (list a b c)) '(2 3 1)) (test (let ((a 1) (b 2) (c 3)) (rotatef a b c) (rotatef a b c) (list a b c)) '(3 1 2)) (test (let ((v #(1 3 2))) (rotatef (v 0) (v 1) (v 2)) v) #(3 2 1)) ;; rotatef does not handle subexprs correctly: (test (catch #t (lambda () (let ((v #(1 3)) (j 0)) (rotatef (v j) (v (set! j (+ j 1)))) (list v j))) (lambda (type info) (apply format #f info))) "vector-set! second argument, 2, is out of range (it is too large)") (test (let ((a 1) (b 2) (c 3)) (let ((d (shiftf a b c (+ 3 2)))) (list a b c d))) '(2 3 5 1)) (test (let ((a 1) (b 2) (c 3)) (let ((d (shiftf a b c (shiftf a b c)))) (list a b c d))) '(3 3 2 1)) ;; this expands to: ;; (let ((a 1) (b 2) (c 3)) ;; (let (({gensym}-22 a)) ;; (set! a b) ;; (set! b c) ;; (set! c (let (({gensym}-23 a)) ;; (set! a b) ;; (set! b c) ;; (set! c (* 2 3)) ;; {gensym}-23)) ;; (list a b c {gensym}-22))) (define swap! (letrec ((no-pairs? (lambda (lst) (or (null? lst) (and (not (pair? (car lst))) (no-pairs? (cdr lst))))))) (macro (a b) (cond ((not (or (symbol? a) (pair? a))) (error 'wrong-type-arg "can't (swap! ~A ~A): ~A is not a symbol or a pair" a b a)) ((not (or (symbol? b) (pair? b))) (error 'wrong-type-arg "can't (swap! ~A ~A): ~A is not a symbol or a pair" a b b)) ((and (or (symbol? a) (hash-table? a) (let? a) (no-pairs? (cdr a))) (or (symbol? b) (hash-table? b) (let? b) (no-pairs? (cdr b)))) (let ((tmp (gensym))) `(let ((,tmp ,a)) (set! ,a ,b) (set! ,b ,tmp)))) (else ; here either a or b or both are pairs with exprs as "indices" (let ((a-object (if (pair? a) (car a) a)) (b-object (if (pair? b) (car b) b)) (a-indices (and (pair? a) (cdr a))) (b-indices (and (pair? b) (cdr b))) (tmp-a-indices (gensym)) (tmp-b-indices (gensym)) (tmp (gensym))) `(let ((,tmp-a-indices (and (pair? ',a) (map eval ',a-indices))) (,tmp-b-indices (and (pair? ',b) (map eval ',b-indices)))) (let ((,tmp (if (pair? ',a) (apply ,a-object ,tmp-a-indices) ,a))) (if (pair? ',a) (if (not (pair? ',b)) (set! (,a-object (apply values ,tmp-a-indices)) ,b) (set! (,a-object (apply values ,tmp-a-indices)) (apply ,b-object ,tmp-b-indices))) (set! ,a (apply ,b-object ,tmp-b-indices))) (if (not (pair? ',b)) (if (pair? ',a) (set! ,b ,tmp)) (set! (,b-object (apply values ,tmp-b-indices)) ,tmp)))))))))) (test (let ((v #(1 3 2))) (let ((d (shiftf (v 0) (v 1) (v 2) (* 4 3)))) (list d v))) '(1 #(3 2 12))) (test (let ((x 1) (y 2)) (swap! x y) (list x y)) '(2 1)) (test (catch #t (lambda () (let ((x 1)) (swap! x 3) x)) (lambda (type info) (apply format #f info))) "can't (swap! x 3): 3 is not a symbol or a pair") (test (let ((x 1) (y (list 2 3))) (swap! x (y 0)) (list x y)) '(2 (1 3))) (test (let ((x 1) (y (list 2 3))) (swap! x (list-ref y 0)) (list x y)) '(2 (1 3))) (test (catch #t (lambda () (let ((x 1)) (swap! 3 x) x)) (lambda (type info) (apply format #f info))) "can't (swap! 3 x): 3 is not a symbol or a pair") (test (let ((y 1) (x (list 2 3))) (swap! (x 0) y) (list x y)) '((1 3) 2)) (test (let ((y 1) (x (list 2 3))) (swap! (list-ref x 0) y) (list x y)) '((1 3) 2)) (test (let ((y 1) (i 0) (x (list 2 3))) (swap! (x i) y) (list x y)) '((1 3) 2)) (test (let ((y (list 0 1)) (i 0) (x (list 2 3))) (swap! (x i) (y i)) (list x y)) '((0 3) (2 1))) (test (let ((y (list 0 1)) (i 0) (x (vector 2 3))) (swap! (x i) (y i)) (list x y)) '(#(0 3) (2 1))) (test (let ((y (string #\a #\b)) (i 0) (x (vector #\c #\d))) (swap! (x i) (y i)) (list x y)) '(#(#\a #\d) "cb")) (test (let ((y (list 0 1)) (i 0) (x #2d((2 3) (4 5)))) (swap! (x i 1) (y i)) (list x y)) '(#2d((2 0) (4 5)) (3 1))) (test (let ((y (let ((yv 0)) (dilambda (lambda () yv) (lambda (ny) (set! yv ny))))) (x 3)) (swap! x (y)) (list x (y))) '(0 3)) (test (let ((y 1) (i 1) (x (list 2 3))) (swap! (x (- i 1)) y) (list x y)) '((1 3) 2)) (test (let ((y (list 0 1)) (i 1) (x (list 2 3))) (swap! (x (- i 1)) (y (- i 1))) (list x y)) '((0 3) (2 1))) (test (let ((x 1) (i 1) (y (list 2 3))) (swap! x (y (- i 1))) (list x y)) '(2 (1 3))) (test (let ((x (list 2 3)) (y (list 0 1)) (i 1) (j 0)) (swap! (x (begin (set! j (+ j 1)) (- i 1))) (y (begin (set! j (+ j 1)) (- i 1)))) (list x y j)) '((0 3) (2 1) 2)) (test (let ((x (hash-table 'a 1)) (y (inlet 'a 2)) (a 32)) (swap! (x 'a) (y 'a)) (list x y)) (list (hash-table 'a 2) (inlet 'a 1)))) ;;; -------------------------------------------------------------------------------- ;;; iterate ;;; make-iterator ;;; iterator? ;;; iterator-sequence ;;; iterator-at-end? ;;; -------------------------------------------------------------------------------- (test (iterate) 'error) (test (iterator?) 'error) (test (iterator-sequence) 'error) (test (iterator-at-end?) 'error) (test (make-iterator) 'error) (test (make-iterator "hi" "ho") 'error) (test (iterator? "hi" "ho") 'error) (test (iterator-sequence "hi" "ho") 'error) (test (iterator-at-end? "hi" "ho") 'error) (test (iterate "hi" "ho") 'error) (test (make-iterator (hash-table 'a 1) (immutable! (cons 0 0))) 'error) (test (make-iterator (inlet 'a 1) (immutable! (cons 0 0))) 'error) (test (make-iterator '(1 2 3) #(0)) 'error) (test (make-iterator (let ((+iterator+ #t)) (lambda (iter) 1))) 'error) (test (iterator? (make-iterator (let ((+iterator+ #t)) (lambda iter 1)))) #t) (test (make-iterator (curlet) 1) 'error) (test (iterator? 1 2) 'error) ;; rogue iterator: ;(with-let (let ((+iterator+ #t)) (curlet)) ; (concatenate (make-int-vector '(2 3) 1) (lambda* (a . b) (cons a b)))) ; this becomes an iterator but only in with-let ;heap has grown past (*s7* 'max-heap-size): 4194304 > 6553600 ; (#) ; t718.scm, line 20, position: 490 ; sequences->list: (#) ; sequences->list: (apply append (map (lamb... ; sequences: (#) ; concatenate: (apply type (apply sequences... ; type: #i2d((1 1 1) (1 ...)) (for-each (lambda (arg) (if (iterator? arg) (format #t ";~A: (iterator? ~A) -> #t?~%" (port-line-number) arg))) (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) # #)) (for-each (lambda (arg) (test (iterate arg) 'error) (test (iterator-sequence arg) 'error) (test (iterator-at-end? arg) 'error)) (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) # #)) (for-each (lambda (arg) (test (make-iterator arg) 'error) (test (make-iterator #(1 2) arg) 'error)) (list 1 'a-symbol quasiquote macroexpand 3.14 3/4 1.0+1.0i #\f :hi (if #f #f) # #)) (let ((str "12345")) (let ((s1 (make-iterator str))) (test (iterator? s1) #t) (test (iterator? str) #f) (test (make-iterator s1) 'error) (test (iterator-sequence s1) str) (test (iterator-at-end? s1) #f) (test (iterate s1) #\1) (test (iterate s1 s1) 'error) (test (object->string s1) "#") (test (s1) #\2) (test (list (s1) (s1) (s1)) (list #\3 #\4 #\5)) (test (s1) #) (test (iterator-at-end? s1) #t) (let ((s2 (copy s1))) (test (equal? s1 s2) #t) (test (equivalent? s1 s2) #t) (test (eq? s1 s2) #f) (test (eqv? s1 s2) #f)))) (let ((str "")) (let ((s1 (make-iterator str))) (let ((s2 (copy s1))) (test (equal? s1 s2) #t) (test (iterator? s1) #t) (test (iterator-sequence s1) str) (test (s1) #) (test (iterator-at-end? s1) #t) (test (iterator? s1) #t)))) (let ((s1 (make-iterator "1234"))) (test (iterator? s1) #t) (test (s1) #\1)) (let ((str (vector #\1 #\2 #\3 #\4 #\5))) (let ((s1 (make-iterator str))) (let ((s2 (copy s1))) (test (equal? s1 s2) #t) (test (iterator? s1) #t) (test (iterator? str) #f) (test (make-iterator s1) 'error) (test (iterator-sequence s1) str) (test (iterate s1) #\1) (test (object->string s1) "#") (test (equal? s1 s2) #f) (s2) (test (equal? s1 s2) #t) (test (iterate s1 s1) 'error) (test (s1) #\2) (test (list (s1) (s1) (s1)) (list #\3 #\4 #\5)) (test (s1) #)))) (let ((str #())) (let ((s1 (make-iterator str))) (test (iterator? s1) #t) (test (iterator-sequence s1) str) (test (s1) #) (test (iterator-at-end? s1) #t) (test (iterator? s1) #t))) (let ((lst ()) (iter (make-iterator '(1 2 3 # 4 5 6)))) (do ((val (iterate iter) (iterate iter))) ((iterator-at-end? iter) (test (reverse lst) '(1 2 3 # 4 5 6))) (set! lst (cons val lst)))) (let ((str #2d((1 2) (3 4)))) (let ((s1 (make-iterator str))) (test (iterator-at-end? s1) #f) (test (s1) 1) (test (iterate s1) 2) (test (s1) 3))) (let ((str (float-vector 1.0 2.0 3.0 4.0))) (let ((s1 (make-iterator str))) (test (iterator? s1) #t) (test (iterator? str) #f) (test (iterator-sequence s1) str) (test (iterate s1) 1.0) (test (s1) 2.0) (test (list (s1) (s1)) (list 3.0 4.0)) (test (s1) #))) (let ((str (float-vector))) (let ((s1 (make-iterator str))) (test (iterator? s1) #t) (test (iterator-sequence s1) str) (test (s1) #) (test (iterator-at-end? s1) #t) (test (iterator? s1) #t))) (let ((str (make-int-vector 4 0))) (do ((i 1 (+ i 1))) ((= i 4)) (set! (str i) i)) (let ((s1 (make-iterator str))) (test (iterator? s1) #t) (test (iterator-sequence s1) str) (test (iterate s1) 0) (test (s1) 1) (test (list (s1) (s1) (s1)) (list 2 3 #)) (test (s1) #))) (let ((fv (float-vector 1 2 3))) (let ((it (make-iterator fv #t))) (test (list (it) (it) (it)) '(3.0 3.0 3.0)))) (let ((fv (float-vector 1 2 3))) (let ((it (make-iterator fv #t))) (test (list (copy (it)) (copy (it)) (copy (it))) '(1.0 2.0 3.0)))) (let ((cv (complex-vector 1+i 2-i 3+3i))) (let ((it (make-iterator cv))) (test (list (it) (it) (it)) '(1.0+1.0i 2.0-1.0i 3.0+3.0i)))) (let ((cv (complex-vector 1+i 2-i 3+3i))) (let ((it (make-iterator cv #t))) (test (list (copy (it)) (copy (it)) (copy (it))) '(1.0+1.0i 2.0-1.0i 3.0+3.0i)))) (let ((iv (int-vector 1 2 3))) (let ((it (make-iterator iv #t))) (test (list (copy (it)) (copy (it)) (copy (it))) '(1 2 3)))) (let ((str (list 0 1 2 3))) (let ((s1 (make-iterator str))) (test (iterator? s1) #t) (test (iterator-sequence s1) str) (test (iterate s1) 0) (test (s1) 1) (test (s1 0) 'error) (test (iterate s1 0) 'error) (test (list (s1) (s1) (s1)) (list 2 3 #)) (test (s1) #))) (let ((str ())) (test (iterator? (make-iterator str)) #t) ; changed 21-Feb-18 (test (length (iterator-sequence (make-iterator str))) 0)) (let ((a1 (make-iterator ())) (a2 (make-iterator ())) (a3 (make-iterator '(1)))) (test (equal? a1 a2) #t) (test (equivalent? a1 a2) #t) (test (equal? a1 a3) #f) (test (equivalent? a1 a3) #f) (iterate a3) (test (equal? a1 a3) #f) (test (equivalent? a1 a3) #f) (test (iterate a1) #)) (test (map values (make-iterator ())) ()) ; infinite loop if iter_ok not cleared in make-iterator (test (equal? (make-iterator (hash-table)) (make-iterator (hash-table))) #t) (test (equal? (make-iterator (inlet)) (make-iterator (inlet))) #t) (when with-block (let ((a1 (make-iterator (block))) (a2 (make-iterator (block))) (a3 (make-iterator (block 1.0)))) (test (equal? a1 a2) #t) (test (equal? a1 a3) #f) (test (a1) #) (test (a3) 1.0) (test (a3) #)) (let ((a1 (make-iterator (block 1 2 3))) (a2 (make-iterator (block 1 2 3)))) (test (equal? a1 a2) #t) (test (a1) 1.0) (test (equal? a1 a2) #f) (a2) (test (equal? a1 a2) #t))) (let ((str '((1 2) (3 4)))) (let ((s1 (make-iterator str))) (test (s1) '(1 2)) (test (iterate s1) '(3 4)) (test (s1) #))) (let ((str (list 0 1))) (set! (cdr (cdr str)) str) (let ((s1 (make-iterator str))) (test (iterator? s1) #t) (test (iterator-sequence s1) str) (test (iterate s1) 0) (test (s1) 1) (test (s1) #))) (let ((p (cons #f #f)) (h (hash-table 'a 1 'b 2))) (let ((iter (make-iterator h p))) (let ((v (iter))) (test (pair? v) #t) (test (eq? v p) #t) (test (pair? (memq (car v) '(a b))) #t) (set! v (iter)) (test (pair? v) #t) (test (eq? v p) #t) (test (pair? (memq (car v) '(a b))) #t)))) ;; hash-table and let dealt with elsewhere (test (length (make-iterator (list 1 2 3))) 3) (test (length (make-iterator "123")) 3) (test (length (make-iterator #(1 2 3))) 3) (test (length (make-iterator (int-vector 1 2 3))) 3) (test (length (make-iterator (float-vector 1 2 3))) 3) (test (length (make-iterator (inlet 'a 1 'b 2))) 2) (test (length (make-iterator (hash-table 'a 1 'b 2))) 8) (when with-block (test (length (make-iterator (block 1 2 3))) 3) (let ((b (block 0.0 1.0 2.0))) (let ((b1 (make-iterator b))) (test (iterator? b1) #t) ;(test (iterator-sequence b1) b) ; this is now a function (test (b1) 0.0) (test (iterate b1) 1.0) (test (list (b1) (b1)) '(2.0 #))))) (let ((c1 (let ((+iterator+ #t) (a 0)) (lambda () (set! a (+ a 1)))))) (let ((iter (make-iterator c1))) (test (iterate iter) 1) (test (iterator? c1) #f) (test (iterator? iter) #t) (test (eq? (iterator-sequence iter) c1) #t))) (let () (define c1 #f) (let ((length (lambda (x) 3)) (+iterator+ #t) (x 0)) (set! c1 (openlet (lambda () (let ((res (* x 2))) (set! x (+ x 1)) res))))) (let ((c2 (make-iterator c1))) (test (iterator? c2) #t) (test (iterator-sequence c2) c1) (test (c2) 0) (test (c2) 2) (test (c2) 4))) (let ((lst (list 1))) (set-cdr! lst lst) (let ((i (make-iterator lst))) (test (map values i) '(1)))) (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (let ((i (make-iterator lst))) (test (map values i) '(1 2)))) (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) (let ((i (make-iterator lst))) (test (> (length (map values i)) 2) #t))) ; '(1 2 3) ideally (let ((lst (list 1 2 3 4))) (set-cdr! (cdddr lst) lst) (let ((i (make-iterator lst))) (test (> (length (map values i)) 3) #t))) ; '(1 2 3 4)? (let ((a 1)) (let ((lti (make-iterator (curlet)))) (test (cdr (lti)) 1) (test (lti) #) (test (lti) #))) (let () (let ((lti (make-iterator (curlet)))) (test (lti) #))) (let ((lti (make-iterator (inlet 'a 1 'b 2)))) ;(test (length lti) #f) (test (reverse lti) 'error) (test (iterator? lti) #t) (test (lti) '(a . 1)) (test (lti) '(b . 2)) (test (lti) #) (test (set! (lti) 32) 'error)) (let ((lti (make-iterator (rootlet)))) (test (defined? (car (lti))) #t) (test (let ((b (lti))) (equal? (symbol->value (car b)) (cdr b))) #t)) ;;; test keyword-as-let-ref-arg -- this is an experiment, see let_ref_1 and let_set_1 (let ((e (inlet :name 'hi))) (test (e :name) 'hi) (set! (e :name) 'ho) (test (e :name) 'ho) (test (let-ref e :name) 'ho) (let-set! e :name 'ha) (test (e 'name) 'ha)) (test ((rootlet) :abs) abs) (test ((rootlet) :allow-other-keys) #) ;;; but this only works directly, not in with-let: (test (with-let (inlet :x 1 :y 2) (+ :x :y)) 'error) ; + argument 1, :x, is a symbol but should be a number ;;; but that's actually parallel to (+ 'x 'y) so I think it's not a show-stopper (let ((y 12)) (test ((curlet) :y) 12) (define f1 (let ((x 32)) (lambda (a) (+ a x)))) (test ((funclet f1) :x) 32)) (let ((e (inlet :aaa 1))) (varlet e :b 2) (test (e 'b) 2) (cutlet e :aaa) (test (e 'aaa) #)) (let ((e (inlet 'a 1 'b 2 'c 3 'd 4))) (test (object->string e) "(inlet 'a 1 'b 2 'c 3 'd 4)") (let-temporarily (((*s7* 'print-length) 2)) (test (object->string e) "(inlet 'a 1 'b 2 ...)") (set! (*s7* 'print-length) 4) (test (object->string e) "(inlet 'a 1 'b 2 'c 3 'd 4)") (set! (*s7* 'print-length) 3) (test (object->string e) "(inlet 'a 1 'b 2 'c 3 ...)"))) (test (format #f "~{~{[~A ~A]~}~}" (make-iterator (let ((lst '((a . 1) (b . 2) (c . 2))) (+iterator+ #t)) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #))))) "[a 1][b 2][c 2]") (test (object->string (make-iterator (let ((lst '((a . 1) (b . 2) (c . 2))) (+iterator+ #t)) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #))))) "#") (when (zero? (*s7* 'debug)) (test (object->string (make-iterator (let ((lst '((a . 1) (b . 2) (c . 2))) (+iterator+ #t)) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #)))) :readable) "(make-iterator (let ((+iterator+ #t) ) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #))))")) (let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2))) (+iterator+ #t)) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #))))) (test (equivalent? (make-iterator iterf) (make-iterator iterf)) #t)) (let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2)))) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #))))) (test (make-iterator iterf) 'error)) (let ((iterf (let ((lst '((a . 1) (b . 2) (c . 2))) (+iterator+ #f)) (lambda () (if (pair? lst) (let ((res (list (caar lst) (cdar lst)))) (set! lst (cdr lst)) res) #))))) (test (make-iterator iterf) 'error)) (let () (define (make-diagonal-iterator matrix) (if (or (= (vector-rank matrix) 1) (< (length matrix) 2)) (make-iterator matrix) (make-iterator (let ((inds (vector-rank matrix)) (len (apply min (vector-dimensions matrix)))) (let ((length (lambda (obj) len)) (+iterator+ #t) (pos 0)) (openlet (lambda () (if (>= pos len) # (let ((res (apply matrix (make-list inds pos)))) (set! pos (+ pos 1)) res))))))))) (define v #2d((1 2 3 4) (5 6 7 8))) (let ((iv (make-diagonal-iterator v))) (let ((vals (map values iv))) (test vals '(1 6))))) (test (let ((iter (make-iterator "123"))) (map values iter)) '(#\1 #\2 #\3)) (test (let ((iter (make-iterator '(1 2 3))) (str "456") (vals ())) (for-each (lambda (x y) (set! vals (cons (cons y x) vals))) iter str) vals) '((#\6 . 3) (#\5 . 2) (#\4 . 1))) (let () (define* (make-full-let-iterator lt (stop (rootlet))) (if (eq? stop lt) (make-iterator #()) (let ((iter (make-iterator lt))) (if (eq? stop (outlet lt)) iter (letrec ((iterloop (let ((+iterator+ #t)) (lambda () (let ((result (iter))) (if (and (eof-object? result) (iterator-at-end? iter)) (if (eq? stop (outlet (iterator-sequence iter))) result (begin (set! iter (make-iterator (outlet (iterator-sequence iter)))) (iterloop))) (if (not (char=? ((symbol->string (car result)) 0) #\_)) result (iterloop)))))))) (make-iterator iterloop)))))) (let ((stop #f)) (set! stop (curlet)) (test (let ((a 1)) (map values (make-full-let-iterator (curlet) stop))) '((a . 1)))) (let ((stop #f)) (set! stop (curlet)) (test (let ((b 2)) (let ((a 1)) (map values (make-full-let-iterator (curlet) stop)))) '((a . 1) (b . 2)))) (let ((stop #f)) (set! stop (curlet)) (test (let ((b 2) (c 3)) (let () (let ((a 1)) (map values (make-full-let-iterator (curlet) stop))))) '((a . 1) (b . 2) (c . 3)))) ) (let () (define (make-range lo hi) (make-iterator (let ((+iterator+ #t) (now lo)) (lambda () (if (> now hi) # (let ((result now)) (set! now (+ now 1)) result)))))) (test (map values (make-range 4 8)) '(4 5 6 7 8))) (let () (define (make-input-iterator port) (make-iterator (let ((+iterator+ #t)) (lambda () (read-char port))))) (test (let ((p (open-input-string "12345"))) (let ((ip (make-input-iterator p))) (let ((res (map values ip))) (close-input-port p) res))) '(#\1 #\2 #\3 #\4 #\5))) (let () (define (make-input-iterator port) (make-iterator (let ((+iterator+ #t)) (define-macro (_m_) `(read-char ,port))))) (test (let ((p (open-input-string "12345"))) (let ((ip (make-input-iterator p))) (let ((res (map values ip))) (close-input-port p) res))) '(#\1 #\2 #\3 #\4 #\5))) (let ((iter (make-iterator (let ((+iterator+ #t) (pos 0)) (lambda () (if (< pos 3) (let ((p pos)) (set! pos (+ pos 1)) (list p (* p 2))) #)))))) (test (map values iter) '((0 0) (1 2) (2 4)))) (let () (define (make-row-iterator v) (make-iterator (let ((+iterator+ #t) (col 0)) (lambda () (if (< col (car (vector-dimensions v))) (let ((c col)) (set! col (+ col 1)) (subvector v (* c (cadr (vector-dimensions v))) (* (+ c 1) (cadr (vector-dimensions v))))) #))))) (let ((v #2d((0 1 2) (4 5 6)))) (let ((iter (make-row-iterator v))) (test (map values iter) '(#(0 1 2) #(4 5 6)))))) (let () (define (make-semi-complete-iterator obj) (make-iterator (let ((iters ()) (iter (make-iterator obj))) (define (iterloop) (let ((result (iter))) (if (length result) ; i.e. result is a sequence (begin (set! iters (cons iter iters)) (set! iter (make-iterator result)) result) ; this returns the sequence before we descend into it ; we could also call iterloop here to skip that step (if (eof-object? result) (if (null? iters) result ; return # (begin (set! iter (car iters)) (set! iters (cdr iters)) (iterloop))) result)))) (let ((+iterator+ #t)) (lambda () (iterloop)))))) (test (let ((v '(1 2 (4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 (4 5) 4 5)) (test (let ((v #(1 2 (4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 (4 5) 4 5)) (test (let ((v '((1 2 (4 5))))) (let ((i (make-semi-complete-iterator v))) (map values i))) '((1 2 (4 5)) 1 2 (4 5) 4 5)) (test (let ((v '(1 2 #(4 5)))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5)) (test (let ((v '(1 2 #(4 5) ("67")))) (let ((i (make-semi-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5 ("67") "67" #\6 #\7))) (let () (define (make-settable-iterator obj) (make-iterator (let ((+iterator+ #t) (pos 0)) (dilambda (lambda () (let ((res (obj pos))) (set! pos (+ pos 1)) res)) (lambda (val) (set! (obj pos) val)))))) (test (procedure? (setter (make-settable-iterator (vector 1 2 3)))) #t) (let ((v (vector 1 2 3))) (let ((iter (make-settable-iterator v))) (set! (iter) 32) (test v #(32 2 3)))) (let ((v (vector 1 2 3))) (let ((iter (make-settable-iterator v))) (test (catch #t (lambda () (set! (iter 0) 32)) (lambda (type info) (apply format #f info))) "# (an iterator): too many arguments: ((iter 0) 32)"))) (let ((v (vector 1 2 3))) (let ((iter (make-settable-iterator v))) (set! (iter) (iter)) (test (iter) 1))) (let ((v "asdf")) (let ((iter (make-settable-iterator v))) (test (catch #t (lambda () (set! (iter) 32)) (lambda (type info) (apply format #f info))) (if with-bignums "string-set! third argument, 32, is an integer but should be a character" "string-set!: value must be a character: (set! (obj pos) val)")))) (let ((v "asdf")) (let ((iter (make-settable-iterator v))) (set! (iter) #\z) (test v "zsdf"))) (let ((v (list 0))) (let ((iter (make-settable-iterator v))) (iter) (test (catch #t (lambda () (set! (iter) #\z)) (lambda (type info) (apply format #f info))) "list-set! second argument, 1, is out of range (it is too large)") ;; should the error say "iterator is at eof?" or is this for the iterator function above? v)) (let ((v (immutable! "asdf"))) (let ((iter (make-settable-iterator v))) (test (catch #t (lambda () (set! (iter) #\z)) (lambda (type info) (apply format #f info))) "can't string-set! \"asdf\" (it is immutable)"))) (let ((e (inlet :v (vector 1 2)))) (set! (with-let e (with-let (curlet) (v 0))) 32) (test (e 'v) #(32 2))) (let ((e (inlet :v (vector 1 2) :z 0))) (set! (with-let e (v (with-let (curlet) z))) 12) (test (e 'v) #(12 2)))) (let () (define (make-settable-iterator1 obj) (make-iterator (let ((+iterator+ #t) (pos 0)) (dilambda (lambda () (let ((res (obj pos))) (set! pos (+ pos 1)) res)) (macro (val) `(set! (,obj ,pos) ,val)))))) (let ((v (vector 1 2 3))) (let ((iter (make-settable-iterator1 v))) (set! (iter) 32) (test (iter) 32) (test v #(32 2 3))))) (let () (define (make-circular-iterator obj) (let ((iter (make-iterator obj))) (make-iterator (let ((+iterator+ #t)) (lambda () (let ((result (iter))) (if (eof-object? result) ((set! iter (make-iterator obj))) result))))))) (let ((iter (make-circular-iterator '(1 2 3))) (lst ())) (do ((i 0 (+ i 1))) ((= i 10) (test (reverse lst) '(1 2 3 1 2 3 1 2 3 1))) (set! lst (cons (iter) lst)))) (let ((iter (make-circular-iterator (hash-table :a 1 :b 2))) (lst ())) (do ((i 0 (+ i 1))) ((= i 4) (test (let ((r (reverse lst))) (or (equal? r '((:a . 1) (:b . 2) (:a . 1) (:b . 2))) (equal? r '((:b . 2) (:a . 1) (:b . 2) (:a . 1))))) #t)) (set! lst (cons (iter) lst))))) (test (setter (make-iterator "123")) #f) (test (setter (make-iterator #(1))) #f) (test (setter (make-iterator '(1))) #f) (test (setter (make-iterator (float-vector pi))) #f) (test (copy (make-iterator '(1 2 3)) (vector 1)) 'error) (let () (define (make-file-iterator file) ;; reads a text file, returning one word at a time (let* ((port (open-input-file file)) (line (read-line port #t)) (pos -1) (new-pos 0) (eol (string #\space #\tab #\newline #\linefeed))) (define (next-word) (set! pos (char-position eol line (+ pos 1))) (if (not pos) (begin (set! pos -1) (set! new-pos 0) (set! line (read-line port #t)) (if (eof-object? line) (begin (close-input-port port) line) (next-word))) (if (= new-pos pos) (next-word) (let ((start (do ((k new-pos (+ k 1))) ((or (= k pos) (char-alphabetic? (string-ref line k)) (char-numeric? (string-ref line k))) k)))) (if (< start pos) (let ((end (do ((k (- pos 1) (- k 1))) ((or (= k start) (char-alphabetic? (string-ref line k)) (char-numeric? (string-ref line k))) (+ k 1))))) (set! new-pos (+ pos 1)) (if (> end start) (substring line start end) (next-word))) (next-word)))))) (make-iterator (let ((+iterator+ #t)) (lambda* (p) (if (eq? p 'eof) (begin (close-input-port port) #) (next-word))))))) (define iter (make-file-iterator "s7.c")) (test (iter) "s7") (test (iter) "a") (test (iter) "Scheme") (test (iter) "interpreter") (test ((iterator-sequence iter) 'eof) #) ) (let ((olt (openlet (inlet 'make-iterator (lambda args (#_make-iterator "123")))))) (let ((iter1 (make-iterator olt))) (test (object->string iter1) "#") (test (object->string iter1 :readable) "(make-iterator \"123\")")) (let ((iter2 (make-iterator olt (cons 1 2)))) (test (object->string iter2) "#") (test (object->string iter2 :readable) "(make-iterator \"123\")"))) (let () ; catch_all_function (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (catch #t (lambda () (abs 1 2)) (lambda args 'error)))))) (test (iterate iter) 'error) (let () ; catch #list x)) (list #(1 2) #(3 4))))))) (define (f) (map (lambda (a) (iterate iter)) (list 0 1 2))) (test (f) '(((1 2) (3 4)) ((1 2) (3 4)) ((1 2) (3 4))))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (vector->list x)) (list #(1 2) #(3 4))))))) (define (f) (map (lambda (a) (iterate iter)) (list 0 1 2))) (test (f) '(((1 2) (3 4)) ((1 2) (3 4)) ((1 2) (3 4))))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (catch #t (lambda () (vector->list x)) (lambda (t i) 'error))) (list #(1 2) #\a)))))) (define (f) (map (lambda (a) (iterate iter)) (list 0 1 2))) (test (f) '(((1 2) error) ((1 2) error) ((1 2) error)))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (vector->list x)) (list #(1 2) #\a)))))) (define (f) (catch #t (lambda () (map (lambda (a) (iterate iter)) (list 0 1 2))) (lambda (t i) 'error))) (test (f) 'error)) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (vector->list x)) (list #(1 2) #(3 4))))))) (test (iterate iter) '((1 2) (3 4)))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (display x #f) (display x #f) (vector->list x)) #(#(1 2) #(3 4))))))) (define (f) (map (lambda (a) (iterate iter)) #(-1 -2 -3))) (test (f) '(((1 2) (3 4)) ((1 2) (3 4)) ((1 2) (3 4))))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (vector->list x)) #(#(1 2) #(3 4))))))) (define (f) (map (lambda (a) (iterate iter)) #(-1 -2 -3))) (test (f) '(((1 2) (3 4)) ((1 2) (3 4)) ((1 2) (3 4))))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (catch #t (lambda () (string->list x)) (lambda (t i) 'error))) #(#(1 2) #(3 4))))))) (define (f) (map (lambda (a) (iterate iter)) #(-1 -2 -3))) (test (f) '((error error) (error error) (error error)))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (string->list x)) #(#(1 2) #(3 4))))))) (define (f) (catch #t (lambda () (map (lambda (a) (iterate iter)) #(-1 -2 -3))) (lambda (t i) 'error))) (test (f) 'error)) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (catch #t (lambda () (char->integer x)) (lambda (t i) 'error))) "1234"))))) (define (f) (map (lambda (a) (iterate iter)) "4321")) (test (f) '((49 50 51 52) (49 50 51 52) (49 50 51 52) (49 50 51 52)))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x) (abs x)) "1234"))))) (define (f) (catch #t (lambda () (map (lambda (a) (iterate iter)) "1234")) (lambda (t i) 'error))) (test (f) 'error)) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x y) (display x #f) (display y #f) (list x y)) '(1 2) '(3 4)))))) (define (f) (map (lambda (a b) (iterate iter)) '(-1 -2) '(-3 -4))) (test (f) '(((1 3) (2 4)) ((1 3) (2 4))))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x y) (list x y)) '(1 2) '(3 4)))))) (define (f) (map (lambda (a b) (iterate iter)) '(-1 -2) '(-3 -4))) (test (f) '(((1 3) (2 4)) ((1 3) (2 4))))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x y) (catch #t (lambda () (string->list x)) (lambda (t i) 'error))) '(1 2) '(3 4)))))) (define (f) (map (lambda (a b) (iterate iter)) '(-1 -2) '(-3 -4))) (test (f) '((error error) (error error)))) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (map (lambda (x y) (string->list x)) '(1 2) '(3 4)))))) (define (f) (catch #t (lambda () (map (lambda (a b) (iterate iter)) '(-1 -2) '(-3 -4))) (lambda (t i) 'error))) (test (f) 'error)) (let () (define iter (make-iterator (let ((+iterator+ #t)) (lambda () (for-each (lambda (x) (vector->list x)) #(#(1 2) #(3 4))))))) (define (f) (for-each (lambda (a) (iterate iter)) #(-1 -2 -3))) (test (f) #)) (let () ; iterate_p_p (define (f) (let ((iter (make-iterator "asdf"))) (do ((i 0 (+ i 1))) ((= i 1) (iter)) (iterate (car (list iter)))))) (test (f) #\s)) (let () (define (f1) (let ((L1 (make-iterator "asdfasdf")) (L2 (make-iterator #(1 2 3 4))) (V1 (make-vector 4))) (do ((L L1 L2) (i 0 (+ i 1))) ((= i 4) V1) (vector-set! V1 i (iterate L))))) ; fx_c_opsq -> g_display(g_iterate) (test (f1) #(#\a 1 2 3)) (define (f2) (let ((L1 (make-iterator "asdfasdf")) (V1 (make-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) V1) (vector-set! V1 i (iterate L1))))) ; opt_p_p_s_iterate_unchecked from opt_p_p_f (test (f2) #(#\a #\s #\d #\f)) (define (f5) (let ((L1 (make-iterator "asdfasdf")) (L2 (make-iterator #(0 1 2 3 4))) (V1 (make-vector 4))) (do ((i 0 (+ i 1))) ((= i 4) V1) (vector-set! V1 i (iterate L1)) ; opt_p_p_s_iterate_unchecked (set! L1 L2)))) (test (f5) #(#\a 0 1 2))) ;;; -------------------------------------------------------------------------------- ;;; do ;;; -------------------------------------------------------------------------------- (test (do () (#t 1)) 1) (for-each (lambda (arg) (test (do () (#t arg)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (do ((i arg)) (#t i)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))) (test (do ((i 0 (+ i 1))) ((= i 3) #f)) #f) (test (do ((i 0 (+ i 1))) ((= i 3) i)) 3) (test (do ((i 1/2 (+ i 1/8))) ((= i 2) i)) 2) (test (do ((i 1/2 (+ i 1/8))) ((> i 2) i)) 17/8) (test (do ((vec (make-vector 5)) (i 0 (+ i 1))) ((= i 5) vec) (vector-set! vec i i)) #(0 1 2 3 4)) (test (let ((x '(1 3 5 7 9))) (do ((x x (cdr x)) (sum 0 (+ sum (car x)))) ((null? x) sum))) 25) (test (do ((i 4 (- i 1)) (a 1 (* a i))) ((zero? i) a)) 24) (test (do ((i 2 (+ i 1))) ((> i 0) 123)) 123) (test (do () (() ()) ()) ()) (test (do () ('() ())) ()) (test (do () ('())) ()) (test (do () (())) ()) (test (do) 'error) (test (do ((i 0 (+ i 1)) (i 0)) ((= i 0)) i) 'error) (test (let ((x 0) (y 0)) (set! y (do () (#t (set! x 32) 123))) (list x y)) (list 32 123)) (test (let ((i 32)) (do ((i 0 (+ i 1)) (j i (+ j 1))) ((> j 33) i))) 2) (test (let ((i 0)) (do () ((> i 1)) (set! i (+ i 1))) i) 2) (test (let ((i 0) (j 0)) (do ((k #\a)) (#t i) (set! i (char->integer k)) (set! j (+ j i)))) 0) (test (let ((i 0) (j 0)) (do ((k #\a)) ((> i 1) j) (set! i (char->integer k)) (set! j (+ j i)))) (char->integer #\a)) (test (let ((x 0)) (do ((i 0 (+ i 2)) (j 1 (* j 2))) ((= i 4) x) (set! x (+ x i j)))) 5) (test (let ((sum 0)) (do ((lst '(1 2 3 4) (cdr lst))) ((null? lst) sum) (set! sum (+ sum (car lst))))) 10) (test (do ((i 0 (+ 1 i))) ((= i 4) (do ((i 0 (+ i 2))) ((= i 10) i)))) 10) (test (let ((i 0)) (do ((i 1 (+ i 1))) ((= i 3) i))) 3) (test (let ((j 0)) (do ((i 0 (+ i 1))) ((= i 3) (+ i j)) (do ((j 0 (+ j i 1))) ((> j 3) j)))) 3) (test (let ((add1 (lambda (a) (+ a 1)))) (do ((i 0 (add1 i))) ((= i 10) (add1 i)))) 11) (test (do ((i 0 (do ((j 0 (+ j 1))) ((= j i) (+ i 1))))) ((= i 3) i)) 3) (test (do ((i 0 (do ((i 0 (+ i 1))) ((= i 3) i)))) ((= i 3) i)) 3) (test (let ((i 123)) (do ((i 0 (+ i 1)) (j i (+ j i))) ((> j 200) i))) 13) (test (do ((i 0 (+ i 1))) ((> i 3) i) (set! i (* i 10))) 11) (test (do ((i 123) (j 0 (+ j i))) ((= j 246) i)) 123) (test (do ((i 123 i) (j 0 (+ j i))) ((= j 246) i)) 123) (test (do ((i 0 i)) (i i)) 0) (test (do ((i 1 i)) (i i (+ i i) (+ i i i))) 3) (test (do ((i 1)) (#t 1) 123) 1) (test (do ((i 0 (+ i j)) (j 0 (+ j 1))) (#t 1)) 1) (test (do ((i 0 j) (j 0 (+ j 1))) ((= j 3) i)) 2) ; uh, lessee... lexical scoping... (test (do ((i 1 j) (j 0 k) (k 0 m) (m 0 (+ i j k))) ((> m 10) (list i j k m))) (list 4 5 8 11)) (test (let ((i 10) (j 11) (k 12)) (do ((i i j) (j j k) (k k m) (m (+ i j k) (+ i j k))) ((> m 100) (list i j k m)))) (list 33 56 78 122)) (test (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x) 44) (test (let () (define (hi) (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x)) (hi)) 44) (test (do ((i 0 (let () (set! j 3) (+ i 1))) (j 0 (+ j 1))) ((= i 3) j)) 4) (test (let ((i 0)) (do () ((= i 3) (* i 2)) (set! i (+ i 1)))) 6) (num-test (do ((i 0 (- i 1))) ((= i -3) i)) -3) (num-test (do ((i 1/2 (+ i 1/2))) ((> i 2) i)) 5/2) (num-test (do ((i 0.0 (+ i 0.1))) ((>= i 0.9999) i)) 1.0) (num-test (do ((i 0 (- i 1/2))) ((< i -2) i)) -5/2) (num-test (do ((i 0+i (+ i 0+i))) ((> (magnitude i) 2) i)) 0+3i) (test (let ((x 0)) (do ((i 0 (+ i 1))) ((> i 4) x) (set! x (+ x i)) (set! i (+ i 0.5)))) 4.5) (test (do ((i 0 1)) ((> i 0) i)) 1) (test (do ((i 1.0+i 3/4)) ((= i 3/4) i)) 3/4) (test (do ((i 0 "hi")) ((not (number? i)) i)) "hi") (test (do ((i "hi" 1)) ((number? i) i)) 1) (test (do ((i #\c "hi")) ((string? i) i)) "hi") (test (do ((i #\c +)) ((not (char? i)) i)) +) (test (let ((j 1)) (do ((i 0 j)) ((= i j) i))) 1) (test (let ((j 1)) (do ((i 0 j)) ((= i j) i) (set! j 2))) 2) (test (do ((j 1 2) (i 0 j)) ((= i j) i)) 2) (test (let ((old+ +) (j 0)) (do ((i 0 (old+ i 1))) ((or (< i -3) (> i 3))) (set! old+ -) (set! j (+ j i))) j) -6) (test (do ((i 0 (case i ((0) 1) ((1) "hi")))) ((string? i) i)) "hi") (test (do ((i if +)) ((equal? i +) i)) +) (test (let ((k 0)) (do ((j 0 (+ j 1)) (i 0 ((if (= i 0) + -) i 1))) ((= j 5)) (set! k (+ k i))) k) 2) (test (let ((j -10) (k 0)) (do ((i 0 (+ i j)) (j 2)) ((> i 4) k) (set! k (+ k i)))) 6) (test (let ((j -10) (k 0)) (do ((i j (+ i j)) (j 2)) ((> i 4) k) (set! k (+ k i)))) -24) (test (let ((j -10) (k 0)) (do ((i j (+ i j)) (j 2)) ((= i j) k) (set! k (+ k i)))) -30) (test (let ((j -10) (k 0)) (do ((i j (+ i j)) (j 2)) ((= i j) j) (set! k (+ k i)))) 2) (test (let ((equal =)) (do ((i 0 (+ i 1))) ((equal i 3) i))) 3) (test (let ((equal =)) (do ((i 0 (+ i 1))) ((equal i 3) i) (set! equal >))) 4) (test (do ((equal =) (i 0 (+ i 1))) ((equal i 3) i)) 3) (test (do ((equal = >) (i 0 (+ i 1))) ((equal i 3) i)) 4) (test (do ((j 0) (plus + -) (i 0 (plus i 1))) ((= i -1) j) (set! j (+ j 1))) 3) (test (let ((expr `(+ i 1))) (do ((j 0) (i 0 (eval expr))) ((= i 3) j) (set! j (+ j 1)))) 3) (test (let ((expr `(+ i 1))) (do ((j 0) (i 0 (eval expr))) ((= i -3) j) (set! j (+ j 1)) (if (= j 3) (set! expr `(- i 1))))) 7) (test (do ((i 0 (+ i 1))) ((or (= i 12) (not (number? i)) (> (expt 2 i) 32)) (expt 2 i))) 64) (test (let ((k 0)) (do ((i 0 (+ i 1))) ((let () (set! k (+ k 1)) (set! i (+ i 1)) (> k 3)) i))) 7) (num-test (do ((i 0 (+ i 1))) ((> i 3) i) (set! i (* .9 i))) 3.439) (test (let ((v #(0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (set! (v i) i))) #(0 1 2)) (test (let ((v (list 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (set! (v i) i))) '(0 1 2)) (test (let ((sum 0)) ((do ((i 0 (+ i 1))) ((> i 64) (lambda () sum)) (set! sum (+ sum i))))) 2080) (test (do ((lst () (cons i lst)) (i 0 (+ i 1))) ((> i 6) (reverse lst))) '(0 1 2 3 4 5 6)) (test (do ((i (do ((i 2 (do ((i i (+ i 1))) ((> i 0) i)))) ((> i 0) i)))) ((> i 0) i)) 2) (let () (define (d1) (do ((i 0 (+ i 1))) ((= i 10) i))) (define (d2) (do ((i 0 (+ i 1))) ((= i 10) i) i)) (test (d1) 10) (test (d1) (d2))) (test (+ 1 (do ((i 2 (+ i 1))) ((values i (+ i 1))))) 6) (test (+ 1 (do ((i 2 (+ i 1))) ((= i 3) (values i (+ i 1))))) 8) (test (let () (define (f) (+ 1 (do ((i 2 (+ i 1))) ((values i (+ i 1)))))) (f) (f)) 6) (test (let () (define (f) (+ 1 (do ((i 2 (+ i 1))) ((= i 3) (values i (+ i 1)))))) (f) (f)) 8) (test (list (do ((i 0 (+ i 1))) ((= i 1) (values #f 1)))) '(#f 1)) (test (let ((lst '(1 2))) (do ((p lst (cdr p))) ((or (not (pair? p)) (car p)) => (lambda (val) (and (pair? p) val))))) 1) (let () (define (f lst) (do ((p lst (cdr p))) ((or (not (pair? p)) (car p)) => (lambda (val) (and (pair? p) val))))) (test (f '(1 2)) 1) (test (f '(2 3)) 2)) (let () (define (f lst) (do ((p lst (cdr p))) ((or (not (pair? p)) (car p)) => car))) (test (f '((1) 2)) 1) (test (f '((2) 3)) 2)) (let () (define (f lst) (do ((p lst (cdr p))) ((if (pair? p) (apply values (car p)) #t) => +))) (test (f '((1 2) 2)) 3) (test (f '((2 3 4) 3)) 9)) (let ((size 10)) (define (f5) (let ((v (make-vector size 1 integer?)) (sum 0)) (do ((i 0 (+ i 1))) ((= i size) sum) (set! sum (+ sum (vector-ref v i)))))) (test (f5) size)) (test (do () (1)) 1) (test (do () (1 2)) 2) (test (do () '2) 2) (test (do () (())) ()) (test (do ((i 0 (+ i 1))) ((= i 2) (+ i j)) (define j i) j) 3) ; bizarre (Guile sez "bad define placement" from r6|7rs I guess) (test (do ((i 1 (+ i j))) ((>= i 2) (+ i j)) (define j i) j) 3) (test (do ((i 1 (+ i j))) ((>= i 2) (+ i j)) (define j (+ i 10)) j) 23) ;(test (do ((i 1 (+ i j))) ((>= i 2) (+ i j)) (if (integer? i) (define j i)) j) 3) (test (do ((i 0 (+ i 1))) ((>= i 2) i) (define i 10) i) 11) (test (do ((x (values (substring "0123" 2) #b101))) (#t (vector))) 'error) (test (do ((x 0 (values 1 2))) ((= x 2)) (display x #f)) 'error) (test (do ((i 0 (+ i 1))) ((values #t #f) 21) (abs i)) 21) (test (+ 1 (do ((i 0 (+ i 1))) ((values (= i 1) 2 3) 4)) 5) 10) ; (+ 1 (do (...) (#t 2 3 4)) 5) -> (+ 1 4 5) (test (+ 1 (do ((i 0 (+ i 1))) ((values (= i 1) 2 3))) 5) 'error) ; the #f gets spliced into + args (test (+ 1 (do ((i 0 (+ i 1))) ((values 2 3))) 5) 11) ; (+ 1 2 3 5) -- hmmm. (test (let ((x (do ((i 0 (+ i 1))) (#t)))) x) #t) ; guile: # (test (let () (define (f lst) (do ((lst lst (cddr lst)) (a () (cons (car lst) a))) ((null? lst) a))) (f '(1 2 3 4))) '(3 1)) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (list func cond (quote (nan? "") (append (lambda*)))))) (func)) 'error) (test (let () (define (func) (let ((x #f) (i 0)) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) (sqrt (* 2 2)))))) (func)) 2) ; tree_outer shadowed check (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (#_sqrt 2.0)))) (func)) #t) ; opt #_* change (test (let () (define (f) (do ((sum 0) (n 0 (+ n 1))) ((= n 3) sum) (do ((n 0 (+ n 1))) ((= n 4)) (set! sum (+ sum 1))))) (f) (f)) 12) (let () (define (f1) (do ((i 0 (+ i __unbound__))) ((= i 0) 32) (display "oops\n"))) (test (f1) 32)) (let () (define (func) (let ((x #f)) (do () ((not false) (((vector msym4) 0) my-with-baffle (* 2 x 3.0 4)))))) (test (func) 'error)) ;fx_T in check_do ("false"=undef) (test (let () (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1) x 3 4))) (f)) 4) ; op_dox_no_body_1 (test (let () (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1)))) (f)) #t) ; op_dox_no_body_1 (test (let () (define (f) (do ((i 0 (do ((i 0 (+ i 1))) ((= i 3) i)))) ((> i 0) i))) (f)) 3) (let () ; macroexpand in int-optimize bug (define-macro (hi) (values 3 1.2)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (hi))) (test (func) #t)) (let () (define (func) (do ((i '(1) (cdr i))) ((null? i)) (hi))) (test (func) #t)) (let () (define (func) (do ((i '(1) (cdr i))) ((null? i)) 1 (hi))) (test (func) #t))) ;;; do_loop_end slot arg bug (test (let ((__var2__ 3)) (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 100)) (let* () __var2__)))) (func) (func)) #t) (let () (define (strcop str) ; opt_dotimes >= case (coverage) (let* ((len (length str)) (new-str (make-string (+ len 3) #\a))) (do ((i 0 (+ i 1))) ((>= i len) new-str) (string-set! new-str i (string-ref str i))))) (test (strcop "123") "123aaa")) (let ((dbac (bacro* (c) `(provide 'asdf)))) ; check fx_tree choice in op_dox portion of check_do (define (func) (do ((x #f) (i 0 (+ i 1))) ((= i 1) x) (set! x (dbac)))) (test (func) 'asdf)) (let () ; check fx_choose let choice (define (frame1 n) (do ((_p_ (curlet)) (out _p_) (i 0 (+ i 1))) ((or (= i n) (not (let? out))) (format #t "frame1 _p_: ~S, out: ~S~%" _p_ out)))) (define (frame2) (frame1 1)) (catch #t (lambda () (let ((result (frame1 1))) (format *stderr* "frame1: ~S?\n" result))) (lambda (type info) (unless (and (eq? type 'unbound-variable) (string=? (substring (apply format #f info) 0 20) "unbound variable _p_")) (format *stderr* "frame1: ~S ~S~%" type (apply format #f info))))) (catch #t (lambda () (let ((result (frame2))) (format *stderr* "frame2: ~S?\n" result))) (lambda (type info) (unless (and (eq? type 'unbound-variable) (string=? (substring (apply format #f info) 0 20) "unbound variable _p_")) (format *stderr* "frame2: ~S ~S~%" type (apply format #f info)))))) (let ((y 0)) ; coverage test (do_no_body_fx_vars) (define (end x) (set! y x) (= y 3)) (define (dot) (do ((i 0 (+ i 1)) (j 3)) ((or (< i 0) (end i))))) (dot) (test y 3)) (let () (define (f1) (eval '(do ((i 0 j) (j 0 (+ j 1))) ((= j 3) i)))) (define (g) (catch #t f1 (lambda args #f))) (test (g) 2)) (let () ; int->real via set! after use as int in body: d_id_ok -> opt_d_id_sf bug (define (f1) (let ((x 0) (y 2.0)) (do ((i 0 (+ i 1))) ((= i 2)) (set! x (* i y)) (cos (+ x (* y 2.0)))))) (test (f1) #t) (define (f2) (let ((x 0) (y 2.1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 2) x) (set! x (* i j)) (cos (+ x (* y 2.3)))))) (test (f2) 1) (define (f3) (let ((x 0) (y 2)) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (* i y)) (set! y (* i 2.1)) (cos (+ x (* y 2.1)))))) (test (f3) 4.2) (define (f4) (let ((x 0) (y 2)) (do ((i 0 (+ i 1)) (j 0 (+ j 1.1))) ((= i 3) x) (set! x (* i j)) (cos (+ x (* y 2.1)))))) (test (f4) 4.4) (define (f5) (let ((x 0)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3) x) (set! x (max x (* i j)))))) (test (f5) 4) (define (f5a) (let ((x 0) (i 2.2) (j 2.1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3) x) (set! x (max x (* i j)))))) (test (f5a) 4) (define (f6) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (do ((j 0 (+ j 1))) ((= j 3)) (set! sum (+ sum i j)))))) (test (f6) 165)) (test (let ((lst '(1 2 3)) (v (vector 0 0 0))) (do ((l lst (map (lambda (a) (+ a 1)) (cdr l)))) ((null? l)) (set! (v (- (length l) 1)) (apply + l))) v) #(5 7 6)) (test (do ((i 0 (+ i 1)) (j 1 2)) ((= i 4) j) (set! j 3)) 2) (let () (define (iota n) (do ((n n (- n 1)) (lst () (cons (- n 1) lst))) ((= n 0) lst))) (test (iota 10) '(0 1 2 3 4 5 6 7 8 9))) ; a test of shadowing detection in check_do (test (let ((lst '(1 2 3))) (map (lambda (a) (let ((! 1)) (do ((i 0 (+ i 1)) (sum 0)) ((= i a) sum) (set! sum (+ sum a))))) lst)) '(1 4 9)) (let () ;; test that set! of stepper is ignored in step vals etc, Guile agrees except it says z is #, do is weird (define (hash-ints1 calls) (do ((i 0 (+ i 1)) (z 0 (set! i (- calls 1))) (steps 0 (+ steps i))) ((= i calls) (list i z steps)))) (test (hash-ints1 10) '(10 9 90))) (test (let ((sum 0)) (do ((i_0 0 (+ i_0 0))(i_1 1 (+ i_1 1))(i_2 2 (+ i_2 2))(i_3 3 (+ i_3 3))(i_4 4 (+ i_4 4))(i_5 5 (+ i_5 5))(i_6 6 (+ i_6 6))(i_7 7 (+ i_7 7))(i_8 8 (+ i_8 8))(i_9 9 (+ i_9 9))(i_10 10 (+ i_10 10))(i_11 11 (+ i_11 11))(i_12 12 (+ i_12 12))(i_13 13 (+ i_13 13))(i_14 14 (+ i_14 14))(i_15 15 (+ i_15 15))(i_16 16 (+ i_16 16))(i_17 17 (+ i_17 17))(i_18 18 (+ i_18 18))(i_19 19 (+ i_19 19))(i_20 20 (+ i_20 20))(i_21 21 (+ i_21 21))(i_22 22 (+ i_22 22))(i_23 23 (+ i_23 23))(i_24 24 (+ i_24 24))(i_25 25 (+ i_25 25))(i_26 26 (+ i_26 26))(i_27 27 (+ i_27 27))(i_28 28 (+ i_28 28))(i_29 29 (+ i_29 29))(i_30 30 (+ i_30 30))(i_31 31 (+ i_31 31))(i_32 32 (+ i_32 32))(i_33 33 (+ i_33 33))(i_34 34 (+ i_34 34))(i_35 35 (+ i_35 35))(i_36 36 (+ i_36 36))(i_37 37 (+ i_37 37))(i_38 38 (+ i_38 38))(i_39 39 (+ i_39 39))) ((= i_1 10) sum) (set! sum (+ sum i_0 i_1 i_2 i_3 i_4 i_5 i_6 i_7 i_8 i_9 i_10 i_11 i_12 i_13 i_14 i_15 i_16 i_17 i_18 i_19 i_20 i_21 i_22 i_23 i_24 i_25 i_26 i_27 i_28 i_29 i_30 i_31 i_32 i_33 i_34 i_35 i_36 i_37 i_38 i_39)))) 35100) (let () (define (jtest) (let ((j 0)) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set! j i))))) (test (jtest) 3)) (let () (define (jtest1) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (j 0) i))))) (test (jtest1) 3)) (let () (define (jtest2) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (vector-set! j 0 i))))) (test (jtest2) 3)) (let () (define (jtest3) (let ((j (vector 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (vector-ref j 0) i))))) (test (jtest3) 3)) (let () (define (jtest4) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (j 0) i))))) (test (jtest4) 3)) (let () (define (jtest5) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! (car j) i))))) (test (jtest5) 3)) (let () (define (jtest6) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set-car! j i))))) (test (jtest6) 3)) (let () (define (jtest7) (let ((j (list 0))) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (list-set! j 0 i))))) (test (jtest7) 3)) (let () (define (jtest8) (let ((j #f)) (do ((i 0 (+ i 1))) ((= i 10) (car j)) (if (= i 3) (set! j (list i)))))) (test (jtest8) 3)) (let () (define (jtest9) (let ((j #f)) (do ((i 0 (+ i 1))) ((= i 10) (j 0)) (if (= i 3) (set! j (vector i)))))) (test (jtest9) 3)) (let () (define (jtest10) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set-car! j i))))) (test (jtest10) '(3 . 2))) (let () (define (jtest10a) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (list-set! j 0 i))))) (test (jtest10a) '(3 . 2))) (let () (define (jtest11) (let ((j (cons 1 2))) (do ((i 0 (+ i 1))) ((= i 10) j) (if (= i 3) (set! j (cons 0 i)))))) (test (jtest11) '(0 . 3))) ;; (let ((f #f)) (define (jtest12) (do ((i 0 (+ i 1))) ((= i 10) (f)) (if (= i 3) (set! f (lambda () i))))) (test (jtest12) 3)) ;; this lambda business is a separate issue (s7 returns 10 here) ;; kinda excessive... (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j :allow-other-keys)))) (func) (func)) 'error) (test (let () (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (set! j :allow-other-keys))) (func)) 'error) (test (let ((v #r(1.0))) (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v))) (func)) 'error) ;opt_dotimes[82710]: not an integer, but a float-vector (type: 23) (test (let ((v "asdf")) (define (func) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v))) (func)) 'error) (test (let ((v #r(1.0))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) ;opt_i_ii_sc_add[59014] (test (let ((v '(1 2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v ())) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v #i(2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v #r(2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v #u(2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v (hash-table 'a 1))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v (inlet 'a 1))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v #)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v #)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v #)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v #t)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v #\a)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v when)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v 'when)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v (make-iterator #(1)))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v (c-pointer 1234))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v (random-state 1234))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v quasiquote)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) (test (let ((v abs)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) ;and the rest (i/o etc) (test (let ((v (block))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (set! j v)))) (func)) 'error) ; missing + method in (test (let ((v (byte-vector-ref #u(0) 0))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) #t) (test (let ((v 1/2)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0.0 (+ j 1.0))) ((>= j 0.0)) (set! j v)))) (func)) #t) ;float != rational also (test (let ((v 1/2)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) #t) (test (let ((v 2.0)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) #t) (test (let ((v 2+i)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) 'error) (test (let ((v #(2))) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((> j 0)) (set! j v)))) (func)) 'error) (let () ; opt_set_p_i|d_fm bug (define (f1) (let ((v (vector 0 0 0)) (y 1)) (do ((i 0 (+ i 1))) ((= i 3) v) (set! y (round (+ y 1))) (vector-set! v i y)))) (test (f1) #(2 3 4)) (define (f2) (let ((v (vector 0 0 0)) (y 1.0)) (do ((i 0 (+ i 1))) ((= i 3) v) (set! y (+ y 1.0)) (vector-set! v i y)))) (test (f2) #(2.0 3.0 4.0))) (test (let () (define-constant _bg_ 0) (define (f) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (set! _bg_ x)))) (f)) 0) ; op_set1 s7_is_eqv (let () ; opt_dotimes coverage tests (some miss their target...) (define (od1) (let ((fv #2r((0 1 2) (2 3 4)))) (do ((i 0 (+ i 1))) ((= i 2) fv) (float-vector-set! fv (+ i 0) (+ i 1) (* 2.0 3.0))))) (test (od1) #r2d((0.0 6.0 2.0) (2.0 3.0 6.0))) (define (od2) (let ((y 0) (z 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (= (+ z 1) 2.2) (display (+ z 1)))))) (test (od2) 0) (define (od3) (let ((len 2) (lst '(0 1 2 3))) (do ((i 0 (+ i 1))) ((= i len)) (if (not (= (list-ref lst i) i)) (display "oops"))))) (test (od3) #t) (define (od4) (let ((size 2) (vct-hash (hash-table #r(0.0) 0 #r(1.0) 1))) (do ((i 0 (+ i 1))) ((= i size)) (unless (= (hash-table-ref vct-hash (float-vector i)) i) (display "oops"))))) (test (od4) #t) (define (od5) (let ((v (vector 0 1 2)) (size 2)) (do ((i 0 (+ i 1))) ((= i size) (vector-ref v 0)) (vector-set! v i 2)))) (test (od5) 2) (define (od51) (let ((v #u(0 1 2)) (size 2)) (do ((i 0 (+ i 1))) ((= i size) (byte-vector-ref v 0)) (byte-vector-set! v i 2)))) (test (od51) 2) (define (od6) (do ((i 0 (+ i 1))) ((= i 1)) (char-alphabetic? (string-ref "asdf" 1)))) (test (od6) #t) (define (od7) (let ((len 2) (mx 0) (loc 0) (vect #(0 1 2))) (do ((i 0 (+ i 1))) ((= i len) (list mx loc)) (when (> (abs (vect i)) mx) (set! mx (vect i)) (set! loc i))))) (test (od7) '(1 1)) (define (od8) (let ((sum 0) (v #2d((0 0) (1 1) (2 2))) (size/10 1)) (do ((k 0 (+ k 1))) ((= k 1) sum) (do ((i 0 (+ i 1))) ((= i size/10)) (set! sum (+ sum (round (vector-ref v k i)))))))) (test (od8) 0) (define (od9) (let ((len 2) (mx 0) (loc 0) (vect #(0 1 2))) (do ((i 0 (+ i 1))) ((= i len) (list mx loc)) (when (> (abs (vect i)) mx) (set! mx (vect i)) (set! loc i))))) (test (od9) '(1 1)) (define (od10) (let ((x 0.0) (x1 1.0) (x2 2.0) (b1 (block 1.0)) (b2 (block 2.0)) (j 0)) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (+ (* x1 (block-ref b1 i)) (* x2 (block-ref b2 j))))))) (test (od10) 5.0) (define (od11) (let ((sum 0) (v #r(1 2 3)) (size 3)) (do ((i 0 (+ i 1))) ((= i size) sum) (set! sum (+ sum (floor (vector-ref v i))))))) (test (od11) 6) (define (od12) (let ((strs #("asdf"))) (do ((i 0 (+ i 1))) ((= i 1) strs) (copy (vector-ref strs i) (make-string 1)) (copy (vector-ref strs i) (make-string 0))))) (test (od12) #("asdf")) (define (od13) (let ((j 0) (len2 1) (obj #(0 1)) (n 0) (seq2 '(0 1))) (do ((k j (+ k 1))) ((= k len2) obj) (set! (obj n) (seq2 k)) (set! n (+ n 1))))) (test (od13) #(0 1))) ;; do_all_x: (let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i (abs i))))) (test (f1) #(0 1 2))) (let () (define (f1) (let ((v (vector 0 0 0)) (x #f)) (do ((i 0 (+ i 1))) ((= i 3) (set! x v) x) (vector-set! v i (abs i))))) (test (f1) #(0 1 2))) (let () (define (f1) (let ((end 3) (v (vector 0 0 0))) (vector (do ((i 0 (+ i 1))) ((= i end)) (vector-set! v i (abs i))) v))) (test (f1) #(#t #(0 1 2)))) (let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 3) v) (display i #f) (vector-set! v i (abs i))))) (test (f1) #(0 1 2))) (let () ; op_dox gxable section (coverage) (define (f2 x) (floor x)) (define (ftst2) (do ((i 1 (+ i 1)) (j 1.0 (+ j 0.21))) ((= i 10) (f2 j)) (f2 j))) (test (ftst2) 2)) (let () (define (f1) (let ((v (vector 0 0 0))) (do ((i 0 (+ i 1))) ((= i 0) v) (vector-set! v i (abs i))))) (test (f1) #(0 0 0))) (let () (define (safe-do-all-x) (let ((v1 (vector 1 2 3 4 5 6)) (v2 (vector 10 11 12 13 14 15))) (do ((i 0 (+ i 1))) ((= i 3)) (vector-set! v1 i (vector-ref v2 (+ i 1)))) v1)) (test (safe-do-all-x) (vector 11 12 13 4 5 6))) (test (let () (define (step-it a) (+ a 1)) (define (hi) (do ((i 0 (step-it i))) ((= i 3) i))) (hi) (hi)) 3) (test (call-with-exit (lambda (return) (do () () (if #t (return 123))))) 123) (test (call-with-exit (lambda (return) (do () (#f) (if #t (return 123))))) 123) (test (call-with-exit (lambda (return) (do ((i 0 (+ i 1))) () (if (= i 100) (return 123))))) 123) (test (call-with-exit (lambda (return) (do () ((return 123))))) 123) (test (call-with-exit (lambda (return) (do () (#t (return 123))))) 123) (test (do () (/ 0)) 0) (test (do () (+)) +) (test (do () (+ +) *) +) (when with-bignums (num-test (do ((i 24444516448431392447461 (+ i 1)) (j 0 (+ j 1))) ((>= i 24444516448431392447471) j)) 10) (num-test (do ((i 0 (+ i 24444516448431392447461)) (j 0 (+ j 1))) ((>= i 244445164484313924474610) j)) 10) (num-test (do ((i 4096 (* i 2)) (j 0 (+ j 1))) ((= i 4722366482869645213696) j)) 60)) (test (do ((i 9223372036854775805 (+ i 1)) (j 0 (+ j 1))) ((>= i 9223372036854775807) j)) 2) (test (do ((i -9223372036854775805 (- i 1)) (j 0 (+ j 1))) ((<= i -9223372036854775808) j)) 3) (num-test (do ((x (list 1 2 3) (cdr x)) (j -1)) ((null? x) j) (set! j (car x))) 3) (test (let ((x 0)) (do ((i 0 (+ i 1))) ((= i (do ((j 0 (+ j 1))) ((= j 2) (+ j 1))))) (set! x (+ x i))) x) 3) (test (let ((x 0)) (do ((i 0 (+ i (do ((j 0 (+ j 1))) ((= j 2) 1))))) ((= i 3) x) (set! x (+ x i)))) 3) (test (let ((x 0)) (do ((i 0 (+ i (do ((j 0 (+ j 1))) ((= j 2) 1))))) ((= i 3) (do ((j 0 (+ j 1))) ((= j 5) x) (set! x j))) (set! x (+ x i)))) 4) (let () (define (mk2 n) (do ((n n (- n 1)) (a () (cons () a))) ((= n 0) a))) (test (mk2 3) '(() () ()))) (test (call-with-exit (lambda (exit) (do ((i 0 (+ i 1))) ((= i 100) i) (if (= i 2) (exit 321))))) 321) (test (call-with-exit (lambda (exit) (do ((i 0 (if (= i 3) (exit 321) (+ i 1)))) ((= i 100) i)))) 321) (test (call-with-exit (lambda (exit) (do ((i 0 (+ i 1))) ((= i 10) (exit 321))))) 321) (test (call-with-exit (lambda (exit) (do ((i 0 (+ i 1))) ((= i 10) i) (if (= i -2) (exit 321))))) 10) (test (do ((x 0 (+ x 1)) (y 0 (call/cc (lambda (c) c)))) ((> x 5) x) #f) 6) (test (let ((happy #f)) (do ((i 0 (+ i 1))) (happy happy) (if (> i 3) (set! happy i)))) 4) (test (+ (do ((i 0 (+ i 1))) ((= i 3) i)) (do ((j 0 (+ j 1))) ((= j 4) j))) 7) (test (do ((i (if #f #f))) (i i)) (if #f #f)) (test (do ((i (if #f #f)) (j #f i)) (j j)) (if #f #f)) (test (let ((cont #f) (j 0) (k 0)) (call/cc (lambda (exit) (do ((i 0 (+ i 1))) ((= i 100) i) (set! j i) (call/cc (lambda (r) (set! cont r))) (if (= j 2) (exit)) (set! k i)))) (if (= j 2) (begin (set! j 3) (cont)) (list j k))) (list 99 99)) (test (call/cc (lambda (r) (do () (#f) (r 1)))) 1) (test (let ((hi (lambda (x) (+ x 1)))) (do ((i 0 (hi i))) ((= i 3) i))) 3) (test (do ((i 0 (+ i 1))) (list 1) ((= i 3) #t)) 1) ; a typo originally -- Guile and Gauche are happy with it (test (do () (1 2) 3) 2) ;; from sacla tests (test (let ((rev (lambda (list) (do ((x list (cdr x)) (reverse () (cons (car x) reverse))) ((null? x) reverse))))) (and (null? (rev ())) (equal? (rev '(0 1 2 3 4)) '(4 3 2 1 0)))) #t) (test (let ((nrev (lambda (list) (do ((f1st (if (null? list) () (cdr list)) (if (null? f1st) () (cdr f1st))) (s2nd list f1st) (t3rd () s2nd)) ((null? s2nd) t3rd) (set-cdr! s2nd t3rd))))) (and (null? (nrev ())) (equal? (nrev (list 0 1 2 3 4)) '(4 3 2 1 0)))) #t) (test (do ((temp-one 1 (+ temp-one 1)) (temp-two 0 (- temp-two 1))) ((> (- temp-one temp-two) 5) temp-one)) 4) (test (do ((temp-one 1 (+ temp-one 1)) (temp-two 0 (+ temp-one 1))) ((= 3 temp-two) temp-one)) 3) (let ((vec (vector 0 1 2 3 4 5 6 7 8 9))) (test (do ((i 0 (+ 1 i)) (n #f) (j 9 (- j 1))) ((>= i j) vec) (set! n (vector-ref vec i)) (vector-set! vec i (vector-ref vec j)) (vector-set! vec j n)) #(9 8 7 6 5 4 3 2 1 0))) (test (do ((i 0 (+ i 1))) (#t i) (error 'syntax-error "do evaluated its body?")) 0) (test (do '() (#t 1)) 'error) (test (do . 1) 'error) (test (do ((i i i)) (i i)) 'error) (test (do ((i 0 i (+ i 1))) (i i)) 'error) (test (do ((i)) (#t i)) 'error) (test (do ((i 0 (+ i 1))) #t) 'error) (test (do 123 (#t 1)) 'error) (test (do ((i 1)) (#t . 1) 1) 'error) (test (do ((i 1) . 1) (#t 1) 1) 'error) (test (do ((i 1) ()) (= i 1)) 'error) (test (do ((i 0 . 1)) ((= i 1)) i) 'error) (test (do ((i 0 (+ i 1))) ((= i 3)) (set! i "hiho")) 'error) (test (let ((do+ +)) (do ((i 0 (do+ i 1))) ((= i 3)) (set! do+ abs))) 'error) (test (do () . 1) 'error) (test (do ((i)) (1 2)) 'error) (test (do (((i))) (1 2)) 'error) (test (do ((i 1) ((j))) (1 2)) 'error) (test (do (((1))) (1 2)) 'error) (test (do ((pi 1 2)) (#t pi)) 'error) (test (do ((1+i 2 3)) (#t #t)) 'error) (test (do ((1.2 2 3)) (#t #t)) 'error) (test (do (((1 . 2) "hi" (1 2))) (#t 1)) 'error) (test (do ((() () ())) (#t #t)) 'error) (test (do (("hi" "hi")) ("hi")) 'error) (test (do ((:hi 1 2)) (#t :hi)) 'error) (test (do ((i 0 (abs ()))) ((not (= i 0)) i)) 'error) (test (do ((i j) (j i)) (i i)) 'error) (test (do ((i 0 0) . ((j 0 j))) (#t j)) 0) (test (do ((i 0 1 . 2)) (#t i)) 'error) (test (do ((i 0 "hi")) ((string? i) . i)) 'error) (test (do ((i 0 j)) (#t i)) 0) ; guile also -- (do ((i 0 (abs "hi"))) (#t i)) etc (do ((i 0 1)) (#t i) (abs "hi")) (test (do ((i 0 1) . (j 0 0)) ((= i 1) i) i) 'error) (test (do ((i 0 1) ((j 0 0)) ((= i 1) i)) i) 'error) (test (do #f) 'error) (test (do () #f) 'error) (test (do () #()) 'error) (test (do '((i 1)) ()) 'error) (test (do #() ()) 'error) (test (do ((#() 1)) ()) 'error) (test (do ((1)) ()) 'error) (test (do ((i 1) . #(a 1)) ()) 'error) (test (do () ((3 4))) 'error) (test (do ((i 1)) '()) ()) (test (do . (() (#t 1))) 1) (test (do () . ((#t 1))) 1) (test (do ((i 1 (+ i 1))) . ((() . ()))) ()) (test (do ((a . 1) (b . 2)) () a) 'error) (let () (define (d1) (do ((i 0 (+ i 1))) ((= i 3) . i) (display i))) (test (d1) 'error)) (let () (define (d1) (do ((i 0 (+ i 1))) ((= i 3) i) . i)) (test (d1) 'error)) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1) i) ((0 1) ()))) (f)) 'error) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1) i) () (define-macro (_m1_ a) (list-values '+ a 1)))) (f)) 1) (test (let () (define (f) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 1) i) () (define-macro (_m1_ a) (list-values '+ a 1)))) (f)) 1) (test (let () (define (f) (do ((i 0 (+ i 1)) (x (provide ':allow-other-keys) (provide ':allow-other-keys))) ((= i 1) x))) (f)) :allow-other-keys) (test (let () (define-constant bigcmp1 1+2i) (define (func) (let ((_x_ 1)) (do ((i 0 (+ i _x_))) ((= i _x_)) (set! bigcmp1 (bignum 0+i))))) (func)) 'error) ; bigcmp1 constant (test (let () (define (func) (let ((x #f)) (do () ((not false) (abs x))))) (func) (func)) 'error) ; op_do_no_vars don't free inner let! (let () ; opt_cell_do test for expr as init (define (f v x) (let ((len (length v)) (sum 0)) (do ((j 0 (+ j 1))) ((= j 1) sum) (do ((i (+ x 1) (+ i 1))) ((= i len)) (set! sum (+ sum (int-vector-ref v i))))))) (define v (make-int-vector 10)) (do ((i 0 (+ i 1))) ((= i 10)) (int-vector-set! v i i)) (test (f v 2) (+ 3 4 5 6 7 8 9))) (test (define-constant) 'error) (test (define-constant _asdf_ 2 3) 'error) (test (define-constant pi 3) 'error) ; except in Utah (test (define-constant pi . 3) 'error) (define-constant __do_step_var_check__ 1) (test (do ((__do_step_var_check__ 2 3)) (#t #t)) 'error) (test (let ((__do_step_var_check__ 2)) 1) 'error) (test (let () (set! __do_step_var_check__ 2)) 'error) (test (let ((__a_var__ 123)) (set! (setter '__a_var__) (lambda (val sym) 0)) (set! __a_var__ -1123)) 0) (test (do ((hi #3d(((1 2) (3 4)) ((5 6) (7 8))) (hi 1))) ((equal? hi 8) hi)) 8) (test (do ((i 0 ('((1 2) (3 4)) 0 1))) ((not (= i 0)) i)) 2) (test (do () (#t (+ 1 2 3))) 6) (test (do ((f + *) (j 1 (+ j 1))) ((= j 2) (apply f (list j j)))) 4) (test (do ((f lambda) (j 1 (+ j 1))) ((= j 2) ((f (a) (+ a j)) 3))) 5) (let () (define-macro (add-1 x) `(+ ,x 1)) (test (do ((i 0 (add-1 i))) ((= i 3) i)) 3) (test (do ((i 0 (add-1 i))) ((= i 3) (add-1 i))) 4)) (test (let ((j #f)) (do ((i 0 (let ((x 0)) (dynamic-wind (lambda () (set! x i)) (lambda () (+ x 1)) (lambda () (if (> x 3) (set! j #t))))))) (j i))) 5) (test (let ((j 0)) (do ((i 0 (eval-string "(+ j 1)"))) ((= i 4) j) (set! j i))) 3) (test (do ((i (do ((i (do ((i 0 (+ i 1))) ((= i 3) (+ i 1))) (do ((j 0 (+ j 1))) ((= j 3)) (+ j i)))) ((> (do ((k 0 (+ k 1))) ((= k 2) (* k 4))) (do ((n 0 (+ n 1))) ((= n 3) n))) (do ((m 0 (+ m 1))) ((= m 3) (+ m i))))) i)) ((> i 6) i)) 7) (test (let ((L (list 1 2))) (do ((sum 0 (+ sum (car lst))) (i 0 (+ i 1)) (lst L (cdr lst))) ((or (null? lst) (> i 10)) sum) (set-cdr! (cdr L) L))) 16) ;;; optimizer checks (num-test (let ((x 0)) (do ((i 1.0 (+ i 1))) ((> i 3)) (set! x (+ x i))) x) 6.0) (num-test (let ((x 0)) (do ((i 1 4)) ((> i 3)) (set! x (+ x i))) x) 1) (num-test (let ((x 0)) (do ((i 1 ((if #t + -) i 1))) ((> i 3)) (set! x (+ x i))) x) 6) (num-test (let ((x 0)) (do ((i 1 (+))) ((> i 0)) (set! x (+ x i))) x) 0) (let () (define (f12345) (let ((x 0)) (do ((i 1 (+))) ((> i 0)) (set! x (+ x i))) x) 0) (f12345) (f12345)) (num-test (let ((x 0)) (do ((i 1 (+ 1))) ((> i 0)) (set! x (+ x i))) x) 0) (num-test (let ((x 0)) (do ((i 1 (+ 1 i 2))) ((> i 10)) (set! x (+ x i))) x) 22) (num-test (let ((x 0)) (do ((i 1 (+ 1.0 i))) ((> i 3)) (set! x (+ x i))) x) 6.0) (num-test (let ((x 0)) (do ((i 1 (+ 1 pi))) ((> i 2)) (set! x (+ x i))) x) 1) (num-test (do ((i 0 (+ 1 pi))) ((> i 2) i)) (+ pi 1.0)) (num-test (let ((x 0)) (do ((i 0 (+ i 8796093022208))) ((> i 0)) (set! x (+ x i))) x) 0) (num-test (let ((x 0)) (do ((i 0 (+ i 8796093022208))) ((> i 17592186044416)) (set! x (+ x i))) x) (+ (expt 2 44) (expt 2 43))) (num-test (let ((x 0)) (do ((i 1 (* i 2))) ((> i 10)) (set! x (+ x i))) x) 15) (num-test (do ((i 0 (+ i 1))) ((> i 2) i) (set! i (+ i 3.0))) 4.0) (num-test (let ((x 0)) (let ((add +)) (do ((i 0 (add i 1))) ((< i -2)) (set! add -) (set! x (+ x i)))) x) -3) (num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) x) (set! x (+ x i)))) 3) (num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) x) (set! x (+ x i)) (set! i (* i 1.0)))) 3.0) (num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) x) (set! x (+ x i)) (set! equals >))) 6) (num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) x) (set! x (+ x i)) (set! equals =))) 3) (num-test (let ((equals =) (x 0)) (do ((i 0 (+ i 1))) ((equals i 3) (set! x (+ x 1)) x) (set! x (+ x i)) (set! equals =))) 4) (num-test (do ((i 0 (+ i 1))) ((> i 3) i) (set! i (expt 2 60))) (+ 1 (expt 2 60))) (num-test (let ((x 0) (n 3)) (do ((i 0 (+ i 1))) ((= i n) x) (set! x (+ x i)))) 3) (num-test (let ((x 0) (n 3)) (do ((i 0 (+ i 1))) ((= 1 1) x) (set! x (+ x i)))) 0) (num-test (let ((x 0) (n (expt 2 50))) (do ((i 0 (+ i n))) ((= i (expt 2 51)) x) (set! x (+ x i)))) (expt 2 50)) (num-test (let ((x 0) (n 31.0)) (do ((i 0 (+ i 1))) ((= i n) x) (set! x (+ x i)) (set! n 3))) 3) (num-test (let ((x 0)) (do ((i 0 (+ i 1/2))) ((= i 3) x) (set! x (+ x i)))) 15/2) (num-test (let ((x 0)) (do ((i 0 (+ i 1+i))) ((> (magnitude i) 3) x) (set! x (+ x i)))) 3+3i) (num-test (call-with-exit (lambda (r) (do () () (r 1)))) 1) (num-test (call-with-exit (lambda (r) (do () (#t 10 14) (r 1)))) 14) (num-test (do ((i 0 (+ i 1))) (#t 10 12)) 12) (num-test (do ((i 0 (+ i 1))) ((= i 3) i)) 3) (num-test (do ((i 0 (+ i 1))) ((> i 3) i)) 4) (num-test (do ((i 0 (+ i 1))) ((< i 3) i)) 0) (num-test (do ((i 0 (+ i 1))) ((<= i 3) i)) 0) (num-test (do ((i 0 (+ i 1))) ((>= i 3) i)) 3) (num-test (do ((i 0 (+ i 1))) ((>= 3 i) i)) 0) (num-test (do ((i 0 (+ i 1))) ((> 3 i) i)) 0) (num-test (do ((i 0 (+ i 1))) ((< 3 i) i)) 4) (num-test (do ((i 0 (+ i 1))) ((<= 3 i) i)) 3) (num-test (let ((n 3)) (do ((i 0 (+ i 1))) ((> i n) i))) 4) (num-test (let ((n 3)) (do ((i 0 (+ i 1))) ((< n i) i))) 4) (num-test (do ((i 10 (- i 1))) ((= i 0) i)) 0) (num-test (do ((i 10 (- 1 i))) ((< i 0) i)) -9) (num-test (do ((i 10 (- i 3))) ((< i 0) i)) -2) (let () (define (hi) (do ((i 1 (+ 1 i))) ((= i 1) i))) (hi) (test (hi) 1)) (let () (define (hi) (do ((i 10 (+ i 1))) ((= i 10) i) (abs i))) (hi) (test (hi) 10)) (let ((sum 0)) (define (hi) (do ((i 10 (+ i 1))) ((= i 10) i) (set! sum (+ sum i)))) (hi) (test (hi) 10)) (let () (define (hi a) (do ((i a (+ i 1))) ((= i a) i) (+ a 1))) (hi 1) (test (hi 1) 1)) (let () (define (lcopy x) (length x)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (lcopy '(1 2)))) (test (f) #t)) ; safe_dotimes_step_o (let () (define (fx) (let ((iter (make-iterator #(1 2 3)))) (do () ((or (string? (iterate iter)) (iterator-at-end? iter)) (not (iterator-at-end? iter)))))) (test (fx) #f)) (let () (define (fx1) (let ((iter (make-iterator #(1 2 3)))) (do () ((or (= (iterate iter) 2) (iterator-at-end? iter)) (iterate iter))))) (test (fx1) 3)) (let () (define (fx2) (let ((iter (make-iterator #(1 2 3)))) (do () ((= (iterate iter) 2) (iterate iter))))) (test (fx2) 3)) (let () (define (fdo1) (let ((abs (lambda (x) (+ x 1))) (x '(1 2 3))) (do ((i 0 (+ i 1))) ((= i 1)) (if (not (equal? (map abs x) '(2 3 4))) (format () "fdo1 map case: ~S" (map abs x)))) (do ((i 0 (+ i 1))) ((= i 1)) (if (not (equal? (for-each abs x) #)) (display "fdo1 for-each case"))))) (define (fdo2) (let ((abs (lambda (x y) (= x y))) (x '(1 2 3))) (do ((i 0 (+ i 1))) ((= i 1)) (if (not (member 2 x abs)) (display "fdo2 member case"))))) (define (fdo3) (let ((abs (lambda (x y) (= x y))) (x '((1 a) (2 b) (3 c)))) (do ((i 0 (+ i 1))) ((= i 1)) (if (not (assoc 2 x abs)) (display "fdo3 assoc case"))))) (define (fdo4) (let ((abs (lambda (x y) (> x y))) (x (list 1 2 3))) (do ((i 0 (+ i 1))) ((= i 1)) (if (not (equal? (sort! x abs) '(3 2 1))) (display "fdo4 sort! case"))))) (fdo1) (fdo2) (fdo3) (fdo4)) ;; next 7 are probing 2 bugs in opt_cell_do (let () (define (ho1) (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((z 12) (i i (+ i 1))) ((= i 7)) (set! x (+ x i)))) x)) (test (ho1) 44)) (let () (define (ho2) (let ((x 0) (i 3)) (do ((i i (+ i 1))) ((= i 6)) (do ((j i (+ j 1))) ((= j 7)) (set! x (+ x j)))) x)) (test (ho2) 44)) (let () (define (ho3) (let ((x 0) (k 3)) (do ((i k (+ i 1))) ((= i 6)) (do ((j i (+ j 1))) ((= j 7)) (set! x (+ x j)))) x)) (test (ho3) 44)) (let () (define (ho4) (let ((x (vector 0)) (k 3)) (do ((i k (+ i 1))) ((= i 6)) (do ((j i (+ j 1))) ((= j 7)) (vector-set! x 0 (+ (vector-ref x 0) j)))) ; also int-vector, list, but not car! x)) (test (ho4) #(44))) (let () (define (ho5) (let ((x (vector 0)) (k 3)) (let loop1 ((i k)) (when (< i 6) (do ((j i (+ j 1))) ((= j 7)) (vector-set! x 0 (+ (vector-ref x 0) j))) (loop1 (+ i 1)))) x)) (test (ho5) #(44))) (let () (define (ho6) (let ((x (vector 0)) (k 3)) (let loop1 ((i k)) (when (< i 6) (let loop2 ((j i)) (when (< j 7) (vector-set! x 0 (+ (vector-ref x 0) j)) (loop2 (+ j 1)))) (loop1 (+ i 1)))) x)) (test (ho6) #(44))) (let () (define (ho7) (let ((x (list 0)) (k 3)) (do ((i k (+ i 1))) ((= i 6)) (do ((j i (+ j 1))) ((= j 7)) (set-car! x (+ (car x) j)))) x)) (test (ho7) '(44))) (let () (define (f6 x) (let ((j 32)) (let ((k 20)) (if (= x 1) (define j 12)) (do ((i 0 (+ i 1))) ((>= i 3) j) (display i #f))))) (test (f6 0) 32) (test (f6 1) 12)) ; fx_W bug -> 32 (let () ;; opt_do_any (define (h1) (let ((sum 0) (lsum 0)) (do ((i 0 (+ i 1))) ((= i 10)) (do ((k 0 (+ k 1))) ((= k 8) (set! sum (+ sum lsum))) (set! lsum (+ lsum k)))) sum)) (test (h1) 1540) (define (h2) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10)) (do ((lsum 0) (k 0 (+ k 1))) ((= k 8) (set! sum (+ sum lsum))) (set! lsum (+ lsum k)))) sum)) (test (h2) 280) (define (h3) (do ((sum 0) (i 0 (+ i 1))) ((= i 10) sum) (do ((lsum 0) (k 0 (+ k 1))) ((= k 8) (set! sum (+ sum lsum))) (set! lsum (+ lsum k))))) (test (h3) 280) (define (h4) (do ((sum 0) (i 0 (+ i 1))) ((= i 10) (set! sum (/ sum 2)) sum) (do ((lsum 0) (k 0 (+ k 1))) ((= k 8) (set! sum (+ sum lsum))) (set! lsum (+ lsum k))))) (test (h4) 140) (define (f1) (let ((sum #i(0))) (do ((i 0 (+ i 1))) ((= i 10) sum) (case (remainder i 3) ((0) (int-vector-set! sum 0 (+ (int-vector-ref sum 0) 1))) ((1) (int-vector-set! sum 0 (+ (int-vector-ref sum 0) 2))) (else (int-vector-set! sum 0 (+ (int-vector-ref sum 0) 3))))))) (test (f1) #i(19)) (define (f2) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (case (remainder i 3) ((0) (set! sum (+ sum 1))) ((1) (set! sum (+ sum 2))) (else (set! sum (+ sum 3))))))) ; 19 (test (f2) 19) (define (f3) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (case (remainder i 3) ((0) (set! sum (+ sum 2)) (set! sum (- sum 1))) ((1) (set! sum (+ sum 2))) (else (set! sum (+ sum 3))))))) ; 19 (test (f3) 19) (define (f4) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (case (remainder i 3) ((0) (set! sum (+ sum 1))) ((1) (set! sum (+ sum 2))) ((3) (set! sum (+ sum 3))))))) ; 10 (test (f4) 10) (define (f41) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (case (remainder i 3) ((0) (set! sum (+ sum 1))) ((1) (set! sum (+ sum 2))) ((2) (set! sum (+ sum 3))))))) ; 19 (test (f41) 19) (define (f5) (let ((res 0)) (do ((i 0 (+ i 1))) ((= i 10) res) (case i ((0 1 2 3 4 5 6) (set! res 1)) ((7 8 9) (set! res 123)))))) ; 123 (test (f5) 123) (define (f6) (let ((res 0)) (do ((i 0 (+ i 1))) ((= i 10) res) (set! res (case i ((0 1 2 3 4 5 6) 1) ((7 8 9) 2)))))) ; 2 (test (f6) 2) (define (f7) (let ((res 0)) (do ((i 0 (+ i 1))) ((= i 10) res) (set! res (case i ((0 1 2 3 4 5 6) 1) ((7 8) 2)))))) ; # (test (f7) #) (define (f8) (let ((res 0)) (do ((i 0 (+ i 1))) ((= i 10) res) (set! res (+ (case i ((0 1 2 3 4 5 6) 1) (else 2)) 123))))) ; 125 (test (f8) 125) (let () ; opt_cond_1 (define (cd1) (let ((v (make-vector 6 #f))) (do ((i 0 (+ i 1))) ((= i 6) v) (vector-set! v i (cond ((< i 3) (+ i 10))))))) (test (cd1) #(10 11 12 # # #)) (define (cd2 x) ; opt_cond_2 (let ((y 0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x z) (set! y (+ y 1))) (else 3))))) (test (cd2 1.0) 3) (test (cd2 0.0) 0) (define (cd3) ; opt_cond (let ((v (make-vector 6 #f))) (do ((i 0 (+ i 1))) ((= i 6) v) (vector-set! v i (cond ((< i 3) (+ i 10)) ((>= i 3) (- i 10))))))) (test (cd3) #(10 11 12 -7 -6 -5)) (define (cd4) ; opt_cond (let ((v (make-vector 6 #f))) (do ((i 0 (+ i 1))) ((= i 6) v) (vector-set! v i (cond ((< i 2) (+ i 10)) ((= i 2) 123) ((> i 3) (- i 10))))))) (test (cd4) #(10 11 123 # -6 -5))) (define (do1) (let ((v (make-int-vector 10))) (do ((k 0 (+ k 1))) ((= k 1) (int-vector-ref v 0)) (do ((i 0 (+ i 1)) (j 0 (+ j 2))) ((= i 10) (set! j (* j 2)) (int-vector-set! v 0 (+ i j))) (int-vector-set! v 1 1) (int-vector-set! v 0 0))))) (test (do1) 50) (define (do2) (let ((v (make-int-vector 10))) (do ((k 0 (+ k 1))) ((= k 1) (int-vector-ref v 0)) (do ((i 0 (+ i 1)) (j 0 (+ j 2)) (z 32)) ((= i 10) (set! j (* j 2)) (int-vector-set! v 0 (+ i j z))) (int-vector-set! v 1 1) (int-vector-set! v 0 0))))) (test (do2) 82) (define (do3) (let ((v (make-int-vector 10))) (do ((k 0 (+ k 1))) ((= k 1) (int-vector-ref v 0)) (do ((i 0 (+ i 1)) (z 32) (j 0 (+ j 2))) ((= i 10) (set! j (* j 2)) (int-vector-set! v 0 (+ i j z))) (int-vector-set! v 1 1) (int-vector-set! v 0 0))))) (test (do3) 82)) (let () (define (fdo5) (do ((si () '())) ((null? si) 'mi))) (test (fdo5) 'mi)) (let () (define (fdo5) (do ((si '() '())) ((null? si) 'mi))) (test (fdo5) 'mi)) (let () (define (fdo5) (do ((si () ())) ((null? si) 'mi))) (test (fdo5) 'mi)) (let () (define (fdo5) (do ((si () ())) ((null? si) 'mi))) (test (fdo5) 'mi)) (let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (if x (set! y (+ y 1)))))) (test (f1 #t) 3)) ; b_s -> if_bp (let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not x) (set! y (+ y 1)))))) (test (f1 #f) 3)) ; b_s -> if_nbp (let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond (x (set! y (+ y 1))) (else 3))))) (test (f1 #t) 3)) ; b_s (let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((zero? x) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_i_s and b_t (let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((positive? x) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_d_s (let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((positive? (car x)) (set! y (+ y 1))) (else 3))))) (test (f1 '(1)) 3)) ; b_p_f (let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x 1) (set! y (+ y 1))) (else 3))))) (test (f1 1) 3)) ; b_ii_sc (let () (define (f1 x) (let ((y 0) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x z) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_ii_ss (let () (define (f1 x) (let ((y 0) (z '(0))) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x (car z)) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_pp_sfo (let () (define (f1 x) (let ((y 0) (z '(0))) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= (car z) x) (set! y (+ y 1))) (else 3))))) (test (f1 0) 3)) ; b_pi_fs (let () (define (f1 x) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x 1.0) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_dd_sc (let () (define (f1 x) (let ((y 0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= x z) (set! y (+ y 1))) (else 3))))) (test (f1 1.0) 3)) ; b_dd_ss (let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y 1))))) (test (f1) 3)) ; i_ii_sc set_i_i_f (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y z))))) (test (f1) 3)) ; i_ii_ss (let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y 1)))) (test (f1) 1)) ; i_c (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y z)))) (test (f1) 1)) ; i_s (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor z))))) (test (f1) 1)) ; i_i_s (let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor 1.1))))) (test (f1) 1)) ; i_d_c (let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor 1))))) (test (f1) 1)) ; i_i_c (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor (* 1.2 z)))))) (test (f1) 1)) ; i_d_f (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (floor (* 1 z)))))) (test (f1) 1)) ; i_ii_cs i_i_f set_i_i_f (let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1 1))))) (test (f1) 2)) ; i_ii_cc (let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1 (abs 1)))))) (test (f1) 2)) ; i_ii_cf (let () (define (f1) (let ((y 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1) 1))))) (test (f1) 2)) ; i_ii_fc (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z (abs 1)))))) (test (f1) 2)) ; i_ii_sf (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1) (abs 1)))))) (test (f1) 2)) ; i_ii_ff (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1 z 1))))) (test (f1) 4)) ; i_add2 (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1 z 1 z 1))))) (test (f1) 6)) ; i_add_any_f (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1 z 1))))) (test (f1) 1)) ; i_mul2 (let () (define (f1) (let ((y 0) (z 1)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1 z 1 z 1))))) (test (f1) 1)) ; i_multiply_any_f (let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y 1.0))))) (test (f1) 3.0)) ; d_dd_sc set_d_d_f (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ y z))))) (test (f1) 3.0)) ; d_dd_ss (let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y 1.0)))) (test (f1) 1.0)) ; d_c (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y z)))) (test (f1) 1.0)) ; d_s (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs z))))) (test (f1) 1.0)) ; d_d_s (let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs 1.1))))) (test (f1) 1.1)) ; d_d_c (let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs 1))))) (test (equivalent? (f1) 1.0) #t)) ; d_d_c (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs (* 1.2 z)))))) (test (f1) 1.2)) ;d_dd_cs (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (abs (* 1 z)))))) (test (f1) 1.0)) ; d_dd_cs (let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1.0 1.0))))) (test (f1) 2.0)) ; d_dd_cc (let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ 1.0 (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_cf (let () (define (f1) (let ((y 0.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1.0) 1.0))))) (test (f1) 2.0)) ; d_d_c d_dd_fc (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_sf (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ (abs 1.0) (abs 1.0)))))) (test (f1) 2.0)) ; d_dd_ff (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1.0 z 1.0))))) (test (f1) 4.0)) ; d_dddd_ffff (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (+ z 1.0 z 1.0 z 1.0))))) (test (f1) 6.0)) ; d_add_any_f (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1.0 z 1.0))))) (test (f1) 1.0)) ; d_dddd_ffff (let () (define (f1) (let ((y 0.0) (z 1.0)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (* z 1.0 z 1.0 z 1.0))))) (test (f1) 1.0)) ; d_multiply_any_f (let () (define (f1) (let ((y #\b)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y #\a)))) (test (f1) #\a)) ; p_c set_p_p_f (let () (define (f1) (let ((y #\b) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) z) (set! z (char->integer y))))) (test (f1) 98)) ; p_s i_p_f set_i_i_f (let () (define (f1) (let ((y #\b) (z 98)) (do ((i 0 (+ i 1))) ((= i 3) y) (set! y (integer->char z))))) (test (f1) #\b)) ; p_p_s (let () (define (f1) (let ((y (list 2)) (z '(1))) (do ((i 0 (+ i 1))) ((= i 3) y) (list-set! y 0 (car z))))) (test (f1) '(1))) ; i_c p_pip_sff (let () (define (f1) (let ((y (list 2)) (z 0)) (do ((i 0 (+ i 1))) ((= i 3) y) (list-set! y z (car '(1)))))) (test (f1) '(1))) ; p_pip_ssf (let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list y z))))) (test (f1) '(2 0))) ; p_cf_ss (let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list 0 0))))) (test (f1) '(0 0))) ; p_cf_ff (let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list y 0))))) (test (f1) '(2 0))) ; p_cf_sf (let () (define (f1) (let ((y 2) (z 0) (x '(1))) (do ((i 0 (+ i 1))) ((= i 3) x) (set! x (list 2 z))))) (test (f1) '(2 0))) ; p_cf_fs (let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not (= (floor z) 1)) (display "oops"))))) (test (f1) 0)) ; b_ii_fc p_p_c if_nbp (let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (not (= (+ z z) 2.2)) (display (+ z z)))))) (test (f1) 0)) ; p_p_f b_dd_fc d_dd_ss p_pp_ss (let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (if (= (+ z 1) 2.2) (display (+ z 1)))))) (test (f1) 0)) ; if_bp p_pp_sc d_dd_sc (let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (when (= (+ 1 z) z) (display (+ 1 z)))))) (test (f1) 0)) ; when_p p_pp_cs b_dd_fs (let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (unless (= (+ z z 1) 3.2) (display (+ z z 1)))))) (test (f1) 0)) ; unless_p p_cf_ppp d_ddd_ssf (let () (define (f1) (let ((y 0) (z 1.1)) (do ((i 0 (+ i 1))) ((= i 3) y) (cond ((= (+ z (- y)) 2.1) (display (+ z (- y)))))))) (test (f1) 0)) ; cond p_cf_s p_pp_sf ;;; check an optimizer bug (define _do_call_cc_end_ 1) (define (call-cc-do-test) (do ((i 0 (+ i 1))) ((= i _do_call_cc_end_)) (let ((ctr 0)) (call/cc (lambda (exit) (if (> 3 2) (let () (exit ctr) (set! ctr 100) ctr) #f))))) (do ((i 0 (+ 1 i))) ((= i _do_call_cc_end_)) (let ((ctr 0)) (call/cc (lambda (exit) (if (> 3 2) (let () (exit ctr) (set! ctr 100) ctr) #f)))))) (call-cc-do-test) ;;; and another (let() (define (hi) (let ((checker (lambda (nlst v) (let ((chr (car nlst))) (if (not (char-alphabetic? chr)) (if (not (char=? v chr)) (format #t ";(char-downcase #\\~A) -> ~A" chr v)) (if (and (not (char=? chr v)) (not (char=? chr (char-upcase v)))) (format #t ";(char-downcase #\\~A) -> ~A~%" chr v)))))) (result 0)) (let ((try 0)) (do ((i 0 (+ i 1))) ((> i 10)) (set! try i) (checker '(#\a) #\a) (checker '(#\a) #\a))))) (test (hi) #t)) (define (__a-func__ a) (format #t ";oops called first a-func by mistake: ~A~%" a) (if (> a 0) (__a-func__ (- a 1)))) (define (__a-func__ a) (if (> a 0) (__a-func__ (- a 1)))) (__a-func__ 3) (define (__c-func__ a) (format #t ";oops called first __c-func__ by mistake: ~A~%" a) (if (> a 0) (__c-func__ (- a 1)))) (let () (define (__c-func__ a) (if (> a 0) (__c-func__ (- a 1)))) (__c-func__ 3)) ;;; more optimizer checks (let () (define (do-test-1) (do ((i 0 (+ i 1))) ((= i 10)) (display i))) (test (with-output-to-string (lambda () (do-test-1))) "0123456789")) (let () (define (do-test-2) (do ((i 0 (+ 1 i))) ((= i 10)) (display i))) (test (with-output-to-string (lambda () (do-test-2))) "0123456789")) (let ((start 0)) (define (do-test-3) (do ((i start (+ i 1))) ((= i 10)) (display i))) (test (with-output-to-string (lambda () (do-test-3))) "0123456789")) (let ((start 0) (end 10)) (define (do-test-4) (do ((i start (+ i 1))) ((= i end)) (display i))) (test (with-output-to-string (lambda () (do-test-4))) "0123456789")) (let ((start 0) (end 10)) (define (do-test-5) (do ((i start (+ i 1))) ((= end i)) (display i))) (test (with-output-to-string (lambda () (do-test-5))) "0123456789")) (let () (define (do-test-6) (do ((i 0 (+ i 1))) ((= i 10)) (let ((k i)) (display k)))) (test (with-output-to-string (lambda () (do-test-6))) "0123456789")) (let () (define (do-test-7) (do ((i 0 (+ i 2))) ((= i 20)) (display (/ i 2)))) (test (with-output-to-string (lambda () (do-test-7))) "0123456789")) (let () (define (do-test-8) (do ((i 0 (+ i 1))) ((= i 10)) (let ((a (+ 1 2))) (display #\0)))) (test (with-output-to-string (lambda () (do-test-8))) "0000000000")) (let () (define (do-test-9) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (set! j i) (display j)))) (test (with-output-to-string (lambda () (do-test-9))) "0123456789")) (let () (define (do-test-10) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (display i)))) (test (with-output-to-string (lambda () (do-test-10))) "0123456789")) (let () (define (do-test-11) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j 0)) (set! j 32) (display i)))) (test (with-output-to-string (lambda () (do-test-11))) "0123456789")) (let () (define (do-test-12) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j i)) (display j)))) (test (with-output-to-string (lambda () (do-test-12))) "0123456789")) (let () (define (do-test-13) (do ((i 0 (+ i 1))) ((= i 5)) (let ((j (+ i 1))) (let ((i j)) (display (- i 1)))))) (test (with-output-to-string (lambda () (do-test-13))) "01234")) (let () (define (do-test-14) (do ((i 0 (+ i 1))) ((= i 10)) (set! i (+ i 1)) (display i))) (test (with-output-to-string (lambda () (do-test-14))) "13579")) (let ((lst ())) (define (do-test-15) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (set! lst (cons i lst))) lst) (test (do-test-15) '(9 8 7 6 5 4 3 2 1 0))) (let ((lst ())) (define (do-test-15a) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (set! lst (append (list i) lst))) lst) (test (do-test-15a) '(9 8 7 6 5 4 3 2 1 0))) (let ((lst ())) (define (do-test-15b) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (set! lst (list i lst))) lst) (test (do-test-15b) '(9 (8 (7 (6 (5 (4 (3 (2 (1 (0 ())))))))))))) (let ((lst (list 9 8 7 6 5 4 3 2 1 0))) (define (do-test-16) (do ((i 0 (+ i 1))) ((= i 10)) (list-set! lst i i)) lst) (test (do-test-16) '(0 1 2 3 4 5 6 7 8 9))) (let ((lst ())) (define (do-test-17) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j i)) (set! lst (cons j lst)))) lst) (test (do-test-17) '(9 8 7 6 5 4 3 2 1 0))) (let ((lst ())) (define (do-test-17a) (set! lst ()) (do ((i 0 (+ i 1))) ((= i 10)) (let ((j (min i 100))) (set! lst (cons j lst)))) lst) (test (do-test-17a) '(9 8 7 6 5 4 3 2 1 0))) (let () (define (do-test-18) (do ((i 0 (+ i 1)) (j 0)) ((= i 10) j) (if (= i 3) (set! j i)))) (test (do-test-18) 3)) (let ((end 10)) (define (do-test-19) (do ((i 0 (+ i 1))) ((= i end)) (display i))) (test (with-output-to-string (lambda () (do-test-19))) "0123456789")) (let ((end 10)) (define (do-test-19A) (do ((i 0 (+ 1 i))) ((= end i)) (display i))) (test (with-output-to-string (lambda () (do-test-19A))) "0123456789")) (let ((end 10)) (define (do-test-20) (do ((i 0 (+ i 1))) ((= i end)) (set! end 8) (display i))) (test (with-output-to-string (lambda () (do-test-20))) "01234567")) (let ((end 10)) (define (do-test-20A) (do ((i 0 (+ 1 i))) ((= end i)) (set! end 8) (display i))) (test (with-output-to-string (lambda () (do-test-20A))) "01234567")) (let () (define (do-test-21) (do ((i 0 (+ i 1))) ((= i 3)) (with-let (rootlet) (+ 1 2)))) (do-test-21)) (let ((v (vector 0 0 0))) (define (hi a) (do ((i 0 (+ i 1))) ((> i a)) (vector-set! v i 1))) (hi 2) (test v (vector 1 1 1))) (let () ; dotimes_c_c case can't involve set so we use write-char (define (hi a) (do ((i 0 (+ i 1))) ((= i a)) (write-char #\a))) (with-output-to-file tmp-output-file (lambda () (hi 3))) (let ((str (with-input-from-file tmp-output-file (lambda () (read-line))))) (test str "aaa"))) (let () (define (do-test-22) (do ((i 0 (+ i 1))) ((= i 10)) (display i))) (test (with-output-to-string (lambda () (do-test-22))) "0123456789")) (let ((v (make-list 10))) (define (do-test-23) (do ((i 0 (+ i 1))) ((= i 10)) (list-set! v i i))) (do-test-23) (test v '(0 1 2 3 4 5 6 7 8 9))) ;;; safe simple h_safe_c_s (let () (define (do-test-24) (do ((i 0 (+ i 1))) ((> i 10)) (display i))) (test (with-output-to-string (lambda () (do-test-24))) "012345678910")) ;;; safe simple h_safe_c_ss (let () (define (do-test-25 p) (do ((i 0 (+ i 1))) ((> i 10)) (display i p))) (test (call-with-output-string (lambda (p) (do-test-25 p))) "012345678910")) ;;; safe simple h_safe_c_c (let () (define (do-test-26) (do ((i 0 (+ i 1))) ((> i 10)) (display 0))) (test (with-output-to-string (lambda () (do-test-26))) "00000000000")) ;;; safe simple h_safe_c_opsq_s (let () (define (do-test-27 p) (do ((i 0 (+ i 1))) ((> i 10)) (display (- i) p))) (test (call-with-output-string (lambda (p) (do-test-27 p))) "0-1-2-3-4-5-6-7-8-9-10")) (let () (define (do-test-22 i o) (catch #t (lambda () (do () () (write-char (read-char i) o))) (lambda err (get-output-string o)))) (test (call-with-output-string (lambda (out) (call-with-input-string "0123" (lambda (in) (do-test-22 in out))))) "0123")) ;;; safe_dotimes_step coverage (let () (define (fv-test len) (let ((fv (make-float-vector len))) (if (not (= (length fv) len)) #f fv))) (define (fv) (do ((k 0 (+ k 1))) ((= k 2)) (fv-test k) (fv-test k))) (fv)) ;;; the do spec is ambiguous. Guile and s7 disagree on: (let ((v (vector #f #f))) (do ((i 0 (+ i 1))) ((= i 2)) (vector-set! v i (lambda () i))) (test ((vector-ref v 0)) 2)) ; s7 2, Guile 0 ;;; In s7, the lambda "i" is a delayed reference to the do "i" through ;;; the let chain. In Guile, do has a new let on every iteration! (let ((v (vector #f #f))) (do ((i 0)) ((>= i 2)) (vector-set! v i (lambda () i)) (set! i (+ i 1))) (test ((vector-ref v 0)) 2)) ; s7 2, Guile 1 ;;; So the let is recreated at the start of the step section, I guess. ;;; But Guile's interpretation is inconsistent with the rest of Scheme: (let ((v (vector #f #f)) (i 0)) (for-each (let ((i 0)) (lambda (x) (vector-set! v i (lambda () i)) (set! i (+ i 1)))) (list 1 2)) (test ((vector-ref v 0)) 2)) ; Guile also 2! ;;; This is independent of this situation: (let ((v (vector #f #f))) (do ((i 0 (+ i 1))) ((= i 2)) (vector-set! v i i)) (test (vector-ref v 0) 0)) ; 0 in both ;;; To get Guile's behavior: (let ((v (vector #f #f))) (do ((i 0 (+ i 1))) ((= i 2)) (vector-set! v i (let ((i i)) (lambda () i)))) (test ((vector-ref v 0)) 0)) ;;; -------------------------------------------------------------------------------- ;;; set! ;;; -------------------------------------------------------------------------------- (test (let ((a 1)) (set! a 2) a) 2) (for-each (lambda (arg) (test (let ((a 0)) (set! a arg) a) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t (list 1 2 3) '(1 . 2))) (test (let ((a 1)) (call/cc (lambda (r) (set! a (let () (if (= a 1) (r 123)) 321)))) a) 1) (test (let ((a (lambda (b) (+ b 1)))) (set! a (lambda (b) (+ b 2))) (a 3)) 5) (test (let ((a (lambda (x) (set! x 3) x))) (a 1)) 3) (test (let ((x (vector 1 2 3))) (set! (x 1) 32) x) #(1 32 3)) (test (let* ((x (vector 1 2 3)) (y (lambda () x))) (set! ((y) 1) 32) x) #(1 32 3)) (test (let* ((x (vector 1 2 3)) (y (lambda () x)) (z (lambda () y))) (set! (((z)) 1) 32) x) #(1 32 3)) (test (let ((a 1)) (set! a)) 'error) (test (let ((a 1)) (set! a 2 3)) 'error) (test (let ((a 1)) (set! a . 2)) 'error) (test (let ((a 1)) (set! a 1 . 2)) 'error) (test (let ((a 1)) (set! a a) a) 1) (test (set! "hi" 1) 'error) (test (set! 'a 1) 'error) (test (set! 1 1) 'error) (test (set! (list 1 2) 1) 'error) (test (set! (let () 'a) 1) 'error) (test (set!) 'error) (test (set! #t #f) 'error) (test (set! () #f) 'error) (test (set! #(1 2 3) 1) 'error) (test (set! (call/cc (lambda (a) a)) #f) 'error) (test (set! 3 1) 'error) (test (set! 3/4 1) 'error) (test (set! 3.14 1) 'error) (test (set! #\a 12) 'error) (test (set! (1 2) #t) 'error) (test (set! _not_a_var_ 1) 'error) (test (let ((x 3)) (set! _not_a_var5_ x)) 'error) (test (do ((i 0 (+ i 1))) ((= i 1)) (set! _not_a_var1_ 1)) 'error) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! _not_a_var4_ 1))) (f) (f)) 'error) (test (let () (define (f) (set! _not_a_var2_ 1)) (f)) 'error) (test (let () (define (f) (set! _not_a_var3_ 1)) (define (g) (f)) (g)) 'error) (test (set! (_not_a_var6_ 1) 2) 'error) (test (let ((_not_a_var7_ 1)) (with-let (rootlet) (set! _not_a_var7_ 2))) 'error) (test (let ((_not_a_var7_ 1)) (with-let (rootlet) (do ((i 0 (+ i 1))) ((= i 1)) (set! _not_a_var7_ 2)))) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (set! (x 0) 1))) (f _not_a_var8_)) 'error) (test (set! (_not_a_pws_) 1) 'error) (test (let ((x 1)) (set! ((lambda () 'x)) 3) x) 'error) (test (let ((x '(1 2 3))) (set! (((lambda () 'x)) 0) 3) x) '(3 2 3)) (test (let ((x '(1 2 3))) (set! (((lambda () x)) 0) 3) x) '(3 2 3)) ; ?? (test (let ((x '(1 2 3))) (set! ('x 0) 3) x) '(3 2 3)) ; ??? I suppose that's similar to (test (let ((x '((1 2 3)))) (set! ((car x) 0) 3) x) '((3 2 3))) (test (let ((x '((1 2 3)))) (set! ('(1 2 3) 0) 32) x) '((1 2 3))) ; this still looks wrong... (expands to (list-set! '(1 2 3) 0 3) I guess) (test (let ((a (lambda (x) (set! a 3) x))) (list (a 1) a)) 'error) (test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error) (test (let ((a (lambda () "hi"))) (set! (a) "ho")) 'error) (test (let ((a (let ((b 1)) (set! a 3) b))) a) 'error) ;;; (test (set! s7-autoloading 3) 'error) ; s7-autoloading is unbound in (set! s7-autoloading 3) op_set1 79803 (let-set-fallback check in rootlet) ;;; but this doesn't test the bug -- this hits it: (test (with-let (rootlet) (set! s7-auto #f)) 'error) (test (catch #t (lambda () (set! (_not_a_pws_) 1)) (lambda (typ info) (apply format #f info))) "unbound variable _not_a_pws_ in (set! (_not_a_pws_) 1)") (test (catch #t (lambda () (set! (lambda () 1) 4)) (lambda (typ info) (apply format #f info))) "lambda (syntactic) does not have a setter: (set! (lambda () 1) 4)") (test (catch #t (lambda () (let ((lti (make-iterator (inlet 'a 1 'b 2)))) (set! (lti) 32))) (lambda (typ info) (apply format #f info))) "lti (an iterator) does not have a setter: (set! (lti) 32)") (test (catch #t (lambda () (let ((x 0)) (define-macro (hi) 'x) (set! (hi) 3) x)) (lambda (typ info) (apply format #f info))) "hi (a macro) does not have a setter: (set! (hi) 3)") (test (catch #t (lambda () (set! 'a 1)) (lambda (typ info) (apply format #f info))) "#_quote (syntactic) does not have a setter: (set! 'a 1)") (let ((__asdf__ #f)) (set! __asdf__ if) (set! __asdf__ 3) (test __asdf__ 3)) ; make sure this doesn't get locked (test (set! . -1) 'error) (test (set!) 'error) (test (let ((x 1)) (set! x x x)) 'error) (test (let ((x 1)) (set! x x) x) 1) (test (set! (cons 1 2) 3) 'error) (test (let ((var 1) (val 2)) (set! var set!) (var val 3) val) 3) (test (let ((var 1) (val 2)) (set! var +) (var val 3)) 5) (test (let ((sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 1) (sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456780 3)) (set! sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 2) sym0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789) 2) (test (let ((x '(1)) (y '(2))) (set! ((if #t x y) 0) 32) x) '(32)) (test (let ((hi 0)) (set! hi 32)) 32) (test (let ((hi 0)) ((set! hi ('((1 2) (3 4)) 0)) 0)) 1) (test (set! # 1) 'error) (test (set! # 1) 'error) (test (set! # 1) 'error) (test (let ((x 0)) (define-macro (hi) 'x) (set! (hi) 3) x) 'error) (test (set! ("hi" . 1) #\a) 'error) (test (set! (#(1 2) . 1) 0) 'error) (test (set! ((1 . 2)) 3) 'error) (test (let ((lst (list 1 2))) (set! (lst . 0) 3) lst) 'error) (test (let ((lst (list 1 2))) (set! (list-ref lst . 1) 2)) 'error) (test (let ((v #2d((1 2) (3 4)))) (set! (v 0 . 0) 2) v) 'error) (test (set! ('(1 2) . 0) 1) 'error) (test (set! ('(1 2) 0) 3) 3) (test (set! (''(1 . 2)) 3) 'error) (test (set! (''(1 2)) 3) 'error) (test (set! ('(1 . 2)) 3) 'error) (test (set! ('(1 2)) 3) 'error) (test (set! (''(1 2) 0 0) 3) 'error) (test (set! (#(1 2) 0 0) 3) 'error) (test (let ((x 1)) (set! (quasiquote . x) 2) x) 'error) (test (let ((x 1)) (set! (quasiquote x) 2) x) 'error) (test (set! `,(1) 3) 'error) (test (set! (1) 3) 'error) (test (set! `,@(1) 3) 'error) (test (let ((x 0)) (set! x 1 . 2)) 'error) (test (let ((x 0)) (apply set! x '(3))) 'error) ; ;set!: can't alter immutable object: 0 (test (let ((x 0)) (apply set! 'x '(3)) x) 3) (test (set! (#(a 0 (3)) 1) 0) 0) (test (set! ('(a 0) 1) 0) 0) (test (apply set! (apply list (list ''(1 2 3) 1)) '(32)) 32) (test (set! (let ((x 1)) x) 3) 'error) (test (set! (lambda () 1) 4) 'error) (test (set! (with-baffle (display x)) 5) 'error) (test (set! (define x 3) 6) 'error) (test (let ((x 0)) (define (func) (catch #t (lambda () (let-temporarily ((x (set! => #<...>))) x)) (lambda (type info) 'error))) (func) (func)) 'error) ;op_set_s_c (test (let ((x 0)) (define (func) (catch #t (lambda () (let-temporarily ((x (set! => abs))) x)) (lambda (type info) 'error))) (func) (func)) 'error) ;op_set_s_s (test (let ((x 0)) (define (func) (catch #t (lambda () (let-temporarily ((x (set! => (+ 1 2)))) x)) (lambda (type info) 'error))) (func) (func)) 'error) ;op_set_s_a (test (let ((x #f)) (map set! '((set! x (+ x 1)) (* x 2)) (hash-table 'a 1))) 'error) (test (let ((x #f)) (map set! (hash-table 'a 1) '((set! x (+ x 1)) (* x 2)))) 'error) (let () (define-macro (symbol-set! var val) `(apply set! ,var (list ,val))) ; but this evals twice (test (let ((x 32) (y 'x)) (symbol-set! y 123) (list x y)) '(123 x))) (let () (define-macro (symbol-set! var val) ; like CL's set `(apply set! ,var ',val ())) (test (let ((var '(+ 1 2)) (val 'var)) (symbol-set! val 3) (list var val)) '(3 var)) (test (let ((var '(+ 1 2)) (val 'var)) (symbol-set! val '(+ 1 3)) (list var val)) '((+ 1 3) var))) (test (set! ('(1 2) 1 . 2) 1) 'error) (test (set! ('((1 2) 1) () . 1) 1) 'error) (test (set! ('(1 1) () . 1) 1) 'error) (test (let () (define (hi) (let ((x 1000)) (set! x (+ x 1)) x)) (hi) (hi)) 1001) (test (let () (define (hi) (let ((x 1000.5)) (set! x (+ x 1)) x)) (hi) (hi)) 1001.5) (test (let () (define (hi) (let ((x 3/2)) (set! x (+ x 1)) x)) (hi) (hi)) 5/2) (test (let () (define (hi) (let ((x 3/2)) (set! x (- x 1)) x)) (hi) (hi)) 1/2) (test (let () (define (hi) (let ((x 3/2)) (set! x (- x 2)) x)) (hi) (hi)) -1/2) (test (let () (define (hi) (let ((x "asdf")) (set! x (+ x 1)) x)) (hi) (hi)) 'error) (let () ;; check an optimizer bug (define (bad-increment a b) (cons a b)) (define (use-bad-increment b) (let ((x ())) (set! x (bad-increment x b)) x)) (use-bad-increment 1) (use-bad-increment 1) (use-bad-increment 1)) (when with-block (let ((b (block 0.0 1.0))) (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (set! (b i) 3.0))) (set! (b 0) 2.0) (test b (block 2.0 1.0)) (test (b 0) 2.0) (f) (test b (block 3.0 3.0)) (immutable! b) (test (set! (b 0) 4.0) 'error) (test (f) 'error)) (test (set! ((block)) 1) 'error) (test (make-vector 1 (append (block) (block)) (setter (block-append))) 'error) (test ((block 1 2 3) 1 "abs") 'error) (test ((block)) 'error) (test ((block 1 2 3) 1 32) 'error) (test ((block 1 2 3) 1 0) 'error)) ;;; set_pair_p_3 coverage (test (let ((i 0) (x (hash-table))) (define (func) (set! (x 'a) 1) (immutable! x) (x 'a)) (define (hi) (func)) (hi) (hi)) 'error) (test (let ((i #\b)) (define (func) (let ((x (string #\a))) (set! (x 0) i) (x 0))) (define (hi) (func)) (hi) (set! i pi) (hi)) 'error) (test (let ((i 0)) (define (func) (let ((x (byte-vector 0))) (set! (x 0) i) (x 0))) (define (hi) (func)) (hi) (set! i 300) (hi)) 'error) (test (let ((i 0)) (define (func) (let ((x (byte-vector 0))) (set! (x 0) i) (x 0))) (define (hi) (func)) (hi) (set! i #\b) (hi)) 'error) (test (let ((i 0)) (define (func) (let ((x (string #\a))) (set! (x i) #\b) (x 0))) (define (hi) (func)) (hi) (set! i -3) (hi)) 'error) (test (let ((i 0)) (define (func) (let ((x (string #\a))) (set! (x i) #\b) (x 0))) (define (hi) (func)) (hi) (set! i 3) (hi)) 'error) (test (let ((i 0) (x (int-vector 0))) (define (func) (set! (x i) 1) (immutable! x) (x 0)) (define (hi) (func)) (hi) (hi)) 'error) (test (let ((i 0)) (define (func) (let ((x (int-vector 0))) (set! (x i) 1) (x 0))) (define (hi) (func)) (hi) (set! i 3) (hi)) 'error) (test (let ((i 0)) (define (func) (let ((x (int-vector 0))) (set! (x i) 1) (x 0))) (define (hi) (func)) (hi) (set! i -1) (hi)) 'error) (test (let ((i 0)) (define (func) (let ((x (int-vector 0))) (set! (x i) 1) (x 0))) (define (hi) (func)) (hi) (set! i 0.0) (hi)) 'error) (test (let () (define (func) (let ((x (make-int-vector '(2 3) 0))) (set! (x 0 0) 1) (x 0 0))) (define (hi) (func)) (hi) (hi)) 1) (test (let () (define (func) (let ((x 32)) (set! (x 0) 1))) (define (hi) (func)) (hi) (hi)) 'error) ;; optimizer (opt_p_pip_ssf etc) (test (let ((tf13 '(()))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) 0 )))) (f)) 'error) (test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) (integer->char 96))))) (f)) 'error) (test (let ((tf13 #(0))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) (list 123))))) (f)) 'error) (test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) #\0)))) (f)) 'error) (test (let ((tf13 #(1))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) 0)))) (f)) 'error) (test (let ((tf13 #())) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) (car (list #\0)))))) (f)) 'error) (test (let ((tf13 '(()))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 "asdf") 0)))) (f)) 'error) (test (let ((tf13 #(0)) (index "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 index) 0)))) (f)) 'error) (test (let ((tf13 #(0)) (index 0.0)) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 index) #f)))) (f)) 'error) (test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 quasiquote) #\0)))) (f)) 'error) (test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 abs) #\0)))) (f)) 'error) (test (let ((tf13 "asdf")) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 tf13) #\0)))) (f)) 'error) (test (let ((tf13 "asdf") (index '(0))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 index) 0)))) (f)) 'error) (test (let ((tf13 #u(0))) (define (f) (let () (do ((i 0 (+ i 1))) ((= i 1)) (set! (tf13 letrec*) 123)))) (f)) 'error) ;;; amusements (test (let ((x 0)) (set! (x 0) (define x (list 1 2))) x) 'error) (test (procedure? (let ((x 0)) (set! x (define (x) 31)) x)) #t) (test (let ((x (list 1 2))) (set! x (define x 31)) x) 31) (test (let ((x (list 1 2))) (set! (x 0) (define x 31)) x) 31) (test (let ((x (list 1 2))) (set! (x 0) (define x #(2 3))) x) #(2 3)) (test (let ((x (list 1 2))) (let ((y x)) (set! (x 0) (define x (list 2 3))) (list x y))) '((2 3) ((2 3) 2))) (test (let ((x (list 1 2))) (let ((y x)) (set! (x 0) (define x (vector 2 3))) (list x y))) '(#(2 3) (#(2 3) 2))) (test (let ((x (list 1 2))) (let ((y x)) (list-set! x 0 (define x (list 2 3))) (list x y))) '((2 3) ((2 3) 2))) (test (let ((x (list 1 2))) (let ((y x)) (vector-set! x 0 (define x (vector 2 3))) (list x y))) 'error) (test (let () (vector-set! x 0 (begin (define x (vector 2 3)))) x) 'error) (test (let ((f1 (lambda (x) "we're number 1"))) (f1 (let () (set! f1 (lambda (x) "we're number 2"))))) "we're number 1") (let() ; set_caller+catch+error bug, will cause early exit from s7test in older s7's (define (fc in) (catch 'wrong-type-arg (lambda () (+ in 2)) (lambda (type info) type))) (define state (let ((file #f) (contents #f)) (set! (setter 'file) (lambda (s v) (set! contents (fc #\1)) v)) (curlet))) (set! (state 'file) 321) (test (state 'file) 321) (test (state 'contents) 'wrong-type-arg)) ;;; similar cases (test ((list (lambda (x) (catch 'wrong-type-arg (lambda () (+ 1 #\a)) (lambda (type info) x)))) 0 "hi") 'error) ; "hi") (test ((list (lambda* (x) (catch 'wrong-type-arg (lambda () (+ 1 #\a)) (lambda (type info) x)))) 0 "hi") 'error) ; "hi") (test (apply (inlet) '(define y (catch #t (lambda () (+ 1 #\a)) (lambda (type info) 32)))) 32) ;; (apply (inlet) '(define y 32)) -> ((inlet) 'define 'y 32) -> (apply define '(y 32)) [because ((inlet) 'define) is define] -> 32! (let ((H (make-hash-table 8 (cons (lambda (a b) (eq? a b)) ; as above hash mapper (lambda (a) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) 0))))))) (set! (H 'a) 1) (test (H 'a) 1)) (let ((H (make-hash-table 8 (cons (lambda (a b) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (eq? a b)))) (lambda (a) 0))))) ; as above hash-checker (set! (H 'a) 1) (test (H 'a) 1)) (test (catch #t ; t_c_function branch in implicit_index (lambda () (apply (list cons cons) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (list 1 2))))) (lambda (y i) y)) 'wrong-number-of-args) (test (catch #t (lambda () (apply (list cons cons) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (list 1 2 3))))) (lambda (y i) y)) '(2 . 3)) (let () (define (g a b) (+ a b)) (test (apply (list g g) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (list 1 2 3)))) 5)) (let ((lt 3)) (let-temporarily ((lt (catch #t (lambda () (+ 1 #\a)) (lambda (t i) 43)))) (test lt 43)) (test lt 3)) (let ((seq (vector 3 2 4 1 5))) (sort! seq (lambda (a b) (catch #t (lambda () (< 1 #\a)) (lambda (t i) (> a b))))) (test seq #(5 4 3 2 1))) (let ((ctr 0)) (let ((dw (dynamic-wind (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (set! ctr 1)))) (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (set! ctr (+ ctr 1)))) (set! ctr (+ ctr 9))) ; 11 (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (set! ctr (+ ctr 1)))))))) ; 12 (test (+ dw ctr) 23))) (let ((ctr 0)) (let ((dw (call/cc (lambda (exit) (dynamic-wind (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (set! ctr 1)))) (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (exit 33) (set! ctr 1))) (set! ctr (+ ctr 9))) (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (set! ctr 1))))))))) (test (list ctr dw) '(1 33)))) (let ((ctr 0)) (let ((dw (call-with-exit (lambda (exit) (dynamic-wind (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (set! ctr 1)))) (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (exit 33) (set! ctr 1))) (set! ctr (+ ctr 9))) (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (set! ctr 1))))))))) (test (list ctr dw) '(1 33)))) (let ((ctr 0)) (define (ifn) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (set! ctr (+ ctr 1)))) (set! ctr (+ ctr 1))) (let ((dw (dynamic-wind ifn ifn ifn))) (test (+ dw ctr) 10))) (test (let ((path ()) (c #f)) (let ((add (lambda (s) (set! path (cons s path))))) (dynamic-wind (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (add 'connect)))) (lambda () (add (call-with-current-continuation (lambda (c0) (set! c c0) 'talk1)))) (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (add 'disconnect))))) (if (< (length path) 4) (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (c 'talk2))) (reverse path)))) '(connect talk1 disconnect connect talk2 disconnect)) (test (catch #t (lambda () (set! #_abs 32)) (lambda (t i) (apply format #f i))) "set! can't change #_abs (a c-function)") ;;; -------------------------------------------------------------------------------- ;;; or ;;; -------------------------------------------------------------------------------- (test (or (= 2 2) (> 2 1)) #t) (test (or (= 2 2) (< 2 1)) #t) (test (or #f #f #f) #f) (test (or) #f) (test (or (memq 'b '(a b c)) (+ 3 0)) '(b c)) (test (or 3 9) 3) (test (or #f 3 asdf) 3) ; "evaluation stops immediately" (test (or 3 (/ 1 0) (display "or is about to exit!") (exit)) 3) (for-each (lambda (arg) (test (or arg) arg) (test (or #f arg) arg) (test (or arg (error 'test-error "oops or ")) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) # # '(1 . 2))) (test (call-with-input-file "s7test.scm" (lambda (p) (let ((loc 0)) (let loop ((val (read-char p))) (or (eof-object? val) (> loc 1000) ; try to avoid the read-error stuff (begin (set! loc (+ loc 1)) (loop (read-char p))))) (> loc 1000)))) #t) (test (or (and (or (> 3 2) (> 3 4)) (> 2 3)) 4) 4) (test (or or) or) (test (or (or (or))) #f) (test (or (or (or) (and))) #t) (test (let ((a 1)) (or (let () (set! a 2) #f) (= a 1) (let () (set! a 3) #f) (and (= a 3) a) (let () (set! a 4) #f) a)) 3) (test (or '#f ()) ()) (test (call/cc (lambda (r) (or #f (> 3 2) (r 123) 321))) #t) (test (call/cc (lambda (r) (or #f (< 3 2) (r 123) 321))) 123) (test (+ (or #f (not (null? ())) 3) (or (zero? 1) 2)) 5) (test (or 0) 0) (test (if (or) 1 2) 2) (test (or . 1) 'error) (test (or #f . 1) 'error) (test (or . (1 2)) 1) (test (or . ()) (or)) ; (test (or 1 . 2) 1) ; this fluctuates (test (let () (or (define (hi a) a)) (hi 1)) 1) (test (let () (or #t (define (hi a) a)) (hi 1)) 'error) (test (let () (and (define (hi a) a) (define (hi a) (+ a 1))) (hi 1)) 2) ; guile agrees with this (test ((lambda (arg) (arg #f 123)) or) 123) (test (let ((oar or)) (oar #f 43)) 43) (test (let ((oar #f)) (set! oar or) (oar #f #f 123)) 123) (test (member 1 (list 2 3) (lambda (a b) (negative? (or (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y)))) (string->keyword))))) #f) ;;; -------------------------------------------------------------------------------- ;;; and ;;; -------------------------------------------------------------------------------- (test (and (= 2 2) (> 2 1)) #t) (test (and (= 2 2) (< 2 1)) #f) (test (and 1 2 'c '(f g)) '(f g)) (test (and) #t) (test (and . ()) (and)) (test (and 3) 3) (test (and (memq 'b '(a b c)) (+ 3 0)) 3) (test (and 3 9) 9) (test (and #f 3 asdf) #f) ; "evaluation stops immediately" (test (and 3 (zero? 1) (/ 1 0) (display "and is about to exit!") (exit)) #f) (test (if (and) 1 2) 1) (test (if (+) 1 2) 1) (test (if (*) 1 2) 1) (test (and (if #f #f)) (if #f #f)) (test (let ((x '(1))) (eq? (and x) x)) #t) (for-each (lambda (arg) (test (and arg) arg) (test (and #t arg) arg) (test (and arg #t) #t)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (call-with-input-file "s7test.scm" (lambda (p) (let ((loc 0)) (let loop ((val (read-char p))) (and (not (eof-object? val)) (< loc 1000) (begin (set! loc (+ loc 1)) (loop (read-char p))))) (>= loc 1000)))) #t) (test (and (or (and (> 3 2) (> 3 4)) (> 2 3)) 4) #f) (test (and and) and) (test (and (and (and))) #t) (test (and (and (and (and (or))))) #f) (test (let ((a 1)) (and (let () (set! a 2) #t) (= a 1) (let () (set! a 3) #f) (and (= a 3) a) (let () (set! a 4) #f) a)) #f) (test (and '#t ()) ()) (test (call/cc (lambda (r) (and #t (> 3 2) (r 123) 321))) 123) (test (call/cc (lambda (r) (and #t (< 3 2) (r 123) 321))) #f) (test (+ (and (null? ()) 3) (and (zero? 0) 2)) 5) (test (and . #t) 'error) (test (and 1 . 2) 'error) (test (and . (1 2)) 2) (test (let () (and (define (hi a) a)) (hi 1)) 1) (test (let () (and #f (define (hi a) a)) (hi 1)) 'error) (test (+ 1 (and (define (hi a) a) (hi 2))) 3) ;;; from some net site (let () (define (fold fn accum list) (if (null? list) accum (fold fn (fn accum (car list)) (cdr list)))) (test (fold and #t '(#t #f #t #t)) #f)) (test (let ((and! and)) (and! #f (error 'test-error "oops"))) #f) (test (let ((and! #f)) (set! and! and) (and! #f (error 'test-error "oops"))) #f) (test (let () (define (try and!) (and! #f (error 'test-error "oops"))) (try and)) #f) ;;; here are some tests from S. Lewis in the r7rs mailing list (let () (define myand and) (test (myand #t (+ 1 2 3)) 6) (define (return-op) and) (define myop (return-op)) (test (myop #t (+ 1 2 3)) 6) (test (and #t (+ 1 2 3)) 6) (test ((return-op) #t (+ 1 2 3)) 6) (test ((and and) #t (+ 1 2 3)) 6) (define ops `(,* ,and)) (test ((car ops) 2 3) 6) (test ((cadr ops) #t #f) #f) (test (and #f never) #f) (test (and #f and) #f) (test ((and #t and) #t (+ 1 2 3)) 6)) (test (let ((vf (vector abs))) (define (func) (do ((i 0 (+ i 1))) ((= i 100)) (and #f (vf (msym3))))) (func)) #t) ; not error -- s7_macroexpand (test (let ((vf (vector abs))) (define (func) (do ((i 0 (+ i 1))) ((= i 100)) (and #f (vf (msym3 i . i))))) (func)) #t) ;;; -------------------------------------------------------------------------------- ;;; cond ;;; -------------------------------------------------------------------------------- (test (cond ('a)) 'a) (test (cond (3)) 3) (test (cond (#f 'a) ('b)) 'b) (test (cond (#t 'a) (#t 'b)) 'a) (test (cond (#t 'a) (else 'b)) 'a) (test (cond (else 'a) (else 'b)) 'a) (test (cond ((> 3 2) 'greater) ((< 3 2) 'less)) 'greater) (test (cond((> 3 2)'greater)((< 3 2)'less)) 'greater) (test (cond ((> 3 3) 'greater) ((< 3 3) 'less) (else 'equal)) 'equal) (test (cond ((assv 'b '((a 1) (b 2))) => cadr) (else #f)) 2) (test (cond (#f 2) (else 5)) 5) (test (cond (1 2) (else 5)) 2) (test (cond (1 => (lambda (x) (+ x 2))) (else 8)) 3) (test (cond ((+ 1 2))) 3) (test (cond ((zero? 1) 123) ((= 1 1) 321)) 321) (test (cond ('() 1)) 1) (test (let ((x 1)) (cond ((= 1 2) 3) (else (* x 2) (+ x 3)))) 4) (test (let((x 1))(cond((= 1 2)3)(else(* x 2)(+ x 3)))) 4) (test (let ((x 1)) (cond ((= x 1) (* x 2) (+ x 3)) (else 32))) 4) (test (let ((x 1)) (cond ((= x 1) (let () (set! x (* x 2))) (+ x 3)) (else 32))) 5) (test (let ((x 1)) (cond ((= x 2) (let () (set! x (* x 2))) (+ x 3)) (else 32))) 32) (test (let ((x 1)) (cond ((= x 2) 3) (else (let () (set! x (* x 2))) (+ x 3)))) 5) (test (cond ((= 1 2) 3) (else 4) (else 5)) 4) ; this should probably be an error (test (cond (1 2 3)) 3) (test (cond (1 2) (3 4)) 2) (test (cond ((= 1 2) 3) ((+ 3 4))) 7) (test (cond ((= 1 1) (abs -1) (+ 2 3) (* 10 2)) (else 123)) 20) (test (let ((a 1)) (cond ((= a 1) (set! a 2) (+ a 3)))) 5) (test (let ((a 1)) (cond ((= a 2) (+ a 2)) (else (set! a 3) (+ a 3)))) 6) (test (cond ((= 1 1))) #t) (test (cond ((= 1 2) #f) (#t)) #t) (test (cond ((+ 1 2))) 3) (test (cond ((cons 1 2))) '(1 . 2)) (test (cond (#f #t) ((string-append "hi" "ho"))) "hiho") (test (cond ('() 3) (#t 4)) 3) (test (cond ((list) 3) (#t 4)) 3) ;;; (cond (1 1) (asdf 3)) -- should this be an error? (test (cond (+ 0)) 0) (test (cond (lambda ())) ()) (test (cond . ((1 2) ((3 4)))) 2) (test (cond (define #f)) #f) (test (let () (cond ((> 2 1) (define x 32) x) (#t 1)) x) 32) ; ? a bit strange (test (let ((x 1)) (+ x (cond ((> x 0) (define x 32) x)) x)) 65) (test (cond (("hi" 1))) #\i) (test (cond (()())) ()) (test (let ((a 0)) (let ((b (lambda () (set! a 1) #f))) (cond ((> a 0) 3) ((b) 4) ((> a 0) 5) (#t 6)))) 5) (test (let ((a #t)) (let ((b (lambda () (set! a (not a)) a))) (cond ((b) 1) ((b) 2) (t 3)))) 2) (test (let ((otherwise else)) (cond ((= 1 2) 1) (otherwise 3))) 3) (test (let ((otherwise #t)) (cond ((= 1 2) 1) (otherwise 3))) 3) ; or actually anything... 12 for example (test (let ((x 1)) (cond ((< x 0) 1))) #) (test (let () (cond (#t (define x 7) x))) 7) ; from guile-user (test (let () (cond (else (define x 8) x))) 8) (test (let () (cond ((> 2 1) (define x 9)) (else (define x 10))) x) 9) (test (let () (cond ((< 2 1) (define x 11)) (else (define x 12))) x) 12) (for-each (lambda (arg) (test (cond ((or arg) => (lambda (x) x))) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (set! (*s7* 'print-length) (max (*s7* 'print-length) 40)) (test (catch #t (lambda () (cond () #f)) (lambda (t i) (apply format #f i))) "every clause in cond must be a pair: () in (cond () #f)") (test (cond ((< 2 1)) ((= 1 2)) (else #f)) (or (< 2 1) (= 1 2))) ; (cond (A) (B) (else #f)) is (or A B) (test (cond ((+ 1 2) => (lambda (x) (+ 1 x)))) 4) (test (cond ((cons 1 2) => car)) 1) (test (cond ((values 1 2) => +)) 1) (test (cond (1 2 => +)) 'error) (test (cond ((begin 1 2) => +)) 2) (test (cond ((values -1) => abs)) 1) (test (cond ((= 1 2) => +) (#t => not)) #f) (test (cond ((* 2 3) => (let () -))) -6) (test (cond ((* 2 3) => (cond ((+ 3 4) => (lambda (a) (lambda (b) (+ b a))))))) 13) (test (let ((x 1)) ((cond ((let () (set! x 2) #f) => boolean?) (lambda => (lambda (a) (apply a '((b) (+ b 123)))))) x)) 125) (test (cond ((values 1 2 3) => +)) 1) (test (cond ((values #f #f) => equal?)) #) (test (let () (cond (#t (define (hi a) a))) (hi 1)) 1) (test (let () (cond (#f (define (hi a) a))) (hi 1)) 'error) (test (let () (cond ((define (hi a) a) (hi 1)))) 1) (test (cond ((assq 'x '((x . 1) (y . 0))) => abs (display 'oops)) (else #f)) 'error) (test (cond (else 1)) 1) (test (call/cc (lambda (r) (cond ((r 4) 3) (else 1)))) 4) (test (cond ((cond (#t 1)))) 1) (test (symbol? (cond (else else))) #t) (test (equal? else (cond (else else))) #t) (test (cond (#f 2) ((cond (else else)) 1)) 1) (test (let ((x #f) (y #t)) (cond (x 1) (y 2))) 2) (test (cond ((- 3 2)) ((< 2 3))) (or (- 3 2) (< 3 2))) ; (cond (e) ...)) is the same as (or e ...) (test (let ((i 0)) (cond ((null? i) i) (else))) else) (test (let () (define (func) (let ((i 0)) (cond ((null? i) i) (else)))) (define (hi) (func) (func)) (hi) (hi)) else) (for-each (lambda (arg) (test (cond (#t arg)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (cond (arg)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (cond (#f 1) (else arg)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (cond (arg => (lambda (x) x))) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (cond ((let () 1) => (let ((x 2)) (lambda (n) (+ n x))))) 3) (test (cond ((let () 1) => (let ((x 2)) (cond (3 => (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y))))))))) 10) (test (let ((=> 3)) (cond (=> =>))) 3) (test (cond (cond 'cond)) 'cond) (test (cond (3 => (lambda args (car args)))) 3) (test (cond (3 => (lambda (a . b) a))) 3) (test (cond ((list 3 4) => (lambda (a . b) b))) ()) (test (cond) 'error) (test (let () (define-macro (mac x) `(+ ,x 1)) (cond (1 => mac))) 2) ;(test (cond ((= 1 2) 3) (else 4) (4 5)) 'error) ; trailing ignored (test (cond ((+ 1 2) => (lambda (a b) (+ a b)))) 'error) (test (equal? (cond (else)) else) #t) (test (cond (#t => 'ok)) 'error) (test (cond (else =>)) 'error) (test (cond ((values -1) => => abs)) 'error) (test (cond ((values -1) =>)) 'error) (test (cond (cond (#t 1))) 'error) (test (cond 1) 'error) (test (cond) 'error) (test (cond (1 . 2) (else 3)) 'error) (test (cond (#f 2) (else . 4)) 'error) (test (cond #t) 'error) (test (cond 1 2) 'error) (test (cond 1 2 3) 'error) (test (cond 1 2 3 4) 'error) (test (cond (1 => (lambda (x y) #t))) 'error) (test (cond . 1) 'error) (test (cond ((1 2)) . 3) 'error) (test (cond (1 => + abs)) 'error) (test (cond (1 =>)) 'error) (test (cond (else => symbol?)) #t) ; (symbol? else) -> #t (test (eq? (cond (else => or)) else) #t) (test (cond #((1 2))) 'error) (test (cond (/ 0)) 0) ; / is not #f, so return 0 (test (cond (string-ref 2)) 2) (test (let ((=> 3)) (cond (1 =>))) 3) (test (let ((=> 3)) (cond (1 => abs))) abs) (test (let ((=> 3)) (cond (1 => "hi"))) "hi") (test (let ((=> 3)) (case => ((3) => abs) (else #f))) abs) (test (let ((=> 3)) (cond (12 => abs) (else #f))) abs) ; guile/chicken/chibi agree (let () (define (cond-fx-2e-fx x) (cond ((= x 0) (+ x 1)) (else (+ x 2)))) (define (test-cond-fx-2e-fx) (cond-fx-2e-fx 0) ; prime the pump (test (cond-fx-2e-fx 0) 1) (test (cond-fx-2e-fx 1) 3)) (test-cond-fx-2e-fx) (define (cond-fx-3e-fx x) (cond ((= x 0) (+ x 1)) ((= x 1) (+ x 2)) (else (+ x 3)))) (define (test-cond-fx-3e-fx) (cond-fx-3e-fx 0) (test (cond-fx-3e-fx 0) 1) (test (cond-fx-3e-fx 1) 3) (test (cond-fx-3e-fx 2) 5)) (test-cond-fx-3e-fx) (define (cond-fx-2e x) (cond ((= x 0) (+ x 1)) (else (call-with-exit (lambda (g) (+ x 2)))))) (define (test-cond-fx-2e) (cond-fx-2e 0) ; prime the pump (test (cond-fx-2e 0) 1) (test (cond-fx-2e 1) 3)) (test-cond-fx-2e) (define (cond-fx-3e x) (cond ((= x 0) (+ x 1)) ((= x 1) (call-with-exit (lambda (g) (+ x 2)))) (else (+ x 3)))) (define (test-cond-fx-3e) (cond-fx-3e 0) (test (cond-fx-3e 0) 1) (test (cond-fx-3e 1) 3) (test (cond-fx-3e 2) 5)) (test-cond-fx-3e)) (let () ; check an optimizer typo (define (f x g h) (call-with-exit (lambda (return) (cond ((= x 0) (abs x) (set! x (+ x 1)) (+ x 1)) ((g) (abs x) (set! x (+ x 2)) (+ x 2)) (h) (else (abs x) (set! x (+ x 3)) (+ x 3)))))) (test (f 0 (lambda () #f) #f) 2) (test (f 1 (lambda () #f) #f) 7) (test (f 2 (lambda () #t) #f) 6) (test (f 3 (lambda () #f) 4) 4)) (test (let ((x 0)) (cond ((let ((y x)) (set! x 1) (= y 1)) 0) ((let ((y x)) (set! x 1) (= y 1)) 1) (#t 2))) 1) (let () ; opt_cond_1 as expr (for sc->pc check) (define (cd) (let ((v (make-vector 6 #f))) (do ((i 0 (+ i 1))) ((= i 6) v) (vector-set! v i (cond ((< i 3) (+ i 10))))))) (test (cd) #(10 11 12 # # #))) (let ((c1 #f) (x 1)) (let ((y (cond ((let () (call/cc (lambda (r) (set! c1 r) (r x)))) => (lambda (n) (+ n 3))) (#t 123)))) (if (= y 4) (begin (set! x 2) (c1 321))) (test (list x y) '(2 324)))) (let ((c1 #f) (x 1)) (let ((y (cond (x => (lambda (n) (call/cc (lambda (r) (set! c1 r) (r (+ 3 x)))))) (#t 123)))) (if (= y 4) (begin (set! x 2) (c1 321))) (test (list x y) '(2 321)))) (let ((c1 #f) ; same with do (x 1)) (do ((y (call/cc (lambda (r) (set! c1 r) (r (+ 3 x)))))) (#t (when (= y 4) (set! x 2) (c1 321)) (test (list x y) '(2 321))))) (let ((c1 #f) (x 1)) (do ((z 3) (y (call/cc (lambda (r) (set! c1 r) (r (+ 3 x)))))) (#t (when (= y 4) (set! x 2) (set! z 12) (c1 321)) (test (list x y z) '(2 321 3))))) ; Guile 3.0.8 gets z = 12 unless --no-auto-compile (let ((c1 #f) (x 1)) (do ((z 3) (y (call/cc (lambda (r) (set! c1 r) (r (+ 3 x))))) (w 123)) (#t (when (= y 4) (set! w 1) (set! x 2) (set! z 12) (c1 321)) (test (list w x y z) '(123 2 321 3))))) ; Guile gets z = 3 here ;; opt_cell_cond size limits (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (cond (else 1 2 3 4 5 6 7 8 9 10 11 12)))) (func) (func)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (cond (else 1 2 3 4 5 6 7 8 9 10)))) (func) (func)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (cond ((= i 0) i) ((= i 1) i) ((= i 2) i) ((= i 3) i) ((= i 4) i) ((= i 5) i) ((= i 6) i) ((= i 7) i) ((= i 8) i) ((= i 9) i) ((= i 10) i) ((= i 11) i) ((= i 12) i)))) (func) (func)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (cond ((= i 0) i) ((= i 1) i) ((= i 2) i) ((= i 3) i) ((= i 4) i) ((= i 5) i) ((= i 6) i) ((= i 7) i) ((= i 8) i) ((= i 9) i) ((= i 10) i) ((= i 11) i)))) (func) (func)) ;;; -------- cond-expand -------- ;;; cond-expand (test (let () (cond-expand (guile ) (s7 (define (hi a) a))) (hi 1)) 1) (test (let ((x 0)) (cond-expand (guile (format #t ";oops~%")) (else (set! x 32))) x) 32) (test (let () (cond-expand (guile (define (hi a) (+ a 1))) ((or common-lisp s7) (define (hi a) a))) (hi 1)) 1) (test (let () (cond-expand ((not guile) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 1) (test (let () (cond-expand ((and s7 dfls-exponents) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) (if (provided? 'dfls-exponents) 1 2)) (test (let () (cond-expand ((or s7 guile) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 1) (test (let () (cond-expand ((and s7 dfls-exponents unlikely-feature) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 2) (test (let () (cond-expand ((and unlikely-feature s7) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 2) (test (let () (cond-expand ((and s7 (not s7)) 'oops) (else 1))) 1) (test (when (> 2 1) 23 (cond-expand (ratios 3/4))) 3/4) (unless pure-s7 (test (begin 23 (cond-expand (surreals 1) (foonly 2))) 23) (test (begin (cond-expand (s7 "s7") (else "not s7"))) "s7") (test (begin (cond-expand (s7 "s7"))) "s7") (test (eval-string "(cond-expand (guile #f) (1 3))") 'error) (test (eval-string "(cond-expand (guile #f) 1)") 'error) (test (eval-string "(cond-expand ((guile #f) 1) (else 2))") 'error) (test (eval_string "(cond-expand (guile #f) . 2)") 'error) (test (list (cond-expand (guile #f))) ()) (test (cond-expand (guile 1) ((and s7 (not gmp) ieee-float) 23) (else 0)) (if with-bignums 0 23)) (test (list (cond-expand (s7 1 2 3))) '(1 2 3)) (test (eval-string "(#_cond-expand)") 'error) (test (#_cond-expand (guile 23) (else 0)) 0)) ;;; -------------------------------------------------------------------------------- ;;; case ;;; -------------------------------------------------------------------------------- (test (case (* 2 3) ((2 3 5 7) 'prime) ((1 4 6 8 9) 'composite)) 'composite) (test (case (car '(c d)) ((a e i o u) 'vowel) ((w y) 'semivowel) (else 'consonant)) 'consonant) (test (case 3.1 ((1.3 2.4) 1) ((4.1 3.1 5.4) 2) (else 3)) 2) (test (case 3/2 ((3/4 1/2) 1) ((3/2) 2) (else 3)) 2) (test (case 3 ((1) 1 2 3) ((2) 2 3 4) ((3) 3 4 5)) 5) (test (case 1+i ((1) 1) ((1/2) 1/2) ((1.0) 1.0) ((1+i) 1+i)) 1+i) (test (case 'abs ((car cdr) 1) ((+ cond) 2) ((abs) 3) (else 4)) 3) (test (case #\a ((#\b) 1) ((#\a) 2) ((#\c) 3)) 2) (test (case (boolean? 1) ((#t) 2) ((#f) 1) (else 0)) 1) (test (case 1 ((1 2 3) (case 2 ((1 2 3) 3)))) 3) (test (case 1 ((1 2) 1) ((3.14 2/3) 2)) 1) (test (case 1 ((1 2) 1) ((#\a) 2)) 1) (test (case 1 ((1 2) 1) ((#\a) 2) ((car cdr) 3) ((#f #t) 4)) 1) (test (case #f ((1 2) 1) ((#\a) 2) ((car cdr) 3) ((#f #t) 4)) 4) (test (case 1 ((#t) 2) ((#f) 1) (else 0)) 0) (test (let ((x 1)) (case x ((x) "hi") (else "ho"))) "ho") (test (let ((x 1)) (case x ((1) "hi") (else "ho"))) "hi") (test (let ((x 1)) (case x (('x) "hi") (else "ho"))) "ho") (test (let ((x 1)) (case 'x ((x) "hi") (else "ho"))) "hi") (test (case () ((()) 1)) 1) (test (case #() ((#()) 1) (else 2)) 2) (test (let-temporarily (((*s7* 'safety) 0)) (let ((x '(1))) (eval `(case ',x ((,x) 1) (else 0))))) 1) ; but we can overcome that! (also via apply) (test (let ((x #())) (eval `(case ',x ((,x) 1) (else 0)))) 1) (test (case ''2 (('2) 1) (else 0)) 0) (test (let ((otherwise else)) (case 1 ((0) 123) (otherwise 321))) 321) (test (case 1 ((0) 123) (#t 321)) 'error) ;(test (eqv? "a" "a") (let ((x "a")) (let ((y x)) (eqv? x y)))) ; (eq? x y) here (even Guile agrees though it raises an error on the equivalent case statement) (test (case else ((#f) 2) ((#t) 3) ((else) 4) (else 5)) 4) ; (eqv? 'else else) is #t (Guile says "unbound variable: else") (test (case #t ((#f) 2) ((else) 4) (else 5)) 5) ; else is a symbol here (test (equal? (case 0 ((0) else)) else) #t) (test (cond ((case 0 ((0) else)) 1)) 1) ;(test (let () (case (define b 3) ((b) b))) 3) ; changed define 25-Jul-14 (test (let ((x 1)) (case x ((2) 3) (else (* x 2) (+ x 3)))) 4) (test (let ((x 1)) (case x ((1) (* x 2) (+ x 3)) (else 32))) 4) (test (let ((x 1)) (case x ((1) (let () (set! x (* x 2))) (+ x 3)) (else 32))) 5) (test (let ((x 1)) (case x ((2) (let () (set! x (* x 2))) (+ x 3)) (else 32))) 32) (test (let ((x 1)) (case x ((2) 3) (else (let () (set! x (* x 2))) (+ x 3)))) 5) (test (let((x 1))(case x((2)3)(else(let()(set! x(* x 2)))(+ x 3)))) 5) (test (let ((x 1)) (case x ((2) 3) (else 4) (else 5))) 'error) (test (case () ((()) 2) (else 1)) 2) ; car: (), value: (), eqv: 1, null: 1 1 (test (case () (('()) 2) (else 1)) 1) ; car: (quote ()), value: (), eqv: 0, null: 0 1 (test (case () (('()) 2) (else 1)) 1) ; car: (quote ()), value: (), eqv: 0, null: 0 1 (test (case () ((()) 2) (else 1)) 2) ; car: (), value: (), eqv: 1, null: 1 1 ;;; this is a difference between () and '() ? ;;; (eqv? () ()) -> #t and (eqv? () '()) is #t so it's the lack of evaluation in the search case whereas the index is evaluated ;;; equivalent to: (test (case 2 (('2) 3) (else 1)) 1) ; car: (quote 2), value: 2, eqv: 0, null: 0 0 (test (case '2 (('2) 3) (else 1)) 1) ; car: (quote 2), value: 2, eqv: 0, null: 0 0 (test (case '2 ((2) 3) (else 1)) 3) ; car: 2, value: 2, eqv: 1, null: 0 0 (test (case 2 ((2) 3) (else 1)) 3) ; car: 2, value: 2, eqv: 1, null: 0 0 (test (case '(()) ((()) 1) (((())) 2) (('()) 3) (('(())) 4) ((((()))) 5) (('((()))) 6) (else 7)) 7) ; (eqv? '(()) '(())) is #f (test (let ((x 1)) (case (+ 1 x) ((0 "hi" #f) 3/4) ((#\a 1+3i '(1 . 2)) "3") ((-1 'hi 2 2.0) #\f))) #\f) (test (case (case 1 ((0 2) 3) (else 2)) ((0 1) 2) ((4 2) 3) (else 45)) 3) (test (case 3/4 ((0 1.0 5/6) 1) (("hi" 'hi 3/4) 2) (else 3)) 2) (test (case (case (+ 1 2) (else 3)) ((3) (case (+ 2 2) ((2 3) 32) ((4) 33) ((5) 0)))) 33) (test (let ((x 1)) (case x ((0) (set! x 12)) ((2) (set! x 32))) x) 1) (test (case 1 (else #f)) #f) (test (let () (case 0 ((0) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 1) (test (let () (case 1 ((0) (define (hi a) a)) (else (define (hi a) (+ a 1)))) (hi 1)) 2) ;(test (let () (case (define (hi a) a) ((hi) (hi 1)))) 1) ; 25-Jul-14 (test (catch #t (lambda () (case 1 () ())) (lambda (t i) (apply format #f i))) "case clause is not a pair? (case 1 () ())") (for-each (lambda (arg) (test (case 1 ((0) 'gad) ((1 2 3) arg) (else 'gad)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (case arg ((0) 'gad) ((1 2 3) arg) (else 'gad)) 'gad)) (list "hi" -1 #\a 0 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (call/cc (lambda (r) (case 1 ((1) (r 123) #t) (else #f)))) 123) (test (call/cc (lambda (r) (case 1 ((0) 0) (else (r 123) #f)))) 123) (test (case () ((1) 1) ('() 2)) 2) (test (case (list) ((1) 1) ('() 2)) 2) (test (case () ((1) 1) ((()) 2)) 2) (test (case (list) ((1) 1) ((()) 2)) 2) (test (case # ((#) 1)) 1) (test (case #\newline ((#\newline) 1)) 1) (test (case 'c (else => (lambda (x) (symbol? x)))) #t) (test (case 1.0 ((1e0) 3) ((1.0) 4) (else 5)) 3) (test (let ((x :a)) (case x ((:b) 1) ((:a) 0) (else 3))) 0) (test (eval `(case ,+ ((,-) 0) ((,+) 1) (else 2))) 1) (test (case + ((#_-) 0) ((#_+) 2) (else 3)) 2) (define old-readers *#readers*) (set! *#readers* (cons (cons #\B (lambda (str) (bignum (string->number (substring str 1))))) *#readers*)) (test (case (bignum 1) ((1) 2) (else #f)) 2) (test (case (bignum 1) ((#B1) 2) (else #f)) 2) (test (case 1 ((#B1) 2) (else #f)) 2) (set! *#readers* old-readers) ;; check multiple-value selector (test (list (let ((x 1)) (case 1 ((1) (values 1 2 3)) (else 2)))) '(1 2 3)) (test (list (dynamic-wind (lambda () #f) (lambda () (case (values 1 2 3) (else))) (lambda () #f))) '(1)) (test (list ((lambda () (case (values 1 2 3) (else))))) '(1)) (test (+ (case (call-with-exit (lambda (ret) (ret 1 2 3))) (else))) 1) (test (let ((m1 1)) (list (let-temporarily ((m1 1)) (values 1 2 3)))) '(1 2 3)) (test (let ((m1 1)) (list (call-with-exit (lambda (r) (let-temporarily ((m1 1)) (r 1 2 3)))))) '(1 2 3)) (test (let ((m1 1)) (list (call-with-exit (lambda (r) (let-temporarily ((m1 (r 1 2 3))) 4))))) '(1 2 3)) (let () (define (c1 x) (case x ((3001) 1) ((12345) 2) ((8589934592) 3) (else 4))) (test (c1 3001) 1) (test (c1 12345) 2) (test (c1 8589934592) 3) (test (c1 -1) 4) (define (c2 x) (case x ((0 1 -1) 3) ((9223372036854775807 -9223372036854775808) 4) ((1.5) 5) ((2/3 1+i) 6))) (test (c2 -1) 3) (test (c2 most-positive-fixnum) 4) (test (c2 1.5) 5) (test (c2 2/3) 6) (test (c2 1+i) 6)) (let () (define (f x) (case x ((0) 1) ((0.0) 2) (else 3))) (test (f 0) 1) (test (f 0.0) 2) (test (f 1) 3)) ; case uses eqv? -- why not case-equal? (test (case "" (("") 1)) 1) ; was # (test (case abs ((abs) 1)) #) (test (case (if #f #f) ((1) 1) ((#) 2) (else 3)) 2) ;;; if case falls through, it should return # (not #f for example): ;;; (case x ((a) 1)) should be equivalent to (if (eq? x 'a) 1) (let ((x 'b)) (test (case x ((a) 1)) (if (eq? x 'a) 1))) (test (case) 'error) (test (case 1) 'error) (test (case 1 . "hi") 'error) (test (case 1 ("hi")) 'error) (test (case 1 ("a" "b")) 'error) (test (case 1 (else #f) ((1) #t)) 'error) (test (case "hi" (("hi" "ho") 123) ("ha" 321)) 'error) (test (case) 'error) (test (case . 1) 'error) (test (case 1 . 1) 'error) (test (case 1 (#t #f) ((1) #t)) 'error) (test (case 1 (#t #f)) 'error) (test (case -1 ((-1) => abs)) 1) (test (case 1 (else =>)) 'error) (test (case 1 (else => + - *)) 'error) (test (case #t ((1 2) (3 4)) -1) 'error) (test (case 1 1) 'error) (test (case 1 ((2) 1) . 1) 'error) (test (case 1 (2 1) (1 1)) 'error) (test (case 1 (else)) 1) ; case null 4-Jan-17 (test (case () ((1 . 2) . 1) . 1) 'error) (test (case 1 ((1))) 1) ; case null (test (case 1 ((else))) #) ; case null -- unexpected but ... (test (case 1 ((2) 3) ((1))) 1) ; case null (test (case 1 ((1)) 1 . 2) 'error) (test (case () ((()))) ()) ; case null (test (case 1 (else 3) . 1) 'error) (test (case 1 ((1 2)) (else 3)) 1) ; case null (test (case 1 ('(1 2) 3) (else 4)) 4) (test (case 1 (('1 2) 3) (else 4)) 4) (test (case 1 ((1 . 2) 3) (else 4)) 'error) ; ?? in guile it's an error (test (case 1 ((1 2 . 3) 3) (else 4)) 'error) (test (case 1 (('1 . 2) 3) (else 4)) 'error) (test (case 1 ((1 . (2)) 3) (else 4)) 3) (test (case 1 ((1 2) . (3)) (else 4)) 3) (test (case 1 ((2) 3) (else)) 1) ; case null (test (case 1 ((2) 3) ()) 'error) (test (case 1 ((2) 3) (() 2)) 'error) ; ?? in Guile this is #; our error is confusing: ;case clause key list () is not a list or 'else' (test (case () ('() 2)) 2) ; ?? error?? (test (case () ((()) 2)) 2) (test (case 1 else) 'error) (test (case 1 (((1) 1) 2) (else 3)) 2) ; the (1) can't be matched -- should it be an error? (test (case 1 ((1) . (else 3))) 3) ; ?? guile says "unbound variable: else" (test (case . (1 ((2) 3) ((1) 2))) 2) (test (case 1 (#(1 2) 3)) 'error) (test (case 1 #((1 2) 3)) 'error) (test (case 1 ((2) 3) () ((1) 2)) 'error) (test (case 1 ((2) 3) (1 2) ((1) 2)) 'error) (test (case 1 ((2) 3) (1 . 2) ((1) 2)) 'error) (test (case 1 ((2) 3) (1) ((1) 2)) 'error) (test (case 1 ((2) 3) ((1)) ((1) 2)) 1) ; case null (test (case 1 ((1) 2) ((1) 3)) 2) ; should this be an errror? (test (let () (define-macro (mac x) `(+ ,x 1)) (case 1 ((1) => mac))) 2) (test (let ((x 1)) (case x (else))) 1) (test (let ((x 1)) (case x ((0) 2) (else))) 1) (test (let ((x 1)) (case x ((1) 2) (else))) 2) (test (let ((x 1)) (case x ((0) 2))) #) (test (let ((x 1)) (case x ((1)) ((2) 0))) 1) (test (let ((x 1)) (case x ((lambda lambda*) (display "x") (+ 2 3)) ((case when) 3))) #) (test (let ((x 'lambda)) (case x ((lambda lambda*)) ((case when) (display "x") 3))) 'lambda) (test (let ((s "01234") (i 1)) (case (string-ref s i) ((#\3 #\4) 32) ((#\1 #\2)))) #\1) (test (let ((s "01234") (i 3)) (case (string-ref s i) ((#\3 #\4) 32) ((#\1 #\2)))) 32) (test (let ((head 'and)) (case head ((and if cond when)) ((or if2) (list 'not arg1)))) 'and) (test (let ((s "01234") (i 1)) (case (string-ref s i) ((#\1)) ((#\2) 32))) #\1) (test (let ((s "01234") (i 2)) (case (string-ref s i) ((#\1)) ((#\2) 32))) 32) (test (let ((x 'a)) (case x ((a)))) 'a) (test (case + ((-) 0) ((+)) (else 3)) 3) (test (case + ((-) 0) ((#_+)) (else 3)) +) ;; check optimizer (let () (define (c1 s i) (case (string-ref s i) ((#\a) 1) ((#\i)))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) #\i)) (let () (define (c1 s i) (case s (else))) (define (c3 s i) (c1 s i)) (c3 "hiho" 1) (test (c3 "hiho" 1) "hiho")) (let () (define (c1 s i) (case s (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 2 1) 2)) (let () (define (c1 s i) (case s ((0) 2) (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 1 1) 1)) (let () (define (c1 s i) (case s ((0) 2) (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 0 1) 2)) (let () (define (c1 s i) (case s ((1) 2) (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 1 1) 2)) (let () (define (c1 s i) (case s ((1) 2) (else))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 3 1) 3)) (let () (define (c1 s i) (case s ((0) 2))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 1 1) #)) (let () (define (c1 s i) (case s ((1)) ((2) 0))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 1 1) 1)) (let () (define (c1 s i) (case s ((lambda lambda*)) ((case when) (display "x") 3))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 'lambda 1) 'lambda)) (let () (define (c1 s i) (case (string-ref s i) ((#\3 #\4) 32) ((#\1 #\2)))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 "01234" 1) #\1)) (let () (define (c1 s i) (case s ((and if cond when)) ((or if2) (list 'not arg1)))) (define (c3 s i) (c1 s i)) (c3 2 1) (test (c3 'and 1) 'and)) (let () (define (c1 s i) (case (string-ref s i) ((#\1)) ((#\2) 32))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 "01234" 1) #\1)) (let () (define (c1 s i) (case s ((a)))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 'a 1) 'a)) (let () (define (c1 s i) (case + ((-) 0) ((+)) ((#_+)) (else 3))) (define (c3 s i) (c1 s i)) (c3 "0123" 1) (test (c3 'a 1) +)) (test (let () (define (f1) (let ((x 1)) (case 1 ((0) 0) ((1) 2) (else 3)))) (f1) (f1)) 2) (test (let () (define (f2) (let ((x 1)) (case x ((0) 0) ((1) 2) (else 3)))) (f2) (f2)) 2) (test (let () (define (f3) (let ((x 1)) (case (+ x (* x x) -1) ((0) 0) ((1) 2) (else 3)))) (f3) (f3)) 2) (test (let () (define (f11) (let ((x 2)) (case 2 ((0) 0) ((1) 2) (else 3)))) (f11) (f11)) 3) (test (let () (define (f12) (let ((x 2)) (case x ((0) 0) ((1) 2) (else 3)))) (f12) (f12)) 3) (test (let () (define (f13) (let ((x 2)) (case (+ x (abs (* x x))) ((0) 0) ((1) 2) (else 3)))) (f13) (f13)) 3) (test (let () (define (f21) (let ((x 2)) (case 2 ((0) 0) ((1) 2)))) (f21) (f21)) #) (test (let () (define (f22) (let ((x 2)) (case x ((0) 0) ((1) 2)))) (f22) (f22)) #) (test (let () (define (f23) (let ((x 2)) (case (+ x (abs (* x x))) ((0) 0) ((1) 2)))) (f23) (f23)) #) (test (let () (define (f31) (let ((x 'a)) (case x ((a) 0) ((b) 2) (else 3)))) (f31) (f31)) 0) (test (let () (define (f32) (let ((x '(a b))) (case (car x) ((a) 0) ((b) 2) (else 3)))) (f32) (f32)) 0) (test (let () (define (f33) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2) (else 3)))) (f33) (f33)) 0) (test (let () (define (f41) (let ((x 'c)) (case x ((a) 0) ((b) 2) (else 3)))) (f41) (f41)) 3) (test (let () (define (f42) (let ((x '(c b))) (case (car x) ((a) 0) ((b) 2) (else 3)))) (f42) (f42)) 3) (test (let () (define (f43) (let ((x 'c)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2) (else 3)))) (f43) (f43)) 3) (test (let () (define (f51) (let ((x 'c)) (case x ((a) 0) ((b) 2)))) (f51) (f51)) #) (test (let () (define (f52) (let ((x '(c b))) (case (car x) ((a) 0) ((b) 2)))) (f52) (f52)) #) (test (let () (define (f53) (let ((x 'c)) (case (car (car (list (list x x)))) ((a) 0) ((b) 2)))) (f53) (f53)) #) (test (let () (define (f61) (let ((x 'a)) (case x ((a) 0) ((1) 2) (else 3)))) (f61) (f61)) 0) (test (let () (define (f62) (let ((x '(a b))) (case (car x) ((a) 0) ((1) 2) (else 3)))) (f62) (f62)) 0) (test (let () (define (f63) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2) (else 3)))) (f63) (f63)) 0) (test (let () (define (f71) (let ((x 'b)) (case x ((a) 0) ((1) 2) (else 3)))) (f71) (f71)) 3) (test (let () (define (f72) (let ((x '(b b))) (case (car x) ((a) 0) ((1) 2) (else 3)))) (f72) (f72)) 3) (test (let () (define (f73) (let ((x 'b)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2) (else 3)))) (f73) (f73)) 3) (test (let () (define (f81) (let ((x 'b)) (case x ((a) 0) ((1) 2)))) (f81) (f81)) #) (test (let () (define (f82) (let ((x '(b b))) (case (car x) ((a) 0) ((1) 2)))) (f82) (f82)) #) (test (let () (define (f83) (let ((x 'b)) (case (car (car (list (list x x)))) ((a) 0) ((1) 2)))) (f83) (f83)) #) (test (let () (define (f91) (let ((x 'a)) (case x ((a) 0) ((b c) 2) (else 3)))) (f91) (f91)) 0) (test (let () (define (f92) (let ((x '(a b))) (case (car x) ((a) 0) ((b c) 2) (else 3)))) (f92) (f92)) 0) (test (let () (define (f93) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2) (else 3)))) (f93) (f93)) 0) (test (let () (define (f101) (let ((x 'd)) (case x ((a) 0) ((b c) 2) (else 3)))) (f101) (f101)) 3) (test (let () (define (f102) (let ((x '(d b))) (case (car x) ((a) 0) ((b c) 2) (else 3)))) (f102) (f102)) 3) (test (let () (define (f103) (let ((x 'd)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2) (else 3)))) (f103) (f103)) 3) (test (let () (define (f111) (let ((x 'd)) (case x ((a) 0) ((b c) 2)))) (f111) (f111)) #) (test (let () (define (f112) (let ((x '(d b))) (case (car x) ((a) 0) ((b c) 2)))) (f112) (f112)) #) (test (let () (define (f113) (let ((x 'd)) (case (car (car (list (list x x)))) ((a) 0) ((b c) 2)))) (f113) (f113)) #) (test (let () (define (f121) (let ((x 'a)) (case x ((a) 0) ((b c 12) 2) (else 3)))) (f121) (f121)) 0) (test (let () (define (f122) (let ((x '(a b))) (case (car x) ((a) 0) ((b c 12) 2) (else 3)))) (f122) (f122)) 0) (test (let () (define (f123) (let ((x 'a)) (case (car (car (list (list x x)))) ((a) 0) ((b c 12) 2) (else 3)))) (f123) (f123)) 0) (test (let () (define (func) (let ((i 0)) (case #() ((null? i) i)))) (define (hi) (func) (func)) (hi) (hi)) #) ; case a_e_g not simple selector (when with-block (test (let ((i 0)) (let ((_f_ (lambda () (case (append (block) (block)) ((null? i) i))))) (_f_) (_f_))) #)) ; case p_e_g (test (let () (define (func) (let ((i 0)) ((lambda () (case (lambda sym-args sym-args) ((null? i) i)))))) (define (hi) (func) (func)) (hi) (hi)) #) (test (case 123 ((123) 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6)) 6) (unless with-bignums (test (s7-optimize '((case 123 ((123) 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6)))) #) ; check optimizer overflow bug (test (s7-optimize '((case 123 ((123) 1 2 3 4 5 6 7 8 9 0 1)))) 1) (test (s7-optimize '((case 123 ((123) 1 2 3 4 5 6 7 8 9 0 1 2)))) #)) ;; newly optimized case (let ((lt (inlet 'a 1 'b 2))) (define (c1 s) (case (let-ref lt s) ((#) 3) (else))) (define (c3 s) (c1 s)) (c3 'a) (test (c3 'b) 2) (test (c3 'a) 1) (test (c3 'c) 3)) (let ((lt (inlet 'a 1 'b 2))) (define (c1 s) (case (let-ref lt s) ((# #) 3) (else))) (define (c3 s) (c1 s)) (c3 'a) (test (c3 'b) 2) (test (c3 'a) 1) (test (c3 'c) 3)) (let ((lt (inlet 'a 1 'b 2))) (define (c1 s) (let ((x 1)) (case (let-ref lt s) ((#) (set! x 2) (+ x 1)) (else)))) (define (c3 s) (c1 s)) (c3 'a) (test (c3 'a) 1) (test (c3 'c) 3)) (let () (define (hi x) (case x ((a) 'a) ((b) 'b) (else 'c))) (test (hi 'a) 'a) (test (hi 'd) 'c)) (test (case 'case ((case) 1) ((cond) 3)) 1) (test (case 101 ((0 1 2) 200) ((3 4 5 6) 600) ((7) 700) ((8) 800) ((9 10 11 12 13) 1300) ((14 15 16) 1600) ((17 18 19 20) 2000) ((21 22 23 24 25) 2500) ((26 27 28 29) 2900) ((30 31 32) 3200) ((33 34 35) 3500) ((36 37 38 39) 3900) ((40) 4000) ((41 42) 4200) ((43) 4300) ((44 45 46) 4600) ((47 48 49 50 51) 5100) ((52 53 54) 5400) ((55) 5500) ((56 57) 5700) ((58 59 60) 6000) ((61 62) 6200) ((63 64 65) 6500) ((66 67 68 69) 6900) ((70 71 72 73) 7300) ((74 75 76 77) 7700) ((78 79 80) 8000) ((81) 8100) ((82 83) 8300) ((84 85 86 87) 8700) ((88 89 90 91 92) 9200) ((93 94 95) 9500) ((96 97 98) 9800) ((99) 9900) ((100 101 102) 10200) ((103 104 105 106 107) 10700) ((108 109) 10900) ((110 111) 11100) ((112 113 114 115) 11500) ((116) 11600) ((117) 11700) ((118) 11800) ((119 120) 12000) ((121 122 123 124 125) 12500) ((126 127) 12700) ((128) 12800) ((129 130) 13000) ((131 132) 13200) ((133 134 135 136) 13600) ((137 138) 13800)) 10200) (test (case most-positive-fixnum ((-1231234) 0) ((9223372036854775807) 1) (else 2)) 1) (test (case most-negative-fixnum ((123123123) 0) ((-9223372036854775808) 1) (else 2)) 1) (test (case 0 ((3/4 "hi" #t) 0) ((#f #() -1) 2) ((#\a 0 #t) 3) (else 4)) 3) (test (case 3/4 ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 0) (test (case 'hi ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 2) (test (case #f ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 2) (test (case 3 ((3/4 "hi" #t) 0) ((#f #() hi) 2) ((#\a 0 #t) 3) (else 4)) 4) (test (case 0 ((values 0 1) 2) (else 3)) 2) (test (+ (case 0 ((0) (values 1 2 3))) 4) 10) (test (+ (case 1 ((0) (values 1 2 3)) (else (values 1 2))) 4) 7) (test (let ((otherwise else)) (case 0 ((1) 2) (otherwise 3))) 3) ; maybe this isn't a great idea... (test (case 0 ((1) #t) ((2 else 3) #f) ((0) 0)) 0) ; should this be an error? (it isn't in Guile) (test (case 0 ((1) #t) ((else) #f) ((0) 0)) 0) (test (apply case 1 '(((0) -1) ((1) 2))) 2) (test (let ((x #(1))) (apply case x (list (list (list #()) 1) (list (list #(1)) 2) (list (list x) 3) (list 'else 4)))) 3) (let () ; opt_case tests (define (tcase1) (do ((v (int-vector 0)) (i 0 (+ i 1))) ((= i 1) v) (int-vector-set! v 0 (case 1 ((0) 0) ((1) 1) ((2) 2) (else 3))))) (test (tcase1) #i(1)) (define (tcase2) (do ((v (vector 'a 'b 'c 'd)) (i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (case (v 1) ((a) 0) ((b) 1) ((c) 2) (else 3))))) (test (tcase2) #(1 b c d))) (test (let ((x 0)) (let ((y (case 1 ((2) (set! x (+ x 3))) ((1) (set! x (+ x 4)) (+ x 2))))) (list x y))) '(4 6)) (let () (define (hi a) (case a ((0) 1) ((1) 2) (else 3))) (test (hi 1) 2) (test (hi 2) 3) (test (hi "hi") 3)) (when with-bignums (test (case 8819522415901031498123 ((1) 2) ((8819522415901031498123) 3) (else 4)) 3) (test (case -9223372036854775809 ((1 9223372036854775807) 2) (else 3)) 3) (let () (define (cgmp x) (case x ((0) 1) ((1) 2))) (define (test-cgmp) (cgmp (bignum "1"))) (test (cgmp 0) 1) (test (cgmp (bignum "1")) 2) (test (cgmp (bignum "0")) 1) (test (test-cgmp) 2))) ;;; one thing that will hang case I think: circular key list ;;; C-style case (define-macro (switch selector . clauses) `(call-with-exit (lambda (break) (case ,selector ,@(do ((clause clauses (cdr clause)) (new-clauses ())) ((null? clause) (reverse new-clauses)) (set! new-clauses (cons `(,(caar clause) ,@(cdar clause) ,@(map (lambda (nc) (apply values (cdr nc))) (if (pair? clause) (cdr clause) ()))) new-clauses))))))) (test (switch 1 ((1) (break 1)) ((2) 3) (else 4)) 1) (test (switch 2 ((1) (break 1)) ((2) 3) (else 4)) 4) (test (switch 4 ((1) (break 1)) ((2) 3) (else 4)) 4) (let () (call-with-output-file "test.scm" (lambda (p) (format p "(define (big-cond x)~%") (format p " (cond~%") (do ((i 0 (+ i 1))) ((= i 1000)) (format p " ((= x ~D) x)~%" i)) (format p " ))~%~%") (format p "(define (big-case x)~%") (format p " (case x~%") (do ((i 0 (+ i 1))) ((= i 1000)) (format p " ((~D) x)~%" i)) (format p " ))~%~%"))) (load "test.scm" (curlet)) (test (big-cond 541) 541) (test (big-case 541) 541)) (let-temporarily (((*s7* 'safety) 1)) (test (apply case `(x . 1) (let ((<1> (list #f)) (<2> (list #f #f))) (set-car! <1> <1>) (set-cdr! <1> <2>) (set-cdr! (cdr <2>) <2>) <1>) `((x . 1))) 'error)) ;;; -------------------------------------------------------------------------------- ;;; lambda ;;; -------------------------------------------------------------------------------- (test (procedure? (lambda (x) x)) #t) (test ((lambda (x) (+ x x)) 4) 8) (test (let ((reverse-subtract (lambda (x y) (- y x)))) (reverse-subtract 7 10)) 3) (test (let ((add4 (let ((x 4)) (lambda (y) (+ x y))))) (add4 6)) 10) (test ((lambda x x) 3 4 5 6) (list 3 4 5 6)) (test ((lambda x x)) ()) (test ((lambda (x y . z) z) 3 4 5 6) (list 5 6)) (test ((lambda (a b c d e f) (+ a b c d e f)) 1 2 3 4 5 6) 21) (test (let ((foo (lambda () 9))) (+ (foo) 1)) 10) (test (let ((a 1)) (let ((f (lambda (x) (set! a x) a))) (let ((c (f 123))) (list c a)))) (list 123 123)) (test (let ((a 1) (b (lambda (a) a))) (b 3)) 3) (test (let ((ctr 0)) (letrec ((f (lambda (x) (if (> x 0) (begin (set! ctr (+ ctr 1)) (f (- x 1))) 0)))) (f 10) ctr)) 10) (test (let ((f (lambda (x) (car x)))) (f '(4 5 6))) 4) (test ((lambda () ((lambda (x y) ((lambda (z) (* (car z) (cdr z))) (cons x y))) 3 4))) 12) (test (let ((ctr 0)) (define (f) (set! ctr (+ ctr 1)) ctr) (let ((x (f))) (let ((y (f))) (list x y ctr)))) (list 1 2 2)) (test (let ((x 5)) (define foo (lambda (y) (bar x y))) (define bar (lambda (a b) (+ (* a b) a))) (foo (+ x 3))) 45) (test (let ((x 5)) (letrec ((foo (lambda (y) (bar x y))) (bar (lambda (a b) (+ (* a b) a)))) (foo (+ x 3)))) 45) (num-test (let () (define compose (lambda (f g) (lambda args (f (apply g args))))) ((compose sqrt *) 12 75)) 30.0) (let () (define (compose . args) ; this just removes parens (if (procedure? (car args)) (if (null? (cdr args)) ((car args)) ((car args) (apply compose (cdr args)))) (apply values args))) (test (compose - + (lambda (a b c) (values a (* b c))) 2 3 4) -14) (test (- (+ ((lambda (a b c) (values a (* b c))) 2 3 4))) -14)) ; I prefer this (test (let ((f (lambda () (lambda (x y) (+ x y))))) ((f) 1 2)) 3) (test ((lambda (x) (define y 4) (+ x y)) 1) 5) (test ((lambda(x)(define y 4)(+ x y))1) 5) (test ((lambda () (define (y x) (+ x 1)) (y 1))) 2) (test ((lambda (x) 123 (let ((a (+ x 1))) a)) 2) 3) (test ((lambda (x) "documentation" (let ((a (+ x 1))) a)) 2) 3) (test ((lambda (x) (x 1)) (lambda (y) (+ y 1))) 2) (test (let ((a 1)) (let ((b (lambda (x) (define y 1) (define z 2) (define a 3) (+ x y z a)))) (b a))) 7) (test ((lambda (f x) (f x x)) + 11) 22) (test ((lambda () (+ 2 3))) 5) (test (let ((x (let () (lambda () (+ 1 2))))) (x)) 3) (test (cond (0 => (lambda (x) x))) 0) (test ((lambda () "hiho")) "hiho") (test ((lambda()()))()) (test ((lambda () _undef_)) _undef_) (when (zero? (*s7* 'debug)) (test (procedure-source (apply lambda (list) (list (list)))) '(lambda () ()))) (test (letrec ((f (lambda (x) (g x))) (g (lambda (x) x))) (let ((top (f 1))) (set! g (lambda (x) (- x))) (+ top (f 1)))) 0) (let () (define (f8-1 x) (values (+ x 1) (+ x 2))) (define (f8 a) ((lambda (w x y z) (+ w x y z)) (f8-1 a) (f8-1 (+ a 2)))) (test (f8 3) 22) (define (err type info) 'error) ;(list type (apply format #f info))) (define (f9) ((lambda () 32) 1)) (test (catch #t f9 err) 'error) (test (catch #t f9 err) 'error) (define (f10) ((lambda (x) x))) (test (catch #t f10 err) 'error) (test (catch #t f10 err) 'error) (define (f11) ((lambda (x) x) 1 2)) (test (catch #t f11 err) 'error) (test (catch #t f11 err) 'error) (define (f12) ((lambda (x y) x) (values 1 2 3))) (test (catch #t f12 err) 'error) (test (catch #t f12 err) 'error) (define (f13) ((lambda (x y) x) (values 3))) (test (catch #t f13 err) 'error) (test (catch #t f13 err) 'error)) (for-each (lambda (arg) (test ((lambda (x) x) arg) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (let ((list-length (lambda (obj) (call-with-current-continuation (lambda (return) (letrec ((r (lambda (obj) (cond ((null? obj) 0) ((pair? obj) (+ (r (cdr obj)) 1)) (else (return #f)))))) (r obj))))))) (test (list-length '(1 2 3 4)) 4) (test (list-length '(a b . c)) #f)) (test (let ((samples (vector 0 1 2 3 4 5 6 7 8 9 10))) (let ((make-scaler (lambda (start end) (letrec ((ctr start) (us (lambda (them) (vector-set! samples ctr (* 2 (vector-ref samples ctr))) (set! ctr (+ ctr 2)) (if (<= ctr end) (them us))))) us)))) ((make-scaler 0 11) (make-scaler 1 11))) samples) (vector 0 2 4 6 8 10 12 14 16 18 20)) (test ((lambda (x . y) y) 1 2 '(3 . 4)) '(2 (3 . 4))) (test ((lambda (x . y) y) 1) ()) (test ((lambda x x) ()) '(())) (test ((lambda x x)) ()) (test ((lambda (x) x) ()) ()) (test ((lambda (x) (+ x ((lambda (x) (+ x 1)) 2))) 3) 6) (test ((lambda (x) (define y 1) (+ x y)) 2) 3) (test ((lambda (a) "this is a doc string" a) 1) 1) (test ((lambda (a) "hiho" (define x 1) x) 2) 1) (test ((lambda (a) "hiho" (define x a) x) 2) 2) (test (let ((g (lambda () '3))) (= (g) 3)) #t) (test ((((lambda () lambda)) () 1)) 1) (test (let () ; PLP Scott p168 (define A (lambda () (let* ((x 2) (C (lambda (P) (let ((x 4)) (P)))) (D (lambda () x)) (B (lambda () (let ((x 3)) (C D))))) (B)))) (A)) 2) #| ;;; here s7 "do" uses set! (test (let ((funcs (make-vector 3 #f))) (do ((i 0 (+ i 1))) ((= i 3)) (vector-set! funcs i (lambda () (+ i 1)))) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2)))) 6) |# ;;; the equivalent named let version: (test (let ((funcs (make-vector 3 #f))) (let loop ((i 0)) (if (< i 3) (begin (vector-set! funcs i (lambda () (+ i 1))) (loop (+ i 1))))) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2)))) 6) (test (let ((i 1)) (let ((func1 (lambda () i))) (let ((i 2)) (let ((func2 (lambda () i))) (+ (func1) (func2)))))) 3) (test (let ((funcs (make-vector 3 #f))) (map (lambda (i) (vector-set! funcs i (lambda () (+ i 1)))) (list 0 1 2)) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2)))) 6) (test (let ((funcs (make-vector 3 #f))) (for-each (lambda (i) (vector-set! funcs i (lambda () (+ i 1)))) (list 0 1 2)) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2)))) 6) (test (let ((funcs (make-vector 3 #f))) (sort! (list 0 1 2) (lambda (i j) (vector-set! funcs i (lambda () (+ i 1))) (> i j))) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2)))) 6) (test (let ((funcs (make-vector 3 #f))) (member 4 (list 0 1 2) (lambda (j i) (vector-set! funcs i (lambda () (+ i 1))) #f)) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2)))) 6) (test (let ((funcs (make-vector 3 #f))) (assoc 4 (list (cons 0 0) (cons 1 0) (cons 2 0)) (lambda (j i) (vector-set! funcs i (lambda () (+ i 1))) #f)) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2)))) 6) (test (let ((func #f)) (define (func1 x) (set! func (lambda () (+ x 1)))) (func1 1) (+ (func) (let () (func1 2) (func)))) 5) (test (((lambda (x) (lambda () (+ x 1))) 32)) 33) (test (let ((func #f)) (define (func1 x) (set! func (lambda () (string-append x "-")))) (func1 "hi") (string-append (func) (let () (func1 "ho") (func)))) "hi-ho-") (test (let ((func1 #f) (func2 #f)) (let ((x 1)) (set! func1 (lambda () x)) (set! func2 (lambda (y) (set! x y) y))) (+ (func1) (let () (func2 32) (func1)))) 33) (test (let ((funcs (make-vector 3))) (let ((hi (lambda (a) (vector-set! funcs (- a 1) (lambda () a))))) (hi 1) (hi 2) (hi 3) (+ ((vector-ref funcs 0)) ((vector-ref funcs 1)) ((vector-ref funcs 2))))) 6) (test (let ((hi (lambda (a) (+ a 1))) (ho (lambda (a) (a 32)))) (+ (hi (hi (hi 1))) (ho hi))) 37) (test (let ((x 0) (b 4) (f1 #f) (f2 #f)) (let ((x 1)) (let ((x 2)) (set! f1 (lambda (a) (+ a b x))))) (let ((x 3)) (let ((b 5)) (set! f2 (lambda (a) (+ a b x))))) (+ (f1 10) (f2 100))) ; (+ 10 4 2) (+ 100 5 3) 124) (test ((if (> 3 2) + -) 3 2) 5) (test (let ((op +)) (op 3 2)) 5) (test (((lambda () +)) 3 2) 5) (test ((car (cons + -)) 3 2) 5) (test ((do ((i 0 (+ i 1))) ((= i 3) +) ) 3 2) 5) (test (((lambda (x) x) (lambda (x) x)) 3) 3) (test ((((lambda (x) x) (lambda (x) x)) (lambda (x) x)) 3) 3) (test (((lambda (x) (lambda (y) x)) 3) 4) 3) (test (((lambda (x) (lambda (x) x)) 3) 4) 4) (test (let ((x 32)) (((lambda (x) (lambda (y) x)) 3) x)) 3) (test ((call/cc (lambda (return) (return +))) 3 2) 5) (test ((call-with-values (lambda () (values +)) (lambda (x) x)) 3 2) 5) ;(unless pure-s7 (test ((#_call-with-values (lambda () (values +)) (lambda (x) x)) 3 2) 5)) ; not semipermanent (test ((case '+ ((+) +)) 3 2) 5) (test ((case '+ ((-) -) (else +)) 3 2) 5) (test ((call/cc (lambda (return) (dynamic-wind (lambda () #f) (lambda () (return +)) (lambda () #f)))) 3 2) 5) (test (+ 1 ((call/cc (lambda (return) (dynamic-wind (lambda () #f) (lambda () (return +)) (lambda () #f)))) 3 2) 2) 8) (test (let ((lst (list + -))) ((car lst) 1 2 3)) 6) (test (let ((a +)) ((let ((b -)) (if (eq? a b) a *)) 2 3)) 6) (test ((list-ref (list + - * /) 0) 2 3) 5) (test (((if #t list-ref oops) (list + - * /) 0) 2 3) 5) (test ((((car (list car cdr)) (list car cdr)) (list + -)) 2 3) 5) (test (let () (define function lambda) (define hiho (function (a) (+ a 1))) (hiho 2)) 3) (test ((lambda (a b c d e f g h i j k l m n o p q r s t u v x y z) (+ a b c d e f g h i j k l m n o p q r s t u v x y z)) 1 2 3 4 5 6 7 8 9 11 12 13 14 15 16 17 18 19 21 22 23 24 25 26 27) 348) (test ((lambda (x) "a useless string" x) 32) 32) (test ((lambda (>< =0=? .arg.) (+ >< =0=? .arg.)) 1 2 3) 6) (test ((apply ((lambda () lambda)) ((lambda () (list 'a))) ((lambda () '((+ a 1))))) 3) 4) (define-constant (_?_3 a) #f) (let () (define (hi x) (_?_3 x)) (hi 1) (test (let ((x 1)) (hi x)) #f)) (let () (define (_?_4 x y) x) (define (hi x) (_?_4 x (* x x (+ 1 x)))) (hi 1) (test (let ((x 1)) (hi x)) 1)) (define-constant (_?_5 x) (if (zero? x) x (+ x (_?_5 (- x 1))))) (let () (define (hi x) (_?_5 x)) (hi 1) (test (let ((x 1)) (hi x)) 1)) (let () (define (hi x) (_?_5 (_?_5 1))) (hi 1) (test (hi 1) 1)) (let ((x 1)) (define (hi y) (set! x (* y y y))) (hi 1) (test (hi 1) 1)) (let ((vvv1 (make-vector '(2 2)))) ; implicit closure call (fill! vvv1 (lambda (a b . c) (list a b c))) (define (func) (let ((__x__ 1)) (do ((i 0 (+ i __x__))) ((= i __x__)) (vvv1 (+ i 1) 0 (make-vector 3 #f) ()) ))) (test (func) 'error)) ; #t)) (let () ; from lisp bboard sasstat? (define (last-elt lst) (car (let no-tails ((cd lst)) (if (pair? (cdr cd)) (cdr (no-tails (cdr cd))) lst)))) (test (last-elt '(1 2 3)) 3)) (let () ; from guile mailing list (define (function-generator) (let ((func #f)) (lambda () (set! func (let a () a)) func))) (define x (function-generator)) (define y (function-generator)) (test (eq? (x) (y)) #f)) (test (let () (begin (define f1 #f) (define f2 #f) (let ((lv 32)) (set! f1 (lambda (a) (+ a lv))) (set! f2 (lambda (a) (- a lv))))) (+ (f1 1) (f2 1))) 2) (test ((lambda () => abs)) 'error) (test ((lambda () => => 3)) 'error) ;; actually, both Guile and Gauche accept ;; ((lambda () + 3)) and (begin + 3) ;; but surely => is an undefined variable in this context? (test (lambda) 'error) (test (lambda (a) ) 'error) ;; should this be an error: (lambda (a) (define x 1)) ? (test (lambda . 1) 'error) (test ((lambda . (x 1))) 1) (test ((lambda . ((x . y) 2)) 1) 2) (test ((lambda (x) . (x)) 1) 1) (test ((lambda . ((x) . (x))) 1) 1) (test ((lambda . (x . (x))) 1) '(1)) (test ((lambda . ((x . ()) x)) 1) 1) (test (eval-string "((lambda . (x 1 . 3)) 1)") 'error) (test (let () (define x (lambda . 1))) 'error) (test (lambda 1) 'error) (test (lambda (x 1) x) 'error) (test (lambda "hi" 1) 'error) (test (lambda (x x) x) 'error) (test ((lambda (x x) x) 1 2) 'error) (test (lambda (x "a")) 'error) (test ((lambda (x y) (+ x y a)) 1 2) 'error) (test ((lambda ())) 'error) (test (lambda (x (y)) x) 'error) (test ((lambda (x) x . 5) 2) 'error) (test (lambda (1) #f) 'error) (test (eval-string "(lambda (x . y z) x)") 'error) (test ((lambda () 1) 1) 'error) (test ((lambda (()) 1) 1) 'error) (test ((lambda (x) x) 1 2) 'error) (test ((lambda (x) x)) 'error) (test ((lambda ("x") x)) 'error) (test ((lambda "x" x)) 'error) (test ((lambda (x . "hi") x)) 'error) (test (lambda ((:hi . "hi") . "hi") 1) 'error) (test ((lambda (x) (* quote ((x . 1) . 2))) 1) 'error) (test ((lambda* (a (quote . -1)) a)) 'error) (test (let () (define x (lambda (= i 0) i))) 'error) (test (let () (define x (lambda (arg)))) 'error) (test (let () (define (x (arg)))) 'error) (let-temporarily (((*s7* 'safety) 1)) ; not sure about these two -- cyclic bodies (test (let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda () lst ())) 'error) (test (let ((lst (list '+ 1))) (set-cdr! (cdr lst) (cdr lst)) (apply lambda* () lst ())) 'error)) (test (letrec ((f (lambda () f))) (object->string f :readable)) "(letrec ((f (lambda () f))) f)") (test (let ((f (lambda () f))) (object->string f :readable)) "(lambda () f)") (test (letrec ((f (let ((x 1)) (lambda () (f x))))) (object->string f :readable)) "(let ((x 1) ) (letrec ((f (lambda () (f x)))) f))") ; hmm (let () (define (fop11 a b c d e) (abs a) (floor b) (+ a b c d e)) (define (tf12) (let ((a 1) (b 2)) (fop11 a b (fop11 a b 1 2 3) (fop12) (fop12)))) ; hit op_any_closure_np_mv (test (tf12) 'error)) (let () ;; check that the set! below increments setfib's symbol_ctr so that closure_is_ok looks up setfib (define setfib (lambda (n) #f)) (set! setfib (lambda (n) (if (< n 2) n (+ (setfib (- n 1)) (setfib (- n 2)))))) (test (setfib 10) 55)) (test (let ((hi (lambda (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error) (test (object->string ((lambda (arg) (list arg (list (quote quote) arg))) (quote (lambda (arg) (list arg (list (quote quote) arg)))))) "((lambda (arg) (list arg (list (quote quote) arg))) (quote (lambda (arg) (list arg (list (quote quote) arg)))))") ;; "((lambda (arg) (list arg (list 'quote arg))) '(lambda (arg) (list arg (list 'quote arg))))") ;; was "(#1=(lambda (arg) (list arg (list 'quote arg))) '#1#)" (test ((apply lambda '((a) (+ a 1))) 2) 3) (test ((apply lambda '(() #f))) #f) (test ((apply lambda '(arg arg)) 3) '(3)) (test ((apply lambda* '((a (b 1)) (+ a b))) 3 4) 7) (test ((apply lambda* '((a (b 1)) (+ a b))) 3) 4) (let () (define-macro (progv vars vals . body) `(apply (apply lambda ,vars ',body) ,vals)) (test (let ((s '(one two)) (v '(1 2))) (progv s v (+ one two))) 3) (test (progv '(one two) '(1 2) (+ one two)) 3)) (test (lambda #(a b) a) 'error) (test (lambda* (#(a 1)) a) 'error) (test ((lambda (a) a) #) #) (test ((lambda () (let ((a #)) a))) #) (test (let () (define* (foo (a 0) (b (+ a 4)) (c (+ a 7))) (list a b c)) (foo :b 2 :a 60)) '(60 2 67)) (test (let () (define* (f1 (a 0) (b (* 2 a))) (+ a b)) (f1 2)) 6) ; this used to be 2 ;; one oddness: (test (let () (define* (f1 (a (* b 2)) (b 3)) (list a b)) (f1 :b 1)) '(2 1)) ;; (f1) however would be an error? or should we preset args if we can? (let () (define* (f1 (a (+ b 1)) (b (+ a 1))) (list a b)) (test (f1 1) '(1 2)) (test (f1 :b 1) '(2 1)) (test (f1 :b 0 :a 1) '(1 0)) (test (f1 :a 1) '(1 2)) (test (f1 2 3) '(2 3)) (test (f1) 'error)) (let () (define* (f1 (a (if (number? b) (+ b 1) 3)) (b (+ a 1))) (list a b)) (test (f1) '(3 4))) (let () (define* (f1 (a 1) (b (+ a 1))) (+ a b)) (define* (f2 (a (f1))) a) (test (f2) 3)) (let () (define* (f1 (a 1) (b (+ a 1))) (+ a b)) (define* (f2 (a (f1)) (b (f1 2))) (list a b)) (test (f2) '(3 5))) #| (let () ; fx_tree special cases (let () (define (func) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((>= x 1) (#_let () (* 2 x 3 4))))) (test (func) 24)) (let () (define (func) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((>= x 1) (((vector let) 0) () (* 2 x 3 4))))) (test (func) 24)) (let () (define (func) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((>= x 1) ((let () letrec*) ((x 1234) (y 1/2)) (* 2 x 3 4))))) (test (func) 29616))) |# (let () ; bug-guile (define (f . l) (let lp2 ((i 0) (s 0) (l l)) (if (and (pair? l) (< i 64)) (lp2 (+ i 1) (if (car l) (logior (ash 1 i) s) s) (cdr l)) s))) (test (f #f 0 #f 0) 10)) (let ((clet (immutable! (let () (define-constant a 1) (curlet))))) ; constant parameter op_f_np (define (func) (catch #t (lambda () (with-let clet ((lambda (a) (+ a 1)) 2) 0)) (lambda (type info) (apply format #f info)))) (test (func) "lambda parameter a is a constant: (lambda (a) ...)") ; check_lambda_args (test (func) "lambda parameter a is a constant: ((lambda (a) ...) 2)")) ; op_f_np ;;; -------------------------------------------------------------------------------- ;;; a bunch of tc/recur tests for the optimizer (let () ;; -------- OP_TC_IF_A_Z_LA -------- (define (tc-if-a-z-la-1 x) (if (zero? x) 3 (tc-if-a-z-la-1 (- x 1)))) (test (tc-if-a-z-la-1 10) 3) (define (tc-if-a-z-la-2 x) (if (zero? x) (let ((z (+ x 1))) z) (tc-if-a-z-la-2 (- x 1)))) (test (tc-if-a-z-la-2 10) 1) (define tc-if-a-z-la-3 (let ((y #(10))) (lambda (x) (if (zero? (vector-ref y 0)) y (tc-if-a-z-la-3 (vector-set! y 0 (- (vector-ref y 0) 1))))))) (test (tc-if-a-z-la-3 10) #(0)) (define (tc-if-a-z-la-4 x) (if (zero? x) 3 (tc-if-a-z-la-4))) (test (tc-if-a-z-la-4 10) 'error) (define (tc-if-a-z-la x) (if (= x 0) 12 (tc-if-a-z-la (- x 1)))) (test (let ((z 10)) (define (ftc-2 x) (+ x (tc-if-a-z-la 10))) (ftc-2 z)) 22) (define (tc-if-a-z-la-5 x) (if (null? x) 3 (tc-if-a-z-la-5 (cdr x)))) (test (tc-if-a-z-la-4 '(1 2 . 3)) 'error) ;; -------- OP_TC_IF_A_LA_Z -------- (define (tc-if-a-la-z-1 x) (if (positive? x) (tc-if-a-la-z-1 (- x 1)) 3)) (test (tc-if-a-la-z-1 10) 3) (define (tc-if-a-la-z-2 x) (if (positive? x) (tc-if-a-la-z-2 (- x 1)) (let ((z (+ x 1))) z))) (test (tc-if-a-la-z-2 10) 1) (define (tc-if-a-la-z-3 x) (if (positive? x) (tc-if-a-la-z-3 (- x 1) (+ y 1)) 3)) (test (tc-if-a-la-z-3 10) 'error) (define (tc-if-a-la-z-4 x) (if (positive? x) (tc-if-a-la-z-4) 3)) (test (tc-if-a-la-z-4 10) 'error) (define (fx-tc-if-a-la-z x) (if (> x 0) (fx-tc-if-a-la-z (- x 1)) 12)) (test (let ((z 10)) (define (ftc-3 x) (+ x (fx-tc-if-a-la-z 10))) (ftc-3 z)) 22) (define (tc-if-a-la-z-5 x) (if (not (null? x)) (tc-if-a-la-z-5 (cdr x)) 3)) (test (tc-if-a-la-z-5 '(1 2 . 3)) 'error) ;; -------- OP_TC_IF_A_Z_L2A -------- (define (tc-if-a-z-l2a-1 x y) (if (null? x) (begin (vector-set! y 0 32) y) (tc-if-a-z-l2a-1 (cdr x) y))) (test (tc-if-a-z-l2a-1 '(1 2 3) #(1 2 3)) #(32 2 3)) (define (tc-if-a-z-l2a-2 x y) (if (null? x) (copy y) (tc-if-a-z-l2a-2 (cdr x) y))) (test (tc-if-a-z-l2a-2 '(1 2 3) #(1 2 3)) #(1 2 3)) (define (tc-if-a-z-l2a-3 x y) (if (null? x) #f (tc-if-a-z-l2a-3 (cdr x) y))) (test (tc-if-a-z-l2a-3 '(1 2 3) #(1 2 3)) #f) (define (tc-if-a-z-l2a-4 x y) (if (null? x) y (tc-if-a-z-l2a-4 (cdr x) (+ y 1)))) (test (tc-if-a-z-l2a-4 '(1 2 3) 0) 3) (define (tc-if-a-z-l2a-0-1 x y) (if (= x 0) y (tc-if-a-z-l2a-0-1 (- x 1) (+ y 1)))) (test (tc-if-a-z-l2a-0-1 10 0) 10) (define (tc-if-a-z-l2a-5 x y) (if (= x 0) y (tc-if-a-z-l2a-5 (- x 1)))) (test (tc-if-a-z-l2a-5 10 0) 'error) (define (tc-if-a-z-l2a-6 x y) (if (= x 0) y (tc-if-a-z-l2a-6 (- x 1) (+ y 1) 0))) (test (tc-if-a-z-l2a-6 10 0) 'error) (define (tc-if-a-z-l2a-0-7 x y) (if (= x 0) y (tc-if-a-z-l2a-0-7 (- x 1) (+ x 1)))) (test (tc-if-a-z-l2a-0-7 10 0) 2) (define (tc-if-a-z-l2a-8 x y) (if (null? x) (begin (vector-set! y 0 32) (tc-if-a-z-l2a-8 () 0)) (tc-if-a-z-l2a-8 (cdr x) y))) (test (tc-if-a-z-l2a-8 '(1 2 3) #(1 2 3)) 'error) (define (fx-tc-if-a-z-l2a x y) (if (= x 0) y (fx-tc-if-a-z-l2a (- x 1) (+ y 1)))) (test (let ((z 10)) (define (ftc-1 x) (+ x (fx-tc-if-a-z-l2a 10 0))) (ftc-1 z)) 20) (define (length>? lst len) ; from Da Shen -- need is_pair before cdr if improper list (let loop ((lst lst) (cnt 0)) (if (null? lst) (< len cnt) (loop (cdr lst) (+ cnt 1))))) (test (length>? '(1 2 . 3) 2) 'error) ;; -------- OP_TC_IF_A_L2A_Z -------- (define (tc-if-a-l2a-z-1 x y) (if (pair? x) (tc-if-a-l2a-z-1 (cdr x) y) (begin (vector-set! y 0 32) y))) (test (tc-if-a-l2a-z-1 '(1 2 3) #(1 2 3)) #(32 2 3)) (define (tc-if-a-l2a-z-2 x y) (if (pair? x) (tc-if-a-l2a-z-2 (cdr x) y) (copy y))) (test (tc-if-a-l2a-z-2 '(1 2 3) #(1 2 3)) #(1 2 3)) (define (tc-if-a-l2a-z-3 x y) (if (pair? x) (tc-if-a-l2a-z-3 (cdr x) y) #f)) (test (tc-if-a-l2a-z-3 '(1 2 3) #(1 2 3)) #f) (define (tc-if-a-l2a-z-4 x y) (if (pair? x) (tc-if-a-l2a-z-4 (cdr x) (+ y 1)) y)) (test (tc-if-a-l2a-z-4 '(1 2 3) 0) 3) (define (tc-if-a-l2a-z-0-1 x y) (if (> x 0) (tc-if-a-l2a-z-0-1 (- x 1) (+ y 1)) y)) (test (tc-if-a-l2a-z-0-1 10 0) 10) (define (tc-if-a-l2a-z-5 x y) (if (pair? x) (tc-if-a-l2a-z-5 (cdr x)) y)) (test (tc-if-a-l2a-z-5 '(1 2 3) 0) 'error) (define (tc-if-a-l2a-z-7 x y) (if (not (null? x)) (tc-if-a-l2a-z-7 (cdr x) y) 0)) (test (tc-if-a-l2a-z-7 '(1 2 . 3) 0) 'error) (define (tc-if-a-l2a-z-1 x y) (if (pair? x) (tc-if-a-l2a-z-1 (cdr x) y) (begin (vector-set! y 0 32) y))) (test (tc-if-a-l2a-z-1 '(1 2 3) #(1 2 3)) #(32 2 3)) (define (fx-tc-if-a-l2a-z x y) (if (> x 0) (fx-tc-if-a-l2a-z (- x 1) (+ y 1)) y)) (test (let ((z 10)) (define (ftc-2 x) (+ x (fx-tc-if-a-l2a-z 10 0))) (ftc-2 z)) 20) (define (length1>? lst len) ; from Da Shen -- need is_pair before cdr if improper list (let loop ((lst lst) (cnt 0)) (if (not (null? lst)) (loop (cdr lst) (+ cnt 1)) (< len cnt)))) (test (length1>? '(1 2 . 3) 2) 'error) ;; -------- OP_TC_IF_A_Z_L3A -------- (define (tc-if-a-z-l3a-1 x y z) (if (null? x) (begin (vector-set! y 0 (+ z 32)) y) (tc-if-a-z-l3a-1 (cdr x) y (+ z 1)))) (test (tc-if-a-z-l3a-1 '(1 2 3) #(1 2 3) 1) #(36 2 3)) (define (tc-if-a-z-l3a-2 x y z) (if (null? x) (+ y z) (tc-if-a-z-l3a-2 (cdr x) y (+ z 1)))) (test (tc-if-a-z-l3a-2 '(1 2 3) 2 3) 8) (define (tc-if-a-z-l3a-3 x y z) (if (null? x) (+ y z) (tc-if-a-z-l3a-3 (cdr x) y))) (test (tc-if-a-z-l3a-3 '(1 2 3) #(1 2 3) 1) 'error) ; (+ #(1 2 3) 1) (define (tc-if-a-z-l3a-4 x y z) (if (null? x) (+ y z) (tc-if-a-z-l3a-4 (cdr x) y z (+ z 1)))) (test (tc-if-a-z-l3a-4 '(1 2 3) #(1 2 3) 1) 'error) (define (tc-if-a-z-l3a-5 x y z) (if (null? x) (+ y z) (tc-if-a-z-l3a-5 (cdr x) y (+ z 1)))) (test (tc-if-a-z-l3a-5 '(1 2 . 3) 2 3) 'error) ;; -------- OP_TC_IF_A_L3A_Z -------- (define (tc-if-a-l3a-z-1 x y z) (if (pair? x) (tc-if-a-l3a-z-1 (cdr x) y (+ z 1)) (begin (vector-set! y 0 (+ z 32)) y))) (test (tc-if-a-l3a-z-1 '(1 2 3) #(1 2 3) 1) #(36 2 3)) (define (tc-if-a-l3a-z-2 x y z) (if (null? x) (tc-if-a-l3a-z-2 (cdr x) y) (+ y z))) (test (tc-if-a-l3a-z-2 '(1 2 3) #(1 2 3) 1) 'error) ; (+ #(1 2 3) 1) (define (tc-if-a-l3a-z-3 x y z) (if (pair? x) (tc-if-a-l3a-z-3 (cdr x) y z (+ z 1)) z)) (test (tc-if-a-l3a-z-3 '(1 2 3) #(1 2 3) 1) 'error) (define (tc-if-a-l3a-z-4 x y z) (if (not (null? x)) (tc-if-a-l3a-z-4 (cdr x) y) (+ y z))) (test (tc-if-a-l3a-z-4 '(1 2 . 3) #(1 2 3) 1) 'error) ;; -------- OP_TC_WHEN_LA -------- (define (when_la1 x) (when (> x 0) (when_la1 (- x 1)))) (test (when_la1 3) #) (define (tc-when-la2 x) (when (> x 0) (tc-when-la2))) (test (tc-when-la2 2) 'error) (define (tc-when-la3 x) (when (> x 0) (tc-when-la3 (- x 1) 0 0))) (test (tc-when-la3 2) 'error) (define (tc-when-la4 x) (when (> x 0) (display x #f) (tc-when-la4 (- x 1)))) (test (tc-when-la4 2) #) (define (tc-when-la5 x) (when (> x 0) (tc-when-la5 (- x 1) 0))) (test (tc-when-la5 2) 'error) (define (unless_la1 x) (unless (<= x 0) (when_la1 (- x 1)))) (test (unless_la1 3) #) ;; -------- OP_TC_WHEN_L2A -------- (define (when_l2a1 x y) (let loop ((x x) (y y)) (when (pair? x) (set-car! y (car x)) (loop (cdr x) (cdr y)))) y) (let ((x (make-list 20 #\a)) (y (make-list 20 #\b))) (when_l2a1 x y) (test y (make-list 20 #\a))) (define (tc-when-l2a2 x y) (when (> x 0) (tc-when-l2a2))) (test (tc-when-l2a2 2 0) 'error) (define (tc-when-l2a3 x y) (when (> x 0) (tc-when-l2a3 (- x 1) y 0))) (test (tc-when-l2a3 2 0) 'error) (define (tc-when-l2a4 x y) (when (> x 0) (display x #f) (tc-when-l2a4 (- x 1) y))) (test (tc-when-l2a4 2 0) #) (define (tc-when-l2a5 x y) (when (> x 0) (tc-when-l2a5 (- x 1)))) (test (tc-when-l2a5 2 0) 'error) (define (unless_l2a1 x y) (let loop ((x x) (y y)) (unless (null? x) (set-car! y (car x)) (loop (cdr x) (cdr y)))) y) (let ((x (make-list 20 #\a)) (y (make-list 20 #\b))) (unless_l2a1 x y) (test y (make-list 20 #\a))) ;; -------- OP_TC_WHEN_L3A -------- (define (when_l3a x y z) (when (> x 0) (when_l3a (- x 1) (- y 2) (+ z 1)))) (test (when_l3a 1 2 3) #) (define (tc-when-l3a2 x y z) (when (> x 0) (tc-when-l3a2))) (test (tc-when-l3a2 2 0 0) 'error) (define (tc-when-l3a3 x y z) (when (> x 0) (tc-when-l3a3 (- x 1) y 0 0))) (test (tc-when-l3a3 2 0 0) 'error) (define (tc-when-l3a4 x y z) (when (> x 0) (display x #f) (display y #f) (tc-when-l3a4 (- x 1) y z))) (test (tc-when-l3a4 2 0 0) #) (define (tc-when-l3a5 x y z) (when (> x 0) (tc-when-l3a5 (- x 1)))) (test (tc-when-l3a5 2 0 0) 'error) (define (unless_l3a x y z) (unless (<= x 0) (unless_l3a (- x 1) (- y 2) (+ z 1)))) (test (unless_l3a 1 2 3) #) ;; -------- OP_TC_COND_A_Z_LA -------- (define (tc-cond-a-z-la-1 x) (cond ((zero? x) 3) (else (tc-cond-a-z-la-1 (- x 1))))) (test (tc-cond-a-z-la-1 10) 3) (define (tc-cond-a-z-la-2 x) (cond ((zero? x) (let ((z (+ x 1))) z)) (else (tc-cond-a-z-la-2 (- x 1))))) (test (tc-cond-a-z-la-2 10) 1) (define tc-cond-a-z-la-3 (let ((y #(10))) (lambda (x) (cond ((zero? (vector-ref y 0)) y) (else (tc-cond-a-z-la-3 (vector-set! y 0 (- (vector-ref y 0) 1)))))))) (test (tc-cond-a-z-la-3 10) #(0)) (define (tc-cond-a-z-la-4 x) (cond ((zero? x) 3) (else (tc-cond-a-z-la-4)))) (test (tc-cond-a-z-la-4 10) 'error) (define (tc-cond-a-z-la x) (cond ((= x 0) 12) (else (tc-cond-a-z-la (- x 1))))) (test (let ((z 10)) (define (ftc-2 x) (+ x (tc-cond-a-z-la 10))) (ftc-2 z)) 22) ;; -------- OP_TC_COND_A_LA_Z -------- (define (tc-cond-a-la-z-1 x) (cond ((positive? x) (tc-cond-a-la-z-1 (- x 1))) (else 3))) (test (tc-cond-a-la-z-1 10) 3) (define (tc-cond-a-la-z-2 x) (cond ((positive? x) (tc-cond-a-la-z-2 (- x 1))) (else (let ((z (+ x 1))) z)))) (test (tc-cond-a-la-z-2 10) 1) (define (tc-cond-a-la-z-3 x) (cond ((positive? x) (tc-cond-a-la-z-3 (- x 1) (+ y 1))) (else 3))) (test (tc-cond-a-la-z-3 10) 'error) (define (tc-cond-a-la-z-4 x) (cond ((positive? x) (tc-cond-a-la-z-4)) (else 3))) (test (tc-cond-a-la-z-4 10) 'error) (define (fx-tc-cond-a-la-z x) (cond ((> x 0) (fx-tc-cond-a-la-z (- x 1))) (else 12))) (test (let ((z 10)) (define (ftc-3 x) (+ x (fx-tc-cond-a-la-z 10))) (ftc-3 z)) 22) (let () (define (if-a-z-la p) (if (null? (cdr p)) (car p) (if-a-z-la (cdr p)))) (define (cond-a-z-la p) (cond ((null? (cdr p)) (car p)) (else (cond-a-z-la (cdr p))))) (define (if-a-la-z p) (if (pair? (cdr p)) (if-a-la-z (cdr p)) (car p))) (define (cond-a-la-z p) (cond ((pair? (cdr p)) (cond-a-la-z (cdr p))) (else (car p)))) (define big-list (let ((L (make-list 5 0))) (set! (list-ref L 4) 1) L)) (define (f1) (do ((i 0 (+ i 1)) (sum 0)) ((= i 2) sum) (set! sum (+ sum (if-a-z-la big-list))))) (define (f2) (do ((i 0 (+ i 1)) (sum 0)) ((= i 2) sum) (set! sum (+ sum (cond-a-z-la big-list))))) (define (f3) (do ((i 0 (+ i 1)) (sum 0)) ((= i 2) sum) (set! sum (+ sum (if-a-la-z big-list))))) (define (f4) (do ((i 0 (+ i 1)) (sum 0)) ((= i 2) sum) (set! sum (+ sum (cond-a-la-z big-list))))) (test (f1) 2) (test (f3) 2) (test (f2) 2) (test (f4) 2)) ;; -------- OP_TC_COND_A_Z_L2A -------- (define (tc-cond-a-z-l2a-1 x q) (cond ((zero? x) q) (else (tc-cond-a-z-l2a-1 (- x 1) (+ q 1))))) (test (tc-cond-a-z-l2a-1 10 0) 10) (define (tc-cond-a-z-l2a-2 x q) (cond ((zero? x) (let ((z (+ x q))) z)) (else (tc-cond-a-z-l2a-2 (- x 1) (+ q 1))))) (test (tc-cond-a-z-l2a-2 10 0) 10) (define tc-cond-a-z-l2a-3 (let ((y #(10))) (lambda (x q) (cond ((zero? (vector-ref y 0)) q) (else (tc-cond-a-z-l2a-3 (vector-set! y 0 (- (vector-ref y 0) 1)) (+ q 1))))))) (test (tc-cond-a-z-l2a-3 10 0) 10) (define (tc-cond-a-z-l2a-4 x q) (cond ((zero? x) q) (else (tc-cond-a-z-l2a-4 x)))) (test (tc-cond-a-z-l2a-4 10 0) 'error) (define (tc-cond-a-z-l2a-5 x q) (cond ((zero? x) q) (else (tc-cond-a-z-l2a-5 x q q)))) (test (tc-cond-a-z-l2a-5 10 0) 'error) (define (tc-cond-a-z-l2a-6 x q) (cond ((zero? x) q) (else (tc-cond-a-z-l2a-6)))) (test (tc-cond-a-z-l2a-6 10 0) 'error) (define (tc-cond-a-z-l2a x q) (cond ((= x 0) (+ q 2)) (else (tc-cond-a-z-l2a (- x 1) (+ q 1))))) (test (let ((z 10)) (define (ftc-2 x) (+ x (tc-cond-a-z-l2a 10 0))) (ftc-2 z)) 22) ;; -------- OP_TC_COND_A_L2A_Z -------- (define (tc-cond-a-l2a-z-1 x q) (cond ((positive? x) (tc-cond-a-l2a-z-1 (- x 1) (+ q 1))) (else q))) (test (tc-cond-a-l2a-z-1 10 0) 10) (define (tc-cond-a-l2a-z-2 x q) (cond ((positive? x) (tc-cond-a-l2a-z-2 (- x 1) (+ q 1))) (else (let ((z (+ q x 1))) z)))) (test (tc-cond-a-l2a-z-2 10 0) 11) (define (tc-cond-a-l2a-z-3 x q) (cond ((positive? x) (tc-cond-a-l2a-z-3 (- x 1) (+ y 1) 1)) (else 3))) (test (tc-cond-a-l2a-z-3 10 0) 'error) (define (tc-cond-a-l2a-z-4 x q) (cond ((positive? x) (tc-cond-a-l2a-z-4 x)) (else 3))) (test (tc-cond-a-l2a-z-4 10 0) 'error) (define (fx-tc-cond-a-l2a-z x q) (cond ((> x 0) (fx-tc-cond-a-l2a-z (- x 1) (+ q 1))) (else (+ q 2)))) (test (let ((z 10)) (define (ftc-3 x) (+ x (fx-tc-cond-a-l2a-z 10 0))) (ftc-3 z)) 22) (let () (define (if-a-z-l2a p q) (if (null? p) q (if-a-z-l2a (cdr p) (+ q (car p))))) (define (cond-a-z-l2a p q) (cond ((null? p) q) (else (cond-a-z-l2a (cdr p) (+ q (car p)))))) (define (if-a-l2a-z p q) (if (pair? p) (if-a-l2a-z (cdr p) (+ q (car p))) q)) (define (cond-a-l2a-z p q) (cond ((pair? p) (cond-a-l2a-z (cdr p) (+ q (car p)))) (else q))) (define big-list (let ((L (make-list 10 0))) (set! (list-ref L 9) 1) L)) (define (f1) (do ((i 0 (+ i 1)) (sum 0)) ((= i 10) sum) (set! sum (+ sum (if-a-z-l2a big-list 0))))) (define (f2) (do ((i 0 (+ i 1)) (sum 0)) ((= i 10) sum) (set! sum (+ sum (cond-a-z-l2a big-list 0))))) (define (f3) (do ((i 0 (+ i 1)) (sum 0)) ((= i 10) sum) (set! sum (+ sum (if-a-l2a-z big-list 0))))) (define (f4) (do ((i 0 (+ i 1)) (sum 0)) ((= i 10) sum) (set! sum (+ sum (cond-a-l2a-z big-list 0))))) (test (f1) 10) (test (f3) 10) (test (f2) 10) (test (f4) 10)) ;; -------- OP_TC_COND_A_Z_L3A -------- (define (tc-cond-a-z-l3a-1 x y z) (cond ((null? x) (begin (vector-set! y 0 (+ z 32)) y)) (else (tc-cond-a-z-l3a-1 (cdr x) y (+ z 1))))) (test (tc-cond-a-z-l3a-1 '(1 2 3) #(1 2 3) 1) #(36 2 3)) (define (tc-cond-a-z-l3a-2 x y z) (cond ((null? x) (+ y z)) (else (tc-cond-a-z-l3a-2 (cdr x) y (+ z 1))))) (test (tc-cond-a-z-l3a-2 '(1 2 3) 2 3) 8) (define (tc-cond-a-z-l3a-3 x y z) (cond ((null? x) (+ y z)) (#t (tc-cond-a-z-l3a-3 (cdr x) y)))) (test (tc-cond-a-z-l3a-3 '(1 2 3) #(1 2 3) 1) 'error) ; (+ #(1 2 3) 1) (define (tc-cond-a-z-l3a-4 x y z) (cond ((null? x) (+ y z)) (else (tc-cond-a-z-l3a-4 (cdr x) y z (+ z 1))))) (test (tc-cond-a-z-l3a-4 '(1 2 3) #(1 2 3) 1) 'error) ;; -------- OP_TC_COND_A_L3A_Z -------- (define (tc-cond-a-l3a-z-1 x y z) (cond ((pair? x) (tc-cond-a-l3a-z-1 (cdr x) y (+ z 1))) (else (begin (vector-set! y 0 (+ z 32)) y)))) (test (tc-cond-a-l3a-z-1 '(1 2 3) #(1 2 3) 1) #(36 2 3)) (define (tc-cond-a-l3a-z-2 x y z) (cond ((null? x) (tc-cond-a-l3a-z-2 (cdr x) y)) (#t (+ y z)))) (test (tc-cond-a-l3a-z-2 '(1 2 3) #(1 2 3) 1) 'error) ; (+ #(1 2 3) 1) (define (tc-cond-a-l3a-z-3 x y z) (cond ((pair? x) (tc-cond-a-l3a-z-3 (cdr x) y z (+ z 1))) (else z))) (test (tc-cond-a-l3a-z-3 '(1 2 3) #(1 2 3) 1) 'error) ;; -------- OP_TC_AND_A_IF_A_Z_LA -------- (define (tc-and-a-if-a-z-la-1 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) x (tc-and-a-if-a-z-la-1 (+ x 1))))) (test (tc-and-a-if-a-z-la-1 22) 25) (test (tc-and-a-if-a-z-la-1 6) 10) (define (tc-and-a-if-a-z-la-2 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) x (tc-and-a-if-a-z-la-2)))) (test (tc-and-a-if-a-z-la-2 22) 'error) (define (tc-and-a-if-a-z-la-3 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) x (tc-and-a-if-a-z-la-3 x x)))) (test (tc-and-a-if-a-z-la-3 22) 'error) (define (tc-and-a-if-a-z-la-4 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) x (tc-and-a-if-a-z-la-4 (+ x 1))))) (test (tc-and-a-if-a-z-la-4 6) 10) (define (tc-and-a-if-a-z-la-5 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) (let ((z (* 2 x))) z) (tc-and-a-if-a-z-la-5 (+ x 1))))) (test (tc-and-a-if-a-z-la-5 22) 50) (define (tc-and-a-if-a-z-la-6 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) (* x 2) (tc-and-a-if-a-z-la-6 (+ x 1))))) (test (tc-and-a-if-a-z-la-6 22) 50) (define (tc-and-a-if-a-z-la-7 x) (and (not (zero? (modulo x 17))) (if (zero? (modulo x 5)) (* x 2) (tc-and-a-if-a-z-la-7 (+ x 1))))) (test (tc-and-a-if-a-z-la-7 17) #f) ;; -------- OP_TC_AND_A_IF_A_LA_Z -------- (define (tc-and-a-if-a-la-z-1 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-1 (+ x 1)) x))) (test (tc-and-a-if-a-la-z-1 22) 25) (test (tc-and-a-if-a-la-z-1 6) 10) (define (tc-and-a-if-a-la-z-2 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-2) x))) (test (tc-and-a-if-a-la-z-2 22) 'error) (define (tc-and-a-if-a-la-z-3 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-3 x x) x))) (test (tc-and-a-if-a-la-z-3 22) 'error) (define (tc-and-a-if-a-la-z-4 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-4 (+ x 1)) x))) (test (tc-and-a-if-a-la-z-4 6) 10) (define (tc-and-a-if-a-la-z-5 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-5 (+ x 1)) (let ((z (* 2 x))) z)))) (test (tc-and-a-if-a-la-z-5 22) 50) (define (tc-and-a-if-a-la-z-6 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-6 (+ x 1)) (* x 2)))) (test (tc-and-a-if-a-la-z-6 22) 50) (define (tc-and-a-if-a-la-z-7 x) (and (not (zero? (modulo x 17))) (if (positive? (modulo x 5)) (tc-and-a-if-a-la-z-7 (+ x 1))) (* x 2))) (test (tc-and-a-if-a-la-z-7 17) #f) ;; -------- OP_TC_COND_A_Z_A_Z_LA -------- (define (tc-cond-a-z-a-z-la-1 x) (cond ((zero? (modulo x 7)) x) ((zero? (modulo x 5)) x) (else (tc-cond-a-z-a-z-la-1 (+ x 1))))) (test (tc-cond-a-z-a-z-la-1 22) 25) (test (tc-cond-a-z-a-z-la-1 6) 7) (define (tc-cond-a-z-a-z-la-2 x) (cond ((zero? (modulo x 7)) x) ((zero? (modulo x 5)) x) (else (tc-cond-a-z-a-z-la-2)))) (test (tc-cond-a-z-a-z-la-2 22) 'error) (define (tc-cond-a-z-a-z-la-3 x) (cond ((zero? (modulo x 7)) x) ((zero? (modulo x 5)) x) (else (tc-cond-a-z-a-z-la-3 x x)))) (test (tc-cond-a-z-a-z-la-3 22) 'error) (define (tc-cond-a-z-a-z-la-4 x) (cond ((zero? (modulo x 7)) (set! x (* 2 x)) x) ((zero? (modulo x 5)) x) (else (tc-cond-a-z-a-z-la-4 (+ x 1))))) (test (tc-cond-a-z-a-z-la-4 6) 14) (define (tc-cond-a-z-a-z-la-5 x) (cond ((zero? (modulo x 7)) x) ((zero? (modulo x 5)) (let ((z (* 2 x))) z)) (else (tc-cond-a-z-a-z-la-5 (+ x 1))))) (test (tc-cond-a-z-a-z-la-5 22) 50) (define (tc-cond-a-z-a-z-la-6 x) (cond ((zero? (modulo x 7)) (- x 7)) ((negative? (modulo x 5)) (* x 2)) (#t (tc-cond-a-z-a-z-la-6 (+ x 1))))) (test (tc-cond-a-z-a-z-la-6 22) 21) (let ((z (let ((zz (make-vector 30 0))) (do ((i 1 (+ i 1))) ((= i 30)) (vector-set! zz i i)) (vector-set! zz 10 #\space) zz))) (define (tc-cond-a-z-a-z-la-7 x) (cond ((< 20 x 30) (+ (* x 2) 1)) ((> x 20) (* x 2)) (else (tc-cond-a-z-a-z-la-7 (vector-ref z (+ x 1)))))) (test (tc-cond-a-z-a-z-la-7 (vector-ref z 0)) 'error)) ;; -------- OP_TC_COND_A_Z_A_LA_Z -------- (define (tc-cond-a-z-a-la-z-1 x) (cond ((zero? (modulo x 17)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-1 (+ x 1))) (else x))) (test (tc-cond-a-z-a-la-z-1 22) 25) (test (tc-cond-a-z-a-la-z-1 6) 10) (define (tc-cond-a-z-a-la-z-2 x) (cond ((zero? (modulo x 17)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-2)) (else x))) (test (tc-cond-a-z-a-la-z-2 22) 'error) (define (tc-cond-a-z-a-la-z-3 x) (cond ((zero? (modulo x 17)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-3 x x)) (else x))) (test (tc-cond-a-z-a-la-z-3 22) 'error) (define (tc-cond-a-z-a-la-z-4 x) (cond ((zero? (modulo x 17)) (set! x (* 2 x)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-4 (+ x 1))) (else x))) (test (tc-cond-a-z-a-la-z-4 6) 10) (define (tc-cond-a-z-a-la-z-5 x) (cond ((zero? (modulo x 17)) x) ((positive? (modulo x 5)) (tc-cond-a-z-a-la-z-5 (+ x 1))) (else (let ((z (* 2 x))) z)))) (test (tc-cond-a-z-a-la-z-5 22) 50) (define (tc-cond-a-z-a-la-z-6 x) (cond ((zero? (modulo x 7)) (- x 7)) ((not (negative? (modulo x 5))) (tc-cond-a-z-a-la-z-6 (+ x 1))) (else (* x 2)))) (test (tc-cond-a-z-a-la-z-6 22) 21) (define (tc-cond-a-z-a-la-z-7 x) (cond ((< 20 x 30) (let ((z (* x 2))) (+ z 1))) ((<= x 20) (tc-cond-a-z-a-la-z-7 (+ x 1))) (else (* x 2)))) (test (tc-cond-a-z-a-la-z-7 0) 43) (define (tc-cond-a-z-a-la-z-8 x) (cond ((and (< 20 x) (< x 30)) (let ((z (* x 2))) (+ z 1))) ((<= x 20) (tc-cond-a-z-a-la-z-8 (+ x 1))) (else (* x 2)))) (test (tc-cond-a-z-a-la-z-8 0) 43) (define (tc-cond-a-z-a-la-z-11 x) (cond ((let ((a x)) (< 20 a 30)) (let ((z (* x 2))) (+ z 1))) ((<= x 20) (tc-cond-a-z-a-la-z-11 (+ x 1))) (else (* x 2)))) (test (tc-cond-a-z-a-la-z-7 0) 43) (define (tc-cond-a-z-a-la-z-12 x) (cond ((< 20 x 30) (let ((z (* x 2))) (+ z 1))) ((<= x 20) (tc-cond-a-z-a-la-z-12 (+ x 1))) (else (let ((a x)) (* a 2))))) (test (tc-cond-a-z-a-la-z-12 0) 43) (define (tc-cond-a-z-a-la-z-13 x) (cond ((< 20 x 30) (+ (* x 2) 1)) ((<= x 20) (tc-cond-a-z-a-la-z-13 (+ x 1))) (else (* x 2)))) (test (tc-cond-a-z-a-la-z-13 0) 43) (define (tc-cond-a-z-a-la-z-14 x) (cond ((< 20 x 30) (+ (* x 2) 1)) ((<= x 20) (tc-cond-a-z-a-la-z-14 (+ x 1))) (else (* x 2)))) (test (tc-cond-a-z-a-la-z-14 3/4) 85/2) (let ((z (let ((zz (make-vector 30 0))) (do ((i 1 (+ i 1))) ((= i 30)) (vector-set! zz i i)) (vector-set! zz 10 #\space) zz))) (define (tc-cond-a-z-a-la-z-15 x) (cond ((< 20 x 30) (+ (* x 2) 1)) ((<= x 20) (tc-cond-a-z-a-la-z-15 (vector-ref z (+ x 1)))) (else (* x 2)))) (test (tc-cond-a-z-a-la-z-15 (vector-ref z 0)) 'error)) (define (tc-cond-a-z-a-la-z-16 x) (cond ((< 20 x 30) x) ((< x 20) (tc-cond-a-z-a-la-z-16 (+ x 1))) ((= x 20) 201) (else (* x 2)))) (test (tc-cond-a-z-a-la-z-16 0) 201) ;; -------- OP_TC_COND_N -------- (define (tc-cond-n1 x) (cond ((= x 1) 1) ((= x 2) 2) ((= x 3) 3) (else (tc-cond-n1 (- x 1))))) (test (tc-cond-n1 5) 3) (define (tc-cond-n2 x) (cond ((= x 1) 1) ((= x 2) 2) ((= x 3) (tc-cond-n2 (- x 2))) (else (tc-cond-n2 (- x 1))))) (test (tc-cond-n2 5) 1) (define (tc-cond-n4 w x y z) (cond ((= x 1) w) ((= x 2) y) ((= x 3) z) (else (tc-cond-n4 w (- x 1) y z)))) (test (tc-cond-n4 1 5 3 4) 4) (define (tc-cond-n5 x y) (cond ((= x 1) (+ x y)) ((= x 2) (tc-cond-n5 (- x 1) (+ y 1))) (else (tc-cond-n5 (- x 1) (+ y 1))))) (test (tc-cond-n5 10 0) 10) (define (tc-cond-n6 x y) (cond ((= x 1) (+ x y)) ((= x 2) (tc-cond-n6 (- x 1) (+ y 2))) ((= y 0) x) ((= x 0) y) (#t (tc-cond-n6 (- x 1) (+ y 1))))) (test (tc-cond-n6 10 1) 12) ; = 1 + 11 ;; -------- OP_TC_IF_A_Z_IF_A_LA_Z -------- (define (tc-if-a-z-if-a-la-z-1 x) (if (zero? (modulo x 7)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-1 (+ x 1)) x))) (test (tc-if-a-z-if-a-la-z-1 22) 25) (test (tc-if-a-z-if-a-la-z-1 6) 7) (define (tc-if-a-z-if-a-la-z-2 x) (if (zero? (modulo x 7)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-2) x))) (test (tc-if-a-z-if-a-la-z-2 22) 'error) (define (tc-if-a-z-if-a-la-z-3 x) (if (zero? (modulo x 7)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-3 x x) x))) (test (tc-if-a-z-if-a-la-z-3 22) 'error) (define (tc-if-a-z-if-a-la-z-4 x) (if (zero? (modulo x 7)) (begin (set! x (* 2 x)) x) (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-4 (+ x 1)) x))) (test (tc-if-a-z-if-a-la-z-4 6) 14) (define (tc-if-a-z-if-a-la-z-5 x) (if (zero? (modulo x 7)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-5 (+ x 1)) (let ((z (* 2 x))) z)))) (test (tc-if-a-z-if-a-la-z-5 22) 50) (define (tc-if-a-z-if-a-la-z-6 x) (if (zero? (modulo x 7)) (- x 7) (if (positive? (modulo x 5)) (tc-if-a-z-if-a-la-z-6 (+ x 1)) (* x 2)))) (test (tc-if-a-z-if-a-la-z-6 22) 50) ;; -------- OP_TC_IF_A_Z_IF_A_Z_L2A -------- (define (tc-if-a-z-if-a-z-l2a-1 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-l2a-1 (+ x 1) y)))) (test (tc-if-a-z-if-a-z-l2a-1 22 7) 25) (test (tc-if-a-z-if-a-z-l2a-1 6 7) 7) (define (tc-if-a-z-if-a-z-l2a-2 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-l2a-2)))) (test (tc-if-a-z-if-a-z-l2a-2 22 7) 'error) (define (tc-if-a-z-if-a-z-l2a-3 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-l2a-3 x)))) (test (tc-if-a-z-if-a-z-l2a-3 22 7) 'error) (define (tc-if-a-z-if-a-z-l2a-4 x y) (if (zero? (modulo x y)) (begin (set! x (* 2 x)) x) (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-l2a-4 (+ x 1) y)))) (test (tc-if-a-z-if-a-z-l2a-4 6 7) 14) (define (tc-if-a-z-if-a-z-l2a-5 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) (let ((z (* 2 x))) z) (tc-if-a-z-if-a-z-l2a-5 (+ x 1) y)))) (test (tc-if-a-z-if-a-z-l2a-5 22 7) 50) (define (tc-if-a-z-if-a-z-l2a-6 x y) (if (zero? (modulo x y)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-l2a-6 x y y)))) (test (tc-if-a-z-if-a-z-l2a-6 22 7) 'error) (define (tc-if-a-z-if-a-z-l2a-7 x y) (if (null? y) #f (if (null? x) #f (tc-if-a-z-if-a-z-l2a-7 (cdr x) (cdr y))))) (test (tc-if-a-z-if-a-z-l2a-7 '(1 2 3 4) '(1 2 . 3)) 'error) ;; -------- OP_TC_IF_A_Z_IF_A_L2A_Z -------- (define (tc-if-a-z-if-a-l2a-z-1 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-l2a-z-1 (+ x 1) y) x))) (test (tc-if-a-z-if-a-l2a-z-1 22 7) 25) (test (tc-if-a-z-if-a-l2a-z-1 6 7) 7) (define (tc-if-a-z-if-a-l2a-z-2 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-l2a-z-2) x))) (test (tc-if-a-z-if-a-l2a-z-2 22 7) 'error) (define (tc-if-a-z-if-a-l2a-z-3 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-l2a-z-3 x) x))) (test (tc-if-a-z-if-a-l2a-z-3 22 7) 'error) (define (tc-if-a-z-if-a-l2a-z-4 x y) (if (zero? (modulo x y)) (begin (set! x (* 2 x)) x) (if (positive? (modulo x 5)) (tc-if-a-z-if-a-l2a-z-4 (+ x 1) y) x))) (test (tc-if-a-z-if-a-l2a-z-4 6 7) 14) (define (tc-if-a-z-if-a-l2a-z-5 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-l2a-z-5 (+ x 1) y) (let ((z (* 2 x))) z)))) (test (tc-if-a-z-if-a-l2a-z-5 22 7) 50) (define (tc-if-a-z-if-a-l2a-z-6 x y) (if (zero? (modulo x y)) x (if (positive? (modulo x 5)) (tc-if-a-z-if-a-l2a-z-6 x y y) x))) (test (tc-if-a-z-if-a-l2a-z-6 22 7) 'error) ;; -------- OP_TC_IF_A_Z_IF_A_L3A_L3A -------- (define (l3a x y z) (if (> x y) z (if (< y z) (l3a x y (- z 1)) (l3a x (- y 1) z)))) (test (l3a 0 10 10) 0) (define (xl3a x y z) (if (> x y) z (if (< y z) (xl3a x y (- z 1)) z))) (test (xl3a 0 10 10) 10) (define (x1l3a x y z) (if (= x 10) z (if (= y 10) (x1l3a (+ x 1) y (- z 1)) (x1l3a (+ x 1) (+ y 1) z)))) (test (x1l3a 0 10 10) 0) ;; -------- OP_TC_IF_A_Z_IF_A_Z_L3A -------- (define (zl3a x y z) (if (> x y) z (if (< y z) y (zl3a x (- y 1) z)))) (test (zl3a 0 10 10) 9) (define (z1l3a n a b) (if (= n 0) a (if (= n 1) b (z1l3a (- n 1) b (+ a b))))) (test (z1l3a 12 1 1) 233) (define (z2l3a n a b) (if (= n 0) (catch #t (lambda () a) (lambda (t i) #f)) (if (= n 1) b (z1l3a (- n 1) b (+ a b))))) (test (z2l3a 0 1 2) 1) ;; -------- OP_TC_IF_A_Z_IF_A_L3A_Z -------- (define (z33a x y z) (if (> x y) z (if (>= y z) (z33a x (- y 1) z) y))) (test (z33a 0 10 10) 9) (define (z4l3a n a b) (if (= n 0) a (if (not (= n 1)) (z4l3a (- n 1) b (+ a b)) b))) (test (z4l3a 12 1 1) 233) (define (z5l3a n a b) (if (= n 0) (catch #t (lambda () a) (lambda (t i) #f)) (if (not (= n 1)) (z5l3a (- n 1) b (+ a b)) b))) (test (z5l3a 0 1 2) 1) ;; -------- OP_TC_IF_A_Z_IF_A_Z_LA -------- (define (tc-if-a-z-if-a-z-la-1 x) (if (zero? (modulo x 7)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-la-1 (+ x 1))))) (test (tc-if-a-z-if-a-z-la-1 22) 25) (test (tc-if-a-z-if-a-z-la-1 6) 7) (define (tc-if-a-z-if-a-z-la-2 x) (if (zero? (modulo x 7)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-la-2)))) (test (tc-if-a-z-if-a-z-la-2 22) 'error) (define (tc-if-a-z-if-a-z-la-3 x) (if (zero? (modulo x 7)) x (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-la-3 x x)))) (test (tc-if-a-z-if-a-z-la-3 22) 'error) (define (tc-if-a-z-if-a-z-la-4 x) (if (zero? (modulo x 7)) (begin (set! x (* 2 x)) x) (if (zero? (modulo x 5)) x (tc-if-a-z-if-a-z-la-4 (+ x 1))))) (test (tc-if-a-z-if-a-z-la-4 6) 14) (define (tc-if-a-z-if-a-z-la-5 x) (if (zero? (modulo x 7)) x (if (zero? (modulo x 5)) (let ((z (* 2 x))) z) (tc-if-a-z-if-a-z-la-5 (+ x 1))))) (test (tc-if-a-z-if-a-z-la-5 22) 50) (define (tc-if-a-z-if-a-z-la-6 x) (if (zero? (modulo x 7)) (- x 7) (if (negative? (modulo x 5)) (* x 2) (tc-if-a-z-if-a-z-la-6 (+ x 1))))) (test (tc-if-a-z-if-a-z-la-6 22) 21) ;; -------- OP_TC_LET_IF_A_Z_LA -------- (define (tc-let-if-a-z-la-1 x) (let ((y (- x 1))) (if (<= y 0) 0 (tc-let-if-a-z-la-1 (- x 1))))) (test (tc-let-if-a-z-la-1 3) 0) (define (tc-let-if-a-z-la-2 x) (let ((y (- x 1))) (if (<= y 1) (let* ((z (* 2 x))) (+ z 1)) (tc-let-if-a-z-la-2 (- x 1))))) (test (tc-let-if-a-z-la-2 3) 5) (define (tc-let-if-a-z-la-3 x) (let ((y (- x 1))) (if (<= y 0) 0 (tc-let-if-a-z-la-3 (- x 1) 2)))) (test (tc-let-if-a-z-la-3 3) 'error) (define (tc-let-if-a-z-la-4 x) (let ((y (- x 1))) (if (<= y 0) 0 (tc-let-if-a-z-la-4)))) (test (tc-let-if-a-z-la-4 3) 'error) (define (tc-let-if-a-z-la-5 x) (let ((y (- x 1))) (if (<= y 0) (* x 12) (tc-let-if-a-z-la-5 (- x 1))))) (test (tc-let-if-a-z-la-5 3) 12) ;; -------- OP_TC_LET_IF_A_Z_L2A -------- (define (tc-let-if-a-z-l2a-1 x y) (let ((z (+ y 1))) (if (null? x) z (tc-let-if-a-z-l2a-1 (cdr x) (+ y 1))))) (test (tc-let-if-a-z-l2a-1 '(1 2 3) 0) 4) (define (tc-let-if-a-z-l2a-2 x y) (let ((z (+ y 1))) (if (null? x) z (tc-let-if-a-z-l2a-2 (cdr x))))) (test (tc-let-if-a-z-l2a-2 '(1 2 3) 0) 'error) (define (tc-let-if-a-z-l2a-3 x y) (let ((z (+ y 1))) (if (null? x) z (tc-let-if-a-z-l2a-3)))) (test (tc-let-if-a-z-l2a-3 '(1 2 3) 0) 'error) (define (tc-let-if-a-z-l2a-4 x y) (let ((z (+ y 1))) (if (null? x) (let ((zz (* z 2))) (+ zz 1)) (tc-let-if-a-z-l2a-4 (cdr x) (+ y 1))))) (test (tc-let-if-a-z-l2a-4 '(1 2 3) 0) 9) ;; -------- OP_TC_IF_A_Z_LET_IF_A_Z_L2A -------- (define (tc-if-a-z-let-if-a-z-l2a-1 x y) (if (> y 0) y (let* ((z (+ y 1))) (if (null? x) z (tc-if-a-z-let-if-a-z-l2a-1 (cdr x) (+ y 1)))))) (test (tc-if-a-z-let-if-a-z-l2a-1 '(1 2 3) -6) -2) (define (tc-if-a-z-let-if-a-z-l2a-2 x y) (if (> y 0) y (let* ((z (- y 1)) (zz (+ z 2))) (if (null? x) zz (tc-if-a-z-let-if-a-z-l2a-2 (cdr x) (+ y 1)))))) (test (tc-if-a-z-let-if-a-z-l2a-2 '(1 2 3) -6) -2) (define (tc-if-a-z-let-if-a-z-l2a-3 x y) (if (< y 0) (car (cons (values y x))) (let* ((z (- y 1)) (zz (+ z 2))) (if (null? x) zz (tc-if-a-z-let-if-a-z-l2a-3 (cdr x) (+ y 1)))))) (test (tc-if-a-z-let-if-a-z-l2a-3 '(1 2 3) -6) -6) (define (tc-if-a-z-let-if-a-z-l2a-4 x y) (if (> y 0) y (let* ((z (- y 1)) (zz (+ z 2))) (if (null? x) (car (cons (values zz z))) (tc-if-a-z-let-if-a-z-l2a-4 (cdr x) (+ y 1)))))) (test (tc-if-a-z-let-if-a-z-l2a-4 '(1 2 3) -6) -2) (define (tc-if-a-z-let-if-a-z-l2a-5 x y) (if (> y 0) y (let* ((z (+ y 1))) (if (null? x) z (tc-if-a-z-let-if-a-z-l2a-5 (+ y 1)))))) (test (tc-if-a-z-let-if-a-z-l2a-5 '(1 2 3) -6) 'error) (define (tc-if-a-z-let-if-a-z-l2a-6 x y) (if (> y 0) y (let* ((z (+ y 1))) (if (null? x) z (tc-if-a-z-let-if-a-z-l2a-6))))) (test (tc-if-a-z-let-if-a-z-l2a-6 '(1 2 3) -6) 'error) (let ((x 32) (y 32) (z 32) (zz 32)) (define (tc-if-a-z-let-if-a-z-l2a-7 x y) (if (> y 0) y (let* ((z (- y 1)) (zz (+ z 2))) (if (null? x) zz (tc-if-a-z-let-if-a-z-l2a-7 (cdr x) (+ y 1)))))) (test (tc-if-a-z-let-if-a-z-l2a-7 '(1 2 3) -6) -2)) ;; -------- OP_TC_AND_A_OR_A_LA -------- (define (tc-and-a-or-a-la-1 x) (and (positive? x) (or (= x 10) (tc-and-a-or-a-la-1 (+ x 1))))) (test (tc-and-a-or-a-la-1 1) #t) (test (tc-and-a-or-a-la-1 -1) #f) (define (tc-and-a-or-a-la-3 x) (and (positive? x) (or (= x 10) (tc-and-a-or-a-la-3 (- x 1))))) (test (tc-and-a-or-a-la-3 9) #f) (define (tc-and-a-or-a-la-4 x) (and (positive? x) (or (= x 10) (tc-and-a-or-a-la-4)))) (test (tc-and-a-or-a-la-4 9) 'error) (define (tc-and-a-or-a-la-5 x) (and (positive? x) (or (= x 10) (tc-and-a-or-a-la-5 x x)))) (test (tc-and-a-or-a-la-5 9) 'error) ;; -------- OP_TC_AND_A_OR_A_A_LA -------- (define (tc-and-a-or-a-a-la-1 x) (and (positive? x) (or (= x 10) (= x 9) (tc-and-a-or-a-a-la-1 (+ x 1))))) (test (tc-and-a-or-a-a-la-1 1) #t) (test (tc-and-a-or-a-a-la-1 -1) #f) (define (tc-and-a-or-a-a-la-3 x) (and (positive? x) (or (= x 10) (= x 9) (tc-and-a-or-a-a-la-3 (- x 1))))) (test (tc-and-a-or-a-a-la-3 8) #f) (define (tc-and-a-or-a-a-la-4 x) (and (positive? x) (or (= x 10) (= x 9) (tc-and-a-or-a-a-la-4)))) (test (tc-and-a-or-a-a-la-4 8) 'error) (define (tc-and-a-or-a-a-la-5 x) (and (positive? x) (or (= x 10) (= x 9) (tc-and-a-or-a-a-la-5 x x)))) (test (tc-and-a-or-a-a-la-5 8) 'error) ;; -------- OP_TC_OR_A_AND_A_A_LA -------- (test (letrec ((symbols? (lambda (x) (or (null? x) (and (pair? x) (symbol? (car x)) (symbols? (cdr x))))))) (symbols? '(a b c))) #t) (define (tc-or-a-and-a-a-la-1 x) (or (positive? x) (and (< x 10) (< x 9) (tc-or-a-and-a-a-la-1)))) (test (tc-or-a-and-a-a-la-1 -8) 'error) ;; -------- OP_TC_OR_A_AND_A_LA -------- (define (tc-or-a-and-a-la-1 x) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-la-1 (cdr x))))) (test (tc-or-a-and-a-la-1 '(1 2 3 4)) #t) (test (tc-or-a-and-a-la-1 '(1 2 3.1 4)) #f) (define (tc-or-a-and-a-la-2 x) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-la-2)))) (test (tc-or-a-and-a-la-2 '(1 2 3 4)) 'error) (define (tc-or-a-and-a-la-3 x) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-la-3 #f #t)))) (test (tc-or-a-and-a-la-3 '(1 2 3 4)) 'error) ;; -------- OP_TC_AND_A_OR_A_L2A -------- (define (tc-and-a-or-a-l2a-1 x y) (and (pair? x) (or (= y (car x)) (tc-and-a-or-a-l2a-1 (cdr x) y)))) (test (tc-and-a-or-a-l2a-1 '(1 2 3 4) 3) #t) (test (tc-and-a-or-a-l2a-1 '(1 2 3 4) 0) #f) (test (let () (define (ftc x) (and (pair? x) (tc-and-a-or-a-l2a-1 '(1 2 3 4) 3))) (ftc '(1))) #t) (define (tc-and-a-or-a-l2a-2 x y) (and (pair? x) (or (= y (car x)) (tc-and-a-or-a-l2a-2)))) (test (tc-and-a-or-a-l2a-2 '(1 2 3 4) 3) 'error) (define (tc-and-a-or-a-l2a-3 x y) (and (not (null? y)) (or (null? x) (tc-and-a-or-a-l2a-3 (cdr x) (cdr y))))) (test (tc-and-a-or-a-l2a-3 '(1 2 3 4) '(1 2 . 3)) 'error) ;; -------- OP_TC_OR_A_AND_A_L2A -------- (define (tc-or-a-and-a-l2a-1 x y) (or (null? x) (and (= y (car x)) (tc-or-a-and-a-l2a-1 (cdr x) y)))) (test (tc-or-a-and-a-l2a-1 '(1 1 1 1) 1) #t) (test (tc-or-a-and-a-l2a-1 '(1 1 2 1) 1) #f) (define (tc-or-a-and-a-l2a-2 x y) (or (null? x) (and (= y (car x)) (tc-or-a-and-a-l2a-2 (cdr x))))) (test (tc-or-a-and-a-l2a-2 '(1 1 1 1) 1) 'error) ;; -------- OP_TC_AND_A_OR_A_L3A -------- (define (tc-and-f6 x y z) (and (> x 0) (or (= y 0) (tc-and-f6 (- x 1) (- y 1) 0)))) (test (tc-and-f6 2 4 0) #f) (test (tc-and-f6 2 4 0) #f) (define (tc-and-a-or-a-l3a-1 x y z) (and (positive? x) (or (= x 10) (tc-and-a-or-a-l3a-1 (+ x 1) y z)))) (test (tc-and-a-or-a-l3a-1 1 0 0) #t) (test (tc-and-a-or-a-l3a-1 -1 0 0) #f) (define (tc-and-a-or-a-l3a-3 x y z) (and (positive? x) (or (= x 10) (tc-and-a-or-a-l3a-3 (- x 1) y z)))) (test (tc-and-a-or-a-l3a-3 9 0 0) #f) (define (tc-and-a-or-a-l3a-4 x y z) (and (positive? x) (or (= x 10) (tc-and-a-or-a-l3a-4)))) (test (tc-and-a-or-a-l3a-4 9 0 0) 'error) (define (tc-and-a-or-a-l3a-5 x y z) (and (positive? x) (or (= x 10) (tc-and-a-or-a-l3a-5 x x y z)))) (test (tc-and-a-or-a-l3a-5 9 0 0) 'error) ;; -------- OP_TC_OR_A_AND_A_L3A -------- (define (tc-and-f7 x y z) (or (<= x 0) (and (> y 0) (tc-and-f7 (- x 1) (- y 1) 0)))) (test (tc-and-f7 2 4 0) #t) (test (tc-and-f7 2 4 0) #t) (define (tc-or-a-and-a-l3a-1 x y z) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-l3a-1 (cdr x) y z)))) (test (tc-or-a-and-a-l3a-1 '(1 2 3 4) 0 0) #t) (test (tc-or-a-and-a-l3a-1 '(1 2 3.1 4) 0 0) #f) (define (tc-or-a-and-a-l3a-2 x y z) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-l3a-2)))) (test (tc-or-a-and-a-l3a-2 '(1 2 3 4) 0 0) 'error) (define (tc-or-a-and-a-l3a-3 x y z) (or (null? x) (and (integer? (car x)) (tc-or-a-and-a-l3a-3 #f #t y z)))) (test (tc-or-a-and-a-l3a-3 '(1 2 3 4) 0 0) 'error) ;; -------- OP_TC_OR_A_A_AND_A_A-LA -------- (define (tc-or-a-a-and-a-a-la-1 x) (or (null? x) (number? x) (and (pair? x) (integer? (car x)) (tc-or-a-a-and-a-a-la-1 (cdr x))))) (test (tc-or-a-a-and-a-a-la-1 '(1 2 3 4)) #t) (test (tc-or-a-a-and-a-a-la-1 '(1 2 3.1 4)) #f) (define (tc-or-a-a-and-a-a-la-2 x) (or (null? x) (number? x) (and (pair? x) (integer? (car x)) (tc-or-a-a-and-a-a-la-2)))) (test (tc-or-a-a-and-a-a-la-2 '(1 2 3 4)) 'error) (define (tc-or-a-a-and-a-a-la-3 x) (or (null? x) (number? x) (and (pair? x) (integer? (car x)) (tc-or-a-a-and-a-a-la-3 #f #t)))) (test (tc-or-a-a-and-a-a-la-3 '(1 2 3 4)) 'error) ;; -------- OP_TC_OR_A_AND_A_A_L3A -------- (define (tc-or-a-and-a-a-l3a-1 x y z) (or (= x 0) (and (> y 1) (> z 1) (tc-or-a-and-a-a-l3a-1 (- x 1) (- y 1) (- z 1))))) (test (tc-or-a-and-a-a-l3a-1 2 3 4) #t) (define (tc-or-a-and-a-a-l3a-2 x y z) (or (call-with-exit (lambda (cc) (= x 0))) (and (> y 1) (> z 1) (tc-or-a-and-a-a-l3a-2 (- x 1) (- y 1) (- z 1))))) (test (tc-or-a-and-a-a-l3a-2 2 3 4) #t) (define (tc-or-a-and-a-a-l3a-3 x y z) (or (= x 0) (and (> y 1) (> z 1) (tc-or-a-and-a-a-l3a-3 (- x 1) (- z 1))))) (test (tc-or-a-and-a-a-l3a-3 2 3 4) 'error) ;; -------- OP_TC_IF_A_T_AND_A_A_L3A -------- (define (tc-if-a-t-and-a-a-l3a-1 x y z) (if (= x 0) #t (and (> y 1) (> z 1) (tc-if-a-t-and-a-a-l3a-1 (- x 1) (- y 1) (- z 1))))) (test (tc-if-a-t-and-a-a-l3a-1 2 3 4) #t) ;; -------- OP_TC_LET_WHEN_L2A -------- (define (tc-let-when-l2a-1 x y) (let ((z (iterate x))) (when (and (integer? z) (> z y)) (tc-let-when-l2a-1 x y)))) (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-when-l2a-1 x 2) (iterate x)) 2) (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-when-l2a-1 x 0) (iterate x)) #) (test (let ((x (make-iterator '(3 4 1 2)))) (tc-let-when-l2a-1 x 2) (iterate x)) 2) (define (tc-let-when-l2a-2 x y) (let ((z (iterate x))) (when (and (integer? z) (> z y)) (tc-let-when-l2a-2 x)))) (test (let ((x (make-iterator '(3 4 1 2)))) (tc-let-when-l2a-2 x 2) (iterate x)) 'error) (define (tc-let-unless-l2a-1 x y) (let ((z (iterate x))) (unless (> z y) (tc-let-unless-l2a-1 x y)))) (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-unless-l2a-1 x 2) (iterate x)) 4) (define (tc-let-unless-l2a-2 x y) (let ((z (iterate x))) (unless (> z y) (tc-let-unless-l2a-2)))) (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-unless-l2a-2 x 2) (iterate x)) 'error) (define (tc-let-unless-l2a-3 x y) (let ((z (iterate x))) (unless (> z y) (tc-let-unless-l2a-3 x y z)))) (test (let ((x (make-iterator '(1 2 3 4)))) (tc-let-unless-l2a-3 x 2) (iterate x)) 'error) (define (tc-let-unless-l2a-4 x y) (let ((z (iterate x)) (zz (iterate x))) (unless (> z y) (tc-let-unless-l2a-4 x y)))) (test (let ((x (make-iterator '(1 2 3 4 5 6)))) (tc-let-unless-l2a-4 x 2) (iterate x)) 5) ;; -------- OP_TC_COND_A_Z_A_Z_L2A -------- (define (tc-cond-a-z-a-z-l2a-1 x y) (cond ((= x 0) y) ((= y 100) y) (else (tc-cond-a-z-a-z-l2a-1 (- x 1) (+ y 1))))) (test (tc-cond-a-z-a-z-l2a-1 10 0) 10) (define (tc-cond-a-z-a-z-l2a-2 s i) (cond ((< i 0) #f) ((char=? (string-ref s i) #\a) i) (else (tc-cond-a-z-a-z-l2a-2 s (- i 1))))) (test (tc-cond-a-z-a-z-l2a-2 "asdasdf" 6) 3) (test (tc-cond-a-z-a-z-l2a-2 "sdsdfsd" 6) #f) (define (tc-cond-a-z-a-z-l2a-3 s i) (cond ((< i 0) #f) ((char=? (string-ref s i) #\a) i) (else (tc-cond-a-z-a-z-l2a-3 (- i 1))))) (test (tc-cond-a-z-a-z-l2a-3 "asdasdf" 6) 'error) (define (tc-cond-a-z-a-z-l2a-4 s i) (cond ((< i 0) #f) ((char=? (string-ref s i) #\a) i) (else (tc-cond-a-z-a-z-l2a-4)))) (test (tc-cond-a-z-a-z-l2a-4 "asdasdf" 6) 'error) (define (tc-cond-a-z-a-z-l2a-5 x y) (cond ((= x 0) y) ((= y 100) (+ y 1)) (else (tc-cond-a-z-a-z-l2a-5 (- x 1) (+ x 1))))) (test (tc-cond-a-z-a-z-l2a-5 10 0) 2) (test (tc-cond-a-z-a-z-l2a-5 10 100) 101) (define (tc-cond-a-z-a-z-l2a-6 x y) (cond ((= x 0) (let ((z x)) (- y z))) ((= y 100) y) (else (tc-cond-a-z-a-z-l2a-6 (- x 1) (+ x 1))))) (test (tc-cond-a-z-a-z-l2a-6 10 0) 2) (define (tc-cond-a-z-a-z-l2a-7 x y) (cond ((= x 0) y) ((= y 100) (let ((z (+ y 1))) (* z 2))) (else (tc-cond-a-z-a-z-l2a-7 (- x 1) (+ x 1))))) (test (tc-cond-a-z-a-z-l2a-7 10 0) 2) (test (tc-cond-a-z-a-z-l2a-7 10 100) 202) ;; -------- OP_TC_COND_A_Z_A_L2A_Z -------- (define (tc-cond-a-z-a-l2a-z-1 x y) (cond ((= x 0) y) ((not (= y 100)) (tc-cond-a-z-a-l2a-z-1 (- x 1) (+ y 1))) (else y))) (test (tc-cond-a-z-a-l2a-z-1 10 0) 10) (define (tc-cond-a-z-a-l2a-z-2 s i) (cond ((< i 0) #f) ((not (char=? (string-ref s i) #\a)) (tc-cond-a-z-a-l2a-z-2 s (- i 1))) (else i))) (test (tc-cond-a-z-a-l2a-z-2 "asdasdf" 6) 3) (test (tc-cond-a-z-a-l2a-z-2 "sdsdfsd" 6) #f) (define (tc-cond-a-z-a-l2a-z-3 s i) (cond ((< i 0) #f) ((not (char=? (string-ref s i) #\a)) (tc-cond-a-z-a-l2a-z-3 (- i 1))) (else i))) (test (tc-cond-a-z-a-l2a-z-3 "asdasdf" 6) 'error) (define (tc-cond-a-z-a-l2a-z-4 s i) (cond ((< i 0) #f) ((not (char=? (string-ref s i) #\a)) (tc-cond-a-z-a-l2a-z-4)) (else i))) (test (tc-cond-a-z-a-l2a-z-4 "asdasdf" 6) 'error) (define (tc-cond-a-z-a-l2a-z-5 x y) (cond ((= x 0) y) ((not (= y 100)) (tc-cond-a-z-a-l2a-z-5 (- x 1) (+ x 1))) (else (+ y 1)))) (test (tc-cond-a-z-a-l2a-z-5 10 0) 2) (test (tc-cond-a-z-a-l2a-z-5 10 100) 101) (define (tc-cond-a-z-a-l2a-z-6 x y) (cond ((= x 0) (let ((z x)) (- y z))) ((not (= y 100)) (tc-cond-a-z-a-l2a-z-6 (- x 1) (+ x 1))) (else y))) (test (tc-cond-a-z-a-l2a-z-6 10 0) 2) (define (tc-cond-a-z-a-l2a-z-7 x y) (cond ((= x 0) y) ((not (= y 100)) (tc-cond-a-z-a-l2a-z-7 (- x 1) (+ x 1))) (else (let ((z (+ y 1))) (* z 2))))) (test (tc-cond-a-z-a-l2a-z-7 10 0) 2) (test (tc-cond-a-z-a-l2a-z-7 10 100) 202) ;; -------- OP_TC_COND_A_Z_A_L2A_L2A -------- (define (tc-cond-a-z-a-l2a-l2a-1 x y) (cond ((= x 0) y) ((= y 100) (tc-cond-a-z-a-l2a-l2a-1 0 0)) (else (tc-cond-a-z-a-l2a-l2a-1 (- x 1) (+ y 1))))) (test (tc-cond-a-z-a-l2a-l2a-1 10 0) 10) (test (tc-cond-a-z-a-l2a-l2a-1 10 100) 0) (define (tc-cond-a-z-a-l2a-l2a-2 x y) (cond ((= x 0) y) ((= y 100) (tc-cond-a-z-a-l2a-l2a-1 0 0)) (else (tc-cond-a-z-a-l2a-l2a-2 (- x 1))))) (test (tc-cond-a-z-a-l2a-l2a-2 10 0) 'error) (define (tc-cond-a-z-a-l2a-l2a-3 x y) (cond ((= x 0) y) ((= y 100) (tc-cond-a-z-a-l2a-l2a-3 0 0)) (else (tc-cond-a-z-a-l2a-l2a-3)))) (test (tc-cond-a-z-a-l2a-l2a-3 10 0) 'error) (define (tc-cond-a-z-a-l2a-l2a-4 x y) (cond ((= x 0) y) ((= y 100) (tc-cond-a-z-a-l2a-l2a-1)) (else (tc-cond-a-z-a-l2a-l2a-1 (- x 1) (+ y 1))))) (test (tc-cond-a-z-a-l2a-l2a-4 10 100) 'error) ;; -------- OP_TC_LET_COND -------- (define (tc-let-cond-1 x) (let ((z (+ x 1))) (cond ((= x 0) z) ((tc-let-cond-1 (- x 1)))))) ; does not reach check_tc -- unsafe body (test (tc-let-cond-1 10) 1) ; 1 because the recursive call is the test, and there's no result, so the test result is what we get! yikes... (define (tc-let-cond-2 x) (let ((z (+ x 1))) (cond ((= x 0) z) (else (tc-let-cond-2))))) (test (tc-let-cond-2 10) 'error) (define (tc-let-cond-3 x) (let ((z (+ x 1))) (cond ((= x 0) z) (#t (tc-let-cond-3 (- x 1)))))) (test (tc-let-cond-3 10) 1) (define (tc-let-cond-4 x) (let ((z (+ x 1))) (cond ((= x 0) (let ((v (+ z 1))) (* 2 v))) (#t (tc-let-cond-4 (- x 1)))))) (test (tc-let-cond-4 10) 4) (define (tc-let-cond-5 x y) (let ((z (+ x y))) (cond ((= x 1) #\o) ((= y 1) #\O) ((= z 0) #\z) (else (tc-let-cond-5 (- x 1) (+ y 1)))))) (test (tc-let-cond-5 0 0) #\z) (test (tc-let-cond-5 1 1) #\o) (test (tc-let-cond-5 -1 -1) #\O) (define (tc-let-cond-6 x y z) (let ((z1 (+ x y z))) (cond ((= x 1) #\o) ((= y 1) #\O) ((= z 0) #\z) (else (tc-let-cond-6 (- x 1) (+ y 1) (- z 1)))))) (test (tc-let-cond-6 0 0 12) #\O) (define (tc-let-cond-7 w x y z) (let ((z1 (+ w x y z))) (cond ((= x 1) #\o) ((= y 2) z1) ((= z 0) #\z) (else (tc-let-cond-7 w (- x 1) (+ y 1) (- z 1)))))) (test (tc-let-cond-7 0 0 0 12) 10) (define (tc-let-cond-8 x y) (let ((z (+ x y 1))) (cond ((= x 2) z) ((= y 1) (tc-let-cond-8 x (+ y 1))) ((= z 0) #\z) (else (tc-let-cond-8 (+ x 1) (+ y 1)))))) (test (tc-let-cond-8 0 0) 6) (define (tc-let-cond-9 w x y) (let ((z (+ w x y 1))) (cond ((= x 2) z) ((= y 1) (tc-let-cond-9 w x (+ y 1))) ((= z 0) #\z) (else (tc-let-cond-9 w (+ x 1) (+ y 1)))))) (test (tc-let-cond-9 0 0 0) 6) ;; -------- OP_TC_CASE_LA -------- (define (tc-case-1 x) (case (car x) ((#\a) 1) ((#\b) 2) (else (tc-case-1 (cdr x))))) (test (tc-case-1 '(1 #f #\a 95)) 1) (test (tc-case-1 '(1 #f #\b #\a 95)) 2) (define (tc-case-2 x) (case (car x) ((#\a) 1) ((#\b) (tc-case-2 (cdr x))) (else (tc-case-2 (cdr x))))) (test (tc-case-2 '(1 #f #\b #\a 95)) 1) (define (tc-case-3 x) (case (car x) ((#\a) (let ((a 1)) (+ a 1))) ((#\b) (tc-case-3 (cdr x))) (else 1))) (test (tc-case-3 '(#\b #\b #\a 95)) 2) (test (tc-case-3 '(#\b #\b 95 #\1)) 1) (define (tc-case-4 x) (case (car x) ((#\a) 1) ((#\b) 2) ((integer?) (length (symbol->string (car x)))) (else (tc-case-4 (cdr x))))) (test (tc-case-4 '(1 #f integer? #\b #\a 95)) 8) (define (case-5 x) (case (car x) ((#\a) 1) ((#\b)) ; not handled in tc_case ((integer?) 3) (else (case-5 (cdr x))))) (test (case-5 '(1 #f #\b #\a 95)) #\b) (define (case-6 x) (case (car x) ((#\a) 1) ((#\b) => char->integer) ; not handled in tc_case ((integer?) 3) (else (case-6 (cdr x))))) (test (case-6 '(1 #f #\b #\a 95)) 98) (define (case-7 x) (let ((y 123)) (let tc-case-7 ((x x)) (case (car x) ((#\a) (set! y 124) (+ y 1)) (else (tc-case-7 (cdr x))))))) (test (case-7 '(1 #f #\a 95)) 125) ;; -------- OP_TC_CASE_L2A -------- (let ((L (make-vector 10 'c))) (set! (L 9) 'a) (define (tc-case-2 x y) (case (vector-ref x y) ((a) 1) ((b) 2) (else (tc-case-2 x (+ y 1))))) (test (tc-case-2 L 0) 1) (define (tc-case-3 x y) (case (vector-ref x y) ((a) 1) ((c) (tc-case-3 x (+ y 1))) (else 2))) (test (tc-case-3 L 0) 1) (define (tc-case-4 x y) (case (vector-ref x y) ((a) 1) ((b) 2) ((c) (tc-case-4 x (+ y 1))) (else 3))) (test (tc-case-4 L 0) 1)) ;; -------- OP_TC_CASE_L3A -------- (let ((L (make-vector 10 'c))) (set! (L 9) 'a) (define (tc-case-2 x y z) (case (vector-ref x y) ((a) y) ((b) 2) (else (tc-case-2 x (+ y 1) z)))) (test (tc-case-2 L 0 0) 9) (define (tc-case-3 x y z) (case (vector-ref x y) ((a) z) ((c) (tc-case-3 x (+ y 1) z)) (else 2))) (test (tc-case-3 L 0 12) 12) (define (tc-case-4 x y z) (case (vector-ref x y) ((a) z) ((b) 2) ((c) (tc-case-4 x (+ y 1) (* z 2))) (else 3))) (test (tc-case-4 L 0 1) 512)) ;; -------- OP_RECUR_IF_A_A_opLA_LAq -------- (define (recur-if-a-a-opla-laq-1 x) (if (< x 2) x (+ (recur-if-a-a-opla-laq-1 (- x 1)) (recur-if-a-a-opla-laq-1 (- x 2))))) (test (recur-if-a-a-opla-laq-1 10) 55) (define (recur-if-a-a-opla-laq-2 x) (if (< x 2) x (+ (recur-if-a-a-opla-laq-2) (recur-if-a-a-opla-laq-2 (- x 2))))) (test (recur-if-a-a-opla-laq-2 10) 'error) (define (recur-if-a-a-opla-laq-3 x) (if (< x 2) x (+ (recur-if-a-a-opla-laq-3 (- x 1)) (recur-if-a-a-opla-laq-3)))) (test (recur-if-a-a-opla-laq-3 10) 'error) (define (recur-if-a-a-opla-laq-4 x) (if (< x 2.0) x (+ (recur-if-a-a-opla-laq-4 (- x 1.0)) (recur-if-a-a-opla-laq-4 (- x 2.0))))) (num-test (recur-if-a-a-opla-laq-4 10.0) 55.0) (num-test (recur-if-a-a-opla-laq-4 10) 55.0) (define (recur-if-a-a-opla-laq-5 x) (if (< x 2) (call-with-exit (lambda (cc) x)) (+ (recur-if-a-a-opla-laq-1 (- x 1)) (recur-if-a-a-opla-laq-5 (- x 2))))) (test (recur-if-a-a-opla-laq-5 10) 55) (let () (define (fibf n) (if (< n 2.0) n (+ (fibf (- n 1.0)) (fibf (- n 2.0))))) ; 2 1 (test (fibf 8.0) 21.0) (define (fibf1 n) (if (>= n 2.0) (+ (fibf1 (- n 1.0)) (fibf1 (- n 2.0))) n)) ; 2 0 (test (fibf1 8.0) 21.0) (define (fibf2 n) (if (>= n 2) (+ (fibf2 (* 1 (- n 1))) (fibf2 (- n 2))) n)) ; opt_int (test (fibf2 8) 21) (define (fibf3 n) (if (< n 2) n (+ (fibf3 (* 1 (- n 1))) (fibf3 (- n 2))))) ; opt_int (test (fibf3 8) 21) (define (fibc n) (cond ((< n 2) n) (else (+ (fibc (- n 1)) (fibc (- n 2)))))) (test (fibc 8) 21) (define (fibcr n) (cond ((>= n 2) (+ (fibcr (- n 1)) (fibcr (- n 2)))) (else n))) (test (fibcr 8) 21)) ;; -------- OP_RECUR_IF_A_opLA_LAq_A -------- (define (recur-if-a-opla-laq-a-1 x) (if (>= x 2) (+ (recur-if-a-opla-laq-a-1 (- x 1)) (recur-if-a-a-opla-laq-1 (- x 2))) x)) (test (recur-if-a-opla-laq-a-1 10) 55) (define (recur-if-a-opla-laq-a-2 x) (if (>= x 2) (+ (recur-if-a-opla-laq-a-2) (recur-if-a-a-opla-laq-2 (- x 2))) x)) (test (recur-if-a-opla-laq-a-2 10) 'error) (define (recur-if-a-opla-laq-a-3 x) (if (>= x 2) (+ (recur-if-a-opla-laq-a-3 (- x 1)) (recur-if-a-a-opla-laq-3)) x)) (test (recur-if-a-opla-laq-a-3 10) 'error) (define (recur-if-a-opla-laq-a-4 x) (if (>= x 2.0) (+ (recur-if-a-a-opla-laq-4 (- x 1.0)) (recur-if-a-a-opla-laq-4 (- x 2.0))) x)) (num-test (recur-if-a-opla-laq-a-4 10) 55.0) ;; -------- OP_RECUR_COND_A_A_opLA_LAq -------- (define (recur-cond-a-a-opla-laq-1 x) (cond ((< x 2) x) (else (+ (recur-cond-a-a-opla-laq-1 (- x 1)) (recur-cond-a-a-opla-laq-1 (- x 2)))))) (test (recur-cond-a-a-opla-laq-1 10) 55) (define (recur-cond-a-a-opla-laq-2 x) (cond ((< x 2) x) (else (+ (recur-cond-a-a-opla-laq-2) (recur-cond-a-a-opla-laq-2 (- x 2)))))) (test (recur-cond-a-a-opla-laq-2 10) 'error) (define (recur-cond-a-a-opla-laq-3 x) (cond ((< x 2) x) (else (+ (recur-cond-a-a-opla-laq-3 (- x 1)) (recur-cond-a-a-opla-laq-3))))) (test (recur-cond-a-a-opla-laq-3 10) 'error) ;; -------- OP_RECUR_IF_A_A_opL2A_L2Aq -------- (define (recur-if-a-a-opl2a-l2aq-1 x y) (if (< x 2) (+ x y) (+ (recur-if-a-a-opl2a-l2aq-1 (- x 1) (+ y 1)) (recur-if-a-a-opl2a-l2aq-1 (- x 2) (+ y 2))))) (test (recur-if-a-a-opl2a-l2aq-1 10 0) 890) (define (recur-if-a-a-opl2a-l2aq-2 x y) (if (< x 2) (+ x y) (+ (recur-if-a-a-opl2a-l2aq-2) (recur-if-a-a-opl2a-l2aq-2 (- x 2))))) (test (recur-if-a-a-opl2a-l2aq-2 10 0) 'error) (define (recur-if-a-a-opl2a-l2aq-3 x y) (if (< x 2) (+ x y) (+ (recur-if-a-a-opl2a-l2aq-3 (- x 1) (+ y 2)) (recur-if-a-a-opl2a-l2aq-3 (- x 1))))) (test (recur-if-a-a-opl2a-l2aq-3 10 0) 'error) (define (recur-if-a-a-opl2a-l2aq-4 x y) (if (< x 2.0) (+ x y) (+ (recur-if-a-a-opl2a-l2aq-4 (- x 1.0) (+ y 1.0)) (recur-if-a-a-opl2a-l2aq-4 (- x 2.0) (+ y 2.0))))) (num-test (recur-if-a-a-opl2a-l2aq-4 10.0 0.0) 890.0) (num-test (recur-if-a-a-opl2a-l2aq-4 10 0) 890.0) (define (recur-if-a-a-opl2a-l2aq-5 x y) (if (< x 2) (call-with-exit (lambda (cc) (+ x y))) (+ (recur-if-a-a-opl2a-l2aq-1 (- x 1) (+ y 1)) (recur-if-a-a-opl2a-l2aq-5 (- x 2) (+ y 2))))) (test (recur-if-a-a-opl2a-l2aq-5 10 0) 890) ;; -------- OP_RECUR_IF_A_opL2A_L2Aq_A -------- (define (recur-if-a-opl2a-l2aq-a-1 x y) (if (>= x 2) (+ (recur-if-a-opl2a-l2aq-a-1 (- x 1) (+ y 1)) (recur-if-a-opl2a-l2aq-a-1 (- x 2) (+ y 2))) (+ x y))) (test (recur-if-a-opl2a-l2aq-a-1 10 0) 890) (define (recur-if-a-opl2a-l2aq-a-2 x y) (if (>= x 2) (+ (recur-if-a-opl2a-l2aq-a-2) (recur-if-a-opl2a-l2aq-a-2 (- x 2))) (+ x ))) (test (recur-if-a-opl2a-l2aq-a-2 10 0) 'error) (define (recur-if-a-opl2a-l2aq-a-3 x y) (if (>= x 2) (+ (recur-if-a-opl2a-l2aq-a-3 (- x 1) (+ y 2)) (recur-if-a-opl2a-l2aq-a-3 (- x 1))) (+ x y))) (test (recur-if-a-opl2a-l2aq-a-3 10 0) 'error) (define (recur-if-a-opl2a-l2aq-a-4 x y) (if (>= x 2.0) (+ (recur-if-a-opl2a-l2aq-a-4 (- x 1.0) (+ y 1.0)) (recur-if-a-opl2a-l2aq-a-4 (- x 2.0) (+ y 2.0))) (+ x y))) (test (recur-if-a-opl2a-l2aq-a-4 10.0 0.0) 890.0) (test (recur-if-a-opl2a-l2aq-a-4 10 0) 890.0) (define (recur-if-a-opl2a-l2aq-a-5 x y) (if (>= x 2) (+ (recur-if-a-opl2a-l2aq-a-1 (- x 1) (+ y 1)) (recur-if-a-opl2a-l2aq-a-5 (- x 2) (+ y 2))) (call-with-exit (lambda (cc) (+ x y))))) (test (recur-if-a-opl2a-l2aq-a-5 10 0) 890) ;; -------- OP_RECUR_IF_A_A_opL3A_L3Aq -------- (define (recur-if-a-a-opl3a-l3aq-1 x y z) (if (< x 2) (+ x y z) (+ (recur-if-a-a-opl3a-l3aq-1 (- x 1) (+ y 1) (+ z 2)) (recur-if-a-a-opl3a-l3aq-1 (- x 2) (+ y 2) (+ z 4))))) (test (recur-if-a-a-opl3a-l3aq-1 10 0 -10) 1670) (define (recur-if-a-a-opl3a-l3aq-2 x y) (if (< x 2) (+ x y z) (+ (recur-if-a-a-opl3a-l3aq-2) (recur-if-a-a-opl3a-l3aq-2 (- x 2))))) (test (recur-if-a-a-opl3a-l3aq-2 10 0 -10) 'error) (define (recur-if-a-a-opl3a-l3aq-3 x y z) (if (< x 2) (+ x y) (+ (recur-if-a-a-opl3a-l3aq-3 (- x 1) (+ y 2) (+ z 1)) (recur-if-a-a-opl3a-l3aq-3 (- x 1) (+ y 1))))) (test (recur-if-a-a-opl3a-l3aq-3 10 0 -10) 'error) (define (recur-if-a-a-opl3a-l3aq-4 x y z) (if (< x 2.0) (+ x y z) (+ (recur-if-a-a-opl3a-l3aq-4 (- x 1.0) (+ y 1.0) (+ z 2.0)) (recur-if-a-a-opl3a-l3aq-4 (- x 2.0) (+ y 2.0) (+ z 4.0))))) (num-test (recur-if-a-a-opl3a-l3aq-4 10.0 0.0 -10.0) 1670.0) (num-test (recur-if-a-a-opl3a-l3aq-4 10 0 -10.0) 1670.0) (define (recur-if-a-a-opl3a-l3aq-5 x y z) (if (< x 2) (call-with-exit (lambda (cc) (+ x y z))) (+ (recur-if-a-a-opl3a-l3aq-1 (- x 1) (+ y 1) (+ z 2)) (recur-if-a-a-opl3a-l3aq-5 (- x 2) (+ y 2) (+ z 4))))) (test (recur-if-a-a-opl3a-l3aq-5 10 0 -10) 1670) ;; -------- OP_RECUR_IF_A_opL3A_L3Aq_A -------- (define (recur-if-a-opl3a-l3aq-a-1 x y z) (if (>= x 2) (+ (recur-if-a-opl3a-l3aq-a-1 (- x 1) (+ y 1) (+ z 2)) (recur-if-a-opl3a-l3aq-a-1 (- x 2) (+ y 2) (+ z 4))) (+ x y z))) (test (recur-if-a-opl3a-l3aq-a-1 10 0 -10) 1670) (define (recur-if-a-opl3a-l3aq-a-2 x y) (if (>= x 2) (+ (recur-if-a-opl3a-l3aq-a-2) (recur-if-a-opl3a-l3aq-a-2 (- x 2))) (+ x y z))) (test (recur-if-a-opl3a-l3aq-a-2 10 0 -10) 'error) (define (recur-if-a-opl3a-l3aq-a-3 x y z) (if (>= x 2) (+ (recur-if-a-opl3a-l3aq-a-3 (- x 1) (+ y 2) (+ z 1)) (recur-if-a-opl3a-l3aq-a-3 (- x 1) (+ y 1))) (+ x y))) (test (recur-if-a-opl3a-l3aq-a-3 10 0 -10) 'error) (define (recur-if-a-opl3a-l3aq-a-4 x y z) (if (>= x 2.0) (+ (recur-if-a-opl3a-l3aq-a-4 (- x 1.0) (+ y 1.0) (+ z 2.0)) (recur-if-a-opl3a-l3aq-a-4 (- x 2.0) (+ y 2.0) (+ z 4.0))) (+ x y z))) (test (recur-if-a-opl3a-l3aq-a-4 10.0 0.0 -10.0) 1670.0) (test (recur-if-a-opl3a-l3aq-a-4 10 0 -10.0) 1670.0) (define (recur-if-a-opl3a-l3aq-a-5 x y z) (if (>= x 2) (+ (recur-if-a-opl3a-l3aq-a-1 (- x 1) (+ y 1) (+ z 2)) (recur-if-a-opl3a-l3aq-a-5 (- x 2) (+ y 2) (+ z 4))) (call-with-exit (lambda (cc) (+ x y z))))) (test (recur-if-a-opl3a-l3aq-a-5 10 0 -10) 1670) ;; -------- OP_RECUR_IF_A_A_opA_LAq -------- (define (recur-if-a-a-opa-laq-1 x) (if (= x 0) 0 (+ 1 (recur-if-a-a-opa-laq-1 (- x 1))))) (test (recur-if-a-a-opa-laq-1 10) 10) (define (recur-if-a-a-opa-laq-2 x) (if (= x 0) 0 (+ 1 (recur-if-a-a-opa-laq-2)))) (test (recur-if-a-a-opa-laq-2 10) 'error) (define (recur-if-a-a-opa-laq-3 x) (if (= x 0) 0 (+ 1 (recur-if-a-a-opa-laq-3 (- x 1) 2)))) (test (recur-if-a-a-opa-laq-3 10) 'error) (define (recur-if-a-a-opa-laq-4 x) (if (= x 0) (call-with-exit (lambda (cc) 0)) (+ 1 (recur-if-a-a-opa-laq-4 (- x 1))))) (test (recur-if-a-a-opa-laq-4 10) 10) (let () (define (copy-list-1 lis) (if (not (pair? lis)) lis (cons (car lis) (copy-list-1 (cdr lis))))) (define (ftc-4 lis) (copy-list-1 lis)) (test (ftc-4 '(1 2 3)) '(1 2 3))) ;; -------- OP_RECUR_IF_A_A_opLA_Aq -------- (define (recur-if-a-a-opla-aq-1 x) (if (= x 0) 0 (+ (recur-if-a-a-opla-aq-1 (- x 1)) 1))) (test (recur-if-a-a-opla-aq-1 10) 10) (define (recur-if-a-a-opla-aq-2 x) (if (= x 0) 0 (+ (recur-if-a-a-opla-aq-2) 1))) (test (recur-if-a-a-opla-aq-2 10) 'error) (define (recur-if-a-a-opla-aq-3 x) (if (= x 0) 0 (+ (recur-if-a-a-opla-aq-3 (- x 1) 2) 1))) (test (recur-if-a-a-opla-aq-3 10) 'error) (define (recur-if-a-a-opla-aq-4 x) (if (= x 0) (call-with-exit (lambda (cc) 0)) (+ (recur-if-a-a-opla-aq-4 (- x 1)) 1))) (test (recur-if-a-a-opla-aq-4 10) 10) (let () (define (copy-list-2 lis) (if (not (pair? lis)) lis (cons (copy-list-2 (cdr lis)) (car lis)))) (define (ftc-4a lis) (copy-list-2 lis)) (test (ftc-4a '(1 2 3)) '(((() . 3) . 2) . 1))) ;; -------- OP_RECUR_IF_A_A_opA_L2Aq -------- (define (recur-if-a-a-opa-l2aq-1 x y) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l2aq-1 (- x 1) (+ y 1))))) (test (recur-if-a-a-opa-l2aq-1 10 0) 20) (define (recur-if-a-a-opa-l2aq-2 x y) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l2aq-2)))) (test (recur-if-a-a-opa-l2aq-2 10 0) 'error) (define (recur-if-a-a-opa-l2aq-3 x y) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l2aq-3 (- x 1) (+ y 1) 2)))) (test (recur-if-a-a-opa-l2aq-3 10 0) 'error) (define (recur-if-a-a-opa-l2aq-4 x y) (if (= x 0) (call-with-exit (lambda (cc) y)) (+ 1 (recur-if-a-a-opa-l2aq-4 (- x 1) (+ y 1))))) (test (recur-if-a-a-opa-l2aq-4 10 0) 20) (define (recur-if-a-opa-l2aq-a-1 x y) (if (not (= x 0)) (+ 1 (recur-if-a-opa-l2aq-a-1 (- x 1) (+ y 1))) y)) (test (recur-if-a-opa-l2aq-a-1 10 0) 20) ;; -------- OP_RECUR_IF_A_A_opA_L3Aq -------- (define (recur-if-a-a-opa-l3aq-1 x y z) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l3aq-1 (- x 1) (+ y z) (+ z 1))))) (test (recur-if-a-a-opa-l3aq-1 10 0 0) 55) ; z by 1 = 110/2 (define (recur-if-a-a-opa-l3aq-2 x y z) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l3aq-2)))) (test (recur-if-a-a-opa-l3aq-2 10 0 0) 'error) (define (recur-if-a-a-opa-l3aq-3 x y z) (if (= x 0) y (+ 1 (recur-if-a-a-opa-l3aq-3 (- x 1) (+ y 1) 2 1)))) (test (recur-if-a-a-opa-l3aq-3 10 0 0) 'error) (define (wf3 lst i val) (if (= i 0) (cons val (cdr lst)) (cons (car lst) (wf3 (cdr lst) (- i 1) val)))) (test (wf3 (list 1 2 3 4) 3 5) '(1 2 3 5)) (test (wf3 (list 1 2 3 4) 2 5) '(1 2 5 4)) (test (wf3 (list 1 2 3 4) 1 5) '(1 5 3 4)) ;; and flip test (define (recur-if-a-opa-l3aq-a-1 x y z) (if (not (= x 0)) (+ 1 (recur-if-a-opa-l3aq-a-1 (- x 1) (+ y z) (+ z 1))) y)) (test (recur-if-a-opa-l3aq-a-1 10 0 0) 55) ; z by 1 = 110/2 (define (wf3rev lst i val) (if (not (= i 0)) (cons (car lst) (wf3rev (cdr lst) (- i 1) val)) (cons val (cdr lst)))) (test (wf3rev (list 1 2 3 4) 3 5) '(1 2 3 5)) (test (wf3rev (list 1 2 3 4) 2 5) '(1 2 5 4)) (test (wf3rev (list 1 2 3 4) 1 5) '(1 5 3 4)) ;; -------- OP_RECUR_IF_A_A_opA_LA_LAq -------- (define (recur-if-a-a-opa-la-laq-1 n) (if (< n 3) 1 (+ 1 (recur-if-a-a-opa-la-laq-1 (- n 2)) (recur-if-a-a-opa-la-laq-1 (- n 3))))) (test (recur-if-a-a-opa-la-laq-1 10) 23) (define (recur-if-a-a-opa-la-laq-2 n) (if (< n 3) 1 (+ (- n 1) (recur-if-a-a-opa-la-laq-2 (- n 2)) (recur-if-a-a-opa-la-laq-2 (- n 3))))) (test (recur-if-a-a-opa-la-laq-2 10) 59) (define (recur-if-a-a-opa-la-laq-3 n) (if (< n 3) 1 (+ 1 (recur-if-a-a-opa-la-laq-3) (recur-if-a-a-opa-la-laq-3 (- n 3))))) (test (recur-if-a-a-opa-la-laq-3 10) 'error) (define (recur-if-a-a-opa-la-laq-4 n) (if (< n 3) 1 (- 1 (recur-if-a-a-opa-la-laq-4 (- n 2)) (recur-if-a-a-opa-la-laq-4)))) (test (recur-if-a-a-opa-la-laq-4 10) 'error) (define (recur-if-a-a-opa-la-laq-5 n) (if (< n 3) (call-with-exit (lambda (cc) 1)) (+ 1 (recur-if-a-a-opa-la-laq-5 (- n 2)) (recur-if-a-a-opa-la-laq-5 (- n 3))))) (test (recur-if-a-a-opa-la-laq-5 10) 23) ;; -------- OP_RECUR_IF_A_opA_LA_LAq_A -------- (define (recur-if-a-opa-la-laq-a-1 n) (if (>= n 3) (+ 1 (recur-if-a-opa-la-laq-a-1 (- n 2)) (recur-if-a-opa-la-laq-a-1 (- n 3))) 1)) (test (recur-if-a-opa-la-laq-a-1 10) 23) (define (recur-if-a-opa-la-laq-a-2 n) (if (>= n 3) (+ (- n 1) (recur-if-a-opa-la-laq-a-2 (- n 2)) (recur-if-a-opa-la-laq-a-2 (- n 3))) 1)) (test (recur-if-a-opa-la-laq-a-2 10) 59) (define (recur-if-a-opa-la-laq-a-3 n) (if (>= n 3) (+ 1 (recur-if-a-opa-la-laq-a-3) (recur-if-a-opa-la-laq-a-3 (- n 3))) 1)) (test (recur-if-a-opa-la-laq-a-3 10) 'error) (define (recur-if-a-opa-la-laq-a-4 n) (if (>= n 3) (- 1 (recur-if-a-opa-la-laq-a-4 (- n 2)) (recur-if-a-opa-la-laq-a-4)) 1)) (test (recur-if-a-opa-la-laq-a-4 10) 'error) ;; -------- OP_RECUR_IF_A_A_opLA_LA_LAq -------- (define (recur-if-a-a-opla-la-laq-1 n) (if (< n 3) 1 (+ (recur-if-a-a-opla-la-laq-1 (- n 1)) (recur-if-a-a-opla-la-laq-1 (- n 2)) (recur-if-a-a-opla-la-laq-1 (- n 3))))) (test (recur-if-a-a-opla-la-laq-1 10) 193) (define (recur-if-a-opla-la-laq-a-1 n) (if (>= n 3) (+ (recur-if-a-opla-la-laq-a-1 (- n 1)) (recur-if-a-opla-la-laq-a-1 (- n 2)) (recur-if-a-opla-la-laq-a-1 (- n 3))) 1)) (test (recur-if-a-opla-la-laq-a-1 10) 193) (define (recur-if-a-a-opla-la-laq-2 n) (if (< n 3) 1 (+ (recur-if-a-a-opla-la-laq-2) (recur-if-a-a-opla-la-laq-2 (- n 2)) (recur-if-a-a-opla-la-laq-2 (- n 3))))) (test (recur-if-a-a-opla-la-laq-2 10) 'error) (define (recur-if-a-a-opla-la-laq-3 n) (if (< n 3) 1 (+ (recur-if-a-a-opla-la-laq-3 (- n 1)) (recur-if-a-a-opla-la-laq-3) (recur-if-a-a-opla-la-laq-3 (- n 3))))) (test (recur-if-a-a-opla-la-laq-3 10) 'error) (define (recur-if-a-a-opla-la-laq-4 n) (if (< n 3) 1 (+ (recur-if-a-a-opla-la-laq-4 (- n 1) (+ n 1)) (recur-if-a-a-opla-la-laq-4 (- n 2)) (recur-if-a-a-opla-la-laq-4 (- n 3))))) (test (recur-if-a-a-opla-la-laq-4 10) 'error) (define (recur-if-a-a-opla-la-laq-5 n) (if (< n 3) 1 (- (recur-if-a-a-opla-la-laq-5 (- n 1)) (recur-if-a-a-opla-la-laq-5 (- n 2)) (recur-if-a-a-opla-la-laq-5 (- n 3))))) (test (recur-if-a-a-opla-la-laq-5 10) -15) (define (recur-if-a-a-opla-la-laq-6 n) (if (< n 3) (call-with-exit (lambda (cc) 1)) (+ (recur-if-a-a-opla-la-laq-6 (- n 1)) (recur-if-a-a-opla-la-laq-6 (- n 2)) (recur-if-a-a-opla-la-laq-6 (- n 3))))) (test (recur-if-a-a-opla-la-laq-6 10) 193) (define (recur-cond-a-a-a-a-opl3a-l3aq-23 x y z) (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-cond-a-a-a-a-opl3a-l3aq-23 (- x 1) (+ y 1) (recur-if-a-a-opla-la-laq-1 z)) (recur-cond-a-a-a-a-opl3a-l3aq-23 (- x 1) (+ y 1) z))))) (test (recur-cond-a-a-a-a-opl3a-l3aq-23 10 0 1) 10240) ;; -------- OP_RECUR_IF_A_opA_LAq_A -------- (define (recur-if-a-opa-laq-a-1 x) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laq-a-1 (- x 1))) 0)) (test (recur-if-a-opa-laq-a-1 10) 10) (define (recur-if-a-opa-laq-a-2 x) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laq-a-2)) 0)) (test (recur-if-a-opa-laq-a-2 10) 'error) (define (recur-if-a-opa-laq-a-3 x) (if (not (= x 0)) (+ 1 (recur-if-a-opa-laq-a-3 (- x 1) 2)) 0)) (test (recur-if-a-opa-laq-a-3 10) 'error) (let () (define (copy-list-2 lis) (if (pair? lis) (cons (car lis) (copy-list-2 (cdr lis))) lis)) (define (ftc-5 lis) (copy-list-2 lis)) (test (ftc-5 '(1 2 3)) '(1 2 3))) ;; -------- OP_RECUR_IF_A_opLA_Aq_A -------- (define (recur-if-a-opla-aq-a-1 x) (if (not (= x 0)) (+ (recur-if-a-opla-aq-a-1 (- x 1)) 1) 0)) (test (recur-if-a-opla-aq-a-1 10) 10) (define (recur-if-a-opla-aq-a-2 x) (if (not (= x 0)) (+ (recur-if-a-opla-aq-a-2) 1) 0)) (test (recur-if-a-opla-aq-a-2 10) 'error) (define (recur-if-a-opla-aq-a-3 x) (if (not (= x 0)) (+ (recur-if-a-opla-aq-a-3 (- x 1) 2) 1) 0)) (test (recur-if-a-opla-aq-a-3 10) 'error) (let () (define (copy-list-3 lis) (if (pair? lis) (cons (copy-list-3 (cdr lis)) (car lis)) lis)) (define (ftc-6 lis) (copy-list-3 lis)) (test (ftc-6 '(1 2 3)) '(((() . 3) . 2) . 1))) ;; -------- OP_RECUR_IF_A_opA_L2Aq_A -------- (define (recur-if-a-opa-l2aq-a-1 x y) (if (not (= x 0)) (+ 1 (recur-if-a-opa-l2aq-a-1 (- x 1) (+ y 1))) y)) (test (recur-if-a-opa-l2aq-a-1 10 0) 20) (define (recur-if-a-opa-l2aq-a-2 x y) (if (not (= x 0)) (+ 1 (recur-if-a-opa-l2aq-a-2)) y)) (test (recur-if-a-opa-l2aq-a-2 10 0) 'error) (define (recur-if-a-opa-l2aq-a-3 x y) (if (not (= x 0)) (+ 1 (recur-if-a-opa-l2aq-a-3 (- x 1) (+ y 1) 2)) y)) (test (recur-if-a-opa-l2aq-a-3 10 0) 'error) ;; -------- OP_RECUR_IF_A_A_IF_A_L2A_opA_L2Aq -------- (define (recur-if-a-a-if-a-l2a-opa-l2aq-1 m n) (if (= m 0) (+ n 1) (if (= n 0) (recur-if-a-a-if-a-l2a-opa-l2aq-1 (- m 1) 1) (+ (- m 1) (recur-if-a-a-if-a-l2a-opa-l2aq-1 m (- n 1)))))) (test (recur-if-a-a-if-a-l2a-opa-l2aq-1 2 3) 5) (test (recur-if-a-a-if-a-l2a-opa-l2aq-1 4 2) 11) (define (recur-if-a-a-if-a-l2a-opa-l2aq-2 m n) (if (= m 0) (+ n 1) (if (= n 0) (recur-if-a-a-if-a-l2a-opa-l2aq-2 (- m 1) 1) (+ (- m 1) (recur-if-a-a-if-a-l2a-opa-l2aq-2 m))))) (test (recur-if-a-a-if-a-l2a-opa-l2aq-2 2 3) 'error) ;; -------- OP_RECUR_IF_A_A_AND_A_L2A_L2A -------- (define (tree-eq-1? a b) (if (not (pair? a)) (eq? a b) (and (pair? b) (tree-eq-1? (car a) (car b)) (tree-eq-1? (cdr a) (cdr b))))) (test (tree-eq-1? '(1 (b c 2) ((3))) '(1 (b c 2) ((3)))) #t) (test (tree-eq-1? '(1 (b c 2) ((3))) '(1 (b c 2) (3))) #f) (test (tree-eq-1? '(1 (b c) ((3))) '(1 (b c 2) ((3)))) #f) (test (tree-eq-1? '(1 (b c 2) ((3))) '(1 (b c 2) ((4)))) #f) (define (tree-eq-2? a b) (if (not (pair? a)) (call-with-exit (lambda (cc) (eq? a b))) (and (pair? b) (tree-eq-2? (car a) (car b)) (tree-eq-2? (cdr a) (cdr b))))) (test (tree-eq-2? '(1 (b c 2) ((3))) '(1 (b c 2) ((3)))) #t) (define (tree-eq-3? a b) (if (not (pair? a)) (eq? a b) (and (pair? b) (tree-eq-3? (car a)) (tree-eq-3? (cdr a) (cdr b))))) (test (tree-eq-3? '(1 (b c 2) ((3))) '(1 (b c 2) ((3)))) 'error) ;; -------- OP_RECUR_AND_A_OR_A_L2A_L2A -------- (define (tm1 sym tree) (and (pair? tree) (or (equal? (car tree) sym) (tm1 sym (car tree)) (tm1 sym (cdr tree))))) (test (tm1 1 '(2 4 (3 1) 2)) #t) (test (tm1 1 '(2 4 (3 5) 2)) #f) (test (tm1 '(+ x 2) '(abs (log (+ x 2)))) #t) (define (tm2 sym tree) (and (call-with-exit (lambda (return) (return (pair? tree)))) (or (equal? (car tree) sym) (tm2 sym (car tree)) (tm2 sym (cdr tree))))) (test (tm2 '(+ x 2) '(abs (log (+ x 2)))) #t) (define (tm3 sym tree) (and (pair? tree) (or (call-with-exit (lambda (return) (return (equal? (car tree) sym)))) (tm3 sym (car tree)) (tm3 sym (cdr tree))))) (test (tm3 '(+ x 2) '(abs (log (+ x 2)))) #t) (define (tm4 sym tree) (and (pair? tree) (or (equal? (car tree) sym) (tm4 sym (car tree)) (tm4 sym)))) (test (tm4 1 '(2 4 (3 1) 2)) 'error) ;; -------- OP_RECUR_COND_A_A_opA_LAq -------- (define (recur-cond-a-a-opa-laq-1 x) (cond ((= x 0) 0) (else (+ 1 (recur-cond-a-a-opa-laq-1 (- x 1)))))) (test (recur-cond-a-a-opa-laq-1 10) 10) (define (recur-cond-a-a-opa-laq-2 x) (cond ((= x 0) 0) (#t (+ 1 (recur-cond-a-a-opa-laq-2))))) (test (recur-cond-a-a-opa-laq-2 10) 'error) (define (recur-cond-a-a-opa-laq-3 x) (cond ((= x 0) 0) (else (+ 1 (recur-cond-a-a-opa-laq-3 (- x 1) 2))))) (test (recur-cond-a-a-opa-laq-3 10) 'error) (define (recur-cond-a-opa-laq-a-1 x) (cond ((not (= x 0)) (+ 1 (recur-cond-a-opa-laq-a-1 (- x 1)))) (else 0))) (test (recur-cond-a-a-opa-laq-1 10) 10) (define (recur-cond-a-opla-aq-a-1 x) (cond ((not (= x 0)) (+ (recur-cond-a-opla-aq-a-1 (- x 1)) 1)) (else 0))) (test (recur-cond-a-opla-aq-a-1 10) 10) ;; -------- OP_RECUR_COND_A_A_opA_L2Aq -------- (define (recur-cond-a-a-opa-l2aq-1 x y) (cond ((= x 0) y) (else (+ 1 (recur-cond-a-a-opa-l2aq-1 (- x 1) (+ y 1)))))) (test (recur-cond-a-a-opa-l2aq-1 10 0) 20) (test (recur-cond-a-a-opa-l2aq-1 10 10) 30) (define (recur-cond-a-a-opa-l2aq-2 x y) (cond ((= x 0) y) (else (+ 1 (recur-cond-a-a-opa-l2aq-2 (- x 1)))))) (test (recur-cond-a-a-opa-l2aq-2 10 0) 'error) (define (recur-cond-a-a-opa-l2aq-3 x y) (cond ((= x 0) y) (else (+ 1 (recur-cond-a-a-opa-l2aq-3))))) (test (recur-cond-a-a-opa-l2aq-3 10 0) 'error) (define (recur-cond-a-opa-l2aq-a-1 x y) (cond ((not (= x 0)) (+ 1 (recur-cond-a-opa-l2aq-a-1 (- x 1) (+ y 1)))) (else y))) (test (recur-cond-a-opa-l2aq-a-1 10 0) 20) (test (recur-cond-a-opa-l2aq-a-1 10 10) 30) (define (recur-cond-a-opl2a-aq-a-1 x y) (cond ((not (= x 0)) (+ (recur-cond-a-opl2a-aq-a-1 (- x 1) (+ y 1)) 1)) (else y))) (test (recur-cond-a-opl2a-aq-a-1 10 0) 20) (test (recur-cond-a-opl2a-aq-a-1 10 10) 30) ;; -------- OP_RECUR_COND_A_A_A_A_opL2A_L2Aq -------- (define (recur-cond-a-a-a-a-opl2a-l2aq-1 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-cond-a-a-a-a-opl2a-l2aq-1 (- x 1) (+ y 1)) (recur-cond-a-a-a-a-opl2a-l2aq-1 (- x 1) (+ y 1)))))) (test (recur-cond-a-a-a-a-opl2a-l2aq-1 10 0) 10240) (test (recur-cond-a-a-a-a-opl2a-l2aq-1 10 -1) 10) (define (recur-cond-a-a-a-a-opl2a-l2aq-2 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-cond-a-a-a-a-opl2a-l2aq-2 (- x 1) (+ y 1)) (recur-cond-a-a-a-a-opl2a-l2aq-2))))) (test (recur-cond-a-a-a-a-opl2a-l2aq-2 10 0) 'error) (define (recur-cond-a-a-a-a-opl2a-l2aq-3 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-cond-a-a-a-a-opl2a-l2aq-1) (recur-cond-a-a-a-a-opl2a-l2aq-3 (- x 1) (+ y 1)))))) (test (recur-cond-a-a-a-a-opl2a-l2aq-3 10 0) 'error) ;; -------- OP_RECUR_IF_A_A_IF_A_A_opL2A_L2Aq -------- (define (recur-if-a-a-if-a-a-opl2a-l2aq-1 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-if-a-a-if-a-a-opl2a-l2aq-1 (- x 1) (+ y 1)) (recur-if-a-a-if-a-a-opl2a-l2aq-1 (- x 1) (+ y 1)))))) (test (recur-if-a-a-if-a-a-opl2a-l2aq-1 10 0) 10240) (test (recur-if-a-a-if-a-a-opl2a-l2aq-1 10 -1) 10) (define (recur-if-a-a-if-a-a-opl2a-l2aq-2 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-if-a-a-if-a-a-opl2a-l2aq-2 (- x 1) (+ y 1)) (recur-if-a-a-if-a-a-opl2a-l2aq-2))))) (test (recur-if-a-a-if-a-a-opl2a-l2aq-2 10 0) 'error) (define (recur-if-a-a-if-a-a-opl2a-l2aq-3 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-if-a-a-if-a-a-opl2a-l2aq-1) (recur-if-a-a-if-a-a-opl2a-l2aq-3 (- x 1) (+ y 1)))))) (test (recur-if-a-a-if-a-a-opl2a-l2aq-3 10 0) 'error) (define (tree-count1 sym tree) (if (eq? sym tree) 1 (if (not (pair? tree)) 0 (+ (tree-count1 sym (car tree)) (tree-count1 sym (cdr tree)))))) (test (tree-count1 'a '((a b) c () ((b a)))) 2) ;; -------- OP_RECUR_IF_A_A_IF_A_A_opL3A_L3Aq -------- (define (recur-if-a-a-if-a-a-opl3a-l3aq-1 x y z) (if (= x 0) y (if (negative? y) x (+ (recur-if-a-a-if-a-a-opl3a-l3aq-1 (- x 1) (+ y 1) z) (recur-if-a-a-if-a-a-opl3a-l3aq-1 (- x 1) (+ y 1) z))))) (test (recur-if-a-a-if-a-a-opl3a-l3aq-1 10 0 1) 10240) (test (recur-if-a-a-if-a-a-opl3a-l3aq-1 10 -1 1) 10) (define (recur-cond-a-a-a-a-opl3a-l3aq-1 x y z) (cond ((= x 0) y) ((negative? y) x) (else (+ (recur-cond-a-a-a-a-opl3a-l3aq-1 (- x 1) (+ y 1) z) (recur-cond-a-a-a-a-opl3a-l3aq-1 (- x 1) (+ y 1) z))))) (test (recur-cond-a-a-a-a-opl3a-l3aq-1 10 0 1) 10240) (test (recur-cond-a-a-a-a-opl3a-l3aq-1 10 -1 1) 10) ;; -------- OP_RECUR_COND_A_A_A_A_opA_L2Aq-------- (define (recur-cond-a-a-a-a-opa-l2aq-1 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ 1 (recur-cond-a-a-a-a-opa-l2aq-1 (- x 1) (+ y 1)))))) (test (recur-cond-a-a-a-a-opa-l2aq-1 10 0) 20) (test (recur-cond-a-a-a-a-opa-l2aq-1 10 -10) 10) (define (recur-cond-a-a-a-a-opa-l2aq-2 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ 1 (recur-cond-a-a-a-a-opa-l2aq-2))))) (test (recur-cond-a-a-a-a-opa-l2aq-2 10 0) 'error) (define (recur-cond-a-a-a-a-opa-l2aq-3 x y) (cond ((= x 0) y) ((negative? y) x) (else (+ 1 (recur-cond-a-a-a-a-opa-l2aq-3 (- x 1) (+ y 1) 12))))) (test (recur-cond-a-a-a-a-opa-l2aq-3 10 0) 'error) ;; -------- OP_RECUR_COND_A_A_A_A_opLA_LAq -------- (define (recur-cond-a-a-a-a-opla-laq-1 x) (cond ((< x 2) x) ((< x 3) x) (else (+ (recur-cond-a-a-a-a-opla-laq-1 (- x 1)) (recur-cond-a-a-a-a-opla-laq-1 (- x 2)))))) (test (recur-cond-a-a-a-a-opla-laq-1 10) 89) (define (recur-cond-a-a-a-a-opla-laq-2 x) (cond ((< x 2) x) ((< x 3) x) (else (+ (recur-cond-a-a-a-a-opla-laq-2) (recur-cond-a-a-a-a-opla-laq-2 (- x 2)))))) (test (recur-cond-a-a-a-a-opla-laq-2 10) 'error) (define (recur-cond-a-a-a-a-opla-laq-3 x) (cond ((< x 2) x) ((< x 3) x) (else (+ (recur-cond-a-a-a-a-opla-laq-3 (- x 1)) (recur-cond-a-a-a-a-opla-laq-3))))) (test (recur-cond-a-a-a-a-opla-laq-3 10) 'error) (define (recur-cond-a-a-a-a-opla-laq-4 x) (cond ((< x 2) x) ((< x 3) x) (else (+ (recur-cond-a-a-a-a-opla-laq-4 (- x 1)) (recur-cond-a-a-a-a-opla-laq-4 (- x 2)))))) (define (ftc-6) (+ 10 (recur-cond-a-a-a-a-opla-laq-4 10))) ; fx case (test (ftc-6) 99) ;; -------- OP_RECUR_IF_A_A_IF_A_A_opLA_LAq -------- (define (recur-if-a-a-a-a-opla-laq-1 x) (if (< x 2) x (if (< x 3) x (+ (recur-if-a-a-a-a-opla-laq-1 (- x 1)) (recur-if-a-a-a-a-opla-laq-1 (- x 2)))))) (test (recur-if-a-a-a-a-opla-laq-1 10) 89) (define (recur-if-a-a-a-a-opla-laq-2 x) (if (< x 2) x (if (< x 3) x (+ (recur-cond-a-a-a-a-opla-laq-2) (recur-cond-a-a-a-a-opla-laq-2 (- x 2)))))) (test (recur-if-a-a-a-a-opla-laq-2 10) 'error) (define (recur-if-a-a-a-a-opla-laq-3 x) (if (< x 2) x (if (< x 3) x (+ (recur-cond-a-a-a-a-opla-laq-3 (- x 1)) (recur-cond-a-a-a-a-opla-laq-3))))) (test (recur-if-a-a-a-a-opla-laq-3 10) 'error) (define (recur-if-a-a-a-a-opla-laq-4 x) (if (< x 2) x (if (< x 3) x (+ (recur-cond-a-a-a-a-opla-laq-4 (- x 1)) (recur-cond-a-a-a-a-opla-laq-4 (- x 2)))))) (define (ftc-6) (+ 10 (recur-if-a-a-a-a-opla-laq-4 10))) ; fx case?? (test (ftc-6) 99) ;; -------- OP_RECUR_COND_A_A_A_L2A_LopA_L2Aq-------- (define (recur-cond-a-a-a-l2a-lopa-l2aq-1 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (recur-cond-a-a-a-l2a-lopa-l2aq-1 (- m 1) 1)) (else (recur-cond-a-a-a-l2a-lopa-l2aq-1 (- m 1) (recur-cond-a-a-a-l2a-lopa-l2aq-1 m (- n 1)))))) (test (recur-cond-a-a-a-l2a-lopa-l2aq-1 2 3) 9) (define (recur-cond-a-a-a-l2a-lopa-l2aq-1f m n) ; need non-integer case to hit "ptr" block (cond ((= m 0.0) (+ n 1.0)) ((= n 0.0) (recur-cond-a-a-a-l2a-lopa-l2aq-1f (- m 1.0) 1.0)) (else (recur-cond-a-a-a-l2a-lopa-l2aq-1f (- m 1) (recur-cond-a-a-a-l2a-lopa-l2aq-1f m (- n 1.0)))))) (test (recur-cond-a-a-a-l2a-lopa-l2aq-1f 2.0 3.0) 9.0) (define (recur-cond-a-a-a-l2a-lopa-l2aq-2 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (recur-cond-a-a-a-l2a-lopa-l2aq-2 (- m 1) 1)) (else (recur-cond-a-a-a-l2a-lopa-l2aq-2 (recur-cond-a-a-a-l2a-lopa-l2aq-2 m (- n 1)))))) (test (recur-cond-a-a-a-l2a-lopa-l2aq-2 2 3) 'error) (define (recur-cond-a-a-a-l2a-lopa-l2aq-3 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (recur-cond-a-a-a-l2a-lopa-l2aq-3 (- m 1))) (else (recur-cond-a-a-a-l2a-lopa-l2aq-3 (- m 1) (recur-cond-a-a-a-l2a-lopa-l2aq-2 m (- n 1)))))) (test (recur-cond-a-a-a-l2a-lopa-l2aq-3 2 3) 'error) (define (recur-cond-a-a-a-l2a-lopa-l2aq-4 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (recur-cond-a-a-a-l2a-lopa-l2aq-4 (- m 1) 1)) (else (recur-cond-a-a-a-l2a-lopa-l2aq-4 (- m 1) (recur-cond-a-a-a-l2a-lopa-l2aq-4 m (- n 1) 12))))) (test (recur-cond-a-a-a-l2a-lopa-l2aq-4 2 3) 'error) (define (recur-cond-a-a-a-l2a-lopa-l2aq-5 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (recur-cond-a-a-a-l2a-lopa-l2aq-5 (- m 1))) (else (recur-cond-a-a-a-l2a-lopa-l2aq-5 (- m 1) (recur-cond-a-a-a-l2a-lopa-l2aq-5 m))))) (test (recur-cond-a-a-a-l2a-lopa-l2aq-5 2 3) 'error) ;; -------- OP_RECUR_COND_A_A_A_L2A_opA_L2Aq-------- (define (recur-cond-a-a-a-l2a-opa-l2aq-1 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (recur-cond-a-a-a-l2a-opa-l2aq-1 (- m 1) 1)) (else (+ (- m 1) (recur-cond-a-a-a-l2a-opa-l2aq-1 m (- n 1)))))) (test (recur-cond-a-a-a-l2a-opa-l2aq-1 2 3) 5) (define (recur-cond-a-a-a-l2a-opa-l2aq-4 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (recur-cond-a-a-a-l2a-opa-l2aq-4 (- m 1) 1)) (else (+ (- m 1) (recur-cond-a-a-a-l2a-opa-l2aq-4 m (- n 1) 12))))) (test (recur-cond-a-a-a-l2a-opa-l2aq-4 2 3) 'error) (define (recur-cond-a-a-a-l2a-opa-l2aq-5 m n) (cond ((= m 0) (+ n 1)) ((= n 0) (recur-cond-a-a-a-l2a-opa-l2aq-5 (- m 1))) (else (+ (- m 1) (recur-cond-a-a-a-l2a-opa-l2aq-5 m))))) (test (recur-cond-a-a-a-l2a-opa-l2aq-5 2 3) 'error) ) (let ((len 10)) (define (cond-1 x size) (cond ((= x size) x) (else (+ 1 (cond-1 (+ x 1) size))))) (test (cond-1 0 len) (* 2 len)) ; oprec_if_a_a_opa_l2aq 19 (define (cond-2 x size) (cond ((< x size) (+ 1 (cond-2 (+ x 1) size))) (else x))) (test (cond-2 0 len) (* 2 len)) ; oprec_if_a_a_opa_l2aq 20 (define (cond-3 x size) (cond ((< x size) (+ (cond-3 (+ x 1) size) 1)) (else x))) (test (cond-3 0 len) (* 2 len)) ; eval+gc 40 -> 19 (define (cond-4 x size) (cond ((= x size) x) (else (+ (cond-4 (+ x 1) size) 1)))) (test (cond-4 0 len) (* 2 len)) ; eval+gc 40 -> 18 (define (cond-41 x size) (cond ((= x size) x) (#t (+ (cond-41 (+ x 1) size) 1)))) (test (cond-41 0 len) (* 2 len)) ; eval+gc 40 -> 18 (define (cond-42 size) (let loop ((x 0)) (if (= x size) x (+ (loop (+ x 1)) 1)))) (test (cond-42 len) (* 2 len)) ; oprec_i_if_a_a_opa_laq 7 (define (cond-43 len1) (let loop ((x 0) (size len1)) (if (= x size) x (+ (loop (+ x 1) size) 1)))) (test (cond-43 len) (* 2 len)) ; oprec_if_a_a_opa_l2aq 18 (define (if2-1 x size) (if (= x size) x (+ 1 (if2-1 (+ x 1) size)))) (test (if2-1 0 len) (* 2 len)) ; oprec_if_a_a_opa_l2aq 19 (define (if2-2 x size) (if (< x size) (+ 1 (if2-2 (+ x 1) size)) x)) (test (if2-2 0 len) (* 2 len)) ;oprec_if_a_a_opa_l2aq 20 (define (if2-3 x size) (if (< x size) (+ (if2-3 (+ x 1) size) 1) x)) (test (if2-3 0 len) (* 2 len)) ; eval+gc 40 -> 19 (define (if2-4 x size) (if (= x size) x (+ (if2-4 (+ x 1) size) 1))) (test (if2-4 0 len) (* 2 len)) ; eval+gc 40 -> 18 (define (if3-1 x y size) (if (= x size) y (+ 1 (if3-1 (+ x 1) (+ y 1) size)))) (test (if3-1 0 0 len) (* 2 len)) ; oprec_if_a_a_opa_l3aq 25 (define (if3-2 x y size) (if (< x size) (+ 1 (if3-2 (+ x 1) (+ y 1) size)) y)) (test (if3-2 0 0 len) (* 2 len)) ; oprec_if_a_a_opa_l3aq 26 [calls recur_resize 7 times = 128 * 1024 stack size] (define (if3-3 x y size) (if (< x size) (+ (if3-3 (+ x 1) (+ y 1) size) 1) y)) (test (if3-3 0 0 len) (* 2 len)) ; eval+gc 44 -> 25 (define (if3-4 x y size) (if (= x size) y (+ (if3-4 (+ x 1) (+ y 1) size) 1))) (test (if3-4 0 0 len) (* 2 len)) ; eval+gc 44 -> 24 (define (cond-5 x) (cond ((= x len) x) (else (+ 1 (cond-5 (+ x 1)))))) (test (cond-5 0) (* 2 len)) ; oprec_i_if_a_a_opa_laq 7 (define (cond-6 x) (cond ((< x len) (+ 1 (cond-5 (+ x 1)))) (else x))) (test (cond-6 0) (* 2 len)) ; oprec_i_if_a_a_opa_laq 7 (define (cond-7 x) (cond ((< x len) (+ (cond-7 (+ x 1)) 1)) (else x))) (test (cond-7 0) (* 2 len)) ; oprec_i_if_a_opa_laq_a 7 (define (cond-8 x) (cond ((= x len) x) (else (+ (cond-8 (+ x 1)) 1)))) (test (cond-8 0) (* 2 len)) ; oprec_i_if_a_a_opa_laq 7 (define (cond-9 x) (cond ((= x len) x) (else (+ 1 (cond-9 (+ x 1)) 2)))) (test (cond-9 0) (* 4 len)) ; eval 51 (define (cond-10 x) (cond ((= x len) x) (else (+ 1 (cond-10 (+ x 1))) 2))) (test (cond-10 0) 2) ; eval 48 (define (cond-11 x) (cond ((= x len) x) (else (+ (cond-11 (+ x 1)))))) (test (cond-11 0) len) ; eval 40 (define (cond-12 x) (cond ((= x len) x (* 2 x)) (else (+ 1 (cond-12 (+ x 1)))))) (test (cond-12 0) (* 3 len)) ; eval 42 (define (cond-13 x) (cond ((= x len) x (* 2 x)) (else (+ 1 1 (cond-13 (+ x 1)))))) (test (cond-13 0) (* 4 len)) ; eval 56 (define (cond-14 x) (cond ((= x len) x (* 2 x)) (else (+ 1 (cond-14 (+ x 1)))))) (test (cond-14 0) (* 3 len)) ; eval 42 (define (cond-15 x) (cond ((= x len) x (* 2 x)) (else (cond-15 (+ x 1))))) (test (cond-15 0) (* 2 len)) (define (add lst) (let loop ((p lst) (sum 0)) (if (null? p) sum (loop (cdr p) (+ sum (car p)))))) (define (more-add) (add '(1 2 3 4 5 6))) ; op_tc_if_a_z_l2a (test (more-add) 21) ) (let () (define (m . args) ; [346] -> 318 (safe_thunk) but tmisc up 10 6341 if op_safe_thunk_any -> 313 (fx_is_null_t) (if (null? args) 1 0)) ; fx_is_null_t if safe_thunk_any (define (dom) (do ((sum 0) ; op_dox_step_o (i 0 (+ i 1))) ; fx_add_t1 ((= i 10) sum) ; fx_num_eq_ti (set! sum (+ sum (m))))) ; op_safe_c_sp + op_safe_thunk_any (unless (= (dom) 10) (format *stderr* "dom: ~S~%" (dom))) (define (m1 . args) (unless (null? args) (display 'oops)) (set! args 1)) (define (dom1) (do ((sum 0) (i 0 (+ i 1))) ((= i 10) sum) (set! sum (+ sum (m1))))) (unless (= (dom1) 10) (format *stderr* "dom1: ~S~%" (dom1))) (define* (m2 . args) (if (null? args) 1 0)) (define (dom2) (do ((sum 0) (i 0 (+ i 1))) ((= i 10) sum) (set! sum (+ sum (m))))) (unless (= (dom2) 10) (format *stderr* "dom2: ~S~%" (dom2))) (define m3 (lambda args (if (null? args) 1 0))) (define (dom3) (do ((sum 0) ; op_dox_step_o (i 0 (+ i 1))) ; fx_add_t1 ((= i 10) sum) ; fx_num_eq_ti (set! sum (+ sum (m3))))) ; op_safe_c_sp + op_safe_thunk_any (unless (= (dom3) 10) (format *stderr* "dom3: ~S~%" (dom3)))) (when (provided? 'debugging) (report-missed-calls)) ;;; end optimizer stuff (let () ; check let_id bug (define (boolean|integer? x) (or (boolean? x) (integer? x))) (define (_vals5_ x y z) (values x y z)) (define (func) (_vals5_ 1 (make-vector 3 #f boolean|integer?) 3)) (func)) ;;; coverage tests for closure_3p (let () (define (byte siz pos) (list pos siz)) (define (dpb integer bytespec into) (list integer bytespec into)) (define (lpb x integer bytespec into) (let ((v (list-values 0 integer bytespec into))) (set! (v 0) x) v)) (define (mpb x y) (values x y)) (define (mpb1 x) (values x)) (define (g) (test (dpb 1 2 3) '(1 2 3)) (test (dpb 1 2 (byte 4 5)) '(1 2 (5 4))) (test (dpb 1 (byte 4 5) 3) '(1 (5 4) 3)) (test (dpb (byte 4 5) 2 3) '((5 4) 2 3)) (test (dpb 1 (byte 4 5) (byte 6 7)) '(1 (5 4) (7 6))) (test (dpb (byte 4 5) (byte 6 7) 3) '((5 4) (7 6) 3)) (test (dpb (byte 4 5) 2 (byte 6 7)) '((5 4) 2 (7 6))) (test (dpb (byte 4 5) (byte 6 7) (byte 8 9)) '((5 4) (7 6) (9 8))) (test (lpb -1 1 2 3) '(-1 1 2 3)) (test (lpb -1 1 2 (byte 4 5)) '(-1 1 2 (5 4))) (test (lpb -1 1 (byte 4 5) 3) '(-1 1 (5 4) 3)) (test (lpb -1 (byte 4 5) 2 3) '(-1 (5 4) 2 3)) (test (lpb -1 1 (byte 4 5) (byte 6 7)) '(-1 1 (5 4) (7 6))) (test (lpb -1 (byte 4 5) (byte 6 7) 3) '(-1 (5 4) (7 6) 3)) (test (lpb -1 (byte 4 5) 2 (byte 6 7)) '(-1 (5 4) 2 (7 6))) (test (lpb -1 (byte 4 5) (byte 6 7) (byte 8 9)) '(-1 (5 4) (7 6) (9 8))) (test (dpb (mpb 1 2) 3 4) 'error) (test (dpb 1 2 (mpb 1 2)) 'error) (test (dpb 1 (mpb 1 2) 3) 'error) (test (dpb (mpb1 1) 3 4) '(1 3 4)) (test (dpb 1 2 (mpb1 3)) '(1 2 3)) (test (dpb 1 (mpb1 2) 3) '(1 2 3))) (g)) (let () (define (byte-1 siz pos) (list siz pos)) (define (lpb-1 x integer byte-1spec into) (let ((v (list-values 0 integer byte-1spec into))) (set! (v 0) x) v)) (define (test-1) (test (lpb-1 0 1 2 (byte-1 3 4)) '(0 1 2 (3 4))) (test (lpb-1 0 1 (byte-1 2 3) 4) '(0 1 (2 3) 4)) (test (lpb-1 0 (byte-1 1 2) 3 4) '(0 (1 2) 3 4)) (test (lpb-1 (byte-1 0 1) 2 3 4) '((0 1) 2 3 4)) (test (lpb-1 (byte-1 0 1) (byte-1 2 3) (byte-1 4 5) (byte-1 6 7)) '((0 1) (2 3) (4 5) (6 7))) (test (lpb-1 1 (byte-1 2 3) (byte-1 4 5) (byte-1 6 7)) '(1 (2 3) (4 5) (6 7))) (test (lpb-1 (byte-1 0 1) 2 (byte-1 4 5) (byte-1 6 7)) '((0 1) 2 (4 5) (6 7))) (test (lpb-1 (byte-1 0 1) (byte-1 2 3) 4 (byte-1 6 7)) '((0 1) (2 3) 4 (6 7))) (test (lpb-1 (byte-1 0 1) (byte-1 2 3) (byte-1 4 5) 6) '((0 1) (2 3) (4 5) 6)) (test (lpb-1 1 (byte-1 2 3) (byte-1 4 5) (byte-1 6 7)) '(1 (2 3) (4 5) (6 7))) (test (lpb-1 1 2 (byte-1 4 5) (byte-1 6 7)) '(1 2 (4 5) (6 7))) (test (lpb-1 1 (byte-1 2 3) 4 (byte-1 6 7)) '(1 (2 3) 4 (6 7))) (test (lpb-1 1 (byte-1 2 3) (byte-1 4 5) 6) '(1 (2 3) (4 5) 6)) (test (lpb-1 (byte-1 0 1) 2 4 (byte-1 6 7)) '((0 1) 2 4 (6 7))) (test (lpb-1 (byte-1 0 1) 2 (byte-1 4 5) 6) '((0 1) 2 (4 5) 6)) (test (lpb-1 (byte-1 0 1) (byte-1 2 3) 4 6) '((0 1) (2 3) 4 6)))) ;;; -------------------------------------------------------------------------------- ;;; begin ;;; -------------------------------------------------------------------------------- (test (begin) ()) ; I think Guile returns # here (test (begin (begin)) ()) (test ((lambda () (begin))) ()) (test (let () (begin) #f) #f) (test (let () (begin (begin (begin (begin)))) #f) #f) (test (let () (begin (define x 2) (define y 1)) (+ x y)) 3) (test (let () (begin (define x 0)) (begin (set! x 5) (+ x 1))) 6) (test (let () (begin (define first car)) (first '(1 2))) 1) (test (let () (begin (define x 3)) (begin (set! x 4) (+ x x))) 8) (test (let () (begin (define x 0) (define y x) (set! x 3) y)) 0) ; the let's block confusing global defines (test (let () (begin (define x 0) (define y x) (begin (define x 3) y))) 0) (test (let () (begin (define y x) (define x 3) y)) 'error) ; guile says 3 (test (let ((x 12)) (begin (define y x) (define x 3) y)) 12) ; guile says 3 which is letrec-style? (test (begin (define (x) y) (define y 4) (x)) 4) ;; (let ((x 12)) (begin (define y x) y)) is 12 (test (let ((x 3)) (begin x)) 3) (test (begin 3) 3) (test (begin . (1 2)) 2) (test (begin . ()) (begin)) (test (begin . 1) 'error) (test (begin 1 . 2) 'error) (test (begin ("hi" 1)) #\i) (when (equal? (begin 1) 1) (test (let () (begin (define x 0)) (set! x (begin (begin 5))) (begin ((begin +) (begin x) (begin (begin 1))))) 6) (test (let ((x 5)) (begin (begin (begin) (begin (begin (begin) (define foo (lambda (y) (bar x y))) (begin))) (begin)) (begin) (begin) (begin (define bar (lambda (a b) (+ (* a b) a)))) (begin)) (begin) (begin (foo (+ x 3)))) 45) (for-each (lambda (arg) (test (begin arg) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (if (= 1 1) (begin 2) (begin 3)) 2)) (test ((lambda (x) (begin (set! x 1) (let ((a x)) (+ a 1)))) 2) 2) ;;; apparently these can be considered errors or not (guile says error, stklos and gauche do not) (test (begin (define x 0) (+ x 1)) 1) (test ((lambda () (begin (define x 0) (+ x 1)))) 1) (test (let ((f (lambda () (begin (define x 0) (+ x 1))))) (f)) 1) (test ((lambda () (begin (define x 0)) (+ x 1))) 1) (test (let ((f (lambda () (begin (define x 0)) (+ x 1)))) (f)) 1) (test (let ((x 32)) (begin (define x 3)) x) 3) (test ((lambda (x) (begin (define x 3)) x) 32) 3) (test (let* ((x 32) (y x)) (define x 3) y) 32) (test (let ((z 0)) (begin (define x 32)) (begin (define y x)) (set! z y) z) 32) (test (let((z 0))(begin(define x 32))(begin(define y x))(set! z y)z) 32) (test (let ((z 0)) (begin (define x 32) (define y x)) (set! z y) z) 32) (test (let () (begin (define b 1) (begin (define a b) (define b 3)) a)) 1) (test (let () (begin (begin (define a1 1) (begin (define a1 b1) (define b1 3))) a1)) 'error) (test (let () (begin (begin (define (a3) 1)) (begin (define (a3) b3) (define b3 3)) (a3))) 3) ; yow (test (let () (begin (begin (define (a) 1)) (a))) 1) (test (let ((a 1)) (begin (define a 2)) a) 2) (test (+ 1 (begin (values 2 3)) 4) 10) (test (+ 1 (begin (values 5 6) (values 2 3)) 4) 10) (test (let ((hi 0)) (begin (values (define (hi b) (+ b 1))) (hi 2))) 3) ;;; -------------------------------------------------------------------------------- ;;; apply ;;; -------------------------------------------------------------------------------- (test (apply (lambda (a b) (+ a b)) (list 3 4)) 7) (test (apply + 10 (list 3 4)) 17) (test (apply list ()) ()) (test (apply + '(1 2)) 3) (test (apply - '(1 2)) -1) (test (apply max 3 5 '(2 7 3)) 7) (test (apply cons '((+ 2 3) 4)) '((+ 2 3) . 4)) (test (apply + ()) 0) (test (apply + (list 3 4)) 7) (test (apply + ()) 0) (test (apply + 2 '(3)) 5) (test (apply + 2 3 ()) 5) (test (apply + '(2 3)) 5) (test (apply list 1 '(2 3)) (list 1 2 3)) (test (apply apply (list list 1 2 '(3))) (list 1 2 3)) (test (vector? (apply make-vector '(1))) #t) (test (apply make-vector '(1 1)) #(1)) (test (apply make-vector '((1) 1)) #(1)) (test (let ((f +)) (apply f '(1 2))) 3) (test (apply min '(1 2 3 5 4 0 9)) 0) (test (apply min 1 2 4 3 '(4 0 9)) 0) (test (apply vector 1 2 '(3)) #(1 2 3)) (test (apply vector ()) #()) (test (()) 'error) (test (#()) 'error) (test (#(1 2)) 'error) (test (apply #() ()) 'error) (test (apply #r() ()) 'error) (test (apply (byte-vector) ()) 'error) (test (apply #(1 2) ()) 'error) (test (apply (lambda (x . y) x) (list 1 2 3)) 1) (test (apply * (list 2 (apply + 1 2 '(3)))) 12) (test (apply (if (> 3 2) + -) '(3 2)) 5) (test (let ((x (list 1 2))) (eq? x (append () x))) #t) ;; ?? guile says #t also (test (apply (lambda* args args) 1 2 3 '(4 5 6 (7))) '(1 2 3 4 5 6 (7))) ; from lisp bboard (test (apply (list 1 2) '(0)) 1) (test (apply (cons 1 2) '(0)) 1) ; ! (apply (cons 1 2) '(1)) is an error (test (procedure? apply) #t) (test (string? (help apply)) #t) (let ((lst (list 'values '(procedure? sequence?) #t))) ; values rather than #t since (+ (apply values '(1 2))) -> 3 (set-cdr! (cddr lst) (cddr lst)) (test (equal? lst (signature apply)) #t)) (for-each (lambda (arg) (test (apply (lambda (x) x) (list arg)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (apply cadadr (list '''4)) 4) (test (apply string-ref "hi" '(0)) #\h) (test (let ((x (string-copy "hi"))) (apply string-set! x 0 '(#\c)) x) "ci") (test (apply apply (list + '(3 2))) 5) (test (apply apply apply apply (list (list (list + '(3 2))))) 5) (test (apply + 1 2 (list 3 4)) 10) (test ((apply cdr '((1 2) (3 4)) ()) 0) '(3 4)) (test ((apply car '((1 2) (3 4)) ()) 1) 2) (test ((apply cadr '((1 2) (3 4)) ()) 1) 4) (test (apply append ()) ()) (test (apply apply append ()) ()) (test (apply apply apply append '(())) ()) (test (apply apply + ()) 0) (test (apply apply * ()) 1) (test (apply apply not not () ()) #f) (test (apply apply apply eq? eq? eq? () () ()) #t) (test (apply apply apply list list list () () ()) (list list list)) (test (apply apply vector cons (list '1 '2) ()) (vector cons 1 2)) (test (let ((x '(((1 2)) ((3 4))))) (catch #t (lambda () (apply apply apply apply x)) (lambda args 'error)) x) '(((1 2)) ((3 4)))) (test (let ((x '((1 2) (3 4)))) (catch #t (lambda () (apply apply apply apply x)) (lambda args 'error)) x) '((1 2) (3 4))) (test (let ((x '((1 2) 3 4))) (catch #t (lambda () (apply apply apply x)) (lambda args 'error)) x) '((1 2) 3 4)) (test (let ((x '((1 2) (3 4)))) (catch #t (lambda () (apply apply apply not x)) (lambda args 'error)) x) '((1 2) (3 4))) (test (eq? (apply apply apply values '(())) #) #t) (test (eqv? (apply apply apply values '(())) #) #t) (test (equal? (apply apply apply values '(())) #) #t) (test (apply apply apply + '(((1)))) 1) (test (apply apply map + '(((1)))) '(1)) (test (apply apply map quote '(((1)))) '(1)) (test (apply apply map values '(((1)) ((2)))) '((1) 2)) (test (apply apply map append '(((1)) ((2)))) '((1 . 2))) (test (apply apply apply quote '(((1)))) 1) (test (apply map cdr '(((1 2) (3 4)))) '((2) (4))) (test (apply apply + '((1 2))) 3) (test (apply apply cons '(((1 2) (3 4)))) '((1 2) 3 4)) (test (apply apply append '(((1 2) (3 4)))) '(1 2 3 4)) (test (apply map + '((1 2) (3 4))) '(4 6)) (test (apply map reverse '(((1 2) (3 4)))) '((2 1) (4 3))) (test (apply apply map cons '(((1 2) (3 4)))) '((1 . 3) (2 . 4))) (test (apply apply map list-tail '(((1 2) (3 4))) '(((1)))) '(((3 4)))) (test (apply apply map reverse '((1 2) (3 4)) '(())) '((2 1) (4 3))) (test (apply apply map values '(((1)) ((2))) '(((1 2) (3 4)))) '(((1)) 1 3 ((2)) 2 4)) (test (apply apply map append '(((1 2) (3 4))) '(((1)) ((2)))) '(((1 2) (3 4) 1 . 2))) (test (apply apply map append '(()) '(((1)) ((2)))) '((1 . 2))) (test (apply apply map cdr '(((1 2) (3 4))) ()) '((2) (4))) (test (apply apply apply list-tail '((1 2) (3 4)) '(((1)))) '((3 4))) (test (apply apply apply reverse '(((1 2) (3 4))) '(())) '((3 4) (1 2))) (test (apply apply apply values '(1) '(())) 1) (test (apply apply apply values '(1) '((()))) '(1)) (test (apply apply apply values '((1)) ()) 1) (test (apply apply apply values '((1)) '(())) '(1)) (test (apply apply reverse '(((1 2) (3 4))) ()) '((3 4) (1 2))) (test (apply apply append () '(((1 2) (3 4)))) '(1 2 3 4)) (test (apply apply length '(()) ()) 0) (test (apply apply let () '((1))) 1) (test (apply apply apply apply + '((()))) 0) (test (apply apply apply map reverse '((1 2) (3 4)) '((()))) '((2 1) (4 3))) (test (apply apply apply map values '(((1 2) (3 4))) ()) '(1 3 2 4)) (test (apply apply apply apply + '(1) '((()))) 1) (test (apply apply apply append (reverse '(((1)) ((2))))) '((2) . 1)) (test (apply apply map append (reverse '(((1)) ((2))))) '((2 . 1))) (test (apply quote (map reverse (reverse '((1 2))))) '(2 1)) (test (map quote (apply map + '((1 2) (3 4)))) '(4 6)) (test (map car (apply map quote '(((1 2) (3 4))))) '(1 3)) (test (apply length (apply map append '(((1)) ((2))) '((1)))) -1) (test (apply append (apply map list-tail '(((1 2) (3 4))) '((1)))) '((3 4))) (test (apply append (apply map values '(((1)) ((2))) '(((1 2) (3 4))))) '((1) 1 2 (2) 3 4)) (test (apply append (apply map values '((1 2) (3 4)) '(((1 2) (3 4))))) '(1 2 1 2 3 4 3 4)) (test (apply append '((1) () (2 3 4) (5 6) ())) '(1 2 3 4 5 6)) (test (apply append '((1) () (2 3 4) (5 6) 7)) '(1 2 3 4 5 6 . 7)) (test (apply +) 0) (test (apply + #f) 'error) (test (apply #f '(2 3)) 'error) (test (apply make-vector '(1 2 3)) 'error) (test (apply + 1) 'error) (test (apply) 'error) (test (apply 1) 'error) (test (apply . 1) 'error) (test (apply car ''foo) 'error) (test (apply + '(1 . 2)) 'error) (test (apply + '(1 2 . 3)) 'error) (test (apply () ()) 'error) (test (apply list '(1 . 2) ()) '((1 . 2))) (test (apply (lambda (x) x) _ht_ _undef_ _null_ _c_obj_) 'error) (test (apply + #(1 2 3)) 'error) (test (apply (lambda (a b) (+ a b)) '(1 . 2)) 'error) (test (apply (lambda args (apply + args)) 1 2 3) 'error) (test (apply (lambda args (apply + args)) 1 2 #f) 'error) (test (apply (lambda args (apply list args)) 1 2 #f) 'error) (test (apply (lambda args (apply + args)) 1 2 ()) 3) (test (apply (lambda args (apply list args)) 1 2 ()) '(1 2)) (test (apply (lambda args (apply list args)) 1 '(2)) '(1 2)) (test (apply (lambda args (apply list args)) 1 '2) 'error) (test (apply (lambda args (apply list args)) 1 'abs) 'error) (test (apply (lambda args (apply list args)) 1 ''2) '(1 #_quote 2)) (test (apply (lambda args (apply list args)) () ()) '(())) (test (apply (lambda args (apply list args)) () (cons 1 2)) 'error) (test (apply (lambda args (apply list args)) (cons 1 2)) 'error) (test (apply (apply lambda (signature +) '('x)) #i(1)) 'error) (test (let () (define (f x) (apply x ((if (> 3 2) list vector) 3 2))) (f +)) 5) ; optimizer bug (test (let () (define (f x) (apply x ((if (> 3 2) + -) 3 2))) (f abs)) 'error) (test (apply "hi" '(1 2)) 'error) (test ("hi" 1 2) 'error) (test (apply '(1 2) '(1 2)) 'error) (test ((list 1 2 3) 1 2) 'error) (test (apply "hi" '(1)) #\i) (test ("hi" 1) #\i) (test (apply '(1 2) '(1)) 2) (test ((list 1 2 3) 1) 2) (for-each (lambda (arg) (test (apply arg '(1)) 'error) (test (apply abs arg) 'error)) (list -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t)) (test (apply "hi" '(1)) #\i) (test (apply '(1 2 3) '(1)) 2) (test (apply #(1 2 3) '(2)) 3) (test (apply #2d((1 2) (3 4)) 0 0 ()) 1) (test (apply '((1 2) (3 4)) 1 0 ()) 3) (test (let ((ht (make-hash-table))) (set! (ht "hi") 32) (apply ht '("hi"))) 32) (test (let ((x (list 1 2))) (set-cdr! x x) (apply + x)) 'error) (test (apply + '(1 2 . 3)) 'error) (test (apply + '(1 2) (list 3 4)) 'error) (test (let () (define (mrec a b) (if (<= b 0) (list a) (apply mrec (list a) (list (- b 1))))) (mrec (list 1 2) 5)) '(((((((1 2)))))))) (test (apply (inlet) '(define y 32)) 32) (test (let () (define (rfunc) '(define y 32)) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (apply (inlet) (rfunc))))) (func)) 32) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (apply + lst) 'error)) (test (let ((lst '(1 2 3))) (let ((lst1 (apply list lst))) (set! (car lst1) 21) lst)) '(1 2 3)) (test (let ((lst '(1 2))) (let ((lst1 (apply cons lst))) (set! (car lst1) 21) lst)) '(1 2)) (test (let* ((x '(1 2 3)) (y (apply list x))) (eq? x y)) #f) ; this was #t until 26-Sep-11 (test (apply values (values (cons 1 ()))) 1) (test (+ (apply values (values (list 1 2)))) 3) (test (port-filename) (apply port-filename (list))) (num-test (apply atan (#(1 #\a (3)) (max (values 1 2)))) 1.2490457723983) (test (apply #2d((1 2) (3 4)) (list (floor (acosh 1)))) #(1 2)) (test ((apply values (list + 1 2)) 3) 6) (if with-complex (num-test (* 0-2i (acosh (asin 0.0))) pi)) (test (apply truncate (lognot (min 1)) (list)) -2) (num-test (apply /(list 11 11)) 1) (test (apply dynamic-wind (list (lambda () #f) (lambda () 1) (lambda () #f))) 1) (test (apply call-with-exit (list (lambda (exit) 1))) 1) (test (apply call-with-exit (list (lambda (exit) (exit 1) 32))) 1) (test (apply catch (list #t (lambda () 1) (lambda args 'error))) 1) (test (apply eval '((+ 1 2))) 3) (test (apply eval ()) 'error) ; (eval) is an error -- should it be? (eval ()) is () so perhaps (following values), (eval) -> #? (test (apply eval '(())) ()) (test (apply eval-string '("(+ 1 2)")) 3) (test (let () (apply begin '((define x 1) (define y x) (+ x y)))) 2) (test (apply begin ()) (begin)) (test (apply if '(#f 1 2)) 2) (test (apply if '(#f)) 'error) (test (let ((x 1)) (apply set! '(x 3)) x) 3) (test (let ((x 3)) (apply set! (list (values 'x 32))) x) 32) (test (let ((x 1)) (apply cond '(((= x 2) 3) ((= x 1) 32)))) 32) (test (apply and '((= 1 1) (> 2 3))) #f) (test (apply and ()) (and)) (test (apply or '((= 1 1) (> 2 3))) #t) (test (apply or ()) (or)) (test (let () (apply define '(x 32)) x) 32) (test (let () (apply define* '((hi (a 1) (b 2)) (+ a b))) (hi 32)) 34) (test ((apply lambda '((n) (+ n 1))) 2) 3) (test ((apply lambda* '(((n 1)) (+ n 1)))) 2) (test (apply let '(((x 1)) (+ x 2))) 3) (test (apply let* '(((x 1) (y (* 2 x))) (+ x y))) 3) (test (equal? (apply let* '((a 2) (b (+ a 3))) '(list + a b) ()) (list + 2 5)) #t) (test (apply let 'func '((i 1) (j 2)) '((+ i j (if (> i 0) (func (- i 1) j) 0)))) 5) (test (let () (apply define-macro `((hiho a) `(+ ,a 1))) (hiho 2)) 3) (test (let () (apply define-macro* `((hiho (a 2)) `(+ ,a 1))) (hiho)) 3) (test (apply do '(((i 0 (+ i 1))) ((= i 3) i))) 3) (test (apply case '(1 ((2 3) 4) ((1 5) 32))) 32) (test (+ (apply values '(1 2 3))) 6) (test (apply quote '(1)) 1) (test (apply quote ()) 'error) ; (quote) is an error (test (let () (apply letrec '(() (define x 9) x))) 9) (test ((lambda (n) (apply n '(((x 1)) (+ x 2)))) let) 3) (test ((apply lambda (list (apply let (list (list) (quote (list (apply case '(0 ((0 1) 'n))))))) (quasiquote (+ n 1)))) 2) 3) (test (apply let '((x 1)) '((+ x 1))) 2) (test ((apply dilambda (list (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) 23) 24) (test (apply (apply dilambda (list (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) '(23)) 24) (test (apply map list '((1 one) (2 two) (3 three))) '((1 2 3) (one two three))) ; from scheme bboard ;;; so (define (unzip l) (apply values (apply map list l))) (test (apply 'begin) 'error) (test (apply and) #t) (test (apply begin) ()) (test (apply if '((> 1 2) 3 4)) 4) (test (apply or) #f) (test (apply quote '(1)) 1) (let () (define (min-max arg . args) (if (null? args) (apply max arg) (min (apply max arg) (apply min-max args)))) (test (min-max '(1 2 3) '(0 -1 4)) 3) (test (min-max '(1 2 3) '(0 -1 4) '(1 2)) 2)) (let () ; apply_sa picks up fop6 outlet where x and i are not defined while evaluating (vector i x)?!? (define (fop6 x y) (apply x (cons y ()))) (define (func) (let ((x #f) (i 0)) (fop6 begin ((let () quasiquote) (vector i x))))) (test (func) 'error)) ;;; -------------------------------------------------------------------------------- ;;; define ;;; -------------------------------------------------------------------------------- ;;; trying to avoid top-level definitions here (let () (define x 2) (test (+ x 1) 3) (set! x 4) (test (+ x 1) 5) (let () (define (tprint x) #t) (test (tprint 56) #t) (let () (define first car) (test (first '(1 2)) 1) (let () (define foo (lambda () (define x 5) x)) (test (foo) 5) (let () (define (foo x) ((lambda () (define x 5) x)) x) (test (foo 88) 88)))))) (test (letrec ((foo (lambda (arg) (or arg (and (procedure? foo) (foo 99)))))) (define bar (foo #f)) (foo #f)) 99) (test (letrec ((foo 77) (bar #f) (retfoo (lambda () foo))) (define baz (retfoo)) (retfoo)) 77) (test (let () (define .. 1) ..) 1) (test (let () (define (hi a) (+ a 1)) (hi 2)) 3) (test (let () (define (hi a . b) (+ a (cadr b) 1)) (hi 2 3 4)) 7) (test (let () (define (hi) 1) (hi)) 1) (test (let () (define (hi . a) (apply + a)) (hi 1 2 3)) 6) (for-each (lambda (arg) (test (let () (define x arg) x) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test ((lambda (x) (define (hi a) (+ a 1)) (hi x)) 1) 2) (test (let ((x 2)) (define f (lambda (y) (+ y x))) (f 3)) 5) (begin (define r5rstest-plus (lambda (x y) (+ x y))) (define r5rstest-x 32)) (test (r5rstest-plus r5rstest-x 3) 35) (test (let ((x 2.0)) (define (hi a) (set! a 3.0)) (hi x) x) 2.0) (test (let () (define (asdf a) (define (asdf a) (+ a 1)) (+ a (asdf a))) (asdf 4)) 9) (test (let ((asdf 1)) (define (asdf a) (define (asdf a) (+ a 1)) (+ a (asdf a))) (asdf 4)) 9) (test (let () (define (a1 a) (define (a2 a) (define (a3 a) (define (a4 a) (+ a 1)) (+ (a4 a) 1)) (+ (a3 a) 1)) (+ (a2 a) 1)) (a1 0)) 4) (test (let () (define (hi1 a) (define (hi1 b) (+ b 1)) (hi1 a)) (hi1 1)) 2) (test (let () (define (hi1 a) (begin (define (hi1 b) (+ b 1))) (hi1 a)) (hi1 1)) 2) (test (let ((j 0) (k 0)) (define (hi1 a) (let ((hi1 (lambda (b) (set! k (+ k 1)) (hi1 (- b 1))))) (if (<= a 0) (list j k) (begin (set! j (+ j 1)) (hi1 (- a 1)))))) (hi1 3)) '(2 2)) (test (procedure? (let () (define (a) a) (a))) #t) (let ((oddp (lambda (a) (not (even? a))))) (define (hi a) (and (a 123) (a 321))) (test (hi oddp) #t)) (test (define) 'error) (test (define*) 'error) (test (define x) 'error) (test (define . x) 'error) (test (define x 1 2) 'error) (let-temporarily (((*s7* 'print-length) 1)) (test (define x 1 (make-list 10 #)) 'error)) ; try to force truncate_string call (test (define x x) 'error) (test (define x x x) 'error) (test (define x x . x) 'error) (test (let ((x 0)) (define x (x . x))) 'error) (test (define (x x) . x) 'error) (test (eval-string "(define (x .) 1)") 'error) ; need eval-string else a read error that halts our tests (test (eval-string "(define (x) (+ 1 .))") 'error) (test (define (x x) x . x) 'error) (test (let () (define (x x) x) ; sym_id case in define2_ex, let above is id=19, x is id=20 -- new_env (funclet) arg=x id=20 (x 0)) 0) (test (define (x 1)) 'error) (test (define (x)) 'error) (test (define 1 2) 'error) (test (define "hi" 2) 'error) (test (define :hi 2) 'error) (test (define x 1 2) 'error) (test (define x 1 . 2) 'error) (test (define x . 1) 'error) (test (define x (lambda ())) 'error) (test (define # 3) 'error) (test (define (#) 4) 'error) (test (define (:hi a) a) 'error) (test (define (hi: a) a) 'error) (test (define (#b1 a) a) 'error) (test (define (hi #b1) #b1) 'error) (test (define () 1) 'error) (test (let() (define #(hi a) a)) 'error) (test (let () (define hi (lambda args args)) (hi 1 . 2)) 'error) (test (let () (define . 1) 1) 'error) (test (let () (define func (do () (#t (lambda (y) 2)))) (func 1)) 2) (test (let () (define* x 3)) 'error) (test (let () (define (hi) 1 . 2)) 'error) (test (let () (define (hi) (1) . "hi")) 'error) (test (let () (define _definee_ (values))) #) (test (let () (define _definee_ (values 1))) 1) (test (let () (define _definee_ (values 1 2))) 'error) (test ((lambda () (define _definee_ (values 1 2)))) 'error) (test (let () (define (f . f) f) (f 1 2)) '(1 2)) ;(test (let () (define (f f) (define* (f1 (f f)) f) (f1)) (f 0)) 0) ;(test (let () (define (f1 f) (define* (f (f f)) f) (f)) (procedure? (f1 0))) #f) ; either way is fine... ;(test (let () (define (f f) (define* (f (f f)) f) (f)) (procedure? (f 0))) #f) (test (let ((f1 (define f2 32))) (+ f1 f2)) 64) (test (let () (define x (+ (define y 3) 2)) (list x y)) '(5 3)) (test (let ((a 1) (b 2)) (define (f a b) (let ((a a) (b b)) (+ a b))) (f 4 3)) 7) (test (let () (define (f x . y) (if (> x 0) (f (- x 1) y) y)) (f 4 1)) '(((((1)))))) (let () (define x (begin (define y 1) (+ y 1))) (test (+ x y) 3)) (let () (test ((define (fact x) (if (< x 2) 1 (* x (fact (- x 1))))) 3) 6)) (test (map (let () (define (fact x) (if (< x 2) 1 (* x (fact (- x 1)))))) '(3 5)) '(6 120)) ;;; -------- ;;; check envs (test (let () (do ((i 0 (+ i 1))) ((= i 3) (define xyz 37) i)) xyz) 'error) (test (let () (do ((i 0 (+ i 1))) ((= i 3)) (define xyz 37)) xyz) 'error) (test (let () (do ((i (begin (define xyz 37) 0) (+ i 1))) ((= i 3))) xyz) 37) (test (let () (do ((i 0 (begin (define xyz 37) (+ i 1)))) ((= i 3))) xyz) 'error) (test (let () (let ((i (begin (define xyz 37) 0))) i) xyz) 37) (test (let () (let ((i 0)) (define xyz 37) i) xyz) 'error) (test (let () (let* ((i (begin (define xyz 37) 0))) i) xyz) 37) (test (let () (let* ((i 0)) (define xyz 37) i) xyz) 'error) (test (let () (let* ((k 0) (i (begin (define xyz 37) 0))) i) xyz) 'error) (test (let () (letrec ((i (begin (define xyz 37) 0))) i) xyz) 'error) (test (let () (letrec ((i (begin (define xyz 37) 0))) xyz)) 37) (test (let () (letrec ((i 0)) (define xyz 37) i) xyz) 'error) (test (let () (letrec* ((i (begin (define xyz 37) 0))) i) xyz) 'error) (test (let () (letrec* ((i (begin (define xyz 37) 0))) xyz)) 37) (test (let () (letrec* ((i 0)) (define xyz 37) i) xyz) 'error) (test (let () (letrec* ((k 0) (i (begin (define xyz 37) 0))) i) xyz) 'error) (test (let () (cond ((define xyz 37) #f)) xyz) 37) (test (let () (cond ((> 2 1) (define xyz 37) #f)) xyz) 37) (test (let () (cond ((< 2 1) 0) (else (define xyz 37) #f)) xyz) 37) (test (let () (if (define xyz 37) 0 1) xyz) 37) (test (let () (if (> 2 1) (define xyz 37) 1) xyz) 37) (test (let () (if (< 2 1) 0 (define xyz 37)) xyz) 37) (test (let () (when (define xyz 37) #f) xyz) 37) (test (let () (when (> 2 1) (define xyz 37) #f) xyz) 37) (test (let () (unless (define xyz 37) #f) xyz) 37) (test (let () (unless (< 2 1) (define xyz 37) #f) xyz) 37) (test (let () (quote (define xyz 37)) xyz) 'error) (test (let () (begin (define xyz 37) 0) xyz) 37) (test (let () (and (define xyz 37) 0) xyz) 37) (test (let () (or (define xyz 37) 0) xyz) 37) (test (let ((x 0)) (set! x (define xyz 37)) xyz) 37) (test (let () (with-let (curlet) (define xyz 37)) xyz) 37) (test (let () (with-let (inlet 'a 1) (define xyz 37)) xyz) 'error) (test (let () (with-baffle (define xyz 37) 2) xyz) 'error) ; with-baffle introduces a new frame (test (let () (case (define xyz 37) ((0) 1) ((37) #t)) xyz) 37) (test (let () (case 1 ((1) (define xyz 37)) ((0) 1)) xyz) 37) (test (let () (case 1 ((0) 1) (else (define xyz 37) 2)) xyz) 37) (test (let () (lambda () (define xyz 37)) xyz) 'error) (test (let () (define* (fxyz (a (define xyz 37))) a) (fxyz) xyz) 'error) ; ??? it's defined in fxyz! (test (let () (define* (fxyz (a (define xyz 37))) xyz) (fxyz)) 37) ; ! ;;; -------- (test (let () (define (f1 f1) (f1 1)) (f1 (lambda (x) (+ x 2)))) 3) (test (let () (define (f2 x f2) (if (= x 0) x (f2 (- x 1) f2))) (f2 2 (lambda (x f) x))) 1) (let () ; tc optimizer bug (define (f2 x f2) (if (= x 0) x (f2 (- x 1) x))) (test (f2 2 (lambda (x f) (+ x 12))) 13) (define (f3 f3) (if (integer? f3) f3 (f3 32))) (test (f3 (lambda (x) (+ x 12))) 44) (define (f4 x f4) (if (= x 0) 10 (if (= x 1) 11 (f4 (- x 1) x)))) (test (f4 2 (lambda (x f) (+ x 12))) 13)) (let () (define a#b 3) (define a'b 4) (define a,b 5) (define a[b 6) (define a@b 7) (define a\b 8) (define a|b 9) (test (+ a#b a'b a,b a[b a@b a\b a|b) 42)) (let () (define (make-func) (define (a-func a) (+ a 1))) (test (procedure? (make-func)) #t)) (let () (test (if (and (define x 3) (define y 4)) (+ x y)) 7)) (let () (test (if (not (and (define x 2) (define y 4))) (+ x y) (if (define x 3) x)) 3)) (let () (test (if (and (define x 2) (not (define y 4))) (+ x y) (- x y)) -2)) (test (let () (define (f a) (lambda () a)) (+ ((f 1)) ((f 2)))) 3) (test (let () (define (hi) (let ((a 1)) (set! a 2) (define (ho) a) (set! a 3) (ho))) (hi)) 3) ;;; (define-macro (make-lambda args . body) `(apply lambda* ',args '(,@body))): (make-lambda (a b) (+ a b)) (test (length (let ((a 3)) (define a 4) (curlet))) 1) (test (length (let ((a 3)) (define (a) 4) (curlet))) 1) (test (length (let ((a 3)) (define (a) 4) (define (a) 5) (curlet))) 1) (let ((x1 32)) (set! x1 (define x2 12)) (test x1 12) (test x2 12)) ;; y combinator example from some CS website (let () (define Y (lambda (X) ((lambda (procedure) (X (lambda (arg) ((procedure procedure) arg)))) (lambda (procedure) (X (lambda (arg) ((procedure procedure) arg))))))) (define M (lambda (func-arg) (lambda (l) (if (null? l) 'no-list (if (null? (cdr l)) (car l) (max (car l) (func-arg (cdr l)))))))) (test ((Y M) '(4 5 6 3 4 8 6 2)) 8)) (test (((lambda (X) ((lambda (procedure) (X (lambda (arg) ((procedure procedure) arg)))) (lambda (procedure) (X (lambda (arg) ((procedure procedure) arg)))))) (lambda (func-arg) (lambda (n) (if (zero? n) 1 (* n (func-arg (- n 1))))))) 5) 120) ;;; from a paper by Mayer Goldberg (let () (define curry-fps (lambda fs (let ((xs (map (lambda (fi) (lambda xs (apply fi (map (lambda (xi) (lambda args (apply (apply xi xs) args))) xs)))) fs))) (map (lambda (xi) (apply xi xs)) xs)))) (define E (lambda (even? odd?) (lambda (n) (if (zero? n) #t ; return Boolean True (odd? (- n 1)))))) (define O (lambda (even? odd?) (lambda (n) (if (zero? n) #f ; return Boolean False (even? (- n 1)))))) (define list-even?-odd? (curry-fps E O)) (define new-even? (car list-even?-odd?)) (define new-odd? (cadr list-even?-odd?)) (test (new-even? 6) #t) (test (new-odd? 6) #f)) (let () (define (Cholesky:decomp P) ;; from Marco Maggi based on a Scheme bboard post ;; (Cholesky:decomp '((2 -2) (-2 5))) -> ((1.4142135623731 0) (-1.4142135623731 1.7320508075689)) (define (Cholesky:make-square L) (define (zero-vector n) (if (zero? n) () (cons 0 (zero-vector (- n 1))))) (map (lambda (v) (append v (zero-vector (- (length L) (length v))))) L)) (define (Cholesky:add-element P L i j) (define (Cholesky:smaller P) (if (null? (cdr P)) () (reverse (cdr (reverse P))))) (define (Cholesky:last-row L) (car (reverse L))) (define (matrix:element A i j) (list-ref (list-ref A i) j)) (define (Cholesky:make-element P L i j) (define (Cholesky:partial-sum L i j) (let loop ((k j)) (case k ((0) 0) ((1) (* (matrix:element L i 0) (matrix:element L j 0))) (else (+ (* (matrix:element L i k) (matrix:element L j k)) (loop (- k 1))))))) (let ((x (- (matrix:element P i j) (Cholesky:partial-sum L i j)))) (if (= i j) (sqrt x) (/ x (matrix:element L j j))))) (if (zero? j) (append L `((,(Cholesky:make-element P L i j)))) (append (Cholesky:smaller L) (list (append (Cholesky:last-row L) (list (Cholesky:make-element P L i j))))))) (Cholesky:make-square (let iter ((i 0) (j 0) (L ())) (if (>= i (length P)) L (iter (if (= i j) (+ 1 i) i) (if (= i j) 0 (+ 1 j)) (Cholesky:add-element P L i j)))))) (let* ((lst (Cholesky:decomp '((2 -2) (-2 5)))) (lst0 (car lst)) (lst1 (cadr lst))) (if (or (> (abs (- (car lst0) (sqrt 2))) .0001) (not (= (cadr lst0) 0)) (> (abs (+ (car lst1) (sqrt 2))) .0001) (> (abs (- (cadr lst1) (sqrt 3))) .0001)) (format #t ";cholesky decomp: ~A~%" lst)))) (let ((vals #(1 0 -2 0 1 0 1 -1 -10 -30 -67 -138 -291 -642 -1446 -3250 -7244 -16065 -35601 -78985 -175416 -389695 -865609 -1922362 -4268854 -9479595 -21051458 -46750171 -103821058 -230560902 -512016658))) ;; from Programming Praxis -- this is Donald Knuth's Algol compiler test, stack size becomes enormous... (define (A k x1 x2 x3 x4 x5) (define (B) (set! k (- k 1)) (A k B x1 x2 x3 x4)) (if (<= k 0) (+ (x4) (x5)) (B))) (test (A 10 (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0)) (vals 10)) (when full-s7test (define (test-A lim) (do ((i 0 (+ i 1))) ((= i (min lim 24))) (let ((val (A i (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0)))) (unless (= val (vals i)) (format *stderr* "test-A ~D: ~D (should be ~D)~%" i val (vals i)))))) (test-A 20)) ; for lim=24, s7 .33 Guile .34 but the timings are variable based on system allocation times (define (A k x1 x2 x3 x4 x5 x6) (define (B) (set! k (- k 1)) (A k B x1 x2 x3 x4 x5)) (if (<= k 0) (+ (x4) (x5) (x6)) (B))) (test (A 10 (lambda () 1) (lambda () -1) (lambda () -1) (lambda () 1) (lambda () 0) (lambda () 0)) -109) (define (A k x1 x2 x3 x4 x5 x6) (define (B) (set! k (- k 1)) (A k B x1 x2 x3 x4 x5)) (if (<= k 0) (+ (x4) (x5) (x6)) (B))) (test (A 10 (lambda () (define x1 1) x1) (lambda () (define (x1) -1) (x1)) (lambda () (define x1 #(-1)) (x1 0)) (lambda () (define* (x1 (x2 1)) x2) (x1)) (lambda () (define x1 (list 0)) (x1 0)) (lambda () 0)) -109) ;; Jensen's test (from Rosetta CL code) (define (%sum lo hi func) (let ((sum 0.0)) (do ((i lo (+ i 1))) ((> i hi) sum) (set! sum (+ sum (func i)))))) (define-macro (sum i lo hi term) `(%sum ,lo ,hi (lambda (,i) ,term))) (num-test (sum x 1 100 (/ 1.0 x)) 5.187377517639621)) (let () (define* (a1 (b (let () (define* (a1 (b 32)) b) (a1)))) b) (test (a1) 32) (test (a1 1) 1)) (test (let ((f1 (lambda (x) (+ x 1)))) (define f1 (lambda (y) (if (zero? y) y (f1 (- y 1))))) (f1 3)) 0) (test (let ((x 1)) (cond (else (define x 2))) x) 2) (test (let ((x 1)) (and (define x 2)) x) 2) (test (let () (begin 1)) 1) (test (let () (begin (define x 1) x)) 1) (test (let () (let ((lst (define abc 1))) #f) abc) 1) ; ?? (test (let () (let ((lst (define abc 1))) abc)) 1) ; abcd is in the outer let (test (let () (letrec ((lst (define abcd 1))) #f) abcd) 'error) ; abcd: unbound variable (test (let () (letrec ((lst (define abcd 1))) abcd)) 1) (test (let? (let () (letrec ((lst (define abcd 1))) (curlet)))) #t) (test (let () (letrec* ((lst (define abcd 1))) abcd)) 1) ; unproblematic because no pending value ;(test (let () (define (f a) (if (symbol? a) b 0)) (f (define b 3))) 3) ; 25-Jul-14 (test (let () (+ (define b 1) (* b 2))) 3) (test (let () (if (define b 3) b)) 3) (test (let () (do ((i (define b 3)) (j 0 (+ j 1))) ((= j 0) b))) 3) (test (let () (define* (f (a (define b 3))) a) (f) b) 'error) ; ?? where is b? (test (let () (define* (f (a (define b 3))) b) (f)) 3) ; inside the func apparently! 3 cases? let->outer letrec->cur, func->inner! ;(test (let () (define* (f (a (define a 3))) a) (f)) 'a) ; yow -- no duplicate id check! 25-Jul-14 (test (let () (define* (f (a 1) (b (define a 3))) a) (f 2)) 3) (test (let () (define-macro* (f (a 1) (b (define a 3))) a) (f 2)) 2) ; also bacro -- b is '(define a 3)! ;(test (let () (letrec ((a (define a 3))) a)) 'a) ; letrec is the same (it checks normally) 25-Jul-14 (test (let () (letrec ((a 1) (b (define a 3))) a)) 1) (test (let () (letrec* ((a 1) (b (define a 3))) a)) 3) ; same difference in let/let* (test (let () (letrec ((a 1) (b (set! a 3))) a)) 1) (test (let () (letrec* ((a 1) (b (set! a 3))) a)) 3) ; here the let case is an error, let* is 3 ;(test (let () (list (with-let (sublet (curlet) (cons 'b (define b 3))) b) ((curlet) 'b))) '(b 3)) ; 2 b's with 1 define ;(test (let () (list (with-let (varlet (curlet) (cons 'b (define b 3))) b) ((curlet) 'b))) '(b b)) (test (let () (define (f1 a) (+ a 123)) (define (f2 a) (f1 2 (+ a 1))) (define (f3 a b) (+ a b)) (set! f1 f3) (f2 4)) 7) ; this tricks lint (let () (define (f64 arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64) (+ arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64)) (test (f64 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64) 2080)) #| (let ((n 12)) (let ((nums (do ((lst () (cons i lst)) (i 0 (+ i 1))) ((> i n) (reverse lst))))) (format #t "(let ((f~D (lambda (~{arg~D~^ ~})~% (+ ~{arg~D~^ ~}))))~% (f~D ~{~D~^ ~}))~%" n nums nums n nums))) |# (test (let ((f128 (lambda (arg128 arg127 arg126 arg125 arg124 arg123 arg122 arg121 arg120 arg119 arg118 arg117 arg116 arg115 arg114 arg113 arg112 arg111 arg110 arg109 arg108 arg107 arg106 arg105 arg104 arg103 arg102 arg101 arg100 arg99 arg98 arg97 arg96 arg95 arg94 arg93 arg92 arg91 arg90 arg89 arg88 arg87 arg86 arg85 arg84 arg83 arg82 arg81 arg80 arg79 arg78 arg77 arg76 arg75 arg74 arg73 arg72 arg71 arg70 arg69 arg68 arg67 arg66 arg65 arg64 arg63 arg62 arg61 arg60 arg59 arg58 arg57 arg56 arg55 arg54 arg53 arg52 arg51 arg50 arg49 arg48 arg47 arg46 arg45 arg44 arg43 arg42 arg41 arg40 arg39 arg38 arg37 arg36 arg35 arg34 arg33 arg32 arg31 arg30 arg29 arg28 arg27 arg26 arg25 arg24 arg23 arg22 arg21 arg20 arg19 arg18 arg17 arg16 arg15 arg14 arg13 arg12 arg11 arg10 arg9 arg8 arg7 arg6 arg5 arg4 arg3 arg2 arg1 arg0) (+ arg128 arg127 arg126 arg125 arg124 arg123 arg122 arg121 arg120 arg119 arg118 arg117 arg116 arg115 arg114 arg113 arg112 arg111 arg110 arg109 arg108 arg107 arg106 arg105 arg104 arg103 arg102 arg101 arg100 arg99 arg98 arg97 arg96 arg95 arg94 arg93 arg92 arg91 arg90 arg89 arg88 arg87 arg86 arg85 arg84 arg83 arg82 arg81 arg80 arg79 arg78 arg77 arg76 arg75 arg74 arg73 arg72 arg71 arg70 arg69 arg68 arg67 arg66 arg65 arg64 arg63 arg62 arg61 arg60 arg59 arg58 arg57 arg56 arg55 arg54 arg53 arg52 arg51 arg50 arg49 arg48 arg47 arg46 arg45 arg44 arg43 arg42 arg41 arg40 arg39 arg38 arg37 arg36 arg35 arg34 arg33 arg32 arg31 arg30 arg29 arg28 arg27 arg26 arg25 arg24 arg23 arg22 arg21 arg20 arg19 arg18 arg17 arg16 arg15 arg14 arg13 arg12 arg11 arg10 arg9 arg8 arg7 arg6 arg5 arg4 arg3 arg2 arg1 arg0)))) (f128 128 127 126 125 124 123 122 121 120 119 118 117 116 115 114 113 112 111 110 109 108 107 106 105 104 103 102 101 100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0)) 8256) (test (let ((f512 (lambda (arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64 arg65 arg66 arg67 arg68 arg69 arg70 arg71 arg72 arg73 arg74 arg75 arg76 arg77 arg78 arg79 arg80 arg81 arg82 arg83 arg84 arg85 arg86 arg87 arg88 arg89 arg90 arg91 arg92 arg93 arg94 arg95 arg96 arg97 arg98 arg99 arg100 arg101 arg102 arg103 arg104 arg105 arg106 arg107 arg108 arg109 arg110 arg111 arg112 arg113 arg114 arg115 arg116 arg117 arg118 arg119 arg120 arg121 arg122 arg123 arg124 arg125 arg126 arg127 arg128 arg129 arg130 arg131 arg132 arg133 arg134 arg135 arg136 arg137 arg138 arg139 arg140 arg141 arg142 arg143 arg144 arg145 arg146 arg147 arg148 arg149 arg150 arg151 arg152 arg153 arg154 arg155 arg156 arg157 arg158 arg159 arg160 arg161 arg162 arg163 arg164 arg165 arg166 arg167 arg168 arg169 arg170 arg171 arg172 arg173 arg174 arg175 arg176 arg177 arg178 arg179 arg180 arg181 arg182 arg183 arg184 arg185 arg186 arg187 arg188 arg189 arg190 arg191 arg192 arg193 arg194 arg195 arg196 arg197 arg198 arg199 arg200 arg201 arg202 arg203 arg204 arg205 arg206 arg207 arg208 arg209 arg210 arg211 arg212 arg213 arg214 arg215 arg216 arg217 arg218 arg219 arg220 arg221 arg222 arg223 arg224 arg225 arg226 arg227 arg228 arg229 arg230 arg231 arg232 arg233 arg234 arg235 arg236 arg237 arg238 arg239 arg240 arg241 arg242 arg243 arg244 arg245 arg246 arg247 arg248 arg249 arg250 arg251 arg252 arg253 arg254 arg255 arg256 arg257 arg258 arg259 arg260 arg261 arg262 arg263 arg264 arg265 arg266 arg267 arg268 arg269 arg270 arg271 arg272 arg273 arg274 arg275 arg276 arg277 arg278 arg279 arg280 arg281 arg282 arg283 arg284 arg285 arg286 arg287 arg288 arg289 arg290 arg291 arg292 arg293 arg294 arg295 arg296 arg297 arg298 arg299 arg300 arg301 arg302 arg303 arg304 arg305 arg306 arg307 arg308 arg309 arg310 arg311 arg312 arg313 arg314 arg315 arg316 arg317 arg318 arg319 arg320 arg321 arg322 arg323 arg324 arg325 arg326 arg327 arg328 arg329 arg330 arg331 arg332 arg333 arg334 arg335 arg336 arg337 arg338 arg339 arg340 arg341 arg342 arg343 arg344 arg345 arg346 arg347 arg348 arg349 arg350 arg351 arg352 arg353 arg354 arg355 arg356 arg357 arg358 arg359 arg360 arg361 arg362 arg363 arg364 arg365 arg366 arg367 arg368 arg369 arg370 arg371 arg372 arg373 arg374 arg375 arg376 arg377 arg378 arg379 arg380 arg381 arg382 arg383 arg384 arg385 arg386 arg387 arg388 arg389 arg390 arg391 arg392 arg393 arg394 arg395 arg396 arg397 arg398 arg399 arg400 arg401 arg402 arg403 arg404 arg405 arg406 arg407 arg408 arg409 arg410 arg411 arg412 arg413 arg414 arg415 arg416 arg417 arg418 arg419 arg420 arg421 arg422 arg423 arg424 arg425 arg426 arg427 arg428 arg429 arg430 arg431 arg432 arg433 arg434 arg435 arg436 arg437 arg438 arg439 arg440 arg441 arg442 arg443 arg444 arg445 arg446 arg447 arg448 arg449 arg450 arg451 arg452 arg453 arg454 arg455 arg456 arg457 arg458 arg459 arg460 arg461 arg462 arg463 arg464 arg465 arg466 arg467 arg468 arg469 arg470 arg471 arg472 arg473 arg474 arg475 arg476 arg477 arg478 arg479 arg480 arg481 arg482 arg483 arg484 arg485 arg486 arg487 arg488 arg489 arg490 arg491 arg492 arg493 arg494 arg495 arg496 arg497 arg498 arg499 arg500 arg501 arg502 arg503 arg504 arg505 arg506 arg507 arg508 arg509 arg510 arg511 arg512) (+ arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg10 arg11 arg12 arg13 arg14 arg15 arg16 arg17 arg18 arg19 arg20 arg21 arg22 arg23 arg24 arg25 arg26 arg27 arg28 arg29 arg30 arg31 arg32 arg33 arg34 arg35 arg36 arg37 arg38 arg39 arg40 arg41 arg42 arg43 arg44 arg45 arg46 arg47 arg48 arg49 arg50 arg51 arg52 arg53 arg54 arg55 arg56 arg57 arg58 arg59 arg60 arg61 arg62 arg63 arg64 arg65 arg66 arg67 arg68 arg69 arg70 arg71 arg72 arg73 arg74 arg75 arg76 arg77 arg78 arg79 arg80 arg81 arg82 arg83 arg84 arg85 arg86 arg87 arg88 arg89 arg90 arg91 arg92 arg93 arg94 arg95 arg96 arg97 arg98 arg99 arg100 arg101 arg102 arg103 arg104 arg105 arg106 arg107 arg108 arg109 arg110 arg111 arg112 arg113 arg114 arg115 arg116 arg117 arg118 arg119 arg120 arg121 arg122 arg123 arg124 arg125 arg126 arg127 arg128 arg129 arg130 arg131 arg132 arg133 arg134 arg135 arg136 arg137 arg138 arg139 arg140 arg141 arg142 arg143 arg144 arg145 arg146 arg147 arg148 arg149 arg150 arg151 arg152 arg153 arg154 arg155 arg156 arg157 arg158 arg159 arg160 arg161 arg162 arg163 arg164 arg165 arg166 arg167 arg168 arg169 arg170 arg171 arg172 arg173 arg174 arg175 arg176 arg177 arg178 arg179 arg180 arg181 arg182 arg183 arg184 arg185 arg186 arg187 arg188 arg189 arg190 arg191 arg192 arg193 arg194 arg195 arg196 arg197 arg198 arg199 arg200 arg201 arg202 arg203 arg204 arg205 arg206 arg207 arg208 arg209 arg210 arg211 arg212 arg213 arg214 arg215 arg216 arg217 arg218 arg219 arg220 arg221 arg222 arg223 arg224 arg225 arg226 arg227 arg228 arg229 arg230 arg231 arg232 arg233 arg234 arg235 arg236 arg237 arg238 arg239 arg240 arg241 arg242 arg243 arg244 arg245 arg246 arg247 arg248 arg249 arg250 arg251 arg252 arg253 arg254 arg255 arg256 arg257 arg258 arg259 arg260 arg261 arg262 arg263 arg264 arg265 arg266 arg267 arg268 arg269 arg270 arg271 arg272 arg273 arg274 arg275 arg276 arg277 arg278 arg279 arg280 arg281 arg282 arg283 arg284 arg285 arg286 arg287 arg288 arg289 arg290 arg291 arg292 arg293 arg294 arg295 arg296 arg297 arg298 arg299 arg300 arg301 arg302 arg303 arg304 arg305 arg306 arg307 arg308 arg309 arg310 arg311 arg312 arg313 arg314 arg315 arg316 arg317 arg318 arg319 arg320 arg321 arg322 arg323 arg324 arg325 arg326 arg327 arg328 arg329 arg330 arg331 arg332 arg333 arg334 arg335 arg336 arg337 arg338 arg339 arg340 arg341 arg342 arg343 arg344 arg345 arg346 arg347 arg348 arg349 arg350 arg351 arg352 arg353 arg354 arg355 arg356 arg357 arg358 arg359 arg360 arg361 arg362 arg363 arg364 arg365 arg366 arg367 arg368 arg369 arg370 arg371 arg372 arg373 arg374 arg375 arg376 arg377 arg378 arg379 arg380 arg381 arg382 arg383 arg384 arg385 arg386 arg387 arg388 arg389 arg390 arg391 arg392 arg393 arg394 arg395 arg396 arg397 arg398 arg399 arg400 arg401 arg402 arg403 arg404 arg405 arg406 arg407 arg408 arg409 arg410 arg411 arg412 arg413 arg414 arg415 arg416 arg417 arg418 arg419 arg420 arg421 arg422 arg423 arg424 arg425 arg426 arg427 arg428 arg429 arg430 arg431 arg432 arg433 arg434 arg435 arg436 arg437 arg438 arg439 arg440 arg441 arg442 arg443 arg444 arg445 arg446 arg447 arg448 arg449 arg450 arg451 arg452 arg453 arg454 arg455 arg456 arg457 arg458 arg459 arg460 arg461 arg462 arg463 arg464 arg465 arg466 arg467 arg468 arg469 arg470 arg471 arg472 arg473 arg474 arg475 arg476 arg477 arg478 arg479 arg480 arg481 arg482 arg483 arg484 arg485 arg486 arg487 arg488 arg489 arg490 arg491 arg492 arg493 arg494 arg495 arg496 arg497 arg498 arg499 arg500 arg501 arg502 arg503 arg504 arg505 arg506 arg507 arg508 arg509 arg510 arg511 arg512)))) (f512 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512)) 131328) (let ((x 32)) (define (f1) x) (define x 33) (test (f1) 33)) (let () (define (c-2) (let ((v (vector 1 2 3))) (define (c-1 a b) (+ (vector-ref a 0) (* b 32))) (let ((c (c-1 v 1))) (test c 33) (set! c-1 vector-ref)) (let ((d (c-1 v 1))) (test d 2)))) (c-2)) (let () (define (c-2) (let ((v (vector 1 2 3))) (let () (define (c-1 a b) (+ (vector-ref a 0) (* b 32))) (let ((c (c-1 v 1))) (set! c-1 vector-ref))) (test (c-1 v 1) 'error))) (c-2)) (let () (define (f4 a b c d e) (list a b c d e)) (test (f4 1 2 3 4 5) '(1 2 3 4 5))) (let-temporarily (((*s7* 'safety) 1)) (define (redef-1 a) (+ a 1)) (define (use-redef-1 b) (+ (redef-1 b) 2)) ; [use-redef](+ [redef-1](+ b 1) 2) (test (use-redef-1 3) 6) ; b=6 (define (redef-1 a) (+ a 4)) (test (use-redef-1 3) 9) ; [use-redef-1](+ [redef-1](+ a 4) 2), a=3 (let () (define (use-redef-2 c) (+ (redef-1 c) 5)) ; [use-redef-2](+ [redef-1](+ a 4) 5) (test (use-redef-2 6) 15) ; a=6 (define (redef-1 a) (+ a 7)) ; so use-redef-1 is still [use-redef-1](+ [redef-1](+ a 4) 2) (test (use-redef-1 8) 14) ; a=8 -> 14 (test (use-redef-2 8) 20))) ; but use-redef-2 (same let as shadowing use-redef-1) is (+ [new redef-1](+ a 7) 5), a=8 -> 20 (let () (define (redef-3 a) (+ a 1)) (test (redef-3 2) 3) (define (redef-3 a) (abs a)) (test (redef-3 -2) 2)) (test (let () (define (f1 x) (abs x)) (define (f2 x) (f1 x)) (f2 -1)) 1) ; just trying to hit a portion of the s7 code (when with-block (let () (define (f1) ((lambda (x) (cf11 x)) 3)) (f1) (define (f2) ((lambda () (cf21 3 4)))) (f2) (define (f3) ((lambda () (cf11 3)))) (f3) (define (f4) ((lambda (x) (cf11 'x)) 4)) (f4) (define (f5) ((lambda (x) (cf21 x 4)) 3)) (f5) (define (f6) ((lambda (x) (cf21 3 x)) 4)) (f6) (define (f7) ((lambda (x) (cf21 3 4)) 4)) (f7) (define (f8) ((lambda (x y) (cf21 x y)) 3 4)) (f8) (define (f9) ((lambda (x) (cf21 x 'y)) 'x)) (f9) (define (f10) ((lambda (x) (cf21 'y x)) 'x)) (f10) (define (f11) ((lambda (x) (cf21 'y 'x)) 'x)) (f11) (define (f12) ((lambda (x) (cf21 1 'x)) 'x)) (f12) (define (f13) ((lambda (x) (cf21 'x 1)) 'x)) (f13) (define (f14) ((lambda (x y z) (cf31 x y z)) 1 2 3)) (f14) (define (f15) ((lambda (x y z) (cf31 x 2 z)) 1 2 3)) (f15) (define (f16) ((lambda (x y z) (cf31 x y 2)) 1 2 3)) (f16) (define (f17) ((lambda (x y z) (cf31 2 y z)) 1 2 3)) (f17) (define (f18) ((lambda (w x y z) (cf41 w x y z)) 1 2 3 4)) (f18) (define (f19) ((lambda (x y z) (cf31 x 'y z)) 1 2 3)) (f19) (define (f20) ((lambda (x y z) (cf41 'q x y z)) 1 2 3)) (f20) (define (f21) ((lambda (x y) (cf31 x y (+ x 6))) 1 2)) (f21) (define (f22) ((lambda (x y) (cf31 1 y (+ x 6))) 1 2)) (f22) (define (f23) ((lambda (x y) (cf31 x 1 (+ x 6))) 1 2)) (f23) (define (f24) ((lambda (x y) (cf31 1 (+ x 6) y)) 1 2)) (f24) (define (f25) ((lambda (x) (cf11 (cf11 'x))) 1)) (f25) (define (f26) ((lambda (w x y z) (cf51 'q w x y z)) 1 2 3 4)) (f26) (define (f27) ((lambda (w x y) (cf21 (cf21 (cf11 w) (cf11 x)) (cf11 y))) 1 2 3)) (f27) (define (f28) ((lambda (w x y) (cf31 (cf21 w x) 2 y)) 1 2 3)) (f28) (define (f29) ((lambda () (cf11 (cf11 0))))) (f29) (define (f30) ((lambda (x) (cf11 (cf11 x))) 0)) (f30) (define (f31) ((lambda (x) (cf11 (cf10 x))) 0)) (f31) (define (f32) ((lambda (x) (cf11 (cf10 'x))) 1)) (f32) (define (f33) ((lambda (w x y) (cf31 (cf20 w x) 2 y)) 1 2 3)) (f33) (define (f34) ((lambda (w x y) (cf22 (cf21 (cf11 w) (cf11 x)) (cf10 y))) 1 2 3)) (f34) (define (f35) ((lambda (w x y) (cf21 (cf20 (cf11 w) (cf11 x)) (cf11 y))) 1 2 3)) (f35) (define (f36) ((lambda (w x y) (cf21 (cf21 (cf10 w) (cf11 x)) (cf11 y))) 1 2 3)) (f36) (define (f37) ((lambda (x y) (cf33 x y (cf20 x 6))) 1 2)) (f37) (define (f38) ((lambda (x y) (cf33 1 y (cf20 x 6))) 1 2)) (f38) (define (f39) ((lambda (x y) (cf33 x 1 (cf20 x 6))) 1 2)) (f39) (define (f40) ((lambda (x y) (cf32 1 (cf20 x 6) y)) 1 2)) (f40) (define (f41) ((lambda (x y) (cf11 (cf21 x y))) 1 2)) (f41) (define (f42) ((lambda (x y) (cf11 (cf21 x 2))) 1 2)) (f42) (define (f43) ((lambda (x y) (cf11 (cf21 1 x))) 1 2)) (f43) (define (f44) ((lambda (x y) (cf21 x (cf11 y))) 1 2)) (f44) (define (f45) ((lambda (x y) (cf21 (cf11 x) y)) 1 2)) (f45) (define (f46) ((lambda (x y) (cf21 (cf11 x) 2)) 1 2)) (f46) (define (f47) ((lambda (x y) (cf21 (cf11 x) (cf11 y))) 1 2)) (f47) (define (f48) ((lambda (x y) (cf11 (cf20 x y))) 1 2)) (f48) (define (f49) ((lambda (x y) (cf11 (cf20 x 2))) 1 2)) (f49) (define (f50) ((lambda (x y) (cf11 (cf20 1 x))) 1 2)) (f50) (define (f51) ((lambda (x y) (cf22 x (cf10 y))) 1 2)) (f51) (define (f52) ((lambda (x y) (cf21 (cf10 x) y)) 1 2)) (f52) (define (f53) ((lambda (x y) (cf21 (cf10 x) 2)) 1 2)) (f53) (define (f54) ((lambda (x y) (cf21 (cf10 x) (cf11 y))) 1 2)) (f54) (define (f55) ((lambda (x y) (cf22 (cf11 x) (cf10 y))) 1 2)) (f55) (define (f56) ((lambda (x y) (cf21 1 (cf11 y))) 1 2)) (f56) (define (f57) ((lambda (x y) (cf22 1 (cf10 y))) 1 2)) (f57) (define (f58) ((lambda (x y z) (cf21 x (cf21 y z))) 1 2 3)) (f58) (define (f59) ((lambda (x y z) (cf22 x (cf20 y z))) 1 2 3)) (f59) (define (f60) ((lambda (x y z) (cf21 x (cf21 2 z))) 1 2 3)) (f60) (define (f61) ((lambda (x y z) (cf22 x (cf20 2 z))) 1 2 3)) (f61) (define (f62) ((lambda (x y z) (cf21 x (cf21 y 3))) 1 2 3)) (f62) (define (f63) ((lambda (x y z) (cf22 x (cf20 y 3))) 1 2 3)) (f63) (define (f64) ((lambda (x y z) (cf21 1 (cf21 2 z))) 1 2 3)) (f64) (define (f65) ((lambda (x y z) (cf22 1 (cf20 2 z))) 1 2 3)) (f65) (define (f66) ((lambda (x y z) (cf21 1 (cf21 y 3))) 1 2 3)) (f66) (define (f67) ((lambda (x y z) (cf22 1 (cf20 y 3))) 1 2 3)) (f67) (define (f68) ((lambda (x) (cf21 (cf21 2 x) 3)) 1)) (f68) (define (f69) ((lambda (x) (cf21 (cf20 2 x) 3)) 1)) (f69) (define (f70) ((lambda (x y) (cf21 1 (cf21 x y))) 2 3)) (f70) (define (f71) ((lambda (x y) (cf22 1 (cf20 x y))) 2 3)) (f71) (define (f72) ((lambda (x y) (cf21 (cf21 x y) 3)) 1 2)) (f72) (define (f73) ((lambda (x y) (cf21 (cf20 x y) 3)) 1 2)) (f73) (define (f74) ((lambda (x) (cf11 (cf21 x 'y))) 1)) (f74) (define (f75) ((lambda (x) (cf11 (cf20 x 'y))) 1)) (f75) (define (f76) ((lambda (x) (cf21 x (cf11 2))) 1)) (f76) (define (f77) ((lambda (x) (cf22 x (cf10 2))) 1)) (f77) (define (f78) ((lambda (x) (cf21 1 (cf11 2))) 1)) (f78) (define (f79) ((lambda (x) (cf22 1 (cf10 2))) 1)) (f79) (define (f80) ((lambda (x) (cf21 (cf11 1) x)) 2)) (f80) (define (f81) ((lambda (x) (cf21 (cf10 1) x)) 2)) (f81) (define (f82) ((lambda (x y z) (cf21 (cf21 x y) z)) 1 2 3)) (f82) (define (f83) ((lambda (x y z) (cf21 (cf20 x y) z)) 1 2 3)) (f83) (define (f84) ((lambda (x y z) (cf21 (cf21 x 2) z)) 1 2 3)) (f84) (define (f85) ((lambda (x y z) (cf21 (cf20 x 2) z)) 1 2 3)) (f85) (define (f86) ((lambda (x y z) (cf21 (cf21 1 y) z)) 1 2 3)) (f86) (define (f87) ((lambda (x y z) (cf21 (cf20 1 y) z)) 1 2 3)) (f87) (define (f88) ((lambda (x y z) (cf21 (cf21 x 2) 3)) 1 2 3)) (f88) (define (f89) ((lambda (x y z) (cf21 (cf20 x 2) 3)) 1 2 3)) (f89) (define (f90) ((lambda (x) (cf21 (cf11 1) 2)) 2)) (f90) (define (f91) ((lambda (x) (cf21 (cf10 1) 2)) 2)) (f91) (define (f92) ((lambda (w x y z) (cf21 (cf21 w x) (cf21 y z))) 1 2 3 4)) (f92) (define (f93) ((lambda (w x y z) (cf22 (cf21 w x) (cf20 y z))) 1 2 3 4)) (f93) (define (f94) ((lambda (w x y z) (cf21 (cf20 w x) (cf21 y z))) 1 2 3 4)) (f94) (define (f95) ((lambda (w x y z) (cf21 (cf21 w 2) (cf21 y 4))) 1 2 3 4)) (f95) (define (f96) ((lambda (w x y z) (cf22 (cf21 w 2) (cf20 y 4))) 1 2 3 4)) (f96) (define (f97) ((lambda (w x y z) (cf21 (cf20 w 2) (cf21 y 4))) 1 2 3 4)) (f97) (define (f98) ((lambda (x y z) (cf21 (cf11 x) (cf21 y z))) 1 2 3)) (f98) (define (f99) ((lambda (x y z) (cf22 (cf11 x) (cf20 y z))) 1 2 3)) (f99) (define (f100) ((lambda (x y z) (cf21 (cf10 x) (cf21 y z))) 1 2 3)) (f100) (define (f101) ((lambda (x y z) (cf21 (cf21 x y) (cf11 z))) 1 2 3)) (f101) (define (f102) ((lambda (x y z) (cf22 (cf21 x y) (cf10 z))) 1 2 3)) (f102) (define (f103) ((lambda (x y z) (cf21 (cf20 x y) (cf11 z))) 1 2 3)) (f103) (define (f104) ((lambda (x y z) (cf21 (cf21 x y) (cf11 3))) 1 2 3)) (f104) (define (f105) ((lambda (x y z) (cf22 (cf21 x y) (cf10 3))) 1 2 3)) (f105) (define (f106) ((lambda (x y z) (cf21 (cf20 x y) (cf11 3))) 1 2 3)) (f106) (define (f107) ((lambda (x y z) (cf21 (cf11 1) (cf21 y z))) 1 2 3)) (f107) (define (f108) ((lambda (x y z) (cf22 (cf11 1) (cf20 y z))) 1 2 3)) (f108) (define (f109) ((lambda (x y z) (cf21 (cf10 1) (cf21 y z))) 1 2 3)) (f109) (define (f110) ((lambda () (cf21 (cf11 1) (cf11 2))))) (f110) (define (f111) ((lambda () (cf22 (cf11 1) (cf10 2))))) (f111) (define (f112) ((lambda () (cf21 (cf10 1) (cf11 2))))) (f112) (define (f113) ((lambda (x) (cf11 (cf11 (cf11 x)))) 1)) (f113) (define (f114) ((lambda (x) (cf11 (cf11 (cf10 x)))) 1)) (f114) (define (f115) ((lambda (x) (cf11 (cf10 (cf11 x)))) 1)) (f115) (define (f116) ((lambda (w x y z) (cf22 w (cf21 (cf21 x y) z))) 1 2 3 4)) (f116) (define (f117) ((lambda (w x y z) (cf22 w (cf20 (cf21 x y) z))) 1 2 3 4)) (f117) (define (f118) ((lambda (w x y z) (cf22 w (cf21 (cf20 x y) z))) 1 2 3 4)) (f118) (define (f119) ((lambda (w x y z) (cf22 w (cf22 x (cf21 y z)))) 1 2 3 4)) (f119) (define (f120) ((lambda (w x y z) (cf22 w (cf20 x (cf21 y z)))) 1 2 3 4)) (f120) (define (f121) ((lambda (w x y z) (cf22 w (cf22 x (cf20 y z)))) 1 2 3 4)) (f121) (define (f122) ((lambda (x y) (cf11 (cf32 1 (cf21 x y) 4))) 2 3)) (f122) ; c_z (define (f123) ((lambda (x y) (cf11 (cf32 1 (cf20 x y) 4))) 2 3)) (f123) (define (f124) ((lambda (x y) (cf11 (cf30 1 (cf21 x y) 4))) 2 3)) (f124) (define (f125) ((lambda (x y) (cf21 (cf11 (cf21 x y)) 3)) 1 2)) (f125) (define (f126) ((lambda (x y) (cf21 (cf10 (cf21 x y)) 3)) 1 2)) (f126) (define (f127) ((lambda (x y) (cf21 (cf11 (cf20 x y)) 3)) 1 2)) (f127) (define (f128) ((lambda (x) (cf22 1 (cf21 x (cf11 3)))) 2)) (f128) (define (f129) ((lambda (x) (cf22 1 (cf20 x (cf11 3)))) 2)) (f129) (define (f130) ((lambda (x) (cf22 1 (cf22 x (cf10 3)))) 2)) (f130) (define (f131) ((lambda (x y z) (cf22 x (cf21 (cf21 y z) (cf21 z y)))) 1 2 3)) (f131) (define (f132) ((lambda (x y z) (cf22 x (cf20 (cf21 y z) (cf21 z y)))) 1 2 3)) (f132) (define (f133) ((lambda (x y z) (cf22 x (cf21 (cf20 y z) (cf21 z y)))) 1 2 3)) (f133) (define (f134) ((lambda (x y z) (cf22 x (cf22 (cf21 y z) (cf20 z y)))) 1 2 3)) (f134) (define (f135) ((lambda (x y z) (cf21 (cf21 x y) (cf11 (cf21 y z)))) 1 2 3)) (f135) (define (f136) ((lambda (x y z) (cf21 (cf20 x y) (cf11 (cf21 y z)))) 1 2 3)) (f136) (define (f137) ((lambda (x y z) (cf22 (cf21 x y) (cf10 (cf21 y z)))) 1 2 3)) (f137) (define (f138) ((lambda (x y z) (cf22 (cf21 x y) (cf11 (cf20 y z)))) 1 2 3)) (f138) (define (f139) ((lambda (x y z) (cf21 (cf21 (cf21 x y) z) (cf21 y z))) 1 2 3)) (f139) (define (f140) ((lambda (x y z) (cf21 (cf20 (cf21 x y) z) (cf21 y z))) 1 2 3)) (f140) (define (f141) ((lambda (x y z) (cf21 (cf21 (cf20 x y) z) (cf21 y z))) 1 2 3)) (f141) (define (f142) ((lambda (x y z) (cf22 (cf21 (cf21 x y) z) (cf20 y z))) 1 2 3)) (f142) (define (f143) ((lambda (x y z) (cf22 x (cf21 (cf11 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f143) (define (f144) ((lambda (x y z) (cf22 x (cf20 (cf11 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f144) (define (f145) ((lambda (x y z) (cf22 x (cf21 (cf10 (cf21 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f145) (define (f146) ((lambda (x y z) (cf22 x (cf21 (cf11 (cf20 x y)) (cf11 (cf21 y z))))) 1 2 3)) (f146) (define (f147) ((lambda (x y z) (cf22 x (cf22 (cf11 (cf21 x y)) (cf10 (cf21 y z))))) 1 2 3)) (f147) (define (f148) ((lambda (x y z) (cf22 x (cf22 (cf11 (cf21 x y)) (cf11 (cf20 y z))))) 1 2 3)) (f148) (define (f149) ((lambda (x y z) (cf22 x (cf31 (cf11 y) (cf11 z) (cf11 z)))) 1 2 3)) (f149) (define (f150) ((lambda (x y z) (cf22 x (cf30 (cf11 y) (cf11 z) (cf11 z)))) 1 2 3)) (f150) (define (f151) ((lambda (x y z) (cf22 x (cf31 (cf10 y) (cf11 z) (cf11 z)))) 1 2 3)) (f151) (define (f152) ((lambda (x y z) (cf22 x (cf32 (cf11 y) (cf10 z) (cf11 z)))) 1 2 3)) (f152) (define (f153) ((lambda (x y z) (cf22 x (cf33 (cf11 y) (cf11 z) (cf10 z)))) 1 2 3)) (f153) (define (f154) ((lambda (x y z) (cf21 (cf32 1 (cf21 x y) 4) (cf32 1 (cf21 y z) 4))) 1 2 3)) (f154) (define (f155) ((lambda (x y z) (cf21 (cf32 1 (cf20 x y) 4) (cf32 1 (cf21 y z) 4))) 1 2 3)) (f155) (define (f156) ((lambda (x y z) (cf22 (cf32 1 (cf21 x y) 4) (cf30 1 (cf21 y z) 4))) 1 2 3)) (f156) (define (f157) ((lambda (x y z) (cf22 x (cf32 1 (cf21 y z) 4))) 1 2 3)) (f157) (define (f158) ((lambda (x y z) (cf22 x (cf32 1 (cf20 y z) 4))) 1 2 3)) (f158) (define (f159) ((lambda (x y z) (cf21 (cf32 1 (cf21 y z) 4) x)) 1 2 3)) (f159) (define (f160) ((lambda (x y z) (cf21 (cf30 1 (cf20 y z) 4) x)) 1 2 3)) (f160) (define (f161) ((lambda (x y z) (cf22 1 (cf32 1 (cf21 y z) 4))) 1 2 3)) (f161) (define (f162) ((lambda (x y z) (cf22 1 (cf32 1 (cf20 y z) 4))) 1 2 3)) (f162) (define (f163) ((lambda (x y z) (cf21 (cf32 1 (cf21 y z) 4) x)) 1 2 3)) (f163) (define (f164) ((lambda (x y z) (cf21 (cf30 1 (cf20 y z) 4) x)) 1 2 3)) (f164) ;; -------- (test (f1) 3) (test (f2) 3) (test (f3) 3) (test (f4) 'x) (test (f5) 3) (test (f6) 3) (test (f7) 3) (test (f8) 3) (test (f9) 'x) (test (f10) 'y) (test (f11) 'y) (test (f12) 1) (test (f13) 'x) (test (f14) 1) (test (f15) 1) (test (f16) 1) (test (f17) 2) (test (f18) 1) (test (f19) 1) (test (f20) 'q) (test (f21) 1) (test (f22) 1) (test (f23) 1) (test (f24) 1) (test (f25) 'x) (test (f26) 'q) (test (f27) 1) (test (f28) 1) (test (f29) 0) (test (f30) 0) (test (f31) 0) (test (f32) 'x) (test (f33) 1) (test (f34) 3) (test (f35) 1) (test (f36) 1) (test (f37) 1) (test (f38) 1) (test (f39) 1) (test (f40) 1) (test (f41) 1) (test (f42) 1) (test (f43) 1) (test (f44) 1) (test (f45) 1) (test (f46) 1) (test (f47) 1) (test (f48) 1) (test (f49) 1) (test (f50) 1) (test (f51) 2) (test (f52) 1) (test (f53) 1) (test (f54) 1) (test (f55) 2) (test (f56) 1) (test (f57) 2) (test (f58) 1) (test (f59) 2) (test (f60) 1) (test (f61) 2) (test (f62) 1) (test (f63) 2) (test (f64) 1) (test (f65) 2) (test (f66) 1) (test (f67) 2) (test (f68) 2) (test (f69) 2) (test (f70) 1) (test (f71) 2) (test (f72) 1) (test (f73) 1) (test (f74) 1) (test (f75) 1) (test (f76) 1) (test (f77) 2) (test (f78) 1) (test (f79) 2) (test (f80) 1) (test (f81) 1) (test (f82) 1) (test (f83) 1) (test (f84) 1) (test (f85) 1) (test (f86) 1) (test (f87) 1) (test (f88) 1) (test (f89) 1) (test (f90) 1) (test (f91) 1) (test (f92) 1) (test (f93) 3) (test (f94) 1) (test (f95) 1) (test (f96) 3) (test (f97) 1) (test (f98) 1) (test (f99) 2) (test (f100) 1) (test (f101) 1) (test (f102) 3) (test (f103) 1) (test (f104) 1) (test (f105) 3) (test (f106) 1) (test (f107) 1) (test (f108) 2) (test (f109) 1) (test (f110) 1) (test (f111) 2) (test (f112) 1) (test (f113) 1) (test (f114) 1) (test (f115) 1) (test (f116) 2) (test (f117) 2) (test (f118) 2) (test (f119) 3) (test (f120) 2) (test (f121) 3) (test (f122) 2) (test (f123) 2) (test (f124) 1) (test (f125) 1) (test (f126) 1) (test (f127) 1) (test (f128) 2) (test (f129) 2) (test (f130) 3) (test (f131) 2) (test (f132) 2) (test (f133) 2) (test (f134) 3) (test (f135) 1) (test (f136) 1) (test (f137) 2) (test (f138) 2) (test (f139) 1) (test (f140) 1) (test (f141) 1) (test (f142) 2) (test (f143) 1) (test (f144) 1) (test (f145) 1) (test (f146) 1) (test (f147) 2) (test (f148) 2) (test (f149) 2) (test (f150) 2) (test (f151) 2) (test (f152) 3) (test (f153) 3) (test (f154) 1) (test (f155) 1) (test (f156) 1) (test (f157) 2) (test (f158) 2) (test (f159) 2) (test (f160) 1) (test (f161) 2) (test (f162) 2) (test (f163) 2) (test (f164) 1) )) (when with-block (let () (define (thunk1) 3) (define (thunk2) 4) (define (f1) ((lambda (x) (thunk1)) 0)) (f1) (test (f1) 3) (define thunk1 thunk2) (test (f1) 4) (define (thunk3) (*s7* 'max-stack-size) 5) (define (thunk4) (*s7* 'max-stack-size) 6) (define (f2) ((lambda (x) (thunk3)) 0)) (f2) (test (f2) 5) (define thunk3 thunk4) (test (f2) 6) (define (close1 x) (*s7* 'max-stack-size) (+ x 1)) (define (close2 x) (*s7* 'max-stack-size) (+ x 2)) (define (qclose1 x) (*s7* 'max-stack-size) (eq? x 'q)) (define (qclose2 x) (*s7* 'max-stack-size) (eq? x 'r)) (define (sclose1 x) (+ x 1)) (define (sclose2 x) (+ x 2)) (define (qsclose1 x) (eq? x 'q)) (define (qsclose2 x) (eq? x 'r)) (define* (s*close1 (x 1)) (+ x 1)) (define* (s*close2 (x 1)) (+ x 2)) (define* (u*close1 (x 1)) (*s7* 'max-stack-size) (+ x 1)) (define* (u*close2 (x 1)) (*s7* 'max-stack-size) (+ x 2)) (define (close3 x y) (*s7* 'max-stack-size) (+ x y)) (define (close4 x y) (*s7* 'max-stack-size) (+ x y 1)) (define (sclose3 x y) (+ x y)) (define (sclose4 x y) (+ x y 1)) (define* (s*close3 (x 1) (y 0.0)) (+ x y)) (define* (s*close4 (x 1) (y 0.0)) (+ x y 1)) (define* (u*close3 (x 1) (y 0)) (*s7* 'max-stack-size) (+ x y)) (define* (u*close4 (x 1) (y 0)) (*s7* 'max-stack-size) (+ x y 1)) (define (f3) (close1 1)) (f3) (define (f4) (sclose1 1)) (f4) (define (f5 x) (close1 x)) (f5 0) (define (f6 x) (sclose1 x)) (f6 0) (define (f7 x) (close1 ((lambda () (cs11 x))))) (f7 0) (define (f8 x) (sclose1 ((lambda () (cs11 x))))) (f8 0) (define (f9 x) (close1 ((lambda () (cs11 1))))) (f9 0) (define (f10 x) (sclose1 ((lambda () (cs11 1))))) (f10 0) (define (f11 x) (s*close1 x)) (f11 0) (define (f12 x) (s*close1)) (f12 0) (define (f13 x) (u*close1 x)) (f13 0) (define (f14 x) (u*close1)) (f14 0) (define (f15) (qclose1 'q)) (f15) (define (f16) (qsclose1 'q)) (f16) (define (f17 x) (close1 (cdr x))) (f17 '(0 . 0)) (define (f18) (close3 1 2)) (f18) (define (f19) (sclose3 1 2)) (f19) (define (f20) (s*close3 1 2)) (f20) (define (f21) (u*close3 1 2)) (f21) (define (f22 x) (close3 x 2)) (f22 0) (define (f23 x) (sclose3 x 2)) (f23 0) (define (f24 x) (s*close3 x 2)) (f24 0) (define (f25 x) (u*close3 x 2)) (f25 0) (define (f26 x) (close3 1 x)) (f26 0) (define (f27 x) (sclose3 1 x)) (f27 0) (define (f28 x) (s*close3 1 x)) (f28 0) (define (f29 x) (u*close3 1 x)) (f29 0) (define (f30 x y) (close3 x y)) (f30 0 0) (define (f31 x y) (sclose3 x y)) (f31 0 0) (define (f32 x y) (s*close3 x y)) (f32 0 0) (define (f33 x y) (u*close3 x y)) (f33 0 0) (test (f3) 2) (test (f4) 2) (test (f5 1) 2) (test (f6 1) 2) (test (f7 1) 2) (test (f8 1) 2) (test (f9 1) 2) (test (f10 1) 2) (test (f11 1) 2) (test (f12 1) 2) (test (f13 1) 2) (test (f14 1) 2) (test (f15) #t) (test (f16) #t) (test (f17 '(1 . 1)) 2) (test (f18) 3) (test (f19) 3) (test (f20) 3) (test (f21) 3) (test (f22 1) 3) (test (f23 1) 3) (test (f24 1) 3) (test (f25 1) 3) (test (f26 2) 3) (test (f27 2) 3) (test (f28 2) 3) (test (f29 2) 3) (test (f30 1 2) 3) (test (f31 1 2) 3) (test (f32 1 2) 3) (test (f33 1 2) 3) (define cs11 rs11) ;;;(test (f7 1) 3) (test (f8 1) 3) (test (f9 1) 3) (test (f10 1) 3) (define close1 close2) (define close3 close4) (define qclose1 qclose2) (define sclose1 sclose2) (define sclose3 sclose4) (define qsclose1 qsclose2) (define s*close1 s*close2) (define s*close3 s*close4) (define u*close1 u*close2) (define u*close3 u*close4) (define (f31 x y) (sclose3 x y)) (test (f3) 3) (test (f4) 3) (test (f5 1) 3) (test (f6 1) 3) ;;; (test (f7 -1) 2) (test (f8 -1) 2) (test (f9 -1) 4) (test (f10 -1) 4) (test (f11 1) 3) (test (f12 1) 3) (test (f13 1) 3) (test (f14 1) 3) (test (f15) #f) (test (f16) #f) (test (f17 '(1 . 1)) 3) (test (f18) 4) (test (f19) 4) (test (f20) 4) (test (f21) 4) (test (f22 1) 4) (test (f23 1) 4) (test (f24 1) 4) (test (f25 1) 4) (test (f26 2) 4) (test (f27 2) 4) (test (f28 2) 4) (test (f29 2) 4) (test (f30 1 2) 4) (test (f31 1 2) 4) (test (f32 1 2) 4) (test (f33 1 2) 4) )) ;;; global name opts (or lack thereof) ;;; the funny names used here must be nonce words ;;; op_unknown (thunk): (define *x1* #f) (define (test*x1*) (*x1*)) (define (set*x1* n) (set! *x1* (lambda () n))) (set*x1* 1) (test (test*x1*) 1) (set*x1* 2) (test (test*x1*) 2) (define *x2* #f) (define (test*x2*) (*x2*)) (define (set*x2* n) (set! *x2* (define* (_) n))) (set*x2* 1) (test (test*x2*) 1) (set*x2* 2) (test (test*x2*) 2) ;;; op_unknown_q: (define *x3* #f) (define (test*x3*) (*x3* 'a)) (define (set*x3* n) (set! *x3* (lambda (x) n))) (set*x3* 1) (test (test*x3*) 1) (set*x3* 2) (test (test*x3*) 2) ;;; op_unknown_s: (define *x4* #f) (define (test*x4* a) (*x4* a)) (define (set*x4* n) (set! *x4* (lambda (x) n))) (set*x4* 1) (test (test*x4* 0) 1) (set*x4* 2) (test (test*x4* 0) 2) (define *x5* #f) (define (test*x5* a) (*x5* a)) (define (set*x5* n) (set! *x5* (define* (_ __) n))) (set*x5* 1) (test (test*x5* 0) 1) (set*x5* 2) (test (test*x5* 0) 2) ;;; op_unknown_c: (define *x6* #f) (define (test*x6*) (*x6* 0)) (define (set*x6* n) (set! *x6* (lambda (x) n))) (set*x6* 1) (test (test*x6*) 1) (set*x6* 2) (test (test*x6*) 2) ;;; op_unknown_ss: (define *x7* #f) (define (test*x7* a b) (*x7* a b)) (define (set*x7* n) (set! *x7* (lambda (x y) n))) (set*x7* 1) (test (test*x7* 0 0) 1) (set*x7* 2) (test (test*x7* 0 0) 2) (define *x8* #f) (define (test*x8* a b) (*x8* a b)) (define (set*x8* n) (set! *x8* (define* (_ x y) n))) (set*x8* 1) (test (test*x8* 0 0) 1) (set*x8* 2) (test (test*x8* 0 0) 2) ;;; op_unknown_sc: (define *x9* #f) (define (test*x9* a b) (*x9* a 0)) (define (set*x9* n) (set! *x9* (lambda (x y) n))) (set*x9* 1) (test (test*x9* 0 0) 1) (set*x9* 2) (test (test*x9* 0 0) 2) (define *x10* #f) (define (test*x10* a b) (*x10* a 0)) (define (set*x10* n) (set! *x10* (define* (_ x y) n))) (set*x10* 1) (test (test*x10* 0 0) 1) (set*x10* 2) (test (test*x10* 0 0) 2) ;;; op_unknown_cs: (define *x11* #f) (define (test*x11* a b) (*x11* 0 b)) (define (set*x11* n) (set! *x11* (lambda (x y) n))) (set*x11* 1) (test (test*x11* 0 0) 1) (set*x11* 2) (test (test*x11* 0 0) 2) (define *x12* #f) (define (test*x12* a b) (*x12* 0 b)) (define (set*x12* n) (set! *x12* (define* (_ x y) n))) (set*x12* 1) (test (test*x12* 0 0) 1) (set*x12* 2) (test (test*x12* 0 0) 2) ;;; globals (test (let () (define (call-func func arg1 arg2) (define (call) (func arg1 arg2)) (call)) (call-func + 1 2.5) (call-func - 5 2)) 3) (test (let () (define (call-func arg1 arg2) (let ((func (if (= arg1 1) + -))) (define (call) (func arg1 arg2)) (call))) (call-func 1 2.5) (call-func 5 2)) 3) ;;; safe/unsafe troubles (let () (define (testit) (define (f1 x y z) (car z)) (define (f2 lst) (cond ((null? lst) ()) (else (f1 lst (f2 (cdr lst)) lst)))) (test (f2 '(abs -1)) 'abs)) (testit)) (let () (define (testit) (define (f1 x y z) (car z)) (define (f2 lst) (cond ((null? lst) ()) (else (f1 (f2 (cdr lst)) (f2 (cdr lst)) lst)))) (test (f2 '(abs -1)) 'abs)) (testit)) ;;; changing a function's environment -- blocked now if function is safe (let () (let ((e (let ((a 1) (b 2)) (curlet)))) (define (f1 c) (+ a b c)) (test (set! (outlet (funclet f1)) e) 'error)) (let ((e (let ((a 1) (b 2)) (curlet)))) (define f2 (let ((d 10)) (lambda (c) (+ a b c d)))) (test (set! (outlet (outlet (funclet f2))) e) e) (test (f2 4) 17)) (let ((e (let ((a 1) (b 2)) (curlet)))) (define f3 (with-let e (lambda (c) (+ a b c)))) (test (f3 4) 7))) (let () ;; symbol id > let id at redefinition! from Kjetil Matheussen. (define (seq) (let ((fins (lambda () (let ((paint 1)) (lambda () (display paint #f))))) (sub-area #f) (paint 2) (my-display display)) (define (paint-internal) (my-display paint #f) (sub-area)) (set! sub-area (fins)) (define (paint) 3) paint-internal)) (test ((seq)) 1)) ; the first "paint" (let () ; similar to above (define (f1) (define (f2) (define paint 1) (define (_) (display paint #f))) (define paint 2) (define (f3) (sub)) (define sub (f2)) (define (paint) 3) f3) (test ((f1)) 1)) (let () ; similar to above but hits the "add" not the "set" branch (define (f1) (define (f2) (define paint 1) (define (_) (display paint #f))) (define (f3) (sub)) (define sub (f2)) (define (paint) 3) f3) (test ((f1)) 1)) (let () (define (f1) (define (f2) (define (f4) (display paint #f)) (define paint f4)) (define (f3) (sub)) (define sub (f2)) (define (paint) 3) f3) (test (procedure? (((f1)))) #t)) (let () (define (paint) 2) (define (f3) (sub)) (define (sub) (paint)) ; here (define sub paint) is not the same as (define (sub) (paint)): closure delays decision?? (define (paint) 3) (test (f3) 3)) ;; this hits the same code in define2_ex: ;; (let () (define (f2) (define paint 1)) (f2) (define (paint) 3)) (let () (define (f0) (define (f1) paint)) (define (f2) (define paint 1) (define (f3) paint)) (define f4 (f2)) (define f5 (f0)) (define paint 3) (test (+ (f4) (f5)) 4)) ;; same problem but in define_funchecked: (let () (define (A k x1) (define (f1) (define (B) #f) B) (f1) (define (B) (set! k (- k 1)) (A k B)) (if (<= k 0) 0 (B))) (test (A 10 (lambda () 1)) 0)) (let () (define (ftc) (define (safef x) (if x 3 2)) (test (safef 4) 3) (test (varlet (funclet safef) 'y 1) 'error) (test (safef 4) 3)) (catch #t ftc (lambda (type info) (apply format *stderr* info))) (define (ftc1) (define (safef1 x) (if x 3 2)) (test (safef1 4) 3) (test (with-let (funclet safef1) (define y 1)) 'error) (test (safef1 4) 3)) (catch #t ftc1 (lambda (type info) (apply format *stderr* info))) (define (ftc2) (define* (safef2 (x (define y 1))) (if x 3 2)) (test (safef2) 3) (test (safef2) 3)) (catch #t ftc2 (lambda (type info) (apply format *stderr* info))) (define (ftc3) (define* (safef3 x (y (define z 3))) (if x y 2)) (test (safef3) 2) (test (safef3) 2)) (catch #t ftc3 (lambda (type info) (apply format *stderr* info))) (define (ftc4) (let* safef4 ((x 1) (z (define y 1))) (if x 3 2))) (test (ftc4) 3) (define (ftc5) (let safef5 ((x 1) (z (define y 1))) (if x 3 2))) (test (ftc5) 3) (define (ftc6) (define-macro (safef6 x) `(if ,x 3 2)) (test (safef6 4) 3) (varlet (funclet safef6) 'y 1) (test (safef6 4) 3)) (catch #t ftc6 (lambda (type info) (apply format *stderr* info))) ) ;;; -------------------------------------------------------------------------------- ;;; values ;;; call-with-values ;;; list-values ;;; apply-values ;;; multiple-value-bind ;;; -------------------------------------------------------------------------------- (test (call-with-values (lambda () (values 1 2 3)) +) 6) (test (call-with-values (lambda () (values 4 5)) (lambda (a b) b)) 5) (test (call-with-values (lambda () (values 4 5)) (lambda (a b) (+ a b))) 9) (test (call-with-values * -) -1) ; yeah, right... (- (*)) (test (values 1) 1) (test (call-with-values (lambda () (values 1 2 3 4)) list) (list 1 2 3 4)) (test (+ (values 1) (values 2)) 3) (test (+ (values '1) (values '2)) 3) (test (if (values #t) 1 2) 1) (test (if (values '#t) 1 2) 1) (test (if (values #f) 1 2) 2) (test (if (values #f #f) 1 2) 2) (test (if (values #t #f) 1 2) 1) (test (if (values () 1) 3 4) 3) (test (if (values) 1 2) 1) (test (if ((lambda () (values #t #f))) 1 2) 1) (test (if (values #f #t) 1) #) (test (if (values #t 1) (list (values 2 3))) (list 2 3)) (test (equal? (values #t #t)) #t) (test (call-with-values (lambda () 4) (lambda (x) x)) 4) (test (let () (values 1 2 3) 4) 4) (test (apply + (values ())) 0) (test (+ (values 1 2 3)) 6) (test (let ((f (lambda () (values 1 2 3)))) (+ (f))) 6) (num-test (log (values 8 2)) 3) (test (* (values 2 (values 3 4))) 24) (test (* (values (+ (values 1 2)) (- (values 3 4)))) -3) (test (list (values 1 2) (values 3) 4) '(1 2 3 4)) (test (let ((f1 (lambda (x) (values x (+ x 1)))) (f2 (lambda () (values 2)))) (+ (f1 3) (* 2 (f2)))) 11) (test (+ (let () (values 1 2)) 3) 6) (test (let () (values 1 2) 4) 4) (test (let () + (values 1 2) 4) 4) (test (string-ref (values "hiho" 2)) #\h) (test (vector-ref (values (vector 1 2 3)) 1) 2) (test (+ (values (+ 1 (values 2 3)) 4) 5 (values 6) (values 7 8 (+ (values 9 10) 11))) 66) (test (+ (if (values) (values 1 2) (values 3 4)) (if (null? (values)) (values 5 6) (values 7 8))) 18) ; (values) is now # (sort of) (test (+ (cond (#f (values 1 2)) (#t (values 3 4))) 5) 12) (test (+ (cond (#t (values 1 2)) (#f (values 3 4))) 5) 8) (test (apply + (list (values 1 2))) 3) (test (apply + (list ((lambda (n) (values n (+ n 1))) 1))) 3) (test (+ (do ((i 0 (+ i 1))) ((= i 3) (values i (+ i 1))))) 7) (test (+ (with-input-from-string "(values 1 2 3)" (lambda () (eval (read)))) 2) 8) (test (< (values 1 2 3)) #t) (test (apply (values + 1 2) '(3)) 6) (test (let () (define-macro (hi a) `(+ 1 ,a)) (hi (values 1 2 3))) 7) (test (+ 1 (eval-string "(values 2 3 4)")) 10) (test (+ 1 (eval '(values 2 3 4))) 10) (test (or (values #t) #f) #t) (test (and (values #t) #f) #f) (test (let ((x 1)) (set! x (values 32)) x) 32) (test (let ((x #(32 33))) ((values x) 0)) 32) (test (let ((x #(32 33))) (set! ((values x) 0) 123) x) #(123 33)) (test (list-ref '(1 (2 3)) (values 1 1)) 3) (test (list-ref (values '(1 (2 3)) 1 1)) 3) (test (list-ref ((lambda () (values '(1 (2 3)) 1 1)))) 3) (test (set! (values) 1) 'error) (test (+ (values (begin (values 1 2)) (let ((x 1)) (values x (+ x 1))))) 6) (test (vector 1 (values 2 3) 4) #(1 2 3 4)) (test (vector (values 1 (values 2 3) (values (values 4)))) #(1 2 3 4)) (test(+ 1 (values (values (values 2) 3) (values (values (values 4)) 5) 6) 7) 28) (test (map (values values #(1 2))) '(1 2)) (test ((values values) (values 0)) 0) (test (((values values values) 0)) 0) (test ((apply (values values values '((1 2))))) '(1 2)) (test (apply begin (values (list 1))) 1) (test (apply begin (values '(values "hi"))) (apply (values begin '(values "hi")))) (test ((object->string values) (abs 1)) #\a) (test (list? (values 1 2 3)) 'error) (test (list? (values 1)) #f) (test (list? (values (list 1 2 3))) #t) (test (let () (define (f) (and () (values #f 1 2) (vector 0))) (f) (f)) #f) ; and_safe_p2->and_safe_p_rest (test (let () (define (f) (and (values #f 1 2) 1 (vector 0))) (f) (f)) #f) ; same p1 (test (let () (define (f) (and (values #f 1 2) 1 (subvector (vector 0) 0 0))) (f) (f)) #f) (test (let () (define (fv) (let ((x (list-values (values)))) (null? x))) (fv)) #t) (test (let loop ((a 2) (b 0)) (if (zero? a) b (loop (values (- a 1) (+ b 1))))) 2) (test (begin (values 1 2 3) 4) 4) (test (+ 5 (begin (values 1 2 3) 4)) 9) (test (let () (define (f) (+ 5 (begin (values 1 2 3) 4))) (f)) 9) (test (values (values)) #) (test (values (values 1)) 1) (test (list (values (values 1 2 3))) '(1 2 3)) (test (values (values 'one)) 'one) (test (list (c-macro-with-values 1 2 3)) '(1 2 3)) (test (let () (define (f) (list (values (int-vector (values 1 2)) (int-vector (values 1 2))))) (f)) (list #i(1 2) #i(1 2))) (test (list (values2 1 2)) '(1 2)) (test (list (unsafe-values2 1 2)) '(1 2)) (let ((gb1 'gb2) (gb2 'gb3) (gb3 '(+ 1 2))) ;; make sure values does not evaluate (test gb1 'gb2) (test (values gb1) 'gb2) (test (list gb1 gb2 gb3) '(gb2 gb3 (+ 1 2))) (test (list (values gb1 gb2 gb3)) '(gb2 gb3 (+ 1 2))) (test (list (values (values gb1 gb2) gb3)) '(gb2 gb3 (+ 1 2))) (test (eval gb1)'gb3) ; or symbol->value (test (eval (eval gb1)) '(+ 1 2)) (test (eval (eval (eval gb1))) 3)) (test (+ (call-with-exit (lambda (ret) (values 1 2 3)))) 6) (test (+ 4 (call-with-exit (lambda (ret) (values 1 2 3))) 5) 15) (test (+ (call-with-exit (lambda (ret) (ret 1 2 3)))) 6) (test (+ 4 (call-with-exit (lambda (ret) (ret 1 2 3))) 5) 15) (test (+ (call/cc (lambda (ret) (values 1 2 3)))) 6) (test (+ 4 (call/cc (lambda (ret) (values 1 2 3))) 5) 15) (test (+ (call/cc (lambda (ret) (ret 1 2 3)))) 6) (test (+ 4 (call/cc (lambda (ret) (ret 1 2 3))) 5) 15) (test (+ (dynamic-wind (lambda () (values 1 2)) (lambda () (values 3 4)) (lambda () (values 5 6)))) 7) (test (let ((g #f)) (+ (call-with-exit (lambda (ret) (set! g ret) (values 1 2 3)))) (g)) 'error) (test (+ (call-with-exit (lambda (ret) (ret (values 1 2 3))))) 6) (test (+ (call/cc (lambda (ret) (ret (values 1 2 3))))) 6) (test ((lambda () (format #f "~S" (car (list (list-values ((lambda (a) (values a (+ a 1))) 2) :rest) (make-vector 3 '(1) pair?)))))) "(2 3 :rest)") (test (newline (open-output-function (lambda (a) (values a (+ a 1))))) 'error) (test (let () (define (func) (copy # (newline (open-output-function (lambda (a) (values a (+ a 1))))))) (func)) 'error) (test (list ((list (lambda (a) (values a (+ a 1)))) 0 1)) 'error) ; '(1 2)) (test (list (list-ref (list (lambda (a) (catch #t (lambda () (+ 1 #\a)) (lambda (type info) (values a (+ a 1)))))) 0 1)) 'error) ; '(1 2)) (test (+ (with-input-from-string "123" (lambda () (values 1 2 3)))) 6) (test (+ (call-with-input-string "123" (lambda (p) (values 1 2 3)))) 6) (test (+ (eval-string "(values 1 2 3)")) 6) (let ((_d_ (values))) (test (list-values _d_) ()) (test (let () (define (func) (list-values _d_)) (func)) ())) (let () (test (let ((x 1)) (set! x (apply values (signature (hash-table))))) 'error) (test (signature (hash-table)) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) sig))) (test (let ((x 1)) (set! x (values)) x) #) (test ((lambda () (let ((x 1)) (set! x (boolean? (values)))))) #f) (test (let ((x 1)) (set! x (values 1 2 3)) x) 'error) (test (let ((x 1)) (set! x (values 2)) x) 2) (test (let ((x 1)) (set! (values x) 2) x) 'error) ; (no generalized set for values, so (values x) is not the same as x (test (let ((x #(0 1))) (set! (values x 0 32)) x) 'error) (test (let ((var (values 1 2 3))) var) 'error) (test (let* ((var (values 1 2 3))) var) 'error) (test (letrec ((var (values 1 2 3))) var) 'error) (test (let ((x ((lambda () (values 1 2))))) x) 'error) (test (+ 1 ((lambda () ((lambda () (values 2 3)))))) 6) (test (let () (define (hi) (symbol? (values 1 2 3))) (hi)) 'error) (test (let () (define (hi) (symbol? (values))) (hi)) #f) ; this is consistent with earlier such cases: (boolean? (values)) (test (let () (define (hi) (symbol? (values 'a))) (hi)) #t) (test (let () (define (hi) (symbol? (values 1))) (hi)) #f) (test (let () (define (hi a) (log (values 1 2) a)) (hi 2)) 'error) (test (let () (define (arg2 a) (let ((b 1)) (set! b (+ a b)) (values b a))) (define (hi c) (expt (abs c) (arg2 2))) (hi 2)) 'error) (test (let () (define (arg2 a) (let ((b 1)) (set! b (+ a b)) (values b))) (define (hi c) (expt (abs c) (arg2 2))) (hi 2)) 8) (test (let () (define (hi) (+ (values 1 2) (values 3 4))) (hi)) 10) (test (let () (define (func) (let ((i 0)) ((lambda (a) (sort! a >)) (list-values (values 1 2 3) (+ i 1))))) (func)) '(3 2 1 1)) ; list-value embedded immutable list bug (test (catch #t (lambda () (let ((x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "let: can't bind x to (values 1 2)") (test (catch #t (lambda () (let ((y 1) (x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "let: can't bind x to (values 1 2)") (test (catch #t (lambda () (let* ((x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "let*: can't bind x to (values 1 2)") (test (catch #t (lambda () (let* ((y 1) (x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "let*: can't bind x to (values 1 2)") (test (catch #t (lambda () (letrec ((x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "letrec: can't bind x to (values 1 2)") (test (catch #t (lambda () (letrec ((y 1) (x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "letrec: can't bind x to (values 1 2)") (test (catch #t (lambda () (letrec* ((x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "letrec*: can't bind x to (values 1 2)") (test (catch #t (lambda () (letrec* ((y 1) (x (values 1 2))) x)) (lambda (type info) (apply format #f info))) "letrec*: can't bind x to (values 1 2)") (test (catch #t (lambda () (let ((x 1)) (let-temporarily ((x (values 1 2))) x))) (lambda (type info) (apply format #f info))) "set!: can't set x to (values 1 2)") (test (catch #t (lambda () (let-temporarily (((*s7* 'print-length) (values 1 2))) 1)) (lambda (type info) (apply format #f info))) "let-set!: too many arguments: (let-set! *s7* print-length 1 2)") (test (catch #t (lambda () (let ((x 1)) (set! x (values 1 2)))) (lambda (type info) (apply format #f info))) "(set! x (values 1 2)): too many arguments to set!") (test (catch #t (lambda () (let ((x (vector 1))) (set! (x 0) (values 1 2)))) (lambda (type info) (apply format #f info))) "(set! (x 0) (values 1 2)): too many arguments to set!") (test (catch #t (lambda () (with-let (values (curlet) 2) 3)) (lambda (type info) (apply format #f info))) 3) (let () (define (f1) (let ((ints (list 1 2 3))) (apply + (values 5 ints)))) (test (f1) 11)) (let () (define (f2) (let ((ints (list 1 2 3))) (apply + (values 4 5 ints)))) (test (f2) 15)) (let () (define (f3) (let ((ints (list 1 2 3))) (apply + (values 4 5 6 ints)))) (test (f3) 21)) (test (let ((str "hi")) (string-set! (values str 0 #\x)) str) "xi") (test (values if) if) (test (values quote) quote) (test ((values '(1 (2 3)) 1 1)) 3) (test (let ((x #(32 33))) ((values x 0))) 32) (test (+ 1 (apply values '(2 3 4))) 10) (test (eq? (values) (apply values ())) #t) (test (+ 1 ((lambda args (apply values args)) 2 3 4)) 10) (test (apply begin '(1 2 3)) 3) (test (let ((x 1)) ((values set!) x 32) x) 32) ; values_p_p opt2_con? (let ((x 0)) (test (list (set! x 10)) (call-with-values (lambda () (set! x 10)) list))) ; from r7rs discussion (let ((v (vector 1))) (catch #t (lambda () (set! (v 0) (values 1 2)) (format *stderr* "(set! (v 0) (values 1 2)) -> no error?~%")) (lambda (type info) (if (not (eq? type 'syntax-error)) ; maybe should be 'wrong-number-of-args-error (format *stderr* "(set! (v 0) (values 1 2)): ~A ~A~%" type info))))) (let ((p (list 1))) (catch #t (lambda () (set! (p 0) (values 1 2)) (format *stderr* "(set! (p 0) (values 1 2)) -> no error?~%")) (lambda (type info) (if (not (eq? type 'syntax-error)) ; wrong number of args to set! (format *stderr* "(set! (p 0) (values 1 2)): ~A ~A~%" type info))))) (let ((h (hash-table 'a 1))) (catch #t (lambda () (set! (h 'b) (values 1 2)) (format *stderr* "(set! (h 'b) (values 1 2)) -> no error?~%")) (lambda (type info) (if (not (eq? type 'syntax-error)) ; wrong number of args to set! (format *stderr* "(set! (h 'b) (values 1 2)): ~A ~A~%" type info))))) ;;; similarly string/int-vector/float-vector -- seem to be ok (let () (define (curry function . args) (lambda more-args (function (apply values args) (apply values more-args)))) ; unfortunately this doesn't handle 0 args (test ((curry + 1 2) 3 4) 10)) (let () (define (curry function . args) (if (null? args) function (lambda more-args (if (null? more-args) (apply function args) (function (apply values args) (apply values more-args)))))) (test ((curry + 1 2) 3 4) 10) (test ((curry + 2) 3 4) 9) (test ((curry +) 3 4) 7) (test ((curry +)) 0) (test ((curry + 1 2)) 3) (test ((curry + 1)) 1) (test ((curry +) 1) 1)) (test (or (values #t #f) #f) #t) (test (or (values #f #f) #f) #f) (test (or (values #f #t) #f) #t) (test (or (values #f #f) #t) #t) (test (or (values 1 2) #f) 1) (test (+ 1 (or (values 2 3) 4)) 3) (test (+ 1 (and 2 (values 3 4)) 5) 13) (test (and (values) 1) 1) (test (and (values 1 2 #f) 4) #f) (test (and (values 1 2 3) 4) 4) (test (length (values ())) 0) (test (length (values #(1 2 3 4))) 4) (test (vector? (values #())) #t) (test (map + (values '(1 2 3) #(1 2 3))) '(2 4 6)) (test (map + (values '(1 2 3)) (values #(1 2 3))) '(2 4 6)) (test (map + (values '(1 2 3) #(4 5 6)) (values '(7 8 9))) '(12 15 18)) (test (catch 'oops (lambda () (error 'oops (let-temporarily () (values 1 2 3)))) (lambda (t i) 'error)) 'error) ; for sticky mv bit (test (let ((x 1)) (and (let () (set! x 2) #f) (let () (set! x 3) #f)) x) 2) (test (let ((x 1)) (and (values (let () (set! x 2) #f) (let () (set! x 3) #f))) x) 3) (test (+ (values 1 2) 3) 6) (test (+ (values 1 (values 2))) 3) (test (list (values 1 2)) '(1 2)) (test (+ 6 (values 1 (values 2 3) 4 ) 5) 21) (test (+ ((lambda (x) (values (+ 1 x))) 2) 3) 6) (test (list ((lambda (x) (values (+ 1 x))) 2)) '(3)) (test (+ (begin (values 1 2))) 3) (test (+ 1 (let () (values 1 2))) 4) (test (apply (values + 1 2) (list 3)) 6) (test ((lambda* ((a 1) (b 2)) (list a b)) (values :a 3)) '(3 2)) (test (+ (values (values 1 2) (values 4 5))) 12) (test (+ (begin 3 (values 1 2) 4)) 4) (test (map (lambda (x) (if #f x (values))) (list 1 2)) ()) (test (map (lambda (x) (if #f x (begin (values)))) (list 1 2)) ()) (test (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4)) '(1 20 3 60)) (test (map (lambda (x) (if (odd? x) (values x (* x 20)) (if #f #f))) (list 1 2 3 4)) '(1 20 # 3 60 #)) (test (map (lambda (x) (if (odd? x) (apply values '(1 2 3)) (values))) (list 1 2 3 4)) '(1 2 3 1 2 3)) (test (object->string (map (lambda (x) (if (odd? x) (values x (* x 20)) (values))) (list 1 2 3 4))) "(1 20 3 60)") ; make sure no "values" floats through (test (map (lambda (x) (if (odd? x) (values x (* x 20) (cons x (+ x 1))) (values))) (list 1 2 3 4 5 6)) '(1 20 (1 . 2) 3 60 (3 . 4) 5 100 (5 . 6))) (test (* 2 (case 1 ((2) (values 3 4)) ((1) (values 5 6)))) 60) (test (* 2 (case 1 ((2) (values 3 4)) (else (values 5 6)))) 60) (test (* 2 (case 1 ((1) (values 3 4)) (else (values 5 6)))) 24) (test (+ (values (* 3 2) (abs (values -1)))) 7) (test (+ (let ((x 1)) (values x (+ x 1))) (if #f #f (values 2 3))) 8) ;;; the test macro here causes the multiple values to evaporate, ruining the test (let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector #f (_vals_) (append))) (define (hi) (func)) (hi)))) (s2 (object->string (let () (define (func) (vector #f (values 1 2 3) (append))) (define (hi) (func)) (hi))))) (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2))) (let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector (_vals_) (append))) (define (hi) (func)) (hi)))) (s2 (object->string (let () (define (func) (vector (values 1 2 3) (append))) (define (hi) (func)) (hi))))) (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2))) (let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector #f (_vals_))) (define (hi) (func)) (hi)))) (s2 (object->string (let () (define (func) (vector #f (values 1 2 3))) (define (hi) (func)) (hi))))) (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2))) (let ((s1 (object->string (let ((_vals_ (lambda () (values 1 2 3)))) (define (func) (vector (append) (_vals_) #f)) (define (hi) (func)) (hi)))) (s2 (object->string (let () (define (func) (vector (append) (values 1 2 3) #f)) (define (hi) (func)) (hi))))) (unless (equal? s1 s2) (format *stderr* "unequal: ~S ~S~%" s1 s2))) (test (let ((sum 0)) (for-each (lambda (n m p) (set! sum (+ sum n m p))) (values (list 1 2 3) (list 4 5 6) (list 7 8 9))) sum) 45) (test (map (lambda (n m p) (+ n m p)) (values (list 1 2 3) (list 4 5 6) (list 7 8 9))) '(12 15 18)) (test (string-append (values "123" "4" "5") "6" (values "78" "90")) "1234567890") (test (+ (dynamic-wind (lambda () #f) (lambda () (values 1 2 3)) (lambda () #f)) 4) 10) (when with-block ;; op_safe_c_pa_mv plist bug (test (format #f "~S~%" (list (list-values (values 1 2 3 4 5 6 7 8 9 10) (block 1.0 2.0 3.0)) (make-vector 3 :rest keyword?))) (let () (define (func) (format #f "~S~%" (list (list-values (values 1 2 3 4 5 6 7 8 9 10) (block 1.0 2.0 3.0)) (make-vector 3 :rest keyword?)))) (define (hi) (func)) (hi))) ;; list-values bug when args contains an immutable list (test (list-values (vector (block 0.0)) (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y))))) (list (vector (block 0)) 1 2)) (test (let () (define (func) (list (vector (block 0.0)) (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))))) (func)) (list (vector (block 0)) 1 2)) (test (let () (define (func) (list-values (vector (block 0.0)) (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))))) (func)) (list (vector (block 0)) 1 2))) (let ((x 'y) (y 32)) (define (f1) (values #f)) (test (if (values #f) x) #) (test (if (values #t) x) 'y) (test (if (values #f) (values x)) #) (test (if (values #t) (values x)) 'y) (test (if x (values x)) 'y) (test (list (values x)) '(y)) (test (list (values x y)) '(y 32)) (test (cond ((values x) => list)) '(y)) (test (cond ((values x y) => list)) '(y)) (test (cond ((values #f) => list)) #) (test (cond ((values #t) => list)) '(#t)) (test (cond ((f1) => list)) #) (test (list (cond ((values x)))) '(y)) (test (list (cond ((values x y)))) '(y)) (test (list (cond (#t (values x)))) '(y)) (test (list (cond (#t (values x y)))) '(y 32)) (test (cond ((values x) => (lambda args (apply list args)))) '(y)) (test (cond ((values x y) => (lambda args (apply list args)))) '(y))) ;;; increment_sz_mv: (test (let () (define (func) (let ((x 0)) (set! x (float-vector x (values 1 2))))) (define (hi) (func) (func)) (hi) (hi)) #r(0 1 2)) (test (let () (define (func) (let ((x #\a)) (set! x (string x (values #\b #\c))))) (define (hi) (func) (func)) (hi) (hi)) "abc") (test (let () (define (func) (let ((x 0)) (set! x (vector x (values 1 2))))) (define (hi) (func) (func)) (hi) (hi)) #(0 1 2)) (for-each (lambda (arg) (test (values arg) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (apply values arg) 'error) (test (apply values (list arg)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t '(1 . 2))) (for-each (lambda (arg) (test (call-with-values (lambda () (values arg arg)) (lambda (a b) b)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (call-with-values (lambda () (values "hi" 1 3/2 'a)) (lambda (a b c d) (+ b c))) 5/2) ;(test (call-with-values values (lambda arg arg)) ()) (test (string-ref (values "hi") 1) #\i) (test ((lambda (a b) (+ a b)) ((lambda () (values 1 2)))) 3) (test (list (letrec ((split (lambda (ls) (if (or (null? ls) (null? (cdr ls))) (values ls ()) (call-with-values (lambda () (split (cddr ls))) (lambda (odds evens) (values (cons (car ls) odds) (cons (cadr ls) evens)))))))) (split '(a b c d e f)))) '((a c e) (b d f))) (let () (define (f1 . args) (apply values (+ (car args) (cadr args)) (cddr args))) (test (* (f1 2 3 4)) 20) (test (* (f1 2 3 4) (f1 1 2 3)) 180) (test (- (f1 2 3 4) (f1 1 2 3)) -5)) (test (call-with-values (lambda () (call/cc (lambda (k) (k 2 3)))) (lambda (x y) (list x y))) '(2 3)) (test (+ (call/cc (lambda (return) (return (values 1 2 3)))) 4) 10) (test (let ((values 3)) (+ 2 values)) 5) (test (let ((a (values 1))) a) 1) (test (call-with-values (lambda () 2) (lambda (x) x)) 2) (test (call-with-values (lambda () -1) abs) 1) (test (call-with-values (lambda () (values -1)) abs) 1) (test (call-with-values (lambda () (values -1)) (lambda (a) (abs a))) 1) (test (call-with-values (lambda () (values (call-with-values (lambda () (values 1 2 3)) +) (call-with-values (lambda () (values 1 2 3 4)) *))) (lambda (a b) (- a b))) -18) (test (call-with-values (lambda () (values (call-with-values (lambda () (values 1 2 3)) +) (call-with-values (lambda () (values 1 2 3 4)) *))) (lambda (a b) (+ (* a (call-with-values (lambda () (values 1 2 3)) +)) (* b (call-with-values (lambda () (values 1 2 3 4)) *))))) 612) (test (call-with-values (lambda (x) (+ x 1)) (lambda (y) y)) 'error) (test (+ (values . 1)) 'error) (for-each (lambda (arg) (test (call-with-values arg arg) 'error)) (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (call-with-values (lambda () (values -1 2)) abs) 'error) (test (multiple-value-bind (a b) (values 1 2) (+ a b)) 3) (test (multiple-value-bind (a) 1 a) 1) (test (multiple-value-bind (a . rest) (values 1 2 3) (+ a (apply + rest))) 6) (test (multiple-value-bind a (values 1 2 3) a) '(1 2 3)) (test (multiple-value-bind (x y z) (values 1 2 3) (list z y x)) '(3 2 1)) (test (multiple-value-bind (x y z) (values 1 2 3) (let ((x 4)) (list x y z))) '(4 2 3)) (test (multiple-value-bind (x y) (values 1 2) (define z (+ x y)) (+ z 1)) 4) (unless pure-s7 (test (multiple-value-bind (x y z) (values 1 2 3 4 5 6) (list x y z)) 'error) ; was '(1 2 3)) -- 25-Jan-16 (test (multiple-value-bind (x y z) (values 1 2) (list x y z)) 'error) ; was '(1 2 #f)) (test (multiple-value-bind (x y z) (multiple-value-bind () (values 1 2) (values 'a 'b 'c)) (list x y z)) 'error)) ;was '(a b c)) (test (let ((add (lambda (a b) (values (+ a 1) (+ b 1))))) (+ 1 (add 2 3))) 8) (test (min (values 1 2) (values 3 0)) 0) (test ((lambda* ((a 1) (b 2)) (list a b)) (values :b 231)) '(1 231)) (test (cons (values 1 2) (values 3 4)) 'error) (test (cond ((values) 3) (#t 4)) 3) ; an error in Guile "zero values returned" (test (cond ((values (values)) 3) (#t 4)) 3) ; same (test (+ (cond (#t (values 1 2)))) 3) ; 1 in guile (test (+ 1 (values)) 'error) (test (case (values 1) ((1) 2) (else 3)) 2) (test (case (values 1 2) ((1) 2) (else 3)) 2) ; was 3 until 17-Feb-18 (test (case (values 1) (((values 1)) 2) (else 3)) 3) (test (case (values 1 2) (((values 1 2)) 2) (else 3)) 3) (test (let () (define (f) (values 1 2)) (define (g1) (case (f) ((1) 1) (else 2))) (g1) (g1)) 1) ; splice case_i_s (test (let () (define (f1) (values 'a 'b)) (define (g1) (case (f1) ((a) 1) (else 2))) (g1) (g1)) 1) ; case_e_s (test (let () (define (g1) (case (values 'a 'b) ((a) 1) ((2) 0) (else 2))) (g1) (g1)) 1) ; case_g_s (test (let () (define (g1) (case (values 'a 'b) ((a b) 1) ((c) 2) (else 3))) (g1) (g1)) 1) ; case_e_g (test (case (values 1 2) ((1) 0)) 0) (test ((values) 0) 'error) (test ((values "hi") 1) #\i) (test (string-ref (values "hi") 0) #\h) (test (string-ref (values "hi" "ho") 0) 'error) (test (let ((str "hi")) (set! ((values str) 0) #\x) str) "xi") (test (let ((str "hi")) (string-set! (values str) 0 #\x) str) "xi") (test (let ((str "hi")) (set! (values str 0) #\x) str) 'error) ; values does not have a setter? (test (let ((str "hi")) (string-set! (values str 0) #\x) str) "xi") (test ((values 1 2 3) 0) 'error) (test ((values "hi" "ho") 1) 'error) (test ((values + 1 2 3)) 6) (test ((values + 1 2) 3) 6) (test ((values +) 1 2 3) 6) (test ((values "hi" 0)) #\h) (test ((values + 1) (values 2 3) 4) 10) (test ((values - 10)) -10) (test ((values - -10) 0) -10) ; looks odd but it's (- -10 0) that is (- a) != (- a 0) (test ((values - 2 3) 0) -1) (test ((values - 2 3) 1) -2) (test ((values - 2 3) 2) -3) ; it's actually (- 2 3 2) -> -3 (test (let ((str "hi")) (set! ((values str 0) 0) #\x) str) 'error) (test (let ((str "hi")) (set! ((values str) 0) #\x) str) "xi") (test (+ (let ((x 0)) (do ((i (values 0) (+ i 1))) (((values = i 10)) (values x 2 3)) (set! x (+ x i)))) 4) 54) (test (let ((v #2d((1 2) (3 4)))) (set! ((values v) 1 0) 5) v) #2d((1 2) (5 4))) ; same as (let ((v #2d((1 2) (3 4)))) (set! (v 1 0) 5) v) ;;; but: (let ((v #2d((1 2) (3 4)))) (set! ((values v) 1) 5) v): not enough args for vector-set!: (#2d((1 2) (3 4)) 1 5) ;;; (let ((v #2d((1 2) (3 4)))) (set! ((values v) 1) 0 5) v): (set! ((values v) 1) 0 5): too many arguments to set! ;;; (let ((v #2d((1 2) (3 4)))) (set! ((values v 1) 0) 5) v): (set! #2d((1 2) (3 4)) 1 0 5): too many arguments to set! ;;; not sure this is consistent! or even makes any sense (let () ; these are testing values splicing across eval-done boundaries (define (f1 x) (+ 1 (with-input-from-string "asdf" (lambda () (values x x x))))) (test (f1 2) 7) (define (f2 x) (+ 1 (dynamic-wind (lambda () #f) (lambda () (with-input-from-string "asdf" (lambda () (values x x x)))) (lambda () #f)))) (test (f2 2) 7) (define (f3 x) (+ 1 (let-temporarily ((x 2) ((*s7* 'print-length) 12)) (with-input-from-string "asdf" (lambda () (let ((L (openlet (inlet 'func (lambda () (values x x x)))))) (with-let L (func)))))))) (test (f3 3) 7)) (test (map values (list (values 1 2) (values 3 4))) '(1 2 3 4)) (test (let () (define-macro (hi a) `(+ 1 ,a)) (hi (values 2 3 4))) 10) (test (let () (+ 4 (let () (values 1 2 3)) 5)) 15) (test (let* () (+ 4 (let () (values 1 2 3)) 5)) 15) (test (let () (+ 4 (let* () (values 1 2 3)) 5)) 15) (test (letrec () (+ 4 (let () (values 1 2 3)) 5)) 15) (test (let () (+ 4 (letrec () (values 1 2 3)) 5)) 15) (test (letrec* () (+ 4 (let () (values 1 2 3)) 5)) 15) (test (let* () (+ 4 (letrec* () (values 1 2 3)) 5)) 15) (test (cons (values 1 2)) '(1 . 2)) (test (number->string (values 1 2)) "1") (test (object->string (values)) (if (provided? 'debugging) "#" "#")) (test (equal? (begin) (begin (values))) #f) ; () but # (test (map (lambda (x) (if #f x #)) (list 1 2)) '(# #)) (test (equal? (values) (if #f #f)) #t) (test (substring (values "hi") (values 1 2)) "i") (test (cond (call-with-exit (values "hi"))) "hi") (test (values (begin (values "hi"))) "hi") (test (< (values (values 1 2))) #t) (test (apply-values (cdr (list-values (values)))) 'error) (test (apply values (cdr (list-values (values)))) 'error) (test (apply-values) #) (test (apply-values ()) #) (test (apply values) #) (test (apply values ()) #) (test (list-values (values)) ()) (test (list-values (apply-values)) ()) (test (list-values (apply-values) (values)) ()) (test (list-values 1 (values) 2) '(1 2)) (test (list-values 1 2 (values)) '(1 2)) (test (list-values (values) 1 2) '(1 2)) (test (let ((_y_ list-values )) (define (f x) (cyclic-sequences (x 1))) (define (g) (f _y_)) (g)) ()) (test ((lambda (x) (cyclic-sequences (x 1) )) list-values) ()) (test (let ((x list-values)) (cyclic-sequences (x 1))) ()) (test (let () (define (f) ((lambda (a) (sort! a >)) (list-values ((let () quasiquote) (2 1))))) (f)) '((2 1))) (let () (define (func) (list (list-ref (list-values (lambda (a) (values a (+ a 1)))) 0 1))) (test (func) 'error)) ; '(1 2))) (let () (define (func) (list (list-ref (list (lambda (a) (values a (+ a 1)))) 0 1))) (test (func) 'error)) ; '(1 2))) (let () (define (func) (list ((lambda (a) (values a (+ a 1))) 0))) (test (func) '(0 1))) (let ((a 1)) (define (func x y) (list (list-ref (list (lambda (a) (values a (+ a 1)))) x y))) (test (func (+ a (- a)) (* a 1)) 'error)) ; '(1 2))) (test (let ((lst (list (values)))) (map values lst)) (list-values (values))) (test (let ((lst (list 1 (values) 2))) (map values lst)) (list-values 1 (values) 2)) (test (map values (list (values (values (values))))) (list-values (values (values (values))))) (let ((seq (list 1 2 (values) 3))) (test (let ((erg (apply list-values seq))) (let ((iter (if (iterator? erg) erg (make-iterator erg))) (result ())) (do ((x (iter) (iter))) ((iterator-at-end? iter) (reverse result)) (set! result (cons x result))))) (map values seq))) (test (let ((lst (list 0))) (set-cdr! lst lst) (format (values #f "~A" lst))) "#1=(0 . #1#)") (let () (define (mv n) (define (mv-1 a) (values a (+ a 1))) (define (mv-2 b) (values b (* b 2))) (values n (mv-1 n) (mv-2 n))) (test (list (mv 2)) '(2 2 3 2 4)) (test (+ (mv 1) (mv 3)) 26)) (let () (define (fib n) (define (1st a b) a) (define (fib-1 n) (if (< n 3) (values 1 1) (values (+ (fib-1 (- n 1))) (1st (fib-1 (- n 1)))))) (1st (fib-1 n))) (test (fib 8) 21) (test (fib 13) 233)) (let () (define (fib n) (define (1st a b) a) (define (2nd a b) (values (+ a b) a)) (define (fib-1 n) (if (< n 3) (2nd 1 0) (2nd (fib-1 (- n 1))))) (1st (fib-1 n))) (define (real-fib n) (let ((phi (/ (+ 1 (sqrt 5)) 2))) (floor (real-part (/ (- (expt phi n) ; "floor" to return an integer, real-part to guard against epsilonic imag-parts from expt (expt (- 1 phi) n)) (sqrt 5)))))) (test (fib 8) (real-fib 8)) (test (fib 13) (real-fib 13))) (let () (define (cfib z) ; wikipedia "generalized fibonacci numbers" (let ((phi (/ (+ 1 (sqrt 5)) 2))) (/ (- (expt phi z) (* (expt phi (- z)) (cos (* pi z)))) (sqrt 5)))) (num-test (cfib 3) 2.0) (num-test (cfib 8) 21.0) (num-test (cfib 3+4i) -5248.5113072837-14195.962288353i)) (num-test (let ((f- -) (f+ +)) (define (fb n) (if (< n 2.0) n (f+ (fb (f- n 1.0)) (fb (f- n 2.0))))) (fb 12.0)) 144.0) (let () ;; -------- Ely Bandersky (translated from python) -------- (define (fib-tail n0) (let fibber ((n n0) (ac1 1) (ac2 1)) (if (= n 0) ac1 (fibber (- n 1) (+ ac1 ac2) ac1)))) (test (fib-tail 6) 21) (define (fact-tail n0) (let facter ((n n0) (result 1)) (if (= n 0) result (facter (- n 1) (* n result))))) (test (fact-tail 6) 720) (define (fib-iter n0) (let ((ac1 1) (ac2 1)) (do ((n n0 (- n 1))) ((<= n 2) ac1) (let ((ac11 ac1)) (set! ac1 (+ ac1 ac2)) (set! ac2 ac11))))) (test (fib-iter 6) 8) (define (fact-cps n cont) (if (= n 0) (cont 1) (fact-cps (- n 1) (lambda (value) (cont (* n value)))))) (fact-cps 6 (lambda (n) (test n 720))) (define (fib-cps n cont) (if (< n 2) (cont 1) (fib-cps (- n 1) (lambda (value) (fib-cps (- n 2) (lambda (value2) (cont (+ value value2)))))))) (fib-cps 6 (lambda (n) (test n 13))) (define (trampoline f . args) (let ((v (apply f args))) (do () ((not (aritable? v 0)) v) (set! v (v))))) (define (fact-cps-chunked n cont) (if (= n 0) (cont 1) (lambda () (fact-cps-chunked (- n 1) (lambda (value) (lambda () (cont (* n value)))))))) (fact-cps-chunked 6 (lambda (n) (test n 720)))) (let () (define (flatten lst) (map values (list (let flatten-1 ((lst lst)) (cond ((null? lst) (values)) ((not (pair? lst)) lst) (else (values (flatten-1 (car lst)) (flatten-1 (cdr lst))))))))) #| ;; old form (define (flatten lst) ; flatten via values and map (define (flatten-1 lst) (cond ((null? lst) (values)) ((not (pair? lst)) lst) (#t (values (flatten-1 (car lst)) (flatten-1 (cdr lst)))))) (map values (list (flatten-1 lst)))) ;; another: (define (flatten lst) (let loop ((lst lst) (acc ())) (cond ((null? lst) acc) ((pair? lst) (loop (car lst) (loop (cdr lst) acc))) (else (cons lst acc))))) |# (test (flatten '(1 2 3)) '(1 2 3)) (test (flatten ()) ()) (test (flatten '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7)) (test (flatten '(1 ((((2)) 3)))) '(1 2 3)) (test (flatten '(1 () 2)) '(1 2)) (test (flatten '((1 () 2) ())) '(1 2)) (test (flatten '(() 1 ((2 (3)) () 4))) '(1 2 3 4)) (test (flatten '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8)) (test (flatten '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2)) ) (let () (define (flatten! lst) ; in-place flatten (if (not (pair? lst)) lst (let loop ((L lst)) (if (pair? (car L)) (let ((end (cdr L)) (p (car L))) (set! (car L) (car p)) (set! (cdr L) (cdr p)) (set! (cdr (list-tail L (- (length p) 1))) end) (loop L)) (if (not (null? (cdr L))) (if (null? (car L)) (begin (set! (car L) (cadr L)) (set! (cdr L) (cddr L)) (loop L)) (loop (cdr L))))) (if (equal? lst '(())) () (let ((len (length lst))) (if (null? (car (list-tail lst (- len 1)))) (set! (cdr (list-tail lst (- len 2))) ())) lst))))) (test (flatten! '(1 2 3)) '(1 2 3)) (test (flatten! ()) ()) (test (flatten! '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7)) (test (flatten! '(1 ((((2)) 3)))) '(1 2 3)) (test (flatten! '(1 () 2)) '(1 2)) (test (flatten! '((1 () 2) ())) '(1 2)) (test (flatten! '(() 1 ((2 (3)) () 4))) '(1 2 3 4)) (test (flatten! '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8)) (test (flatten! '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2)) ) (let () (define (flatten x) ; standard flatten (cond ((null? x) ()) ((not (pair? x)) (list x)) (#t (append (flatten (car x)) (flatten (cdr x)))))) (test (flatten '(1 2 3)) '(1 2 3)) (test (flatten ()) ()) (test (flatten '((1) 2 (3 4) (6 (7)))) '(1 2 3 4 6 7)) (test (flatten '(1 ((((2)) 3)))) '(1 2 3)) (test (flatten '(1 () 2)) '(1 2)) (test (flatten '((1 () 2) ())) '(1 2)) (test (flatten '(() 1 ((2 (3)) () 4))) '(1 2 3 4)) (test (flatten '((1) 2 ((3 4) 5) ((())) (((6))) 7 8 ())) '(1 2 3 4 5 6 7 8)) (test (flatten '(() 1 () ((2 (1)) 4) (3 2) ())) '(1 2 1 4 3 2)) ) (test (let () (define (hi a) (+ (abs a) (values 1 2 3))) (hi -4)) 10) (let () (define (hi a) (let ((x 0) (again #f)) (let ((y (+ (abs a) (call/cc (lambda (r) (set! again r) 1))))) (set! x (+ x y)) (if (< x 3) (again 1)) x))) (test (hi 0) 3)) (let () (define-macro (define-values1 vars . body) `(apply begin (map (lambda (var val) `(define ,var ,val)) ',vars (list (begin ,@body))))) (define-macro (let*-values1 vars . body) `(let () ,@(map (lambda (nvars . nbody) `(apply define-values1 ',nvars ',@nbody)) (map car vars) (map cdr vars)) ,@body)) (let () (define-values1 (a b) (values 3 2)) (test (* a b) 6)) (let () (test (let*-values1 (((a b) (values 3 2))) (* a b)) 6))) (define __p__ 123) (define current-rootlet (curlet)) (let ((__p__ 321)) (set! __p__ 432)) (if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__)) (let () (define (args) (values __p__ (* __p__ 2))) (let ((__p__ 0) (q 1)) (call-with-values args (lambda (a b) (set! __p__ a) (set! q b))) (if (not (= __p__ 123)) (format #t " local __p__: ~A~%" __p__)) (set! __p__ 432) (call-with-values args (lambda (__p__ q) (set! __p__ 321))) (if (not (= __p__ 432)) (format #t " local __p__: ~A~%" __p__)))) (if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__)) (let () (define-macro (args a b) `(values ,a ,b)) (define (sp a b) (set! a 121)) (define (pq __p__ q) (set! __p__ q)) (sp (args __p__ __p__)) (pq (args __p__ 567))) (if (not (= __p__ 123)) (format #t "__p__: ~A~%" __p__)) (let ((__p__ 321)) (eval '(set! __p__ 432) current-rootlet) (if (not (= __p__ 321)) (format #t " local __p__: ~A~%" __p__)) (eval '(set! __p__ 123)) (if (not (= __p__ 123)) (format #t " local __p__: ~A~%" __p__))) (if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__)) (let () (eval '(let ((__p__ 321)) (set! __p__ 456)) current-rootlet)) (if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__)) (let ((__p__ (values __p__))) (if (not (= __p__ 432)) (format #t " local __p__: ~A~%" __p__)) (set! __p__ 123)) (if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__)) (let () (define (sp __p__ q) (values __p__ q)) (call-with-values (lambda () (sp __p__ (* __p__ 2))) (let ((__p__ 1)) (lambda (a b) (set! __p__ a))))) (if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__)) (let ((lst (list __p__ (* __p__ 2)))) (define-macro (sp a) `(set! __p__ ,a)) (let ((__p__ 0) (q 1)) (define (pq a) (set! __p__ a)) (map sp (list __p__ q)) (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__)) (for-each sp (list __p__ q)) (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__)) (map sp lst) (if (not (= __p__ (* 432 2))) (format #t " local __p__: ~A~%" __p__)) (for-each sp lst) (if (not (= __p__ (* 432 2))) (format #t " local __p__: ~A~%" __p__)) (set! __p__ 0) (set! q 1) (map pq (list __p__ q)) (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__)) (for-each pq (list __p__ q)) (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__)) (map pq lst) (if (not (= __p__ (* 432 2))) (format #t " local __p__: ~A~%" __p__)) (for-each pq lst) (if (not (= __p__ (* 432 2))) (format #t " local __p__: ~A~%" __p__)))) (if (not (= __p__ 432)) (format #t "__p__: ~A~%" __p__)) (when (eq? (curlet) (rootlet)) (let ((__p__ 1)) (eval `(define (__p__ a) (+ a ,__p__)) current-rootlet) (if (not (= __p__ 1)) (format #t " local __p__: ~A~%" __p__))) (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__)) (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2))) (let ((__p__ 1)) (eval `(define __p__ 32)) (if (not (= __p__ 32)) (format #t " local __p__: ~A~%" __p__))) (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__)) (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2))) (let ((__p__ 1)) (eval `(define __p__ 32) (curlet)) (if (not (= __p__ 32)) (format #t " local __p__: ~A~%" __p__))) (if (not (procedure? __p__)) (format #t "__p__: ~A~%" __p__)) (if (not (= (__p__ 2) 3)) (format #t "(__p__ 2): ~A~%" (__p__ 2)))) (let () (define-macro (m1) (values)) (define-macro (m2) (values 2 3)) (define-macro (m3) (values '(+ 1 2) '(* 3 4))) (define-macro (m4) (values '(define a 1) '(define b 2))) (define-macro (m5 a b) (values `(define a ,a) `(define b (+ ,b 1)))) (test (begin (m1)) #) (test (+ (m2)) 5) (test (+ 1 (m3) 3) 19) (test (let () (m4) (+ a b)) 3) (test (let () (m5 1 2) (+ a b)) 4)) (let ((lst (list 1))) (define (sf x y) (and (pair? x) (list x y))) (define (mv x) (values x x)) (define (testsf) (test (sf lst lst) '((1) (1))) (test (sf (mv lst)) '((1) (1))) (test (sf lst (mv lst)) 'error) (test (sf (mv lst) lst) 'error)) (testsf)) (let ((lst (list 1))) (define (sf x y) (and (pair? x) (pair? y))) (define (mv x) (values x x)) (define (testsf) (test (sf lst lst) #t) (test (sf (mv lst)) #t) (test (sf lst (mv lst)) 'error) (test (sf (mv lst) lst) 'error)) (testsf)) (let ((lst (list 1))) (define (sf x) (and (pair? x) (list x x))) (define (mv x) (values x x)) (define (testsf) (test (sf lst) '((1) (1))) (test (sf (mv lst)) 'error)) (testsf)) (let ((lst (list 1))) (define (sf x) (and (pair? x) (pair? x))) (define (mv x) (values x x)) (define (testsf) (test (sf lst) #t) (test (sf (mv lst)) 'error)) (testsf)) ;;; bugs in optimizations of sequence with closure element returning values implicitly invoked (let ((L_3 (inlet 'a (lambda (a) (values a (+ a 1)))))) (test (procedure? (let-ref L_3 'a)) #t) (test (let-ref L_3 'a 12) 'error) (test (list (L_3 'a 12)) 'error) ; '(12 13)) (test (s7-optimize '((let-ref L_3 'a 12))) #) (test (s7-optimize '((L_3 'a 12))) #)) (let ((V_3 (vector (lambda (a) (values a (+ a 1)))))) (test (list (V_3 0 12)) 'error) ; '(12 13)) (test (vector (vector-ref V_3 0 12)) 'error) ; #(12 13)) (test (s7-optimize '((vector-ref V_3 0 12))) #)) (let ((V (vector (lambda (a) (values a 321))))) (test (s7-optimize '((vector-ref V_3 0 'a))) #)) (let ((H_3 (make-hash-table))) (hash-table-set! H_3 (make-hash-table) (lambda (a) (values a (+ a 1)))) (test (s7-optimize '((hash-table-ref H_3 (make-hash-table) 12))) #)) (let ((P_3 (list (lambda (a) (values a (+ a 1)))))) (test (list (P_3 0 12)) 'error) ; '(12 13)) (test (vector (list-ref P_3 0 12)) 'error) ; '(12 13)) (test (s7-optimize '((list-ref P_3 0 12))) #)) (let ((V (vector (lambda (a) (values a 321))))) (test (vector (vector-ref V 0 'a)) 'error)) ; #(a 321))) (let ((P_3 (list (lambda (a) (values a (+ a 1)))))) (test (s7-optimize '((list-ref P_3 0 12))) #)) (let ((V_3 (vector (lambda (a) (values a 321))))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (V_3 0 'a)))) (test (f) 'error)) ; #t)) (let ((V_3 (vector (lambda (a) (values a 321))))) (define (f1) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (V_3 0 'a)))) (test (f1) 'error)) ; #t)) (let ((V_4 (let ((v (make-vector '(2 2)))) (vector-set! v 0 0 (lambda (a) (values a 321))) v))) (test (s7-optimize '((vector-ref V_3 0 'a))) #) (test (s7-optimize '((V_3 0 'a))) #) (test (s7-optimize '((vector-ref V_4 0 0 'a))) #) (test (s7-optimize '((V_4 0 0 'a))) #)) (let ((V_3 (vector (lambda (a) (values a 321))))) (define (f11) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (vector-ref V_3 0 'a)))) (test (f11) 'error)) ;#t)) (test (s7-optimize '((vector-ref => 0 'a))) #) ; will be error afterwards (let ((V_4 (let ((v (make-vector '(2 2)))) (vector-set! v 0 0 (lambda (a) (values a 321))) v))) (define (f2) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (V_4 0 0 'a)))) (test (f2) 'error) ; #t) (define (f22) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (vector-ref V_4 0 0 'a)))) (test (f22) 'error)) ;#t)) (let () (define (fs5) (let ((v (vector (inlet 'a 0)))) (set! (v 0 'a) (ictr)) (v 0 'a))) (test (fs5) 'error) (test (fs5) 'error)) ;;; -------------------------------------------------------------------------------- ;;; let ;;; let* ;;; letrec ;;; letrec* ;;; -------------------------------------------------------------------------------- (test (let ((x 2) (y 3)) (* x y)) 6) (test (let ((x 32)) (let ((x 3) (y x)) y)) 32) (test (let ((x 32)) (let* ((x 3) (y x)) y)) 3) (test (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))) 35) (test (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x))) 70) (test (letrec ((is-even (lambda (n) (if (zero? n) #t (is-odd (- n 1))))) (is-odd (lambda (n) (if (zero? n) #f (is-even (- n 1)))))) (is-even 88)) #t) (test (let loop ((numbers '(3 -2 1 6 -5)) (nonneg ()) (neg ())) (cond ((null? numbers) (list nonneg neg)) ((>= (car numbers) 0) (loop (cdr numbers) (cons (car numbers) nonneg) neg)) ((< (car numbers) 0) (loop (cdr numbers) nonneg (cons (car numbers) neg))))) '((6 1 3) (-5 -2))) (test(let((i 1)(j 2))(+ i j))3) (test (let ((x 3)) (define x 5) x) 5) (test (let* () (define x 8) x) 8) (test (letrec () (define x 9) x) 9) (test (letrec ((x 3)) (define x 10) x) 10) (test (let foo () 1) 1) (test (let ((f -)) (let f ((n (f 1))) n)) -1) (test (let () 1 2 3 4) 4) (test (+ 3 (let () (+ 1 2))) 6) (test (let ((x 1)) (let ((x 32) (y x)) y)) 1) (test (let ((x 1)) (letrec ((y (if #f x 1)) (x 32)) 1)) 1) (test (let ((x 1)) (letrec ((y (lambda () (+ 1 x))) (x 32)) (y))) 33) (test (let ((x 1)) (letrec ((y (* 0 x)) (x 32)) y)) 'error) (test (let* ((x 1) (f (letrec ((y (lambda () (+ 1 x))) (x 32)) y))) (f)) 33) (test (letrec ((x 1) (y (let ((x 2)) x))) (+ x y)) 3) (test (letrec ((f (lambda () (+ x 3))) (x 2)) (f)) 5) (test (let* ((x 1) (x 2)) x) 2) (test (let* ((x 1) (y x)) y) 1) (test (let ((x 1)) (let ((x 32) (y x)) (+ x y))) 33) (test (let ((x 1)) (let* ((x 32) (y x)) (+ x y))) 64) (test (let ((x 'a) (y '(b c))) (cons x y)) '(a b c)) (test (let ((x 0) (y 1)) (let ((x y) (y x)) (list x y))) (list 1 0)) (test (let ((x 0) (y 1)) (let* ((x y) (y x)) (list x y))) (list 1 1)) (test (letrec ((sum (lambda (x) (if (zero? x) 0 (+ x (sum (- x 1))))))) (sum 5)) 15) (test (let ((divisors (lambda (n) (let f ((i 2)) (cond ((>= i n) ()) ((integer? (/ n i)) (cons i (f (+ i 1)))) (else (f (+ i 1)))))))) (divisors 32)) '(2 4 8 16)) (test (let ((a -1)) (let loop () (if (not (positive? a)) (begin (set! a (+ a 1)) (loop)))) a) 1) (test (let () (let () (let () ()))) ()) (test (let ((x 1)) (let ((y 0)) (begin (let ((x (* 2 x))) (set! y x))) y)) 2) (test (let* ((x 1) (x (+ x 1)) (x (+ x 2))) x) 4) (test (let ((.. 2) (.... 4) (..... +)) (..... .. ....)) 6) (test (let ((\"a\"")) \) "a\"") (test (let* ((a 1) (b a) (a 2) (c a)) (list a b c)) '(2 1 2)) (test (let* ((a 1) (b (let ((a 2)) a)) (c (+ a 3))) (list a b c)) '(1 2 4)) (test (let* ((a 1) (b (let ((a 2)) a)) (c a) (a (+ a 4))) (list a b c)) '(5 2 1)) (test (let () (begin (define x 1)) x) 1) (test (let ((y 1)) (begin (define x 1)) (+ x y)) 2) (test (let ((: 0)) (- :)) 0) (test (symbol? (with-input-from-string ":" read)) #t) (test (let ((: 3)) :) 3) (test (keyword? ':) #f) (test (symbol->keyword ':) '::) ; which is not a keyword!! -- '::: is -- this is getting ugly (test (let () (define : 3) :) 3) (test (let hi x 1) 'error) (test (letrec ((x)) 1) 'error) (test (letrec ((v (vector v))) v) #(#)) ; Guile returns #(#) -- isn't this a reference to v which r7rs claims is an error? Chicken gives an error. (test (letrec* ((v1 (vector v2)) (v2 (vector v1))) (list v1 v2)) (list #(#) #(#(#)))) ; same as above? (test (let ((i (catch #t (lambda () 1) (lambda (t i) 'error))) (j 2)) (+ i j)) 3) (test (let ((j 2) (i (catch #t (lambda () 1) (lambda (t i) 'error)))) (+ i j)) 3) (test (let* loop ((i 0) (j 0)) (if (> i 3) (+ i j) (loop :j 2 :i (+ i 1)))) 6) (test (let* loop ((i3 1) (j (+ i3 1))) (+ i3 j)) 3) (test (let n () (set! n 1) (+ n 1)) 2) (test (let () (define (n1) (set! n1 1) (+ n1 1)) (n1)) 2) ;;; srfi 245 example (let ((x 0)) (set! x (+ x 2)) (define var1 (- x 1)) (set! x (+ x 1)) (set! x (+ x var1)) (define var2 (+ var1 x)) (define var3 (+ var2 var1)) (set! x (+ x var3)) (test x 10)) (let ((x 0)) (letrec* ((var1 (begin (set! x 2) (- x 1))) (var2 (begin (set! x (+ x 1)) (set! x (+ x var1)) (+ var1 x))) (var3 (+ var2 var1))) (set! x (+ x var3)) (test x 10))) ;(test (equivalent? (let () (define x 1) (define x (+ x 1)) (curlet)) (inlet 'x 2)) #t) ; ok but confuses t101 cases where first checks outlets, but second outlet is rootlet (let ((err (catch #t (lambda () (let ((x 1) (x 3)) x)) (lambda (type info) (apply format #f info))))) (test err "duplicate identifier in let: x in (let ((x 1) (x 3)) x)")) ;;; optimizer troubles (test (let () (define (f x) (let asd ())) (f 1)) 'error) (test (let () (define (f x) (let ())) (f 1)) 'error) (test (let ((pi 3)) pi) 'error) (test (let ((:key 1)) :key) 'error) (test (let () (define (f) (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) 'error) (let ((:key 1)) :key))) (f)) 'error) ; do_let (test (let ((:3 1)) 1) 'error) (test (let ((3 1)) 1) 'error) (test (let ((3: 1)) 1) 'error) (test (let ((optional: 1)) 1) 'error) (test (let ((x_x_x 32)) (let () (define-constant x_x_x 3) x_x_x) (set! x_x_x 31) x_x_x) 31) ; changed 18-Sep-17 (test (let ((x 1)) (+ (let ((a (begin (define x 2) x))) a) x)) 4) (test (let ((x 1)) (+ (letrec ((a (begin (define x 2) x))) a) x)) 3) (test (let ((a #)) (eof-object? a)) #t) (test (let ((a #)) (eq? a #)) #t) (test (let* ((x 1) (x (+ x 1))) x) 2) ; ?? (test (object->string (let* ((a 1) (e (curlet)) (b (+ a 1))) e)) "(inlet 'a 1)") (let () (define (f) (let* ((a 1) (e (curlet)) (b (+ a 1))) e)) (define (g) (do ((v (vector #f)) (i 0 (+ i 1))) ((= i 1) (v 0)) (vector-set! v 0 (f)))) (test (object->string (g)) "(inlet 'a 1)")) (test (let _name_ ((x 1) (y (_name_ 2))) (+ x y)) 'error) (test (let* _name_ ((x 1) (y (_name_ 2))) (+ x y)) 'error) (let () (define (hi) (let* named-let ((i 0) (j (+ i 1))) j)) (hi) (test (hi) 1)) (let () ; permanent let* opt (define (fls) (let* ((a 1) (b (* 2 a))) (+ a b))) (fls) (test (fls) 3) (test (fls) 3) (define (fls1) (let* ((a 1) (b (* 2 a))) (let ((z (+ a b))) z))) (fls1) (test (fls1) 3) (test (fls1) 3)) (let () (define (f1 x) (let* ((a (+ x 1)) (a (* a 2)) (a ((lambda () (+ a 1)))) (a (- a))) a)) (test (f1 2) -7) (test (f1 3) -9) (define (f2 x) (let* ((a (+ x 1)) (a (* a 2)) (a1 (lambda () (+ a 1))) (a (* a 3)) (a2 (lambda () (+ a (a1))))) (+ a (a1) (a2)))) (test (f2 2) 50) (define (f3 x) (let* ((a (+ x 1)) (a (* a 2)) (a1 (lambda () (+ a 1))) (a (* a 3)) (a1 (lambda () (+ a (a1))))) (+ a (a1)))) (test (f3 2) 43)) ;; from lisp bboard (test (let ((x 1) (y 2)) (let ((x y) (y x)) (let ((x y) (y x)) (let ((x y) (y x)) (+ (* x x) y))))) 5) (test (let* ((x 1) (fx (lambda () x)) (y (define x (* x 2))) (fy (lambda () (* x y)))) (list x y (fx) (fy))) '(2 2 1 4)) ;; from r7rs errata (let () (let ((ton '(3 (1 4)))) (letrec* ((mean (lambda (f g) (f (/ (sum g ton) n)))) (sum (lambda (g ton) (if (null? ton) (+) (if (number? ton) (g ton) (+ (sum g (car ton)) (sum g (cdr ton))))))) (n (sum (lambda (x) 1) ton))) (num-test (mean values values) 8/3) (num-test (mean exp log) 2.289428485106664) (num-test (mean / /) 36/19)))) (let () ; guile-user (define (f x) (letrec ((even (lambda (n) (if (= n 0) #t (odd (- n 1))))) (odd (lambda (n) (if (= n 0) #f (even (- n 1)))))) (cond ((even x) 20) ((odd x) 30) (else 40)))) (test (f 31) 30) (test (f 30) 20)) (test ((let ((x 2)) (let ((x 3)) (lambda (arg) (+ arg x)))) 1) 4) (test ((let ((x 2)) (define (inner arg) (+ arg x)) (let ((x 32)) (lambda (arg) (inner (+ arg x))))) 1) 35) (test ((let ((inner (lambda (arg) (+ arg 1)))) (let ((inner (lambda (arg) (inner (+ arg 2))))) inner)) 3) 6) (test ((let () (define (inner arg) (+ arg 1)) (let ((inner (lambda (arg) (inner (+ arg 2))))) inner)) 3) 6) (test ((let ((x 11)) (define (inner arg) (+ arg x)) (let ((inner (lambda (arg) (inner (+ (* 2 arg) x))))) inner)) 3) 28) (test ((let ((x 11)) (define (inner arg) (+ arg x)) (let ((x 2)) (lambda (arg) (inner (+ (* 2 arg) x))))) 3) 19) (test (let ((f1 (lambda (arg) (+ arg 1)))) (let ((f1 (lambda (arg) (f1 (+ arg 2))))) (f1 1))) 4) (test (let ((f1 (lambda (arg) (+ arg 1)))) (let* ((f1 (lambda (arg) (f1 (+ arg 2))))) (f1 1))) 4) (test (let ((f1 (lambda (arg) (+ arg 1)))) (let* ((x 32) (f1 (lambda (arg) (f1 (+ x arg))))) (f1 1))) 34) (test ((let ((x 11)) (define (inner arg) (+ arg x)) (let ((x 2) (inner (lambda (arg) (inner (+ (* 2 arg) x))))) inner)) 3) 28) (test ((let ((x 11)) (define (inner arg) (+ arg x)) (let* ((x 2) (inner (lambda (arg) (inner (+ (* 2 arg) x))))) inner)) 3) 19) (test (let ((x 1)) (let* ((f1 (lambda (arg) (+ x arg))) (x 32)) (f1 1))) 2) (test (let ((inner (lambda (arg) (+ arg 1)))) (let ((inner (lambda (arg) (+ (inner arg) 1)))) (inner 1))) 3) (test (let ((inner (lambda (arg) (+ arg 1)))) (let* ((inner (lambda (arg) (+ (inner arg) 1)))) (inner 1))) 3) (test (let ((caller #f)) (let ((inner (lambda (arg) (+ arg 1)))) (set! caller inner)) (caller 1)) 2) (test (let ((caller #f)) (let ((x 11)) (define (inner arg) (+ arg x)) (set! caller inner)) (caller 1)) 12) (test (let ((caller #f)) (let ((x 11)) (define (inner arg) (+ arg x)) (let ((y 12)) (let ((inner (lambda (arg) (+ (inner x) y arg)))) ; 11 + 11 + 12 + arg (set! caller inner)))) (caller 1)) 35) (test (let ((caller #f)) (let ((x 11)) (define (inner arg) (+ arg x)) (let* ((y 12) (inner (lambda (arg) (+ (inner x) y arg)))) ; 11 + 11 + 12 + arg (set! caller inner))) (caller 1)) 35) (let () (define (f) (let ((f1 (lambda (arg) (+ arg 1)))) (let* ((x 32) (f1 (lambda (arg) (f1 (+ x arg))))) (f1 1)))) (test (f) 34)) (test (let* ((f1 3) (f1 4)) f1) 4) (test (let ((f1 (lambda () 4))) (define (f1) 3) (f1)) 3) (test (let ((j -1) (k 0)) (do ((i 0 (+ i j)) (j 1)) ((= i 3) k) (set! k (+ k i)))) 3) (test (let ((j (lambda () -1)) (k 0)) (do ((i 0 (+ i (j))) (j (lambda () 1))) ((= i 3) k) (set! k (+ k i)))) 3) (test (let ((j (lambda () 0)) (k 0)) (do ((i (j) (j)) (j (lambda () 1) (lambda () (+ i 1)))) ((= i 3) k) (set! k (+ k i)))) 3) ; 6 in Guile which follows the spec (test (let ((k 0)) (do ((i 0 (+ i 1)) (j 0 (+ j i))) ((= i 3) k) (set! k (+ k j)))) 1) #| (test (let ((j (lambda () 0)) (i 2) (k 0)) (do ((i (j) (j)) (j (lambda () i) (lambda () (+ i 1)))) ((= i 3) k) (set! k (+ k i)))) 3) ; or 2? (test (let ((f #f)) (do ((i 0 (+ i 1))) ((= i 3)) (let () (define (x) i) (if (= i 1) (set! f x)))) (f)) 1) |# (test (let ((x 1)) (let () (define (f) x) (let ((x 0)) (define (g) (set! x 32) (f)) (g)))) 1) (test (let ((a 1)) (let () (if (> a 1) (begin (define a 2))) a)) 1) (test (let ((a 1)) (let () (if (= a 1) (begin (define a 2))) a)) 2) (let ((x 123)) (define (hi b) (+ b x)) (let ((x 321)) (test (hi 1) 124) (set! x 322) (test (hi 1) 124)) (set! x 124) (test (hi 1) 125) (let ((x 321) (y (hi 1))) (test y 125)) (let* ((x 321) (y (hi 1))) (test y 125)) (test (hi 1) 125)) (test (let ((j 0) (k 0)) (let xyz ((i 0)) (let xyz ((i 0)) (set! j (+ j 1)) (if (< i 3) (xyz (+ i 1)))) (set! k (+ k 1)) (if (< i 3) (xyz (+ i 1)))) (list j k)) (list 16 4)) (test (let ((x 123)) (begin (define x 0)) x) 0) ; this strikes me as weird, since (let ((x 123) (x 0)) x) is illegal, so... (test (let ((x 0)) (define x 1) (define x 2) x) 2) (test (let ((x 123)) (begin (define (hi a) (+ x a)) (define x 0)) (hi 1)) 1) ; is non-lexical reference? (test (let ((x 123)) (define (hi a) (+ x a)) (define x 0) (hi 1)) 1) (test (let ((x 123) (y 0)) (define (hi a) (+ y a)) (define y x) (define x 0) (hi 1)) 124) (test (let () (define (sv x) x) (define (func) (let ((x -1) (i 0)) (sv (inlet 'x #f :ho (abs x))))) (func)) (inlet 'x #f 'ho 1)) ; fx_inlet_ca local_slot bug (test (let () (define (func) (for-each (let ((sig 0)) 0) (lcm pi sig pi pi))) (func)) 'error) (test (let () (define (func) (for-each (let* ((sig 0)) 0) (lcm pi sig pi pi))) (func)) 'error) (test (let () (define (func) (let ((sig 0)) 0) (lcm pi sig pi pi)) (func)) 'error) (test (let () (define (func) (let ((sig 0)) 0) (lcm pi sig pi)) (func)) 'error) (test (let () (define (func) (let ((sig 0)) 0) (lcm pi sig)) (func)) 'error) (test (catch #t (lambda () (let () (define (func) (let ((sig 0)) 0) (lcm sig)) (func))) (lambda (t i) (apply format #f i))) "unbound variable sig in (lcm sig)") (test (let () (define (func) (let ((sig 0)) 0) sig) (func)) 'error) (test (let () (define (func) (lambda (sig) 0) (lcm sig)) (func)) 'error) (test (let () (define (func) (do ((sig 0)) (#t #f) 0) (lcm sig)) (func)) 'error) (test (let () (define (func) (macro (sig) 0) (lcm sig)) (func)) 'error) (test (let () (define (func) (let () (define sig 0) sig) (lcm sig)) (func)) 'error) (test (let () (define (func) (let ((sig 1)) (+ (let ((sig 2)) (+ (let ((sig 3)) sig) sig)) sig))) (func)) 6) (let () (define (frame1 n) (let ((_p_ (curlet)) (out _p_)) (format #t "frame1 (2) _p_: ~S, out: ~S~%" _p_ out))) ; frame1 above is do, this is let (define (frame2) (frame1 1)) (catch #t (lambda () (let ((result (frame1 1))) (format *stderr* "frame1 (2): ~S?\n" result))) (lambda (type info) (unless (and (eq? type 'unbound-variable) (string=? (substring (apply format #f info) 0 20) "unbound variable _p_")) (format *stderr* "frame1 (2): ~S ~S~%" type (apply format #f info))))) (catch #t (lambda () (let ((result (frame2))) (format *stderr* "frame2 (2): ~S?\n" result))) (lambda (type info) (unless (and (eq? type 'unbound-variable) (string=? (substring (apply format #f info) 0 20) "unbound variable _p_")) (format *stderr* "frame2 (2): ~S ~S~%" type (apply format #f info)))))) (let () ; from scheme bboard (define (make-accum n) (lambda* (m) (if m (set! n (+ n m)) n))) (let ((x (make-accum 2))) (test (x) 2) (test (x 1) 3) (test (x) 3) (let ((y (make-accum 12))) (test (y) 12) (test (y 12) 24) (test (y) 24) (test (x) 3)))) (let () ; should hit fx_car_t rest out of date if debugging (from op_let_3a_new) from K Matheussen (define (make-assoc-from-flat-list3 rest) (if (null? rest) () (let ((A (car rest)) (B (cadr rest)) (Rest (cddr rest))) (cons (list A B) (make-assoc-from-flat-list3 Rest))))) (make-assoc-from-flat-list3 (list "asdf" (list (lambda () 50) (lambda () 60)) "---------- " (lambda x 70) "asd" (list (lambda () 80) (lambda () 90))))) (let () (define (f1) (let ((f #f)) (do ((i 0 (+ i 1))) ((= i 3)) (let ((x (+ i 1))) (if (= i 2) (set! f (lambda () x))))) (f))) (test (f1) 3)) (let () (define (f2) (let ((f #f)) (for-each (lambda (x) (if (= x 2) (set! f (lambda () (+ x 1))))) #(0 1 2 3)) (f))) (test (f2) 3)) (let () (define (f3) (let ((f #f)) (map (lambda (x) (if (= x 2) (set! f (lambda () (+ x 1)))) x) #(0 1 2 3)) (f))) (test (f3) 3)) (let () (define (f4) (let ((f #f)) (define (f4a a b) (if (and (= a 0) (= b 2)) (set! f (lambda () (+ b 1)))) (+ (if (> a 0) (f4a (- a 1) b) 0) (if (> b 0) (f4a a (- b 1)) 0))) (f4a 3 3) (f))) (test (f4) 3)) (for-each (lambda (arg) (test (let ((x arg)) x) arg)) (list "hi" -1 #\a "" () #() (current-output-port) 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t abs (list 1 2 3) '(1 . 2))) (test (let ((x 1)) (= 1 (let ((y 2)) (set! x y) x)) (+ x 1)) 3) (test (let ((x 1)) (let ((xx (lambda (a) (set! x a) a))) (= 1 (xx 2))) (+ x 1)) 3) (test (let ((x 32)) (begin (define x 123) (define (hi a) (+ a 1))) (hi x)) 124) (test (let () (begin (define x 123) (define (hi a) (+ a 1))) (hi x)) 124) #| (let ((initial-chars "aA!$%&*/:<=>?^_~") (subsequent-chars "9aA!$%&*+-./:<=>?@^_~") (ctr 0)) (format #t ";(let (") (do ((i 0 (+ i 1))) ((= i (string-length initial-chars))) (format #t ";(~A ~D) " (string (string-ref initial-chars i)) ctr) (set! ctr (+ ctr 1))) (do ((i 0 (+ i 1))) ((= i (string-length initial-chars))) (do ((k 0 (+ k 1))) ((= k (string-length subsequent-chars))) (format #t ";(~A ~D) " (string (string-ref initial-chars i) (string-ref subsequent-chars k)) ctr) (set! ctr (+ ctr 1)))) (format #t ")~% (+ ") (do ((i 0 (+ i 1))) ((= i (string-length initial-chars))) (format #t "~A " (string (string-ref initial-chars i)))) (do ((i 0 (+ i 1))) ((= i (string-length initial-chars))) (do ((k 0 (+ k 1))) ((= k (string-length subsequent-chars))) (format #t "~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k))))) (format #t "))~%")) |# (num-test (let ((a 0) (A 1) (! 2) ($ 3) (% 4) (& 5) (| 8) (? 12) (^ 13) (_ 14) (~ 15) (a9 16) (aa 17) (aA 18) (a! 19) (a$ 20) (a% 21) (a& 22) (a* 23) (a+ 24) (a- 25) (a. 26) (a/ 27) (a| 28) (a< 29) (a= 30) (a> 31) (a? 32) (a@ 33) (a^ 34) (a_ 35) (a~ 36) (A9 37) (Aa 38) (AA 39) (A! 40) (A$ 41) (A% 42) (A& 43) (A* 44) (A+ 45) (A- 46) (A. 47) (A/ 48) (A| 49) (A< 50) (A= 51) (A> 52) (A? 53) (A@ 54) (A^ 55) (A_ 56) (A~ 57) (!9 58) (!a 59) (!A 60) (!! 61) (!$ 62) (!% 63) (!& 64) (!* 65) (!+ 66) (!- 67) (!. 68) (!/ 69) (!| 70) (!< 71) (!= 72) (!> 73) (!? 74) (!@ 75) (!^ 76) (!_ 77) (!~ 78) ($9 79) ($a 80) ($A 81) ($! 82) ($$ 83) ($% 84) ($& 85) ($* 86) ($+ 87) ($- 88) ($. 89) ($/ 90) ($| 91) ($< 92) ($= 93) ($> 94) ($? 95) ($@ 96) ($^ 97) ($_ 98) ($~ 99) (%9 100) (%a 101) (%A 102) (%! 103) (%$ 104) (%% 105) (%& 106) (%* 107) (%+ 108) (%- 109) (%. 110) (%/ 111) (%| 112) (%< 113) (%= 114) (%> 115) (%? 116) (%@ 117) (%^ 118) (%_ 119) (%~ 120) (&9 121) (&a 122) (&A 123) (&! 124) (&$ 125) (&% 126) (&& 127) (&* 128) (&+ 129) (&- 130) (&. 131) (&/ 132) (&| 133) (&< 134) (&= 135) (&> 136) (&? 137) (&@ 138) (&^ 139) (&_ 140) (&~ 141) (*9 142) (*a 143) (*A 144) (*! 145) (*$ 146) (*% 147) (*& 148) (** 149) (*+ 150) (*- 151) (*. 152) (*/ 153) (*| 154) (*< 155) (*= 156) (*> 157) (*? 158) (*@ 159) (*^ 160) (*_ 161) (*~ 162) (/9 163) (/a 164) (/A 165) (/! 166) (/$ 167) (/% 168) (/& 169) (/* 170) (/+ 171) (/- 172) (/. 173) (// 174) (/| 175) (/< 176) (/= 177) (/> 178) (/? 179) (/@ 180) (/^ 181) (/_ 182) (/~ 183) (|9 184) (ca 185) (CA 186) (|! 187) (|$ 188) (|% 189) (|& 190) (|* 191) (|+ 192) (|- 193) (|. 194) (|/ 195) (cc 196) (|< 197) (|= 198) (|> 199) (|? 200) (|@ 201) (|^ 202) (|_ 203) (|~ 204) (<9 205) ( 220) ( 241) (=? 242) (=@ 243) (=^ 244) (=_ 245) (=~ 246) (>9 247) (>a 248) (>A 249) (>! 250) (>$ 251) (>% 252) (>& 253) (>* 254) (>+ 255) (>- 256) (>. 257) (>/ 258) (>| 259) (>< 260) (>> 262) (>? 263) (>@ 264) (>^ 265) (>_ 266) (>~ 267) (?9 268) (?a 269) (?A 270) (?! 271) (?$ 272) (?% 273) (?& 274) (?* 275) (?+ 276) (?- 277) (?. 278) (?/ 279) (?| 280) (?< 281) (?= 282) (?> 283) (?? 284) (?@ 285) (?^ 286) (?_ 287) (?~ 288) (^9 289) (^a 290) (^A 291) (^! 292) (^$ 293) (^% 294) (^& 295) (^* 296) (^+ 297) (^- 298) (^. 299) (^/ 300) (^| 301) (^< 302) (^= 303) (^> 304) (^? 305) (^@ 306) (^^ 307) (^_ 308) (^~ 309) (_9 310) (_a 311) (_A 312) (_! 313) (_$ 314) (_% 315) (_& 316) (_* 317) (_+ 318) (_- 319) (_. 320) (_/ 321) (_| 322) (_< 323) (_= 324) (_> 325) (_? 326) (_@ 327) (_^ 328) (__ 329) (_~ 330) (~9 331) (~a 332) (~A 333) (~! 334) (~$ 335) (~% 336) (~& 337) (~* 338) (~+ 339) (~- 340) (~. 341) (~/ 342) (~| 343) (~< 344) (~= 345) (~> 346) (~? 347) (~@ 348) (~^ 349) (~_ 350) (~~ 351) ) (+ a A ! $ % & | ? ^ _ ~ a9 aa aA a! a$ a% a& a* a+ a- a. a/ a| a< a= a> a? a@ a^ a_ a~ A9 Aa AA A! A$ A% A& A* A+ A- A. A/ A| A< A= A> A? A@ A^ A_ A~ !9 !a !A !! !$ !% !& !* !+ !- !. !/ !| !< != !> !? !@ !^ !_ !~ $9 $a $A $! $$ $% $& $* $+ $- $. $/ $| $< $= $> $? $@ $^ $_ $~ %9 %a %A %! %$ %% %& %* %+ %- %. %/ %| %< %= %> %? %@ %^ %_ %~ &9 &a &A &! &$ &% && &* &+ &- &. &/ &| &< &= &> &? &@ &^ &_ &~ *9 *a *A *! *$ *% *& ** *+ *- *. */ *| *< *= *> *? *@ *^ *_ *~ /9 /a /A /! /$ /% /& /* /+ /- /. // /| /< /= /> /? /@ /^ /_ /~ |9 ca CA |! |$ |% |& |* |+ |- |. |/ cc |< |= |> |? |@ |^ |_ |~ <9 =? =@ =^ =_ =~ >9 >a >A >! >$ >% >& >* >+ >- >. >/ >| >< >> >? >@ >^ >_ >~ ?9 ?a ?A ?! ?$ ?% ?& ?* ?+ ?- ?. ?/ ?| ?< ?= ?> ?? ?@ ?^ ?_ ?~ ^9 ^a ^A ^! ^$ ^% ^& ^* ^+ ^- ^. ^/ ^| ^< ^= ^> ^? ^@ ^^ ^_ ^~ _9 _a _A _! _$ _% _& _* _+ _- _. _/ _| _< _= _> _? _@ _^ __ _~ ~9 ~a ~A ~! ~$ ~% ~& ~* ~+ ~- ~. ~/ ~| ~< ~= ~> ~? ~@ ~^ ~_ ~~ )) 61253) (test (let ()(+ (let ((x 0) (y 1) (z 2) )(+ x y (let ((x 3) )(+ x (let ()(+ (let () (+ (let ((x 0) (y 1) (z 2) )(+ x y z (let ((x 3) )(+ x (let ((x 4) (y 5) (z 6) ) (+ x y z (let ()(+ (let ((x 7) )(+ x (let ()(+ (let ((x 8) (y 9) ) (+ x (let ((x 10) (y 11) (z 12) )(+ x )))))))))))))))))))))))))) 50) (test (let* ((x 0) (y x) )(+ x y (let ()(+ (let ((x 2) )(+ x (let ()(+ (let ((x 4) ) (+ x (let ((x 5) )(+ x (let ((x 6) (y x) (z y) )(+ x (let ((x 7) (y x) ) (+ x (let ((x 8) (y x) )(+ x y (let ((x 9) (y x) (z y) )(+ x )))))))))))))))))))) 48) (test (let* ((x 0) (y x) )(+ x y (let* ()(+ (let* ((x 2) )(+ x (let* ()(+ (let* ((x 4) ) (+ x (let* ((x 5) )(+ x (let* ((x 6) (y x) (z y) )(+ x (let* ((x 7) (y x) ) (+ x (let* ((x 8) (y x) )(+ x y (let* ((x 9) (y x) (z y) )(+ x )))))))))))))))))))) 49) (test (let ((!@$%^&*~|}{?><.,/`_-+=:! 1)) (+ !@$%^&*~|}{?><.,/`_-+=:! 1)) 2) (test (let ((:hi 1)) :hi) 'error) (test (let ((:hi: 1)) :hi:) 'error) (test (let ((hi: 1)) hi) 'error) (let ((1.0+2j (lambda (a) (+ a 1.0+2i)))) (num-test (1.0+2j 3+i) 4.0+3i)) (test (let ((*1.11* 3)) *1.11*) 3) (test (let ((1#2 12)) (+ 1#2 2)) 14) (test (let ((1:2 12)) (+ 1:2 2)) 14) (test (let ((1,2 12)) (+ 1,2 2)) 14) (test (let ((1'2 12)) (+ 1'2 2)) 14) (test (let ((1`2 12)) (+ 1`2 2)) 14) (test (let func ((a 1) (b 2)) (set! b a) (if (> b 0) (func (- a 1) b)) b) 1) (test (let func ((a 1) (b 2)) (set! b a) (if (> b 0) (func (- a 1) b) b)) 0) (test (let loop ((numbers '(3 -2 1 6 -5)) (nonneg ()) (neg ())) (cond ((null? numbers) (list nonneg neg)) ((>= (car numbers) 0) (loop (cdr numbers) (cons (car numbers) nonneg) neg)) ((< (car numbers) 0) (loop (cdr numbers) nonneg (cons (car numbers) neg))))) '((6 1 3) (-5 -2))) (test (let ((b '(1 2 3))) (let* ((a b) (b (cons 0 a))) (let b ((a b)) (if (null? a) 'done (b (cdr a)))))) 'done) (test (let lp ((x 100)) (if (positive? x) (lp (- x 1)) x)) 0) (test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1) (- b 1) (- c 1)) 0))) 6) (test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1) (- b 1)) 0))) 6) ; these work only because we don't try to call func -- maybe they should anyway? (test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func (- a 1)) 0))) 6) (test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 1) (func) 0))) 6) (test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 0) (func (- a 1) (- b 1) (- c 1)) 0))) 9) (test (let func ((a 1) (b 2) (c 3)) (+ a b c (if (> a 0) (func (- a 1) (- b 1)) 0))) 'error) (test (let func () 1) 1) (test (let ((a 1)) (let func () (if (> a 1) (begin (set! a (- a 1)) (func)) 0))) 0) (test (let func1 ((a 1)) (+ (let func2 ((a 2)) a) a)) 3) (test (let func1 ((a 1)) (+ (if (> a 0) (func1 (- a 1)) (let func2 ((a 2)) (if (> a 0) (func2 (- a 1)) 0))) a)) 1) (test (let func ((a (let func ((a 1)) a))) a) 1) (test (let ((i 3)) (let func () (set! i (- i 1)) (if (> i 0) (func))) i) 0) (test (let func ((a 1)) (define (func a) 2) (func 1)) 2) (test (let func ((a 1)) (define func (lambda (a) (func a))) (if (> a 1) (func (- a 1)) 0)) 0) (test (let loop ((i 0)) (let loop ((i 0)) (if (< i 1) (loop (+ i 1)))) i) 0) (test (let ((j 123)) (define (f g) (set! j 0) (g 0)) (let loop ((i 1)) (if (> i 0) (f loop))) j) 0) (test (procedure? (let loop () loop)) #t) (test (let loop1 ((func 0)) (let loop2 ((i 0)) (if (not (procedure? func)) (loop1 loop2)) func)) 0) (test (let ((k 0)) (let ((x (let xyz ((i 0)) (set! k (+ k 1)) xyz))) (x 0)) k) 2) (test (let ((hi' 3) (a'b 2)) (+ hi' a'b)) 5) (test (let ((hi''' 3) (a'''b 2)) (+ hi''' a'''b)) 5) (test (let ((f (let func ((i 0)) (if (= i 0) func (if (> i 1) (+ i (func (- i 1))) 1))))) (map f '(1 2 3))) '(1 3 6)) (test (let ((x 0)) (let ((f (lambda (a) (+ a x)))) (map (let () (set! x (+ x 1)) f) '(1 2 3)))) '(2 3 4)) (test (let x ((x (lambda (y) y))) (x 2)) 2) (test (let ((x 123)) (let x ((x x)) x)) 123) (test (let () (define (f4) (let loop ((i 0)) (set! loop 3) loop)) (f4)) 3) (test (let () (define (f5) (let loop ((i 0)) (set! loop (lambda () 2)) (loop))) (f5)) 2) (test (let () (define (f6) (let loop ((i 0)) (define (loop) 2) (loop))) (f6)) 2) (test (let ((f1 (lambda () (x)))) (define (x) 2) (f1)) 'error) (test (let ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 'error) (test (let () (define (f1) (x)) (define (x) 2) (f1)) 2) (test (let () (define (f1) x) (define x 2) (f1)) 2) (test (letrec ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 2) (test (letrec ((f1 (lambda () x)) (x 2)) (f1)) 2) (test (letrec* ((f1 (lambda () (x))) (x (lambda () 2))) (f1)) 2) (test (letrec* ((f1 (lambda () x)) (x 2)) (f1)) 2) (test (letrec ((f1 (lambda () (x)))) (define (x) 2) (f1)) 2) ; Guile: x unbound (test (letrec* ((f1 (lambda () (x)))) (define (x) 2) (f1)) 2) ; same (test (letrec ((f1 (lambda () x))) (define x 2) (f1)) 2) ; same (test (letrec* ((f1 (lambda () x))) (define x 2) (f1)) 2) ; same (test (let () (let ((a (lambda () x))) (let ((b (define x 2))) (a)))) 'error) (test (let () (let* ((a (lambda () x)) (b (define x 2))) (a))) 'error) (test (let () (let ((a (lambda () x))) (define x 2) (a))) 'error) (let ((enter 0) (exit 0) (inner 0)) (define (j1) (set! enter (+ enter 1)) (let ((result (let hiho ((i 0)) (set! inner (+ inner 1)) (if (< i 3) hiho i)))) (set! exit (+ exit 1)) result)) (let ((j2 (j1))) (test (and (procedure? j2) (= enter 1) (= exit 1) (= inner 1)) #t) (let ((result (j2 1))) (test (and (procedure? result) (= enter 1) (= exit 1) (= inner 2)) #t) (set! result (j2 3)) (test (and (= result 3) (= enter 1) (= exit 1) (= inner 3)) #t)))) (let () (define (block-comment-test a b c) (+ a b c)) (let ((val (block-comment-test #| a comment |# 1 #| this is a |# #| another comment |# 2 #| this is b |# 3))) (test val 6))) (test (letrec* ((p (lambda (x) (+ 1 (q (- x 1))))) (q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (x (p 5)) (y x)) y) 5) (test (letrec ((p (lambda (x) (+ 1 (q (- x 1))))) (q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (x (p 5)) (y x)) y) 'error) (test (let* ((p (lambda (x) (+ 1 (q (- x 1))))) (q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (x (p 5)) (y x)) y) 'error) (test (let ((x 1) ((y 2))) x) 'error) (test (let ((x 1 2 3)) x) 'error) (test (let ((+ 1 2)) 2) 'error) (test (let* ((x 1 2)) x) 'error) (test (letrec ((x 1 2)) x) 'error) (test (letrec* ((x 1 2)) x) 'error) (test (let ((x 1 . 2)) x) 'error) (test (let ((x 1 , 2)) x) 'error) (test (let ((x . 1)) x) 'error) (test (let* ((x . 1)) x) 'error) (test (letrec ((x . 1)) x) 'error) (test (letrec* ((x . 1)) x) 'error) (test (let hi ()) 'error) (test (let* ((x -1) 2) 3) 'error) (test (let ((x -1) 2) 3) 'error) (test (letrec ((x -1) 2) 3) 'error) (test (let ((pi 3)) pi) 'error) (test (let* ((pi 3)) pi) 'error) (test (letrec ((pi 3)) pi) 'error) (test (let ((#_abs 3)) #_abs) 'error) ;"variable name #_abs in let is a function, not a symbol" (test (let ((a 1) (a 2)) a) 'error) (test (letrec ((a 1) (a 2)) a) 'error) (test (letrec* ((a 1) (a 2)) a) 'error) (test (let* ((a 1) (a (+ a 1))) a) 2) ; ?? (test (let* hi () . =>) 'error) (test (let hi () . =>) 'error) (test (let hiho ((a 3) (hiho 4)) a) 3) (test (let hiho ((hiho 4)) hiho) 4) ; guile=4 (test (let hiho ((hiho hiho)) hiho) 'error) ; guile sez error (test (let ((hiho 4) (hiho 5)) hiho) 'error) ; guile sez error (test (let hiho ((a (hiho 1))) a) 'error) ; guile sez error (test (let hiho ((hiho 3)) (hiho hiho)) 'error) ; guile sez error (let () ; check that inner let is stable across optimization (define (f) (let func1 () (+ 1 2 (let* func2 ((a -1) (b (- a 1))) (if (< a 0) (func2 (+ a 1) 0) b))))) (test (f) 3)) (test (let) 'error) (test (let*) 'error) (test (letrec) 'error) (test (let . 1) 'error) (test (let* (x)) 'error) (test (let (x) 1) 'error) (test (let ((x)) 3) 'error) (test (let ((x 1) y) x) 'error) (test (let* x ()) 'error) (test (let* ((1 2)) 3) 'error) (test (let () ) 'error) (test (let '() 3) 'error) (test (let* ((x 1))) 'error) (test (let ((x 1)) (letrec ((x 32) (y x)) (+ 1 y))) 'error) ; # seems reasonable if not the 1+ (test (let ((x 1)) (letrec ((y x) (x 32)) (+ 1 y))) 'error) (test (let ((x 1)) (letrec ((y x) (x 32)) 1)) 1) (test (let ((x 1)) (letrec ((y (let () (+ x 1))) (x 32)) (+ 1 y))) 'error) (test (let ((x 1)) (letrec ((y (let ((xx (+ x 1))) xx)) (x 32)) (+ 1 y))) 'error) (test (let ((x 32)) (letrec ((y (apply list `(* ,x 2))) (x 1)) y)) '(* # 2)) (test (letrec) 'error) (test (letrec*) 'error) (test (let ((x . 1)) x) 'error) (test (letrec* ((and #2d((1 2) (3 4)) 3/4))) 'error) (test (letrec* ((hi "" #\a))) 'error) (let () ;; this hits op_letrec_star_unchecked independent of op_letrec_star (define (f1) (letrec* ((x (apply + (list 1 2))) (y (list-values x x))) (catch #t (lambda () (+ x (apply * y))) (lambda (type info) #f)))) (f1) (test (f1) 12)) (let ((f2 #)) (letrec ((f1 (lambda (x) (if (positive? x) (f2 (- x 1)) ; this is a forward ref to f2 below, Guile (1.8.7)/Chicken say f2 unbound, s7/chibi are happy 0)))) (define (f2 x) (if (positive? x) (f1 (- x 1)) 0)) (test (f1 3) 0))) (let ((f2 #)) (let ((f1 (lambda (x) (if (positive? x) (f2 (- x 1)) 0)))) ; unbound -- this is the outer env (define (f2 x) (if (positive? x) (f1 (- x 1)) 0)) (test (f1 3) 'error))) (let ((f2 #)) (letrec ((f1 (lambda (x) ; s7/Chicken/Guile/chibi happy (if (positive? x) (f2 (- x 1)) 0))) (f2 (lambda (x) (if (positive? x) (f1 (- x 1)) 0)))) (test (f1 3) 0))) (let ((f2 #)) (letrec ((f1 (lambda (x) (if (positive? x) (f1 (- x f2)) 0)))) ; so anything subsequently added to this env is already here ? (define f2 1) (test (f1 3) 0))) (let ((f2 #)) (letrec ((f1 (lambda (x) (if (positive? x) (f1 (- x f2)) 0)))) (test (f1 3) 'error) ; nope -- depends on ordering (define f2 1))) (let ((f2 0)) (letrec ((f1 (lambda () f2))) (test (f1) 0) (define f2 1) (test (f1) 1))) ; s7: 0 1, Chicken: 0 0, chibi: 1 1, Guile 1.8: "bad define placement", Guile 2.0: define in expression context ; Gauche also complains about define's placement, as does chibi (a warning) (let ((f2 0)) ; s7 01, chibi #1, chicken/guile 1.8 no letrec*, Guile 2.0.13/Gauche: 00 (letrec* ((f1 (lambda () f2)) (fx (begin (test (f1) 0) 3))) (define f2 1) (test (f1) 1))) (let ((f2 0)) (letrec ((f1 (lambda () f2))) (letrec ((fx (begin (test (f1) 0) 3))) (define f2 1) (test (f1) 0)))) ; s7 00, guile 1.8/2.0 00, chicken 00, chibi 00, gauche 00 (let ((f2 0)) (letrec ((f1 (lambda () f2))) (define f2 (let () (test (f1) 0) 1)) (test (f1) 1))) ; s7 01, guile 1.8/2.0 00, chicken 00, chibi #1, gauche 00 (let ((f2 (lambda () 0))) (letrec ((f1 (lambda () (f2)))) (define f2 (let () (test (f1) 0) (lambda () 1))) (test (f1) 1))) ; s7 01, chicken/guile/gauche 00, chibi: error # application (let ((f2 0)) (letrec* ((f1 (lambda () f2)) (f2 (let () (test (f1) #) 1))) (test (f1) 1))) ; all undefined/unspecified 1 (let ((f2 (lambda () 0))) (letrec* ((f1 (lambda () (f2))) (f2 (let () (test (f1) 'error) (lambda () 1)))) ; f2 undefined s7/chibi (test (f1) 1))) (let ((f2 0)) ; s7 01, guile 1.8/2.0 00, chicken no letrec*, chibi #1, gauche 00 (letrec* ((f1 (lambda () f2))) (define f2 (let () (test (f1) 0) 1)) (test (f1) 1))) (let ((f2 0)) ; all 00 (let ((f1 (lambda () f2))) (define f2 (let () (test (f1) 0) 1)) (test (f1) 0))) (let ((f2 0)) ; all 00 (let ((f1 (lambda () f2))) ((lambda () (define f2 (let () (test (f1) 0) 1)) (test (f1) 0))))) (let ((f2 0)) ; s7 01, guile 1.8/2.0 00, chicken 00, chibi #1, gauche 00 (letrec ((f1 (lambda () f2))) (define f2 (let () (test (f1) 0) 1)) (test (f1) 1))) (let ((f2 0)) ; all 00 (let ((f1 (lambda () f2))) ((lambda () (letrec* ((f2 (let () (test (f1) 0) 1))) (test (f1) 0)))))) (let ((f2 0)) ; all 00 (letrec ((f1 (lambda () f2))) (letrec* ((f2 (let () (test (f1) 0) 1))) (test (f1) 0)))) (let ((f1 0) (f2 1) (f3 2) (f4 3)) (letrec* ((f1 (lambda () f2)) (f2 (let () (test (f1) #) 4)) (f3 (lambda () (f4))) (f4 (lambda () 5))) (test (f1) 4) (test (f3) 5))) (let ((f1 0) (f2 1) (f3 2) (f4 3)) (define (f1) f2) (define f2 (let () (test (f1) 1) 4)) (define (f3) (f4)) (define f4 (lambda () 5)) (test (f1) 4) (test (f3) 5)) ;;; s7/chibi do not treat a body as letrec* (test (let #((a 1)) a) 'error) (test (let* #((a 1)) a) 'error) (test (letrec #((a 1)) a) 'error) (test (letrec* #((a 1)) a) 'error) ;; (let *((a 1)) a) -> 1 ; * is named let name? (test (letrec *((a 1)) a) 'error) (test (letrec* *((a 1)) a) 'error) (test (letrec* (((a 1) 2)) a) 'error) (test (letrec* (#(a 1) 2) a) 'error) (test (letrec* ((a a)) a) #) ; hmm -- guile says Variable used before given a value: a (test (let . (((a 1)) a)) 1) (test (let '((a 1)) a) 'error) (test (let (((x 1)) 2) 3) 'error) (test (let ((#f 1)) #f) 'error) (test (let (()) #f) 'error) (test (let (lambda () ) #f) 'error) (test (let ((f1 3) (f1 4)) f1) 'error) ; not sure about this ;; (let () (define (f1) 3) (define (f1) 4) (f1)) (test (let ((asdf (lambda (a) (if (> a 0) (asdf (- a 1)) 0)))) (asdf 3)) 'error) (test (let* ((asdf (lambda (a) (if (> a 0) (asdf (- a 1)) 0)))) (asdf 3)) 'error) (test (let (('a 3)) 1) 'error) (test (let ((#\a 3)) #\a) 'error) ;; (test (let ((#z1 2)) 1) 'error) (test (let 'a 1) 'error) (test (let* func ((a 1)) a) 1) (test (letrec func ((a 1)) a) 'error) (test (letrec* func ((a 1)) a) 'error) (test (let ((1 3)) 3) 'error) (test (let ((#t 3)) 3) 'error) (test (let ((() 3)) 3) 'error) (test (let ((#\c 3)) 3) 'error) (test (let (("hi" 3)) 3) 'error) (test (let ((:hi 3)) 3) 'error) (test (let 1 ((i 0)) i) 'error) (test (let #f ((i 0)) i) 'error) (test (let "hi" ((i 0)) i) 'error) (test (let #\c ((i 0)) i) 'error) (test (let :hi ((i 0)) i) 'error) (test (let pi () #f) 'error) (test (let func ((a 1) . b) a) 'error) (test (let func a . b) 'error) (test (let let func ((a 1)) func) 'error) (test (let func 1 ((x 1)) x) 'error) (test (let func ((a 1) . b) (if (> a 0) (func (- a 1) 2 3) b)) 'error) (test (let func ((a . 1)) a) 'error) (test (let func (a . 1) a) 'error) (test (let ((a 1) . b) a) 'error) (test (let* ((a 1) . b) a) 'error) (test (let func ((a func) (i 1)) i) 'error) (test (let func ((i 0)) (if (< i 1) (func))) 'error) (test (let func (let ((i 0)) (if (< i 1) (begin (set! i (+ i 1)) (func))))) 'error) (test (let ((x 0)) (set! x (+ x 1)) (begin (define y 1)) (+ x y)) 2) (test (let loop loop) 'error) (test (let loop (loop)) 'error) (test (let loop ((i 0) (loop 1)) i) 0) ; this used to be an error, Guile also returns 0 (test (letrec ((cons 1 (quote ())) . #(1)) 1) 'error) (test (letrec ((a 1) . 2) 1) 'error) (test (let* ((a 1) (b . 2) . 1) (())) 'error) (test (let "" 1) 'error) (test (let "hi" 1) 'error) (test (let #(1) 1) 'error) (test (let __hi__ #t) 'error) (test (letrec (1 2) #t) 'error) (test (letrec* (1 2) #t) 'error) (test (let hi (()) 1) 'error) (test (let hi a 1) 'error) ;;; opt typo tests (test (let ((s "123456")) (let loop ((i 5)) (cond ((< i 0) #f) ((char=? (string-ref s i) #\4) i) (else (loop (- i 1)))))) 3) (test (let leng ((l '(1 2 3)) (n 0)) (cond ((pair? l) (leng (cdr l) (+ n 1))) ((null? l) n) (else #f))) 3) ;;; named let* (test (let* hi #t) 'error) (test (let* "hi" () #f) 'error) (test (let* hi ()) 'error) (test (let* pi () #f) 'error) (test (let* hi x 1) 'error) (test (let* hi (c) 1) 'error) (test (let* hi ((x . 1)) #f) 'error) ;(test (let* hi . a 1) 'error) -- reader error in this context (test (let* hi ((a 1) . b) a) 'error) (test (let* hi ((a 1) :key b) a) 'error) (test (let* hi ((a 1) :allow-other-keys) a) 'error) (test (let* hi (a b) a) 'error) (test (let* x ((x 1)) #f) #f) (test (let* x ((x 1)) x) 1) (test (let* x ((x abs)) (x -1)) 1) (test (let ((x 123)) (let* x ((y x) (z y) (x 1)) x)) 1) (test (let* hi () 1) 1) (test (let* func ((i 1) (j 2)) (+ i j (if (> i 0) (func (- i 1)) 0))) 5) (test (let* func ((i 1) (j 2) (k (+ j 1))) (+ i j k (if (> i 0) (func (- i 1)) 0))) 11) (test (let* func ((i 1) (j 2) (k (+ j 1))) (+ i j k (let () (set! j -123) (if (> i 0) (func (- i 1)) 0)))) 11) (test (let* func1 ((a 1) (b 2)) (+ a b (let* func2 ((a -1) (b (- a 1))) (if (< a 0) (func2 (+ a 1)) b)))) 2) ; 2nd b is -1 -- this changed 8-Jan-14 (test (procedure? (let* func ((i 1) (j 2) (k (+ j 1))) func)) #t) (test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func (- a 1) (- b 1)) 0))) 4) (test (let* func ((a 1) (b 2)) (+ a b)) 3) (test (let* func ((a (+ 1 2)) (b (+ a 2))) (+ a b)) 8) (test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func (- a 1) :b (- b 1)) 0))) 4) (test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :a (- a 1) :b (- b 1)) 0))) 4) (test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :b (- b 1) :a (- a 1)) 0))) 4) (test (let* func ((a 1) (b 2)) (+ a b (if (> a 0) (func :a (- a 1)) 0))) 5) (test (let* loop ((i 10) (j 1) (k 0)) (if (<= i 0) k (loop (- i j) :k (+ k 1)))) 10) (test (let* loop ((i 10) (j 1) (k 0)) (if (<= i 0) k (loop (- i j) :j 2 :k (+ k 1)))) 6) (test (let* loop ((i 10) (j 1) (k 0)) (if (<= i 0) k (loop (- i j)))) 0) ;;; from the scheme wiki ;;; http://community.schemewiki.org/?sieve-of-eratosthenes (let ((results '(2))) (define (primes n) (let ((pvector (make-vector (+ 1 n) #t))) ; if slot k then 2k+1 is a prime (let loop ((p 3) ; Maintains invariant p = 2j + 1 (q 4) ; Maintains invariant q = 2j + 2jj (j 1) (k ()) (vec pvector)) (letrec ((lp (lambda (p q j k vec) (loop (+ 2 p) (+ q (- (* 2 (+ 2 p)) 2)) (+ 1 j) k vec))) (eradicate (lambda (q p vec) (if (<= q n) (begin (vector-set! vec q #f) (eradicate (+ q p) p vec)) vec)))) (if (<= j n) (if (eq? #t (vector-ref vec j)) (begin (set! results (cons p results)) (lp p q j q (eradicate q p vec))) (lp p q j k vec)) (reverse results)))))) (test (primes 10) '(2 3 5 7 11 13 17 19))) (test (let ((gvar 32)) (define (hi1 a) (+ a gvar)) (let ((gvar 0)) (hi1 2))) 34) (test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (hi2 a) gvar)) (let ((gvar 0)) (hi1 2))) 96) (test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ a gvar)) (let ((gvar 0)) (hi1 (hi2 2)))) 32) (test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let ((gvar 0)) (define (hi2 a) (* a 2)) (hi1 hi2))) 36) (test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let ((gvar 0) (hi2 (lambda (a) (hi2 a)))) (hi1 hi2))) 96) (test (let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (a 2) gvar)) (let* ((gvar 0) (hi2 (lambda (a) (hi2 a)))) (hi1 hi2))) 32) (test (let () ((let ((gvar 32)) (define-macro (hi2 b) `(* gvar ,b)) (define (hi1 a) (+ (hi2 2) gvar)) hi1) 2)) 96) (test (let ((gvar 0)) ((let ((gvar 1)) (define-macro (hi2 b) `(+ gvar ,b)) (define (hi1 a) (let ((gvar 2)) (hi2 a))) hi1) 2)) 4) (test (let ((gvar 0)) (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (let ((gvar 2)) (a 2))) hi1) hi2)) 4) (test (let ((gvar 0)) (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (a 2)) hi1) hi2)) 3) (test (let () (define-macro (hi2 b) `(+ gvar ,b)) ((let ((gvar 1)) (define (hi1 a) (a 2)) hi1) hi2)) 3) (test (let ((y 1) (x (let ((y 2) (x (let ((y 3) (x 4)) (+ x y)))) (+ x y)))) (+ x y)) 10) (test (let ((x 0)) (+ (let ((x 1) (y (+ x 1))) (+ (let ((x 2) (y (+ x 1))) (+ (let ((x 3) (y (+ x 1))) (+ (let ((x 4) (y (+ x 1))) (+ (let ((x 5) (y (+ x 1))) (+ (let ((x 6) (y (+ x 1))) (+ (let ((x 7) (y (+ x 1))) (+ x y)) x)) x)) x)) x)) x)) x)) x)) 35) (test (let loop ((lst (list 1 2)) (i 0) (sum 0)) (if (or (null? lst) (> i 10)) sum (begin (set-cdr! (cdr lst) lst) (loop (cdr lst) (+ i 1) (+ sum (car lst)))))) 16) ;;; these are confusing: ;(letrec ((if 0.0)) ((lambda () (if #t "hi")))) -> "hi" ;(let ((let 0)) let) -> 0 ;(let* ((lambda 0)) ((lambda () 1.5))) -> 1.5 ; syntax error in Guile ;(let* ((lambda 0)) lambda) -> 0 ;(define factorial #f) ;; from test-submodel.scm, from MIT I think (test (letrec ((factorial (lambda (n) (if (<= n 0) 1 (* n (factorial (- n 1))))))) (factorial 3)) 6) (test (letrec ((iter-fact (lambda (n) (letrec ((helper (lambda (n p) (if (<= n 0) p (helper (- n 1) (* n p)))))) (helper n 1))))) (iter-fact 3)) 6) (test (letrec ((y-factorial (lambda (n) (letrec ((y (lambda (f) ((lambda (x) (f (lambda (z) ((x x) z)))) (lambda (x) (f (lambda (z) ((x x) z))))))) (fact-def (lambda (fact) (lambda (n) (if (<= n 0) 1 (* n (fact (- n 1)))))))) ((y fact-def) n))))) (y-factorial 3)) 6) (let () ; more silliness ;; from The Evolution of a Scheme Programmer (define factorial-1 ((lambda (f) ((lambda (g) (f (lambda (x) ((g g) x)))) (lambda (g) (f (lambda (x) ((g g) x)))))) (lambda (f) (lambda (n) (if (zero? n) 1 (* n (f (- n 1)))))))) (test (factorial-1 6) 720) (define (factorial-2 n) (letrec ((f (lambda (n k) (if (= n 1) (k 1) (f (- n 1) (lambda (ret) (k (* n ret)))))))) (call-with-current-continuation (lambda (k) (f n k))))) (test (factorial-2 6) 720)) (test (let ((x 1)) (let ((x 0) (y x)) (cons x y))) '(0 . 1)) (test (let ((x 1)) (let* ((x 0) (y x)) (cons x y))) '(0 . 0)) (test (let ((x 1)) (letrec ((x 0) (y x)) (cons x y))) '(0 . #)) (test (let ((x 1)) (letrec* ((x 0) (y x)) (cons x y))) '(0 . 0)) (test (let ((x 1)) (let ((x 0) (y (let () (set! x 2) x))) (cons x y))) '(0 . 2)) (test (let ((x 1)) (letrec ((x 0) (y (let () (set! x 2) x))) (cons x y))) '(0 . 2)) (test (let ((x 1)) (let* ((x 0) (y (let () (set! x 2) x))) (cons x y))) '(2 . 2)) (test (let ((x 1)) (letrec* ((x 0) (y (let () (set! x 2) x))) (cons x y))) '(2 . 2)) (test (letrec ((x x)) x) #) ; weird (test (letrec ((x y) (y x)) x) #) (test (procedure? (letrec ((x (lambda () x))) x)) #t) (test (procedure? (letrec ((x (lambda () x))) (x))) #t) (test (letrec ((x (lambda () x))) (equal? x (x))) #t) ; ! (test (letrec ((x (lambda () x))) (equal? x ((x)))) #t) ; ! (test (letrec* ()) 'error) (test (letrec* ((x 1 x)) x) 'error) (test (letrec* ((x x)) x) #) ;?? (test (let ((x 1)) (letrec* ((x x)) x)) #) (test (letrec ((x x)) x) #) (test (let ((x 1)) (letrec ((x x)) x)) #) ;; here they are different: (test (let ((x 1)) (letrec* ((x 0) (y x)) y)) 0) (test (let ((x 1)) (letrec ((x 0) (y x)) y)) #) ;(test (letrec ((x (let () (set! y 1) y)) (y (let () (set! y (+ y 1)) y))) (list x y)) '(1 2)) ; ! this depends on letrec binding order (test (letrec ((x 1) (y x)) (list x y)) '(1 #)) ; guile says '(1 1) (test (letrec ((y x) (x 1)) (list x y)) '(1 #)) ; guile says '(1 1) (test (letrec ((x 1) (y (let () (set! x 2) x))) (list x y)) '(1 2)) (test (letrec ((history (list 9))) ((lambda (n) (begin (set! history (cons history n)) history)) 8)) '((9) . 8)) (test (((call/cc (lambda (k) k)) (lambda (x) x)) 'HEY!) 'HEY!) (let ((sequence ())) ((call-with-current-continuation (lambda (goto) (letrec ((start (lambda () (set! sequence (cons 'start sequence)) (goto next))) (froz (lambda () (set! sequence (cons 'froz sequence)) (goto last))) (next (lambda () (set! sequence (cons 'next sequence)) (goto froz))) (last (lambda () (set! sequence (cons 'last sequence)) #f))) start)))) (test (reverse sequence) '(start next froz last))) (let () (define thunk 'dummy-thunk) (define (make-fringe-thunk tree) (call-with-exit (lambda (return-to-repl) (cond ((pair? tree) (make-fringe-thunk (car tree)) (make-fringe-thunk (cdr tree))) ((null? tree) (begin (set! thunk (lambda () 'done)) 'null)) (else (call/cc (lambda (cc) (set! thunk (lambda () (begin (display tree) (cc 'leaf)))) (return-to-repl 'thunk-set!)))))))) (define tr '(() () (((1 (( (() 2 (3 4)) (((5))) )) ))) )) (test (make-fringe-thunk tr) 'null) (test (thunk) 'done)) ;;; evaluation order matters, but in s7 it's always left -> right (test (let ((x 1)) (+ x (let () (define x 2) x))) 3) (test (let ((x 1)) (+ (begin (define x 2) x) x)) 4) (test (let ((x 1)) (+ x (begin (define x 2) x))) 3) (test (let ((x 1)) (+ x (begin (set! x 2) x))) 3) (test (let ((x 1)) (+ (begin (set! x 2) x) x)) 4) (test (let ((x 1)) ((if (= x 1) + -) x (begin (set! x 2) x))) 3) (catch #t (lambda () (let () (define-constant _letrec_x_ 32) (test (letrec ((_letrec_x_ 1)) _letrec_x_) 'error)) (let () (define-constant _let_x_ 32) (test (let ((_let_x_ 1)) _let_x_) 'error)) (let () (define-constant _let*_x_ 32) (test (let* ((_let*_x_ 1)) _let*_x_) 'error))) (lambda args 'error)) #| ;;; here is the old letrec* macro: (define-macro (letrec* bindings . body) (if (null? body) (error 'syntax-error "letrec* has no body") (if (not (list? bindings)) (error 'syntax-error "letrec* variables are messed up") `(let (,@(map (lambda (var&init) (list (car var&init) #)) bindings)) ,@(map (lambda (var&init) (if (not (null? (cddr var&init))) (error 'syntax-error "letrec* variable has more than one value")) (list 'set! (car var&init) (cadr var&init))) bindings) ,@body)))) |# ;;; -------------------------------------------------------------------------------- ;;; call/cc ;;; call-with-current-continuation ;;; -------------------------------------------------------------------------------- ;;; some of these were originally from Al Petrovsky, Scott G Miller, Matthias Radestock, J H Brown, Dorai Sitaram, ;;; and probably others. (let ((calls (make-vector 3 #f)) (travels (make-vector 5 0)) (ctr 0)) (set! (travels 0) (+ (travels 0) 1)) (call/cc (lambda (c0) (set! (calls 0) c0))) (set! (travels 1) (+ (travels 1) 1)) (call/cc (lambda (c1) (set! (calls 1) c1))) (set! (travels 2) (+ (travels 2) 1)) (call/cc (lambda (c2) (set! (calls 2) c2))) (set! (travels 3) (+ (travels 3) 1)) (let ((ctr1 ctr)) (set! ctr (+ ctr1 1)) (if (< ctr1 3) ((calls ctr1) ctr1))) (set! (travels 4) (+ (travels 4) 1)) (test travels #(1 2 3 4 1))) (let ((calls (make-vector 5 #f)) (travels (make-vector 5 0)) (ctr2 0)) (let loop ((ctr 0)) (if (< ctr 3) (begin (set! (travels ctr) (+ (travels ctr) 1)) (call/cc (lambda (c0) (set! (calls ctr) c0))) (loop (+ ctr 1))))) (set! (travels 3) (+ (travels 3) 1)) (let ((ctr1 ctr2)) (set! ctr2 (+ ctr1 1)) (if (< ctr1 3) ((calls ctr1) ctr1))) (set! (travels 4) (+ (travels 4) 1)) (test travels #(1 2 3 4 1))) (let ((c1 #f) (c2 #f) (c3 #f) (x0 0) (x1 0) (x2 0) (x3 0)) (let ((x (+ 1 (call/cc (lambda (r1) (set! c1 r1) (r1 2))) (call/cc (lambda (r2) (set! c2 r2) (r2 3))) (call/cc (lambda (r3) (set! c3 r3) (r3 4))) 5))) (if (= x0 0) (set! x0 x) (if (= x1 0) (set! x1 x) (if (= x2 0) (set! x2 x) (if (= x3 0) (set! x3 x))))) (if (= x 15) (c1 6)) (if (= x 19) (c2 7)) (if (= x 23) (c3 8)) (test (list x x0 x1 x2 x3) '(27 15 19 23 27)))) (let ((c1 #f) (c2 #f) (c3 #f) (x0 0) (x1 0) (x2 0) (x3 0) (y1 0) (z0 0) (z1 0) (z2 0) (z3 0)) (let* ((y 101) (x (+ y (call/cc (lambda (r1) (set! c1 r1) (r1 2))) (call/cc (lambda (r2) (set! c2 r2) (r2 3))) (call/cc (lambda (r3) (set! c3 r3) (r3 4))) 5)) (z (+ x y))) (set! y1 y) (if (= x0 0) (begin (set! x0 x) (set! z0 z)) (if (= x1 0) (begin (set! x1 x) (set! z1 z)) (if (= x2 0) (begin (set! x2 x) (set! z2 z)) (if (= x3 0) (begin (set! x3 x) (set! z3 z)))))) (if (= x 115) (c1 6)) (if (= x 119) (c2 7)) (if (= x 123) (c3 8)) (test (list x x0 x1 x2 x3 y1 z0 z1 z2 z3) '(127 115 119 123 127 101 216 220 224 228)))) (let ((c1 #f) (c2 #f) (c3 #f) (x0 0) (x1 0) (x2 0) (x3 0)) (let ((x (+ 1 (call/cc (lambda (r1) (set! c1 r1) (r1 2))) (call/cc (lambda (r2) (set! c2 r2) (r2 3))) (call/cc (lambda (r3) (set! c3 r3) (r3 4))) 5))) (if (= x0 0) (set! x0 x) (if (= x1 0) (set! x1 x) (if (= x2 0) (set! x2 x) (if (= x3 0) (set! x3 x))))) (if (= x 15) (c1 6 1)) (if (= x 20) (c2 7 2 3)) (if (= x 29) (c3 8 3 4 5)) (test (list x x0 x1 x2 x3) '(45 15 20 29 45)))) ;; 45 = (+ 1 6 1 7 2 3 8 3 4 5 5) (let ((x 0) (c1 #f) (results ())) (set! x (call/cc (lambda (r1) (set! c1 r1) (r1 2)))) (set! results (cons x results)) (if (= x 2) (c1 32)) (test results '(32 2))) (let ((x #(0)) (y #(0)) (c1 #f)) (set! ((call/cc (lambda (r1) (set! c1 r1) (r1 x))) 0) 32) (if (= (y 0) 0) (c1 y)) (test (and (equal? x #(32)) (equal? y #(32))) #t)) (test (call/cc (lambda (k) ((call/cc (lambda (top) (k (+ 1 (call/cc (lambda (inner) (top inner))))))) 2))) 3) (let* ((next-leaf-generator (lambda (obj eot) (letrec ((return #f) (cont (lambda (x) (recur obj) (set! cont (lambda (x) (return eot))) (cont #f))) (recur (lambda (obj) (if (pair? obj) (for-each recur obj) (call-with-current-continuation (lambda (c) (set! cont c) (return obj))))))) (lambda () (call-with-current-continuation (lambda (ret) (set! return ret) (cont #f))))))) (leaf-eq? (lambda (x y) (let* ((eot (list 'eot)) (xf (next-leaf-generator x eot)) (yf (next-leaf-generator y eot))) (letrec ((loop (lambda (x y) (cond ((not (eq? x y)) #f) ((eq? eot x) #t) (else (loop (xf) (yf))))))) (loop (xf) (yf))))))) (test (leaf-eq? '(a (b (c))) '((a) b c)) #t) (test (leaf-eq? '(a (b (c))) '((a) b c d)) #f) (test (leaf-eq? '(a b (c)) '((a) b c)) #t)) (test (let ((r #f) (a #f) (b #f) (c #f) (i 0)) (let () (set! r (+ 1 (+ 2 (+ 3 (call/cc (lambda (k) (set! a k) 4)))) (+ 5 (+ 6 (call/cc (lambda (k) (set! b k) 7)))))) (if (not c) (set! c a)) (set! i (+ i 1)) (case i ((1) (a 5)) ((2) (b 8)) ((3) (a 6)) ((4) (c 4))) r)) 28) (test (let ((r #f) (a #f) (b #f) (c #f) (i 0)) (let () (set! r (+ 1 (+ 2 (+ 3 (call/cc (lambda (k) (set! a k) 4)))) (+ 5 (+ 6 (call/cc (lambda (k) (set! b k) 7)))))) (if (not c) (set! c a)) (set! i (+ i 1)) (case i ((1) (b 8)) ((2) (a 5)) ((3) (b 7)) ((4) (c 4))) r)) 28) (test (let ((k1 #f) (k2 #f) (k3 #f) (state 0)) (define (identity x) x) (define (fn) ((identity (if (= state 0) (call/cc (lambda (k) (set! k1 k) +)) +)) (identity (if (= state 0) (call/cc (lambda (k) (set! k2 k) 1)) 1)) (identity (if (= state 0) (call/cc (lambda (k) (set! k3 k) 2)) 2)))) (define (check states) (set! state 0) (let* ((res ()) (r (fn))) (set! res (cons r res)) (if (null? states) res (begin (set! state (car states)) (set! states (cdr states)) (case state ((1) (k3 4)) ((2) (k2 2)) ((3) (k1 -))))))) (map check '((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)))) '((-1 4 5 3) (4 -1 5 3) (-1 5 4 3) (5 -1 4 3) (4 5 -1 3) (5 4 -1 3))) (let () ; Matt Might perhaps or maybe Paul Hollingsworth? (define (current-continuation) (call/cc (lambda (cc) (cc cc)))) (define fail-stack ()) (define (fail) (if (not (pair? fail-stack)) (error 'test-error "back-tracking stack exhausted!") (begin (let ((back-track-point (car fail-stack))) (set! fail-stack (cdr fail-stack)) (back-track-point back-track-point))))) (define (amb choices) (let ((cc (current-continuation))) (cond ((null? choices) (fail)) ((pair? choices) (let ((choice (car choices))) (set! choices (cdr choices)) (set! fail-stack (cons cc fail-stack)) choice))))) (define (assert condition) (if (not condition) (fail) #t)) (let ((a (amb (list 1 2 3 4 5 6 7))) (b (amb (list 1 2 3 4 5 6 7))) (c (amb (list 1 2 3 4 5 6 7)))) (assert (= (* c c) (+ (* a a) (* b b)))) (assert (< b a)) (test (list a b c) (list 4 3 5)))) (let () ; a shorter version (define (current-continuation) (call/cc (lambda (cc) cc))) (define fail-stack ()) (define (fail) (if (not (pair? fail-stack)) (error 'test-error "back-tracking stack exhausted!") (let ((back-track-point (car fail-stack))) (set! fail-stack (cdr fail-stack)) (back-track-point back-track-point)))) (define (amb choices) (let ((cc (current-continuation))) (if (null? choices) (fail) (let ((choice (car choices))) (set! choices (cdr choices)) (set! fail-stack (cons cc fail-stack)) choice)))) (define (assert condition) (or condition (fail))) (let ((a (amb (list 1 2 3 4 5 6 7))) (b (amb (list 1 2 3 4 5 6 7))) (c (amb (list 1 2 3 4 5 6 7)))) (assert (= (* c c) (+ (* a a) (* b b)))) (assert (< b a)) (test (list a b c) (list 4 3 5)))) (let ((c1 #f)) (let ((x ((call/cc (lambda (r1) (set! c1 r1) (r1 "hiho"))) 0))) (if (char=? x #\h) (c1 "asdf")) (test x #\a))) (test (let ((x ()) (y 0)) (call/cc (lambda (escape) (let* ((yin ((lambda (foo) (set! x (cons y x)) (if (= y 10) (escape x) (begin (set! y 0) foo))) (call/cc (lambda (bar) bar)))) (yang ((lambda (foo) (set! y (+ y 1)) foo) (call/cc (lambda (baz) baz))))) (yin yang))))) '(10 9 8 7 6 5 4 3 2 1 0)) (let () ;; taken from wikipedia (define readyList ()) (define (i-run) (if (not (null? readyList)) (let ((cont (car readyList))) (set! readyList (cdr readyList)) (cont ())))) (define (fork fn arg) (set! readyList (append readyList (cons (lambda (x) (fn arg) (i-run)) ())))) (define (yield) (call-with-current-continuation (lambda (thisCont) (set! readyList (append readyList (cons thisCont ()))) (let ((cont (car readyList))) (set! readyList (cdr readyList)) (cont ()))))) (define data (make-vector 10 0)) (define data-loc 0) (define (process arg) (if (< data-loc 10) (begin (set! (data data-loc) arg) (set! data-loc (+ data-loc 1)) (yield) (process (+ arg 1))) (i-run))) (fork process 0) (fork process 10) (fork process 20) (i-run) (test data #(0 10 20 1 11 21 2 12 22 3))) (test (let ((c #f)) (let ((r ())) (let ((w (let ((v 1)) (set! v (+ (call-with-current-continuation (lambda (c0) (set! c c0) v)) v)) (set! r (cons v r)) v))) (if (<= w 1024) (c w) r)))) '(2048 1024 512 256 128 64 32 16 8 4 2)) (test (let ((c #f)) (let ((r ())) (let ((w (let ((v 1)) (set! v (+ (values v (call-with-current-continuation (lambda (c0) (set! c c0) v))) v)) (set! r (cons v r)) v))) (if (<= w 1024) (c w) r)))) '(2047 1023 511 255 127 63 31 15 7 3)) ;;; the first v is 1, the 3rd reflects the previous call/cc which reflects the ;;; env+slot that had the subsequent set! -- weird. (test (let ((cc #f) (r ())) (let ((s (list 1 2 3 4 (call/cc (lambda (c) (set! cc c) 5)) 6 7 8))) (if (null? r) (begin (set! r s) (cc -1)) (list r s)))) '((1 2 3 4 5 6 7 8) (1 2 3 4 -1 6 7 8))) (test (let ((count 0)) (let ((first-time? #t) (k (call/cc values))) (if first-time? (begin (set! first-time? #f) (set! count (+ count 1)) (k values)) )) count) 2) (let ((H ((lambda () (hash-table (call-with-exit (lambda (return) (let ((x 1) (y 2)) (return x y)))) (call/cc (lambda (return) (return 'oops))) 1))))) (test (H 1) 2)) (let ((continuations ())) ; chicken mailing list (define (push arg) (set! continuations (cons arg continuations))) (define (capture-from-map arg) (call-with-current-continuation (lambda (cc) (push cc) arg))) (define numbers (map capture-from-map '(1 2 3))) (test numbers '(1 2 3))) (let ((c #f) (vals ())) (let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3)))))) (set! vals (cons val vals)) (if (< val 20) (c (+ val 1))) (test vals '(22 18 14 10 6)))) (let ((c #f) (vals ())) (let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3)))))) (set! vals (cons val vals)) (if (< val 20) (apply c vals)) (test vals '(36 18 9 6)))) (let ((c #f) (vals ())) (let ((val (+ 1 2 (call/cc (lambda (r) (set! c r) (r 3)))))) (set! vals (cons val vals)) (if (< val 20) (c (apply values vals))) (test vals '(36 18 9 6)))) (test (procedure? (call/cc call/cc)) #t) (test (call/cc (lambda (c) (0 (c 1)))) 1) (test (call/cc (lambda (k) (k "foo"))) "foo") (test (call/cc (lambda (k) "foo")) "foo") (test (call/cc (lambda (k) (k "foo") "oops")) "foo") (test (call/cc (lambda (return) (catch #t (lambda () (error 'hi "")) (lambda args (return "oops"))))) "oops") (test (call/cc (lambda (return) (catch #t (lambda () (return 1)) (lambda args (return "oops"))))) 1) (test (catch #t (lambda () (call/cc (lambda (return) (return "oops")))) (lambda arg 1)) "oops") (test (call/cc (if (< 2 1) (lambda (return) (return 1)) (lambda (return) (return 2) 3))) 2) (test (call/cc (let ((a 1)) (lambda (return) (set! a (+ a 1)) (return a)))) 2) (test (call/cc (lambda (return) (let ((hi return)) (hi 2) 3))) 2) (test (let () (define (hi) (call/cc func)) (define (func a) (a 1)) (hi)) 1) (test (((call/cc (call/cc call/cc)) call/cc) (lambda (a) 1)) 1) (test (+ 1 (eval-string "(+ 2 (call-with-exit (lambda (return) (return 3))) 4)") 5) 15) (test (+ 1 (eval '(+ 2 (call-with-exit (lambda (return) (return 3))) 4)) 5) 15) (test (call-with-exit) 'error) (test (call/cc) 'error) (test (call/cc (lambda () 1)) 'error) (test (call/cc (lambda (a b) (a 1))) 'error) (test (+ 1 (call/cc (lambda (k) (k #\a)))) 'error) (test (+ 1 (call-with-exit (lambda (k) (k #\a)))) 'error) (test ((call/cc (lambda (return) (call/cc (lambda (cont) (return cont))) list)) 1) '(1)) ; from Guile mailing list -- this strikes me as very strange (num-test (let () (define (func) (let ((x 1)) (max (call/cc (lambda (return) (return 1 2))) (log (* 2 x 3.0 4))))) (func)) (log 24.0)) (test (let () (define (func) (sort! (cddar (list imp (call/cc (lambda (return) (return 'oops))))) >)) (func)) 'error) ; copy_stack_list_set_immutable bug (let () (define imp (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ()))))))) (test (immutable? (list-tail imp (call/cc (lambda (cc) (cc 1))))) #t) (test (let () (define (f) (list-tail imp (call/cc (lambda (cc) (cc 1))))) (immutable? (f))) #t)) (test (call/cc begin) 'error) (test (call/cc quote) 'error) (let ((p1 (dilambda (lambda (k) (k 3)) (lambda (k a) (k a))))) (test (call/cc p1) 3) (test (call-with-exit p1) 3)) ;;; guile/s7 accept: (call/cc (lambda (a . b) (a 1))) -> 1 ;;; same: (call/cc (lambda arg ((car arg) 1))) -> 1 (test (let ((listindex (lambda (e l) (call/cc (lambda (not_found) (letrec ((loop (lambda (l) (cond ((null? l) (not_found #f)) ((equal? e (car l)) 0) (else (+ 1 (loop (cdr l)))))))) (loop l))))))) (listindex 1 '(0 3 2 4 8))) #f) (test (let ((product (lambda (li) (call/cc (lambda (return) (let loop ((l li)) (cond ((null? l) 1) ((= (car l) 0) (return 0)) (else (* (car l) (loop (cdr l))))))))))) (product '(1 2 3 0 4 5 6))) 0) (test (let ((lst ())) ((call/cc (lambda (goto) (letrec ((start (lambda () (set! lst (cons "start" lst)) (goto next))) (next (lambda () (set! lst (cons "next" lst)) (goto last))) (last (lambda () (set! lst (cons "last" lst)) (reverse lst)))) start))))) '("start" "next" "last")) (test (let ((cont #f)) ; Al Petrovsky (letrec ((x (call-with-current-continuation (lambda (c) (set! cont c) 0))) (y (call-with-current-continuation (lambda (c) (set! cont c) 0)))) (if cont (let ((c cont)) (set! cont #f) (set! x 1) (set! y 1) (c 0)) (+ x y)))) 0) (test (letrec ((x (call-with-current-continuation (lambda (c) (list #t c))))) (if (car x) ((cadr x) (list #f (lambda () x))) (eq? x ((cadr x))))) #t) (test (call/cc (lambda (c) (0 (c 1)))) 1) (test (let ((membr (lambda (x ls) (call/cc (lambda (return) (do ((ls ls (cdr ls))) ((null? ls) #f) (if (equal? x (car ls)) (return ls)))))))) (list (membr 'd '(a b c)) (membr 'b '(a b c)))) '(#f (b c))) (test (list-values (values) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))) '(1 2)) (test ((lambda x (list-values (values) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))))) '(1 2)) (test (let () (define (func) (list-values (values) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y)))))) (define (hi) (func) (func)) (hi) (hi)) '(1 2)) (let () ; from wikipedia (define (f return) (return 2) 3) (test (f (lambda (x) x)) 3) (test (call/cc f) 2)) (test (+ 2 (call/cc (lambda (k) (* 5 (k 4))))) 6) (test (+ 2 (call/cc (lambda (k) (* 5 (k 4 5 6))))) 17) (test (+ 2 (call/cc (lambda (k) (* 5 (k (values 4 5 6)))))) 17) (test (+ 2 (call/cc (lambda (k) (* 5 (k 1 (values 4 5 6)))))) 18) (test (+ 2 (call/cc (lambda (k) (* 5 (k 1 (values 4 5 6) 1))))) 19) (test ((call/cc (lambda (return) (return + 1 2 3)))) 6) (test (let () (define (func) (catch #t (lambda () 1) (lambda (with-let info) 1.0))) (func)) 'error) (test (let () (define (func) (call/cc (lambda (with-let) 1.0))) (func)) 'error) (test (call/cc (lambda (a . b) (a 1))) 1) (test (call/cc (lambda (x) (set! x abs) (x -1))) 1) ;;; call-with-exit goto? (test (goto? (call-with-exit (lambda (g) g))) #t) (test (goto? (call/cc (lambda (g) g))) #f) (for-each (lambda (arg) (if (goto? arg) (format #t ";(goto? ~A) -> #t?~%" arg))) (list "hi" '(1 2) (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) # #)) (test (+ 2 (call-with-exit (lambda (k) (* 5 (k 4))))) 6) (test (+ 2 (call-with-exit (lambda (k) (* 5 (k 4 5 6))))) 17) (test (+ 2 (call-with-exit (lambda (k) (* 5 (k (values 4 5 6)))))) 17) (test (+ 2 (call-with-exit (lambda (k) (* 5 (k 1 (values 4 5 6)))))) 18) (test (+ 2 (call-with-exit (lambda (k) (* 5 (k 1 (values 4 5 6) 1))))) 19) (test (+ 2 (call-with-exit (lambda* ((hi 1)) (hi 1)))) 3) (test (call-with-exit (lambda (hi) (((hi 1)) #t))) 1) ; !! (jumps out of list evaluation) (test (call-with-exit (lambda* args ((car args) 1))) 1) (test ((call-with-exit (lambda (return) (return + 1 2 3)))) 6) (test ((call-with-exit (lambda (return) (apply return (list + 1 2 3))))) 6) (test (+ 2 (call-with-exit (lambda (return) (let ((rtn (copy return))) (* 5 (rtn 4)))))) 6) (test (let () (define (f1) (+ (call-with-exit (lambda (return) (define (f2) (+ 1 (return 2))) (f2))) 3)) (f1)) 5) (test (+ 2 (values 3 (call-with-exit (lambda (k1) (k1 4))) 5)) 14) (test (+ 2 (call-with-exit (lambda (k1) (values 3 (k1 4) 5))) 8) 14) (test (+ 2 (call-with-exit (lambda (k1) (values 3 (k1 4 -3) 5))) 8) 11) (test (call-with-exit (lambda (pi) 1)) 'error) (test (let () (define (func) (call-with-exit (lambda (pi) 1))) (define (hi) (func) (func)) (hi) (hi)) 'error) (test (let () (define (func) (call-with-exit (lambda (with-let) 1.0))) (func)) 'error) (test (call-with-exit (let () (lambda (k1) (k1 2)))) 2) (test (+ 2 (call/cc (let () (call/cc (lambda (k1) (k1 (lambda (k2) (k2 3)))))))) 5) (test (+ 2 (call/cc (call/cc (lambda (k1) (k1 (lambda (k2) (k2 3))))))) 5) (test (call-with-exit (lambda arg ((car arg) 32))) 32) (test (call-with-exit (lambda arg ((car arg) 32)) "oops!") 'error) (test (call-with-exit (lambda (a b) a)) 'error) (test (call-with-exit (lambda (return) (apply return '(3)))) 3) (test (call-with-exit (lambda (return) (apply return (list (cons 1 2))) (format #t "; call-with-exit: we shouldn't be here!"))) (cons 1 2)) (test (call/cc (lambda (return) (apply return (list (cons 1 2))) (format #t "; call/cc: we shouldn't be here!"))) (cons 1 2)) (test (procedure? (call-with-exit (lambda (return) (call-with-exit return)))) #t) (test (call-with-exit (lambda (return) #f) 1) 'error) (test (+ (call-with-exit ((lambda () (lambda (k) (k 1 2 3)))))) 6) (test (let ((x 1)) (set! x (- (call-with-exit (lambda (go) (catch #t (lambda () (abs "hi") 3) (lambda (t i) (go 4 4) 6)) 5))))) 0) (test (call-with-exit (lambda (a . b) (a 1))) 1) (test (call-with-exit (lambda* (a b) (a 1))) 1) (test (call-with-exit (lambda args ((car args) 0) 1)) 0) (test (call-with-exit (lambda (c) (0 (c 1)))) 1) (test (call-with-exit (lambda (k) (k "foo"))) "foo") (test (call-with-exit (lambda (k) "foo")) "foo") (test (call-with-exit (lambda (k) (k "foo") "oops")) "foo") (test (call-with-exit (lambda (x) (set! x abs) (x -1))) 1) (test (call-with-exit (call-with-exit values)) 'error) (test (call-with-exit (call-with-exit (lambda (go) go))) 'error) (test (call-with-exit (call-with-exit (lambda (go) (go (lambda (gone) (gone 1)))))) 1) (test (call-with-exit cons) 'error) ; aritable? (test (apply call-with-exit (lambda (g) (g 123)) ()) 123) (test (apply call/cc (lambda (g) (g 123)) ()) 123) (test (call/cc call-with-exit) 'error) (test (call-with-exit call/cc) 'error) ; less than ideal error message here: call-with-exit escape procedure called outside its block (test (call-with-exit call-with-exit) 'error) (test (continuation? (call/cc call/cc)) #t) ; hmmm... (test (let () (define (func) (+ (call-with-exit (lambda (goto) goto)) (vector-length))) (func) (func)) 'error) ; has_fn not cleared bug (let () (define (f) (let ((cc #f) (c2 0)) (call-with-exit (lambda (c3) ; test call/exit re-entry (set! cc (call/cc (lambda (ret) ret))) (set! c2 (+ c2 1)) (c3 3) (error 'oops "oops"))) (if (< c2 2) (cc 2) c2))) (test (f) 2)) (let ((x 1)) (define (outer g) (g (+ x 32))) (define (inner) (call-with-exit (lambda (return) (set! x (+ x 1)) (outer return) 'error))) (test (inner) 34)) (test (let ((memb (lambda (x ls) (call-with-exit (lambda (break) (do ((ls ls (cdr ls))) ((null? ls) #f) (if (equal? x (car ls)) (break ls)))))))) (list (memb 'd '(a b c)) (memb 'b '(a b c)))) '(#f (b c))) (let* ((sum 0) (val1 (call-with-exit (lambda (return) (set! sum (+ sum 1)) (let ((val2 (call-with-exit (lambda (return) (set! sum (+ sum 1)) (if #t (return sum)) 123)))) (set! sum (+ sum val2)) (return sum) 32))))) (test (list val1 sum) '(4 4))) (let () (define (fx ret) (do ((n 0 (+ n 1))) ((= n 6) n) (if (> n 3) (ret n)))) (test (call-with-exit fx) 4)) (let () (define c #f) (define (yow f) (call-with-exit (lambda (return) (set! c return) (f)))) (test (yow (lambda () (c 32))) 32)) (test (catch 'invalid-exit-function (lambda () (let ((c #f)) (call-with-exit (lambda (ret) (set! c ret))) (c))) (lambda (type info) (apply format #f info))) "call-with-exit exit procedure, ret, called outside its block") (let ((x 1)) (define y (call-with-exit (lambda (return) (set! x (return 32))))) (test (and (= x 1) (= y 32)) #t) (set! y (call-with-exit (lambda (return) ((lambda (a b c) (set! x a)) 1 2 (return 33))))) (test (and (= x 1) (= y 33)) #t) (set! y (call-with-exit (lambda (return) ((lambda (a b) (return a) (set! x b)) 2 3)))) (test (and (= x 1) (= y 2)) #t)) (let () (define (f go) (if (> 2 1) (go 32)) (display 'oops) (newline)) (test (call-with-exit f) 32)) (test (let ((x 0)) (define (quit z1) (z1 1) (set! x 1)) (call-with-exit (lambda (z) (set! x 2) (quit z) (set! x 3))) x) 2) (let () ; this bug from K Matheussen (define areas (list (lambda* (get-position) (get-position)))) (define (scroll! is-up) (call-with-exit (lambda (exit) (define area (car areas)) (area :get-position (lambda () (exit)))))) (test (scroll! #t) ())) ; will exit s7 if exit is marked global (test (let ((x (call/cc (lambda (k) k)))) (x (lambda (y) "hi"))) "hi") (test (((call/cc (lambda (k) k)) (lambda (x) x)) "hi") "hi") (test (let ((return #f) (lst ())) (let ((val (+ 1 (call/cc (lambda (cont) (set! return cont) 1))))) (set! lst (cons val lst))) (if (= (length lst) 1) (return 10) (if (= (length lst) 2) (return 20))) (reverse lst)) '(2 11 21)) (test (let ((r1 #f) (r2 #f) (lst ())) (define (somefunc x y) (+ (* 2 (expt x 2)) (* 3 y) 1)) (let ((val (somefunc (call/cc (lambda (c1) (set! r1 c1) (c1 1))) (call/cc (lambda (c2) (set! r2 c2) (c2 1)))))) (set! lst (cons val lst))) (if (= (length lst) 1) (r1 2) (if (= (length lst) 2) (r2 3))) (reverse lst)) '(6 12 18)) (let ((tree->generator (lambda (tree) (let ((caller '*)) (letrec ((generate-leaves (lambda () (let loop ((tree tree)) (cond ((null? tree) 'skip) ((pair? tree) (loop (car tree)) (loop (cdr tree))) (else (call/cc (lambda (rest-of-tree) (set! generate-leaves (lambda () (rest-of-tree 'resume))) (caller tree)))))) (caller ())))) (lambda () (call/cc (lambda (k) (set! caller k) (generate-leaves))))))))) (let ((same-fringe? (lambda (tree1 tree2) (let ((gen1 (tree->generator tree1)) (gen2 (tree->generator tree2))) (let loop () (let ((leaf1 (gen1)) (leaf2 (gen2))) (if (eqv? leaf1 leaf2) (if (null? leaf1) #t (loop)) #f))))))) (test (same-fringe? '(1 (2 3)) '((1 2) 3)) #t) (test (same-fringe? '(1 2 3) '(1 (3 2))) #f))) (let () (define (a-func) (call-with-exit (lambda (go) (lambda () (go + 32 1))))) (define (b-func) (call/cc (lambda (go) (lambda () (go + 32 1))))) (test ((a-func)) 'error) ;invalid-exit-function (test ((b-func)) 33)) #| (test ((call-with-exit (lambda (go) (lambda () (eval-string "(go + 32 1)"))))) 'error) |# (test ((call/cc (lambda (go) (lambda () (eval-string "(go + 32 1)"))))) 33) (test ((call/cc (lambda (go-1) (call/cc (lambda (go) (lambda () (go (go-1 + 32 1)))))))) 33) (for-each (lambda (arg) (test (let ((ctr 0)) (let ((val (call/cc (lambda (exit) (do ((i 0 (+ i 1))) ((= i 10) 'gad) (set! ctr (+ ctr 1)) (if (= i 1) (exit arg))))))) (and (equal? val arg) (= ctr 2)))) #t)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (let ((ctr 0)) (let ((val (call/cc (lambda (exit) (do ((i 0 (+ i 1))) ((= i 10) arg) (set! ctr (+ ctr 1)) (if (= i 11) (exit 'gad))))))) (and (equal? val arg) (= ctr 10)))) #t)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (let ((c #f) (r (string-copy "testing-hiho"))) (let ((v (call/cc (lambda (c0) (set! c c0) (list #\a 0))))) (let ((chr (car v)) (index (cadr v))) (string-set! r index chr) (set! index (+ index 1)) (if (<= index 8) (c (list (integer->char (+ 1 (char->integer chr))) index)) r)))) "abcdefghiiho") (test (let ((x 0) (again #f)) (call/cc (lambda (r) (set! again r))) (set! x (+ x 1)) (if (< x 3) (again)) x) 3) (test (let* ((x 0) (again #f) (func (lambda (r) (set! again r)))) (call/cc func) (set! x (+ x 1)) (if (< x 3) (again)) x) 3) (test (let* ((x 0) (again #f)) (call/cc (let () (lambda (r) (set! again r)))) (set! x (+ x 1)) (if (< x 3) (again)) x) 3) (test (let ((x 0) (xx 0)) (let ((cont #f)) (call/cc (lambda (c) (set! xx x) (set! cont c))) (set! x (+ x 1)) (if (< x 3) (cont)) xx)) 0) (test (call/cc procedure?) #t) (test (procedure? (call/cc (lambda (a) a))) #t) (for-each (lambda (arg) (test (call/cc (lambda (a) arg)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (let ((a (call/cc (lambda (a) a)))) (test (eq? a a) #t) (test (eqv? a a) #t) (test (equal? a a) #t) (for-each (lambda (ques) (if (ques a) (format #t ";(~A ~A) returned #t?~%" ques a))) question-ops)) (test (let ((conts (make-vector 4 #f))) (let ((lst ())) (set! lst (cons (+ (call/cc (lambda (a) (vector-set! conts 0 a) 0)) (call/cc (lambda (a) (vector-set! conts 1 a) 0)) (call/cc (lambda (a) (vector-set! conts 2 a) 0)) (call/cc (lambda (a) (vector-set! conts 3 a) 0))) lst)) (let ((len (length lst))) (if (< len 4) ((vector-ref conts (- len 1)) (+ len 1)) (reverse lst))))) '(0 2 5 9)) (test (let ((conts ())) (let ((lst ())) (set! lst (cons (+ (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1)) (* (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1)) (+ (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1)) (* (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) 1)) 2)))) lst)) (let ((len (length lst))) (if (<= len 4) ((list-ref conts (- len 1)) (+ len 1)) (reverse lst))))) ; (+ 1 (* 1 (+ 1 (* 1 2)))) to start ; (+ 1 ... 2 ) ; (+ 1 ... 3 [1] ) ; (+ 1 ...4 [1] ) ; (+ 5 [1] ) '(4 6 6 13 8)) (test (let ((conts (make-vector 4 #f))) (let ((lst ())) (set! lst (cons (+ (call/cc (lambda (a) (if (not (vector-ref conts 0)) (vector-set! conts 0 a)) 0)) (call/cc (lambda (a) (if (not (vector-ref conts 1)) (vector-set! conts 1 a)) 0)) (call/cc (lambda (a) (if (not (vector-ref conts 2)) (vector-set! conts 2 a)) 0)) (call/cc (lambda (a) (if (not (vector-ref conts 3)) (vector-set! conts 3 a)) 0))) lst)) (let ((len (length lst))) (if (< len 4) ((vector-ref conts (- len 1)) (+ len 1)) (reverse lst))))) '(0 2 3 4)) (test (let ((conts ())) (let ((lst ())) (set! lst (cons (+ (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 1 0) (* (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 2 1) (+ (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 1 0) (* (if (call/cc (lambda (a) (if (< (length conts) 4) (set! conts (cons a conts))) #f)) 2 1) 2)))) lst)) (let ((len (length lst))) (if (<= len 4) ((list-ref conts (- len 1)) #t) (reverse lst))))) ; (+ 0 (* 1 (+ 0 (* 1 2)))) to start ; (+ 0 ... 2 ) ; (+ 0 ... 1 [1] ) ; (+ 0 ...2 [0] ) ; (+ 1 [1] ) '(2 4 3 4 3)) (test (let ((call/cc 2)) (+ call/cc 1)) 3) (test (+ 1 (call/cc (lambda (r) (r 2 3 4))) 5) 15) (test (string-ref (call/cc (lambda (s) (s "hiho" 1)))) #\i) (let ((r5rs-ratify (lambda (ux err) (if (= ux 0.0) 0 (let ((tt 1) (a1 0) (b2 0) (a2 1) (b1 1) (a 0) (b 0) (ctr 0) (x (/ 1 ux))) (call-with-current-continuation (lambda (return) (do () (#f) (set! a (+ (* a1 tt) a2)) (set! b (+ (* tt b1) b2)) ;(format #t "~A ~A~%" a (- b a)) (if (or (<= (abs (- ux (/ a b))) err) (> ctr 1000)) (return (/ a b))) (set! ctr (+ 1 ctr)) (if (= x tt) (return)) (set! x (/ 1 (- x tt))) (set! tt (floor x)) (set! a2 a1) (set! b2 b1) (set! a1 a) (set! b1 b))))))))) (test (r5rs-ratify (/ (log 2.0) (log 3.0)) 1/10000000) 665/1054) (if (positive? 2147483648) (test (r5rs-ratify (/ (log 2.0) (log 3.0)) 1/100000000000) 190537/301994))) #| (let ((max-diff 0.0) (max-case 0.0) (err 0.01) (epsilon 1e-16)) (do ((i 1 (+ i 1))) ((= i 100)) (let ((x (/ i 100.))) (let ((vals (cr x err))) (if (not (= (car vals) (cadr vals))) (let ((r1 (car vals)) (r2 (cadr vals))) (let ((diff (abs (- r1 r2)))) (if (> diff max-diff) (begin (set! max-diff diff) (set! max-case x)))) (if (> (abs (- r1 x)) (+ err epsilon)) (format #t "(rationalize ~A ~A) is off: ~A -> ~A~%" x err r1 (abs (- r1 x)))) (if (> (abs (- r2 x)) (+ err epsilon)) (format #t "(ratify ~A ~A) is off: ~A -> ~A~%" x err r2 (abs (- r2 x)))) (if (< (denominator r2) (denominator r1)) (format #t "(ratify ~A ~A) is simpler? ~A ~A~%" x err r1 r2))))))) (list max-case max-diff (cr max-case err))) |# (for-each (lambda (arg) (test (let ((ctr 0)) (let ((val (call/cc (lambda (exit) (for-each (lambda (a) (if (equal? a arg) (exit arg)) (set! ctr (+ ctr 1))) (list 0 1 2 3 arg 5)))))) (list ctr val))) (list 4 arg))) (list "hi" -1 #\a 11 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #f #t '(1 . 2))) (test (+ 2 (call/cc (lambda (rtn) (+ 1 (let () (begin (define x (+ 1 (rtn 3)))) x))))) 5) ;;; others from stackoverflow.com Paul Hollingsworth etc: (test (procedure? (call/cc (lambda (k) k))) #t) (test (call/cc (lambda (k) (+ 56 (k 3)))) 3) (test (apply (lambda (k i) (if (> i 5) i (k (list k (* 2 i))))) (call/cc (lambda (k) (list k 1)))) 8) (test (apply (lambda (k i n) (if (= i 0) n (k (list k (- i 1) (* i n))))) (call/cc (lambda (k) (list k 6 1)))) 720) (test (let* ((ka (call/cc (lambda (k) `(,k 1)))) (k (car ka)) (a (cadr ka))) (if (< a 5) (k `(,k ,(* 2 a))) a)) 8) (test (apply (lambda (k i n) (if (eq? i 0) n (k (list k (- i 1) (* i n))))) (call/cc (lambda (k) (list k 6 1)))) 720) (test ((call/cc (lambda (k) k)) (lambda (x) 5)) 5) (let () (define (generate-one-element-at-a-time a-list) (define (generator) (call/cc control-state)) (define (control-state return) (for-each (lambda (an-element-from-a-list) (set! return (call/cc (lambda (resume-here) (set! control-state resume-here) (return an-element-from-a-list))))) a-list) (return 'you-fell-off-the-end-of-the-list)) generator) (let ((gen (generate-one-element-at-a-time (list 3 2 1)))) (test (gen) 3) (test (gen) 2) (test (gen) 1) (test (gen) 'you-fell-off-the-end-of-the-list))) ;;; from Ferguson and Duego "call with current continuation patterns" (test (let () (define count-to-n (lambda (n) (let ((receiver (lambda (exit-procedure) (let ((count 0)) (letrec ((infinite-loop (lambda () (if (= count n) (exit-procedure count) (begin (set! count (+ count 1)) (infinite-loop)))))) (infinite-loop)))))) (call/cc receiver)))) (count-to-n 10)) 10) (test (let () (define product-list (lambda (nums) (let ((receiver (lambda (exit-on-zero) (letrec ((product (lambda (nums) (cond ((null? nums) 1) ((zero? (car nums)) (exit-on-zero 0)) (else (* (car nums) (product (cdr nums)))))))) (product nums))))) (call/cc receiver)))) (product-list '(1 2 3 0 4 5))) 0) (begin (define fact ((lambda (f) ((lambda (u) (u (lambda (x) (lambda (n) ((f (u x)) n))))) (call/cc (call/cc (call/cc (call/cc (call/cc (lambda (x) x)))))))) (lambda (f) (lambda (n) (if (<= n 0) 1 (* n (f (- n 1)))))))) (test (map fact '(5 6 7)) '(120 720 5040))) ;; http://okmij.org/ftp/Scheme/callcc-calc-page.html (test (let () (define product-list (lambda (nums) (let ((receiver (lambda (exit-on-zero) (letrec ((product (lambda (nums) (cond ((null? nums) 1) ((number? (car nums)) (if (zero? (car nums)) (exit-on-zero 0) (* (car nums) (product (cdr nums))))) (else (* (product (car nums)) (product (cdr nums)))))))) (product nums))))) (call/cc receiver)))) (product-list '(1 2 (3 4) ((5))))) 120) (test (call/cc (lambda () 0)) 'error) (test (call/cc (lambda (a) 0) 123) 'error) (test (call/cc (lambda (3) 9)) 'error) (test (call/cc (lambda arg 0)) 0) (test (call-with-exit (lambda arg 0)) 0) (test (call/cc) 'error) (test (call/cc abs) 'error) (for-each (lambda (arg) (test (call-with-exit arg) 'error) (test (call-with-current-continuation arg) 'error) (test (call/cc arg) 'error)) (list "hi" -1 () #(1 2) _ht_ _undef_ _null_ _c_obj_ #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (call/cc . 1) 'error) (test (call/cc abs) 'error) (test (+ 1 (call/cc (lambda (r1) (call/cc (lambda (r2) (r1 2 3))))) 4) 10) (test (+ 1 (call/cc (lambda (r1) (+ 5 (call/cc (lambda (r2) (r2 2 3)))))) 4) 15) ;;; from Andy Wingo's Guile blog (let () (define (test1 get) (let ((v (make-vector 2 #f))) (vector-set! v 0 (get 0)) (vector-set! v 1 (get 1)) v)) (define (test2 get) (let* ((a (get 0)) (b (get 1))) (vector a b))) (define (discriminate f) (let ((get-zero-cont #t) (first-result #f)) (define (get n) (if (zero? n) (call/cc (lambda (k) (set! get-zero-cont k)))) n) (let ((result (f get))) (cond (first-result (eq? result first-result)) (else (set! first-result result) (get-zero-cont)))))) (test (discriminate test1) #t) (test (discriminate test2) #f) (define (discriminate2 f) (let ((get-zero-cont #f) (escape #f)) (define (get n) (case n ((0) (call/cc (lambda (k) (set! get-zero-cont k) 0))) ((1) (if escape (escape) 1)))) (let ((result (f get))) (call/cc (lambda (k) (set! escape k) (get-zero-cont 42))) result))) (test (discriminate2 test1) #(42 1)) (test (discriminate2 test2) #(0 1))) (let () (define (gotof x) (x (cond ((continuation? x) 1) ((procedure? x) 2) ((macro? x) 3) ((sequence? x) 0) (else (throw 'oops 4))))) (test (call/cc gotof) 1) (test (call-with-exit gotof) 2) (test (gotof abs) 2) (test (gotof (define-macro (m1 a) `(+ ,a ))) 3) (test (catch 'oops (lambda () (gotof 21)) (lambda (type info) (car info))) 4) (test (gotof #(5 9 10 11 12)) 5)) #| ;;; from bug-guile (define k #f) (define result #f) (define results ()) (set! result (map (lambda (x) (if x x (call/cc (lambda (c) (set! k c) 1)))) '(#t #f))) (set! results (cons result results)) (write results) (newline) (if (< (cadr result) 5) (k (+ 1 (cadr result)))) (newline) the claim is that this should return ((#t 1)) ((#t 2) (#t 1)) ((#t 3) (#t 2) (#t 1)) ((#t 4) (#t 3) (#t 2) (#t 1)) ((#t 5) (#t 4) (#t 3) (#t 2) (#t 1)) but I think that depends on how we interpret the sequence of top-level statements. The test should be written: (let* ((k #f) (results ())) (let ((result (map (lambda (x) (if x x (call/cc (lambda (c) (set! k c) 1)))) '(#t #f)))) (set! results (cons result results)) (write results) (newline) (if (< (cadr result) 5) (k (+ 1 (cadr result)))) (newline))) and then s7 is not following r6rs because it stops at ((#t 1)) ((1 . #1=(#t 2)) #1#) saying cadr is not a number. I don't think this example is correct in any case -- who says the continuation has to restart the map from the top? |# (let ((cont #f)) (let ((x (* (call/cc (lambda (return) (set! cont return) (return 3 4)))))) (if (= x 12) (cont 5 6 7)) (test x 210))) ;; Guile handles this very differently (test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return))) (cont 1)) 'error) (test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return))) (apply cont)) 'error) (test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return) (cont 1))) (apply cont)) 'error) (test (let ((cont #f)) (call-with-exit (lambda (return) (set! cont return) (cont 1))) (cont 1)) 'error) (test (procedure? (call-with-exit append)) #t) (test (procedure? (call-with-exit values)) #t) (test (procedure? (car (call-with-exit list))) #t) (test (call-with-exit (call-with-exit append)) 'error) (test (continuation? (call/cc (call/cc append))) #t) (test (procedure? (call-with-exit call-with-exit)) 'error) ; was #t until 9-Nov-20 -- now the inner call/exit returns an inactive goto (test (vector? (call-with-exit vector)) #t) (test (call-with-exit ((lambda args procedure?))) #t) (test (call-with-exit (let ((x 3)) (define (return y) (y x)) return)) 3) (test (call-with-exit (lambda (return) (with-input-from-string "hi" return))) ()) ; because thunk? -- does it close the port? (test (call-with-exit (lambda (return) (call-with-input-string "hi" return))) 'error) (test (call-with-exit (lambda (return) (set! (setter return) abs))) 'error) (test (call-with-exit (lambda (return) (dynamic-wind return (lambda () 1) (lambda () (error 'test-error "oops"))))) ()) (test (call-with-exit (lambda (return) (map return '(1 2 3)))) 1) (test (call-with-exit (lambda (return) (dynamic-wind (lambda () 2) (lambda () 1) return))) ()) ; ?? is this a bug? (test (call-with-exit (lambda (return) (dynamic-wind (lambda () 2) (lambda () 1) (lambda () (return 3))))) 3) ; I guess not (test (let ((c1 #f)) (call-with-exit (lambda (c2) (call-with-exit (lambda (c3) (set! c1 c3) (c2))))) (c1)) 'error) (test (let ((c1 #f)) (call/cc (lambda (c2) (call-with-exit (lambda (c3) (set! c1 c3) (c2))))) (c1)) 'error) (test (let ((cont #f)) (catch #t (lambda () (call-with-exit (lambda (return) (set! cont return) (error 'testing " a test")))) (lambda args 'error)) (apply cont)) 'error) (test (let ((cont #f)) (catch #t (lambda () (call-with-exit (lambda (return) (set! cont return) (error 'testing " a test")))) (lambda args 'error)) (cont 1)) 'error) (test (let ((e (call-with-exit (lambda (go) (lambda () (go 1)))))) (e)) 'error) (test (let ((cc #f) (doit #t) (ctr 0)) (let ((ok (call-with-exit (lambda (c3) (call/cc (lambda (ret) (set! cc ret))) (c3 (let ((res doit)) (set! ctr (+ ctr 1)) (set! doit #f) res)))))) (if ok (cc))) ctr) 2) (test (let ((val (call-with-exit (lambda (ret) (let ((ret1 ret)) (ret1 2) 3))))) val) 2) (test (call-with-exit (lambda (return) (sort! '(3 2 1) return))) 'error) ; "sort! argument 2, #, is a goto ..." ;;; this one from Rick (test (eval '(call/cc (lambda (go) (go 9) 0))) 9) (test (eval-string "(call/cc (lambda (go) (go 9) 0))") 9) (test (call-with-exit (lambda (return) (call/cc (lambda (go) (go 9) 0)) (return 1) 2)) 1) (num-test (/ 1 (call/cc (lambda (go) (go 9) 0))) 1/9) (test (call/cc (lambda (g) (call/cc (lambda (f) (f 1)) (g 2)))) 2) ; !! guile agrees! (evaluating the extraneous arg jumps) (test (call/cc (lambda (g) (abs -1 (g 2)))) 2) ; perhaps this should be an error (test (call/cc (lambda (g) (if #t #f #f (g 2)))) 'error) (test ((call-with-exit (lambda (go) (go go))) eval) 'error) (test ((call/cc (lambda (go) (go go))) eval) eval) (test (call-with-exit quasiquote) 'error) (test (call-with-exit (lambda (go) (if (go 1) (go 2) (go 3)))) 1) (test (call-with-exit (lambda (go) (set! (go 1) 2))) 'error) (test (call-with-exit (lambda (go) (let ((x 1) (y (go x))) #f))) 'error) (test (call-with-exit (lambda (go) (let* ((x 1) (y (go x))) #f))) 1) (test (call-with-exit (lambda (go) (letrec ((x 1) (y (go x))) #f))) #) (test (call-with-exit (lambda (go) (letrec* ((x 1) (y (go x))) #f))) 1) (test (call-with-exit (lambda (go) (case (go 1) ((go 2) 3) (else 4)))) 1) (test (call-with-exit (lambda (go) (case go ((go 2) 3) (else 4)))) 4) (test (call-with-exit (lambda (go) (case 2 ((go 2) 3) (else 4)))) 3) (test (call-with-exit (lambda (go) (eq? go go))) #t) (test (call-with-exit (lambda (go) (case 'go ((go 2) 3) (else 4)))) 3) (test (call-with-exit (lambda (go) (go (go (go 1))))) 1) (test (call-with-exit (lambda (go) (quasiquote (go 1)))) '(go 1)) ;; these tests were messed up -- I forgot the outer parens (test (call-with-exit (lambda (go) ((lambda* ((a (go 1))) a) (go 2) 3))) 2) (test (call-with-exit (lambda (go) ((lambda* ((a (go 1))) a)))) 1) (test (call-with-exit (lambda (go) ((lambda (go) go) 1))) 1) (test (call-with-exit (lambda (go) (quote (go 1)) 2)) 2) (test (call-with-exit (lambda (go) (and (go 1) #f))) 1) (test (call-with-exit (lambda (go) (dynamic-wind (lambda () (go 1) 11) (lambda () (go 2) 12) (lambda () (go 3) 13)))) 1) (test (eval '(call/cc (lambda (go) (if (go 1) (go 2) (go 3))))) 1) (test (eval '(call/cc (lambda (go) (set! (go 1) 2)))) 'error) (test (eval '(call/cc (lambda (go) (let ((x 1) (y (go x))) #f)))) 'error) (test (eval '(call/cc (lambda (go) (let* ((x 1) (y (go x))) #f)))) 1) (test (eval '(call/cc (lambda (go) (letrec ((x 1) (y (go x))) #f)))) #) (test (eval '(call/cc (lambda (go) (letrec* ((x 1) (y (go x))) #f)))) 1) (test (eval '(call/cc (lambda (go) (case (go 1) ((go 2) 3) (else 4))))) 1) (test (eval '(call/cc (lambda (go) (case go ((go 2) 3) (else 4))))) 4) (test (eval '(call/cc (lambda (go) (case 2 ((go 2) 3) (else 4))))) 3) (test (eval '(call/cc (lambda (go) (eq? go go)))) #t) (test (eval '(call/cc (lambda (go) (case 'go ((go 2) 3) (else 4))))) 3) (test (eval '(call/cc (lambda (go) (go (go (go 1)))))) 1) (test (eval '(call/cc (lambda (go) (quasiquote (go 1))))) '(go 1)) (test (eval '(call/cc (lambda (go) ((lambda* (a (go 1)) a) (go 2))))) 2) (test (eval '(call/cc (lambda (go) ((lambda* (a (go 1)) a) 2)))) 2) (test (eval '(call/cc (lambda (go) ((lambda* (a (go 1)) a))))) #f) (test (eval '(call/cc (lambda (go) ((lambda (go) go) 1)))) 1) (test (eval '(call/cc (lambda (go) (quote (go 1)) 2))) 2) (test (eval '(call/cc (lambda (go) (and (go 1) #f)))) 1) (test (eval '(call/cc (lambda (go) (dynamic-wind (lambda () (go 1) 11) (lambda () (go 2) 12) (lambda () (go 3) 13))))) 1) (test (call-with-exit (lambda (go) (eval '(go 1)) 2)) 1) (test (call-with-exit (lambda (go) (eval-string "(go 1)") 2)) 1) (test (call-with-exit (lambda (go) `(,(go 1) 2))) 1) (test (call-with-exit (lambda (go) (case 0 ((0) (go 1) (go 2))))) 1) (test (call-with-exit (lambda (go) (cond (1 => go)) 2)) 1) (test (call-with-exit (lambda (go) (((cond ((go 1) => go)) 2)))) 1) (test (call-with-exit (lambda (go) (cond (1 => (go 2))))) 2) (test (call-with-exit (lambda (go) (go (eval '(go 1))) 2)) 1) (test (+ 10 (call-with-exit (lambda (go) (go (eval '(go 1))) 2))) 11) ;(test (call-with-exit (lambda (go) (go (eval-string "(go 1)")) 2)) 1) ;(test (call-with-exit (lambda (go) (eval-string "(go 1)") 2)) 1) (test (call-with-exit (lambda (go) ((eval 'go) 1) 2)) 1) (test (eval-string "(call/cc (lambda (go) (if (go 1) (go 2) (go 3))))") 1) (test (call-with-exit (lambda (quit) ((lambda* ((a (quit 32))) a)))) 32) (test ((call-with-exit (lambda (go) (go quasiquote))) go) 'go) (if original-test-macro (let ((res #f)) (catch #t (lambda () (test (let ((y 2)) ((lambda () (let ((z 1)) (values y z))))) 'error)) ; binding result in test to the (values 2 1) (lambda args (set! res 'error))) (unless (eq? res 'error) (format *stderr* "bind test result to (values 1 2) not an error?~%")))) (test (let ((x #f)) ((lambda () (let-temporarily ((x 1234)) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))) (if x y) ; y unbound, so x better be #f 3))) 3) (test (let ((x #f)) ((lambda () (call-with-exit (lambda (go) (let-temporarily ((x 1234)) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))) (if x y) (go 3)))))) 3) (test (let ((x #f)) ((lambda () (let-temporarily ((x 1234)) (call-with-exit (lambda (go) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))))) (if x y) 3))) 3) (test (let ((x #f)) (dynamic-wind (lambda () #f) (lambda () (let-temporarily ((x 1234)) (call/cc (lambda (return) (let ((x 1) (y 2)) (return x y))))) (if x y) 3) (lambda () #f))) 3) (test (let ((c #f)) (let ((val -1)) (set! val (call/cc (lambda (c1) (call-with-exit (lambda (c2) (call-with-exit (lambda (c3) (call/cc (lambda (c4) (set! c c4) (c1 (c2 0))))))))))) (if (= val 0) (c 5)) val)) 5) (let () (define-macro (while test . body) ; while loop with predefined break and continue `(call-with-exit (lambda (break) (let loop () (call-with-exit (lambda (continue) (do () ((not ,test) (break)) ,@body))) (loop))))) (test (+ (while #t (break 1 2 3))) 6) (test (let ((sum 0)) (while (< sum 10) (set! sum (+ sum 1))) sum) 10) (test (let ((sum 0)) (while (< sum 10) (set! sum (+ sum 1)) (continue) (break)) sum) 10) (test (let ((i 0) (sum 0)) (while (< i 10) (set! sum (+ sum i)) (set! i (+ i 1)) (when (= i 6) (continue) (error 'oops "we reached the unreachable")) (set! sum (+ sum i))) sum) 94) (test (let ((i 0) (sum 0) (break 32) (continue 48)) (while (let ((break 10) (continue 0)) (< i (+ break continue))) (set! sum (+ sum 1)) (set! i (+ i 1)) (if (< i 5) (continue)) (set! sum (+ sum 10)) (if (> i 7) (break)) (set! sum (+ sum 100))) sum) 348)) (unless (and (defined? 'file-exists?) (file-exists? "t923.scm")) (call-with-output-file "t923.scm" (lambda (p) (format p "(define x 32)~%")))) (test (call/cc (lambda (return) (let ((val (format #f "line 1~%line 2~%line 3"))) (call-with-input-string val (lambda (p) (return "oops")))))) "oops") (test (call/cc (lambda (return) (let ((val (format #f "line 1~%line 2~%line 3"))) (with-input-from-string val (lambda () (return "oops")))))) "oops") (test (call/cc (lambda (return) (let ((val (format #f "line 1~%line 2~%line 3"))) (with-input-from-file "t923.scm" (lambda () (return "oops")))))) "oops") (test (call/cc (lambda (return) (let ((val (format #f "line 1~%line 2~%line 3"))) (call-with-input-file "t923.scm" (lambda (p) (return "oops")))))) "oops") (test (call/cc (lambda (return) ; ok but no output?? (also below) (let ((val (format #f "line 1~%line 2~%line 3"))) (with-output-to-string (lambda () (return "oops")))))) "oops") (test (call/cc (lambda (return) ; ok (let ((val (format #f "line 1~%line 2~%line 3"))) (call-with-output-string (lambda (p) (return "oops")))))) "oops") (test (call/cc (lambda (return) ; ok (let ((val (format #f "line 1~%line 2~%line 3"))) (call-with-output-file "t923.scm" (lambda (p) (return "oops")))))) "oops") (test (call/cc (lambda (return) ; ok (let ((val (format #f "line 1~%line 2~%line 3"))) (with-output-to-file "t923.scm" (lambda () (return "oops")))))) "oops") (test (with-output-to-string (lambda () (display (memq (call/cc (lambda (return) (return 'a))) '(x a))))) "(a)") ;;; -------------------------------------------------------------------------------- ;;; with-baffle (test (with-baffle) ()) ; ?? -- like begin I guess (test (apply with-baffle ()) ()) ; again like begin (test (with-baffle 0) 0) (test (+ 1 (with-baffle (values 2 3)) 4) 10) (test (with-baffle . 1) 'error) (test (with-baffle 1 2 . 3) 'error) (test (let ((vals3t with-baffle)) (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((= i 1) (vals3t (* 2 i 3 4))))) (func)) 24) (let ((b 0)) (define (f1) ; not baffled (let ((a 1) (cc #f)) (call/cc (lambda (return) (set! cc return))) (set! b (+ b a)) (if (< a 3) (begin (set! a (+ a 1)) cc) (lambda () #f)))) (define (g1) (let ((a 3)) ((f1)))) (test (g1) #f) (test b 6) (set! b 0) (define (f2) ; baffled (let ((a 1) (cc #f)) (with-baffle (call/cc (lambda (return) (set! cc return))) (set! b (+ b a)) (if (< a 3) (begin (set! a (+ a 1)) cc) (lambda () #f))))) (define (g2) (let ((a 3)) (catch 'baffled! (lambda () ((f2))) (lambda (type info) (apply format #f info))))) (test (g2) "continuation return can't jump into with-baffle") (test b 1)) (test (with-baffle (let ((x 0) (c1 #f) (results ())) (set! x (call/cc (lambda (r1) (set! c1 r1) (r1 2)))) (set! results (cons x results)) (if (= x 2) (c1 32)) results)) '(32 2)) (test (let ((x 0) (c1 #f) (results ())) (with-baffle (set! x (call/cc (lambda (r1) (set! c1 r1) (r1 2)))) (set! results (cons x results))) (if (= x 2) (c1 32)) results) 'error) (test (let ((what's-for-breakfast ()) (bad-dog 'fido)) ; bad-dog wonders what's for breakfast? (with-baffle ; the syntax is (with-baffle . body) (set! what's-for-breakfast (call/cc (lambda (biscuit?) (set! bad-dog biscuit?) ; bad-dog smells a biscuit! 'biscuit!)))) (if (eq? what's-for-breakfast 'biscuit!) (bad-dog 'biscuit!)) ; now, outside the baffled block, bad-dog wants that biscuit! what's-for-breakfast) ; but s7 says "No!": baffled! ("continuation can't jump into with-baffle") 'error) (test (+ (with-baffle (let ((c1 #f)) (call/cc (lambda (c2) (set! c1 c2) (c2 2))))) 1) 3) (test (+ (let ((c1 #f)) (with-baffle (call/cc (lambda (c2) (set! c1 c2) (c2 2)))) (c1 3)) 1) 'error) (test (let () (define (c3 a) (a 2)) (c3 (with-baffle (call/cc (lambda (c2) c2))))) 'error) (test (call-with-exit (lambda (return) (with-baffle (do () () (return 1))))) 1) (test (let () (define (hi) (null? (with-baffle))) (hi)) #t) (test (continuation? (with-baffle (call/cc (lambda (ret) ret)))) #t) (test (with-baffle (let ((cc #f)) (call/cc (lambda (r) (set! cc r))) (let ((c1 cc)) (if cc (begin (set! cc #f) (c1)) 32)))) 32) (let ((b 0)) (define (f2 x) (let ((a x) (cc1 #f) (cc2 #f)) (with-baffle (with-baffle (call/cc (lambda (return1) (set! b (+ b 1)) (set! cc1 return)))) (call/cc (lambda (return2) (set! b (+ b 2)) (set! cc2 return))) (set! b (+ b a))) (if (= a 1) (begin (set! a (+ a 2)) cc2) (if (< a 3) (begin (set! a (+ a 1)) cc1) (lambda () #f))))) (define (g2) (let ((val (catch 'baffled! (lambda () ((f2 0))) (lambda (type info) (apply format #f info))))) (test val "continuation return1 can't jump into with-baffle")) (test b 3) (set! b 0) (let ((val (catch 'baffled! (lambda () ((f2 1))) (lambda (type info) (apply format #f info))))) (test val "continuation return2 can't jump into with-baffle")) (test b 4))) ;;; -------------------------------------------------------------------------------- ;;; dynamic-wind ;;; -------------------------------------------------------------------------------- (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (dynamic-wind (lambda () (set! ctr1 (+ ctr1 1))) (lambda () (set! ctr2 (+ ctr2 1)) (+ 1 ctr2)) (lambda () (set! ctr3 (+ ctr3 1)))))) (= ctr1 ctr2 ctr3 (- ctr4 1) 1))) #t) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (catch 'dw (lambda () (dynamic-wind (lambda () (set! ctr1 (+ ctr1 1))) (lambda () (set! ctr2 (+ ctr2 1)) (error 'dw "dw-error") ctr2) (lambda () (set! ctr3 (+ ctr3 1))))) (lambda args (car args))))) (and (eq? ctr4 'dw) (= ctr1 1) (= ctr2 1) (= ctr3 1)))) #t) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (catch 'dw (lambda () (dynamic-wind (lambda () (set! ctr1 (+ ctr1 1))) (lambda () (error 'dw "dw-error") (set! ctr2 (+ ctr2 1)) ctr2) (lambda () (set! ctr3 (+ ctr3 1))))) (lambda args (car args))))) (and (eq? ctr4 'dw) (= ctr1 1) (= ctr2 0) (= ctr3 1)))) #t) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (catch #t (lambda () (dynamic-wind (lambda () (set! ctr1 (+ ctr1 1)) (error 'dw-init "dw-error")) (lambda () (set! ctr2 (+ ctr2 1)) (error 'dw "dw-error") ctr2) (lambda () (set! ctr3 (+ ctr3 1))))) (lambda args (car args))))) (and (eq? ctr4 'dw-init) (= ctr1 1) (= ctr2 0) (= ctr3 0)))) #t) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (catch #t (lambda () (dynamic-wind (lambda () (set! ctr1 (+ ctr1 1))) (lambda () (set! ctr2 (+ ctr2 1)) ctr2) (lambda () (set! ctr3 (+ ctr3 1)) (error 'dw-final "dw-error")))) (lambda args (car args))))) (and (eq? ctr4 'dw-final) (= ctr1 1) (= ctr2 1) (= ctr3 1)))) #t) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (catch #t (lambda () (dynamic-wind (lambda () (set! ctr1 (+ ctr1 1))) (lambda () (set! ctr2 (+ ctr2 1)) ctr2) (lambda () (error 'dw-final "dw-error") (set! ctr3 (+ ctr3 1))))) (lambda args (car args))))) (and (eq? ctr4 'dw-final) (= ctr1 1) (= ctr2 1) (= ctr3 0)))) #t) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (call/cc (lambda (exit) (dynamic-wind (lambda () (set! ctr1 (+ ctr1 1))) (lambda () (exit ctr2) (set! ctr2 (+ ctr2 1)) ctr2) (lambda () (set! ctr3 (+ ctr3 1)) 123)))))) (and (= ctr1 ctr3 1) (= ctr2 ctr4 0)))) #t) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (call/cc (lambda (exit) (dynamic-wind (lambda () (exit ctr1) (set! ctr1 (+ ctr1 1))) (lambda () (set! ctr2 (+ ctr2 1)) ctr2) (lambda () (set! ctr3 (+ ctr3 1)))))))) (= ctr1 ctr2 ctr3 ctr4 0))) #t) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((ctr4 (call/cc (lambda (exit) (dynamic-wind (lambda () (set! ctr1 (+ ctr1 1))) (lambda () (set! ctr2 (+ ctr2 1)) ctr2) (lambda () (exit ctr3) (set! ctr3 (+ ctr3 1)))))))) (and (= ctr1 ctr2 1) (= ctr3 ctr4 0)))) #t) (test (let ((path ()) (c #f)) (let ((add (lambda (s) (set! path (cons s path))))) (dynamic-wind (lambda () (add 'connect)) (lambda () (add (call-with-current-continuation (lambda (c0) (set! c c0) 'talk1)))) (lambda () (add 'disconnect))) (if (< (length path) 4) (c 'talk2) (reverse path)))) '(connect talk1 disconnect connect talk2 disconnect)) (for-each (lambda (arg) (test (dynamic-wind (lambda () #f) (lambda () arg) (lambda () #f)) arg)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (dynamic-wind (lambda () #f) (lambda () #f) (lambda () #f)) #f) (test (+ 1 (dynamic-wind (lambda () #f) (lambda () (values 2 3 4)) (lambda () #f)) 5) 15) (test (let () (define-macro (makef val) `(lambda () ,val)) (dynamic-wind (lambda () #f) (makef 123) (lambda () #f))) 123) (test (dynamic-wind (lambda () #f) (define-macro (_m_) 32) (lambda () #f)) 32) (test (dynamic-wind (lambda () 123) #f (lambda () 321)) 'error) ; not sure about this (let () (define-macro (m) `(+ 1 2 3)) (test (dynamic-wind m m m) 6) (test (dynamic-wind m (lambda () 123) m) 123) (test (dynamic-wind (lambda () #f) m (lambda () #f)) 6) (test (dynamic-wind (lambda () #f) m m) 6)) ;;; so... dynamic-wind init load quit would place the loaded defs in the current env -- transparent dw (let () (define-macro* (m (a 1)) `(define __asdf__ ,a)) (dynamic-wind (lambda () #f) m (lambda () #f)) (test __asdf__ 1)) (test (let ((identity (lambda (a) a))) (let ((x ()) (c #f)) (dynamic-wind (lambda () (set! x (cons 'a x))) (lambda () (dynamic-wind (lambda () (set! x (cons 'b x))) (lambda () (dynamic-wind (lambda () (set! x (cons 'c x))) (lambda () (set! c (call/cc identity))) (lambda () (set! x (cons 'd x))))) (lambda () (set! x (cons 'e x)))) (dynamic-wind (lambda () (set! x (cons 'f x))) (lambda () (if c (c #f))) (lambda () (set! x (cons 'g x))))) (lambda () (set! x (cons 'h x)))) (reverse x))) '(a b c d e f g b c d e f g h)) #| (test (dynamic-wind (lambda args (if (not (null? args)) (format *stderr* "args: ~A~%": args))) (lambda args (if (not (null? args)) (format *stderr* "args: ~A~%": args)) args) (lambda args (if (not (null? args)) (format *stderr* "args: ~A~%": args)))) ()) |# (test (list (dynamic-wind (lambda () #f) (lambda () (values 'a 'b 'c)) (lambda () #f))) (list 'a 'b 'c)) (test (let ((ctr1 0) (ctr2 0) (ctr3 0)) (let ((val (dynamic-wind (lambda () #f) (lambda () (set! ctr1 1) (call/cc (lambda (exit) (exit 123) (set! ctr2 2) 321))) (lambda () (set! ctr3 3))))) (and (= ctr1 1) (= ctr2 0) (= ctr3 3) (= val 123)))) #t) (test (let ((ctr1 0)) (let ((val (dynamic-wind (let ((a 1)) (lambda () (set! ctr1 a))) (let ((a 10)) (lambda () (set! ctr1 (+ ctr1 a)) ctr1)) (let ((a 100)) (lambda () (set! ctr1 (+ ctr1 a))))))) (and (= ctr1 111) (= val 11)))) #t) (test (let ((ctr1 0)) (let ((val (+ 3 (dynamic-wind (let ((a 1)) (lambda () (set! ctr1 a))) (let ((a 10)) (lambda () (set! ctr1 (+ ctr1 a)) ctr1)) (let ((a 100)) (lambda () (set! ctr1 (+ ctr1 a))))) 1000))) (and (= ctr1 111) (= val 1014)))) #t) (test (let ((n 0)) (call-with-current-continuation (lambda (k) (dynamic-wind (lambda () (set! n (+ n 1)) (k)) (lambda () (set! n (+ n 2))) (lambda () (set! n (+ n 4)))))) n) 1) (test (let ((n 0)) (call-with-current-continuation (lambda (k) (dynamic-wind (lambda () #f) (lambda () (dynamic-wind (lambda () #f) (lambda () (set! n (+ n 1)) (k)) (lambda () (set! n (+ n 2)) ;(k) ))) (lambda () (set! n (+ n 4)))))) n) 7) (test (let ((n 0)) (call-with-current-continuation (lambda (k) (dynamic-wind (lambda () #f) (lambda () (dynamic-wind (lambda () #f) (lambda () (dynamic-wind (lambda () #f) (lambda () (set! n (+ n 1)) (k)) (lambda () (if (= n 1) (set! n (+ n 2)))))) (lambda () (if (= n 3) (set! n (+ n 4)))))) (lambda () (if (= n 7) (set! n (+ n 8))))))) n) 15) (test (dynamic-wind) 'error) (test (dynamic-wind (lambda () #f)) 'error) (test (dynamic-wind (lambda () #f) (lambda () #f)) 'error) (test (dynamic-wind (lambda (a) #f) (lambda () #f) (lambda () #f)) 'error) (test (dynamic-wind (lambda () #f) (lambda (a b) #f) (lambda () #f)) 'error) (test (dynamic-wind (lambda () #f) (lambda () #f) (lambda (a) #f)) 'error) (test (dynamic-wind (lambda () 1) #f (lambda () 2)) 'error) (test (dynamic-wind (lambda () #f) (lambda () 32) (lambda* (a b) a)) 'error) (test (dynamic-wind . 1) 'error) (test (dynamic-wind () () ()) 'error) (test (dynamic-wind () _ht_ _undef_ _null_ _c_obj_ ()) 'error) (test (dynamic-wind + + +) 0) (test (dynamic-wind (values + + +)) 0) (test (+ (dynamic-wind (lambda () (values 1 2 3)) (lambda () (values 4 5 6)) (lambda () (values 7 8 9)))) 15) (test (dynamic-wind #f (lambda () 32) #f) 32) (test (dynamic-wind #f (lambda () 32) #f #f) 'error) (test (let ((x 0)) (+ (dynamic-wind #f (lambda () 32) (lambda () (set! x 1))) x)) 33) (for-each (lambda (arg) (test (dynamic-wind arg (lambda () #f) (lambda () #f)) 'error) (test (dynamic-wind (lambda () #f) arg (lambda () #f)) 'error) (test (dynamic-wind (lambda () #f) (lambda () #f) arg) 'error)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (test (dynamic-wind (let ((x 1)) (lambda () x)) ((lambda () (lambda () 2))) (lambda () (*s7* 'version))) 2) (test (let ((x 0)) (dynamic-wind (lambda () (set! x 1)) ((lambda () (set! x 32) (lambda () x))) (let () (set! x 44) (lambda () x)))) 1) (test (let ((x 0)) (dynamic-wind (lambda () (set! x (+ x 1))) ((lambda () (set! x 32) (lambda () x))) (let () (set! x 44) (lambda () x)))) 45) (test (let ((x 0)) (dynamic-wind (lambda () (set! x (+ x 1))) ((lambda () (set! x 32) (lambda () x))) (let () (lambda () x)))) 33) (test (let ((x 0)) (dynamic-wind (lambda () (set! x (+ x 1))) ((lambda () (set! x (+ x 32)) (lambda () x))) (let () (lambda () (set! x (+ x 100)) x)))) 33) (test (let ((cc #f)) (dynamic-wind (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)) 32))) (lambda () (cc 33)) (lambda () #f))) 'error) (test (let ((cc #f)) (dynamic-wind (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)) 32))) (lambda () #f) (lambda () (cc 33)))) 'error) (test (let ((cc #f)) (dynamic-wind (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)) 32))) (lambda () #f) (lambda () #f)) (cc 33)) 'error) (let () ; call/cc copy_stack clears opt2_con, affected op_c_catch_all -> catch_all_function (define (func) (let ((x #f)) (define (ff) 1) (catch #t (lambda () (ff (call/cc (lambda (cc) (cc 1))))) (lambda (type info) 'error)))) ; must be simple case to hit the bug (test (func) 'error)) (test (let ((cc #f)) (let ((result (dynamic-wind (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)) 32))) (lambda () (cc 33)) (lambda () (cc 34))))) (cc 35))) 'error) (test (let ((x 32) (cc #f)) (let ((clo (lambda () (call/cc (lambda (r) (if (not cc) (set! cc r)))) x))) (catch #t (lambda () (let ((cc #f)) (dynamic-wind clo (lambda () (cc 33)) (lambda () #f)))) (lambda args (clo))))) 32) (test ((lambda () (dynamic-wind (lambda () #f) (lambda () (let ((!x #f) (_b_ 32)) (dynamic-wind (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_))))) (lambda () !x) (lambda () (set! !x #f))))) (lambda () #f)))) 32) (test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32))))) (let ((!x #f)) (dynamic-wind (lambda () (set! !x (call-with-exit (lambda (_a_) (_a_ _b_))))) (lambda () !x) (lambda () (set! !x #f))))) 32) (test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32))))) (let ((!x #f)) (dynamic-wind (lambda () (set! !x (call/cc (lambda (_a_) _b_)))) (lambda () !x) (lambda () (set! !x #f))))) 32) (test (let ((!x #f) (_b_ 32)) (dynamic-wind (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_))))) (lambda () !x) (lambda () (set! !x #f)))) 32) (test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32))))) (let ((!x #f)) (dynamic-wind (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_))))) (lambda () !x) (lambda () (set! !x #f))))) 32) (test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32))))) (let ((!x #f)) (dynamic-wind (lambda () #f) (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_)))) !y) (lambda () #f)))) 32) (test (let-temporarily (((hook-functions *unbound-variable-hook*) (list (lambda (hook) (set! (hook 'result) 32))))) (let ((!x #f)) (dynamic-wind (lambda () #f) (lambda () #f) (lambda () (set! !x (call/cc (lambda (_a_) (_a_ _b_)))))))) #f) (test (let ((!x #f) (_b_ 32)) (dynamic-wind (lambda () (let-temporarily ((_b_ 100)) (set! !x (call/cc (lambda (_a_) (_a_ _b_)))))) (lambda () (cons !x _b_)) (lambda () (set! !x #f)))) '(100 . 32)) (test (let ((!x #f) (_b_ 32) (_c_ ())) (set! _c_ (cons (let-temporarily ((_b_ 100)) (call/cc (lambda (_a_) (unless !x (set! !x _a_)) (_a_ _b_) 123))) _c_)) (set! _c_ (cons _b_ _c_)) (let ((!y !x)) (set! !x #f) (if !y (!y 32))) (reverse _c_)) '(100 32 32 32)) (let () (define-macro (make-thunk val) `(lambda () ,val)) (test (dynamic-wind (make-thunk 0) (make-thunk 1) (make-thunk 2)) 1)) (let ((jumps 4)) (define (test1 f) (let ((c #f) (ctr 0)) (dynamic-wind (lambda () #f) (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))) (lambda () #f)) (if (< ctr f) (c)) ctr)) (define (test2 f) (let ((c #f) (ctr 0)) (dynamic-wind (lambda () #f) (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1)))) (lambda () #f)) (if (< ctr f) (c)) ctr)) (test (test2 jumps) 'error) (test (test1 jumps) 4) (define (test3 f) (let ((c #f) (ctr 0)) (dynamic-wind (lambda () #f) (lambda () #f) (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1)))) (if (< ctr f) (c)) ctr)) (define (test4 f) (let ((c #f) (ctr 0)) (dynamic-wind (lambda () #f) (lambda () #f) (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))))) (if (< ctr f) (c)) ctr)) (test (test4 jumps) 'error) (test (test3 jumps) 'error) (define (test5 f) (let ((c #f) (ctr 0)) (dynamic-wind (lambda () (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1))) ; error now 12-Aug-18 (lambda () #f) (lambda () #f)) (if (< ctr f) (c)) ctr)) (define (test6 f) (let ((c #f) (ctr 0)) (dynamic-wind (lambda () (with-baffle (when (not c) (call/cc (lambda (k) (set! c k)))) (set! ctr (+ ctr 1)))) (lambda () #f) (lambda () #f)) (if (< ctr f) (c)) ctr)) (test (test6 jumps) 'error) (test (test5 jumps) 'error)) #| ;;; from scheme wiki ;;; http://community.schemewiki.org/?hose-the-repl ;;; jorgen-schafer (test (let loop () (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) (lambda () (let loop () (loop))) k))) (loop)) 'error) ;; that example calls to mind a bunch like it: (test (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) (lambda () (let loop () (loop))) k))) 'error) (test (call-with-exit (lambda (k) (dynamic-wind (lambda () #t) k (lambda () #t)))) 'error) (test (call-with-exit (lambda (k) (dynamic-wind k (lambda () #f) (lambda () #t)))) 'error) |# ;;; dynamic-unwind (test (dynamic-unwind 123 123) 'error) (let () (define (report-1 arg value) (list (car arg) value)) (define (f x) (dynamic-unwind report-1 x) 32) ; report-1 is called with x 32 -- 32 is the value returned by f (test (f 12) '(12 32)) (define (f2 x y) (dynamic-unwind report-1 (list x y)) 32) (test (f2 12 11) '((12 11) 32))) (let () (define (report-2 arg value other) (display arg) (display #\space) (display value) (display #\space) (display other)) (define (f3 x y) (dynamic-unwind report-2 (list x y)) 32) (test (f3 12 11) 'error) (define (report-3 . args) (display args)) (define (f4 x y) (dynamic-unwind report-3 (list x y)) 32) (test (f4 12 11) 'error)) (test (call-with-exit (lambda (k) (documentation k))) "") (test (call-with-exit (lambda (k) (procedure-source k))) ()) (test (let ((pws (dilambda vector-ref vector-set!))) (let ((pws1 (dilambda pws vector-set!))) (let ((v (vector 1 2))) (set! (pws1 v 1) 32) (pws1 v 1)))) 32) (test (call-with-exit (lambda (k) (map k '(1 2 3)))) 1) (test (call-with-exit (lambda (k) (for-each k '(1 2 3)))) 1) (test (call-with-exit (lambda (k) (catch #t k k))) ()) ; was 'error until 14-May-14 (test (call-with-exit (lambda (k) (catch #t (lambda () #f) k))) #f) ;(test (call-with-exit (lambda (k) (catch #t (lambda () (error 'an-error)) k))) 'error) ; this seems like it could be either (test (call-with-exit (lambda (k) (sort! '(1 2 3) k))) 'error) ; "sort! argument 2, #, is a goto" (test (sort! '(1 2 3) (lambda () #f)) 'error) (test (sort! '(1 2 3) (lambda (a) #f)) 'error) (test (sort! '(1 2 3) (lambda (a b c) #f)) 'error) ;(test (let () (define-macro (asdf a b) `(< ,a ,b)) (sort! '(1 2 3) asdf)) 'error) (test (let () (let asdf () (sort! '(1 2 3) asdf))) 'error) (test (let () (let asdf () (map asdf '(1 2 3)))) 'error) (test (let () (let asdf () (for-each asdf '(1 2 3)))) 'error) (test (sort! '(1 2 3) (define-macro (_m_ a b) `(> ,a ,b))) '(3 2 1)) (test (sort! '(2 1 3) (define-macro (_m_ a b) `(< ,a ,b))) '(1 2 3)) (test (let ((ctr 0)) (call-with-exit (lambda (exit) (let asdf () (set! ctr (+ ctr 1)) (if (> ctr 2) (exit ctr)) (dynamic-wind (lambda () #f) (lambda () #f) asdf))))) 3) (test (let ((ctr 0)) (dynamic-wind (lambda () #f) (lambda () (call-with-exit (lambda (exit) (catch #t (lambda () (error 'error)) (lambda args (exit 'error))) (set! ctr 1)))) (lambda () (set! ctr (+ ctr 2)))) ctr) 2) (test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r1 12) (r2 1))) (r1 2))) 3)) 12) (test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r2 12) (r2 1))) (r1 2))) 3)) 3) (test (call-with-exit (lambda (r1) (call-with-exit (lambda (r2) (call-with-exit (lambda (r3) (r3 12) (r2 1))) (r1 2))) 3)) 2) ;; make sure call-with-exit closes ports (test (let ((p (call-with-exit (lambda (return) (call-with-input-file tmp-output-file (lambda (port) (return port))))))) (port-closed? p)) #t) (test (let ((p (call-with-exit (lambda (return) (call-with-input-file tmp-output-file (lambda (port) (if (not (port-closed? port)) (return port)))))))) (port-closed? p)) #t) (test (let ((p (call-with-exit (lambda (return) (with-input-from-file tmp-output-file (lambda () (return (current-input-port)))))))) (port-closed? p)) #t) (test (let ((p (call-with-exit (lambda (return) (with-output-to-file "empty-file" (lambda () (return (current-output-port)))))))) (port-closed? p)) #t) (test (let ((p (call-with-exit (lambda (return) (call-with-output-file "empty-file" (lambda (port) (return port))))))) (port-closed? p)) #t) (test (let ((p (call-with-exit (lambda (return) (call-with-input-string "this is a test" (lambda (port) (return port))))))) (port-closed? p)) #t) (test (let ((p (call-with-exit (lambda (return) (call-with-output-string (lambda (port) (return port))))))) (port-closed? p)) #t) (let ((p (current-input-port))) (catch #t (lambda () (with-input-from-string "asdf" (call/cc (lambda (cc) cc)))) (lambda (type info) 'error)) (test (eq? p (current-input-port)) #t) (catch #t (lambda () (define (func) (with-input-from-string "asdg" (call/cc (lambda (cc) cc)))) (define (hi) (func)) (hi)) (lambda (type info) 'error)) (test (eq? p (current-input-port)) #t)) (let ((pws (dilambda < >))) (test (sort! '(2 3 1 4) pws) '(1 2 3 4))) (test (call-with-exit (lambda (k) (call-with-input-string "123" k))) 'error) (test (call-with-exit (lambda (k) (call-with-input-file tmp-output-file k))) 'error) (test (call-with-exit (lambda (k) (call-with-output-file tmp-output-file k))) 'error) (test (call-with-exit (lambda (k) (call-with-output-string k))) 'error) (test (call-with-output-string (hash-table 'b 2)) 'error) (test (call-with-output-string #(1 2)) 'error) (test (call-with-output-string (inlet 'a 1)) 'error) (test (call-with-output-file (hash-table 'b 2)) 'error) (test (call-with-output-file #(1 2)) 'error) (test (call-with-output-file (inlet 'a 1)) 'error) (test (call-with-output-file (call/cc (lambda (cc) cc))) 'error) (test (call-with-output-file (call-with-exit (lambda (goto) goto))) 'error) (let ((pws (dilambda (lambda (a) (+ a 1)) (lambda (a b) b)))) (test (procedure? pws) #t) (test (map pws '(1 2 3)) '(2 3 4)) (test (apply pws '(1)) 2)) (test (let ((ctr 0)) (call-with-exit (lambda (top-exit) (set! ctr (+ ctr 1)) (call-with-exit top-exit) (set! ctr (+ ctr 16)))) ctr) 1) (test (let () (+ 5 (call-with-exit (lambda (return) (return 1 2 3) 4)))) 11) (test (+ 5 (call-with-exit (lambda (return) (return 1)))) 6) (test (+ 5 (call-with-exit (lambda (return) (return)))) 'error) (test (let ((cur ())) (define (step pos) (dynamic-wind (lambda () (set! cur (cons pos cur))) (lambda () (set! cur (cons (+ pos 1) cur)) (if (< pos 40) (step (+ pos 10))) (set! cur (cons (+ pos 2) cur)) cur) (lambda () (set! cur (cons (+ pos 3) cur))))) (reverse (step 0))) '(0 1 10 11 20 21 30 31 40 41 42 43 32 33 22 23 12 13 2)) (test (let ((cur ())) (define (step pos) (dynamic-wind (lambda () (set! cur (cons pos cur))) (lambda () (set! cur (cons (+ pos 1) cur)) (if (< pos 40) (step (+ pos 10)) (error 'all-done)) (set! cur (cons (+ pos 2) cur)) cur) (lambda () (set! cur (cons (+ pos 3) cur))))) (catch 'all-done (lambda () (reverse (step 0))) (lambda args (reverse cur)))) '(0 1 10 11 20 21 30 31 40 41 43 33 23 13 3)) (test (let ((cur ())) (define (step pos ret) (dynamic-wind (lambda () (set! cur (cons pos cur))) (lambda () (set! cur (cons (+ pos 1) cur)) (if (< pos 40) (step (+ pos 10) ret) (ret (reverse cur))) (set! cur (cons (+ pos 2) cur)) cur) (lambda () (set! cur (cons (+ pos 3) cur))))) (list (call-with-exit (lambda (ret) (step 0 ret))) (reverse cur))) '((0 1 10 11 20 21 30 31 40 41) (0 1 10 11 20 21 30 31 40 41 43 33 23 13 3))) (test (let () (catch #t (lambda () (eval-string "(error 'hi \"hi\")")) (lambda args 'error))) 'error) (test (let () (catch #t (lambda () (eval-string "(+ 1 #\\a)")) (lambda args 'oops))) 'oops) #| (test (let () (call-with-exit (lambda (return) (eval-string "(return 3)")))) 3) (test (let () (call-with-exit (lambda (return) (eval-string "(abs (+ 1 (if #t (return 3))))")))) 3) |# (test (let () (call-with-exit (lambda (return) (eval '(return 3))))) 3) (test (let () (call-with-exit (lambda (return) (eval '(abs (+ 1 (if #t (return 3)))))))) 3) (test (let ((val (catch #t (lambda () (eval-string "(catch 'a (lambda () (+ 1 __asdf__)) (lambda args 'oops))")) (lambda args 'error)))) val) 'error) (test (let ((val (catch #t (lambda () (eval `(catch 'a (lambda () (+ 1 __asdf__)) (lambda args 'oops)))) (lambda args 'error)))) val) 'error) (test ((lambda* ((x 1) (y 2)) (+ x y)) (eval-string "(values 3 4)")) 7) (test (let () (call/cc (lambda (ret) (eval-string "(ret 3)")))) 3) (test (let () (call/cc (lambda (ret) (eval '(ret 3))))) 3) (test (let () (call/cc (lambda (ret) (ret 3)))) 3) (test (let () (call-with-exit (lambda (ret) (eval-string "(ret 3)")))) 3) (let ((x 0) (y 0) (z 0)) (define (dw1 a c) (dynamic-wind (lambda () (set! x (+ x 1))) (lambda () (set! y (+ y 1)) (or (and (>= a c) a) (dw1 (+ a 1) c))) (lambda () (set! z (+ z 1)) (set! y (- y 1))))) (let ((val (dw1 0 8))) (test (list val x y z) (list 8 9 0 9)))) (let ((x 0) (y 0) (z 0)) (define (dw1 a c) (catch #t (lambda () (dynamic-wind (lambda () (set! x (+ x 1))) (lambda () (set! y (+ y 1)) (or (and (>= a c) a) (dw1 (+ a 1) c))) (lambda () (set! z (+ z 1)) (set! y (= y 1))))) ; an error after the first call because we have (= #f 1) (lambda args 'error))) (let ((val (dw1 0 4))) (test val 'error))) (let ((x 0) (y 0) (z 0)) (define (dw1 a c) (catch #t (lambda () (dynamic-wind (lambda () (set! x (+ x 1))) (lambda () (set! y (= y 1)) ; an error after the first call because we have (= #f 1) (or (and (>= a c) a) (dw1 (+ a 1) c))) (lambda () (set! z (+ z 1)) (set! y (= y 1))))) (lambda args 'error))) (let ((val (dw1 0 4))) (test val 'error))) (let ((x 0) (y 0) (z 0)) (define (dw1 a c) (catch #t (lambda () (dynamic-wind (lambda () (set! x (= x 1))) ; an error after the first call because we have (= #f 1) (lambda () (set! y (= y 1)) (or (and (>= a c) a) (dw1 (+ a 1) c))) (lambda () (set! z (+ z 1)) (set! y (= y 1))))) (lambda args 'error))) (let ((val (dw1 0 4))) (test val 'error))) (let ((x 0) (y 0) (z 0)) (let ((val (call-with-exit (lambda (r) (catch #t (lambda () (dynamic-wind (lambda () (set! x (+ x 1))) (lambda () (set! y (+ y 1)) (r y)) (lambda () (set! z (+ z 1))))) (lambda args 'error)))))) (test (list val z) '(1 1)))) (let ((x 0) (y 0) (z 0)) (let ((val (catch #t (lambda () (dynamic-wind (lambda () (set! x (+ x 1))) (lambda () (call-with-exit (lambda (r) (set! y r) x))) (lambda () (set! z (+ z 1)) (y z)))) (lambda args 'error)))) (test val 'error))) (test (dynamic-wind (lambda () (eq? (let ((lst (cons 1 2))) (set-cdr! lst lst) lst) (call/cc (lambda (k) k)))) (lambda () #f) (lambda () #f)) #f) ;;; -------------------------------------------------------------------------------- ;;; quasiquote ;;; -------------------------------------------------------------------------------- (test `(1 2 3) '(1 2 3)) (test `() ()) (test `(list ,(+ 1 2) 4) '(list 3 4)) (test `(1 ,@(list 1 2) 4) '(1 1 2 4)) (test `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b) '(a 3 4 5 6 b)) (test `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f) '(a `(b ,(+ 1 2) ,(foo 4 d) e) f)) ;(test (let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e)) '(a `(b ,x ,'y d) e)) ; list vs list-values confusion (test `(1 2 ,(* 9 9) 3 4) '(1 2 81 3 4)) (test `(1 ,(+ 1 1) 3) '(1 2 3)) (test `(,(+ 1 2)) '(3)) (test `(,'a . ,'b) (cons 'a 'b)) (test `(,@'() . foo) 'foo) (test `(1 , 2) '(1 2)) (test `(1 , @(list 2 3)) 'error) ; ?? this is an error in Guile and Clisp (test `(1 ,@ (list 2 3)) '(1 2 3)) ; seems a bit arbitrary (test `(1 ,@(list)) '(1)) (test `(1 ,@()) '(1)) (test `(1 ,@'()) '(1)) (test `(1 . ,()) '(1)) (test `(1 , #|a comment|# 2) '(1 2)) (test `(1 ,@ #|a comment|# (list 2 3)) '(1 2 3)) (test `(1 , ;a comment 2) '(1 2)) (test `(1 #||#,2) '(1 2)) (test `(1 #||#,@(list #||# 2 3 #||#)) '(1 2 3)) (test (eval ``(+ 1 ,@,@'('(2 3)))) '(+ 1 2 3)) (test (eval ``(+ 1 ,@ #||# ,@ '('(2 3)))) '(+ 1 2 3)) (test `(,1 ,1) '(1 1)) (test `(,1 ,`,1) '(1 1)) (test `(,1 ,`,@(list 1)) '(1 1)) (test `(,1 ,`,`,1) '(1 1)) (test `(,1 ,`,@'(1)) '(1 1)) (test `(,1 ,`,@`(1)) '(1 1)) (test `(,1 ,`,@`(,1)) '(1 1)) (test `(,1 ,@`,@(list (list 1))) '(1 1)) (test (eval ``(,,1 ,@,@(list (quote (list 1))))) '(1 1)) (test (eval ``(,,1 ,@,@(list `(list 1)))) '(1 1)) (test (eval (eval ```(,,,1 ,@,@,@(list '(list '(list 1)))))) '(1 1)) (test (+ 1 (eval (eval ```,@,,@(list ''(list 2 3))))) 6) (test (+ 1 (eval (eval (eval ````,@,,,@(list '''(list 2 3)))))) 6) (test (apply + `(1 ,@`(2 ,@(list 3)))) 6) (test (eval `(- ,@()',1)) -1) (test (eval `(,- ,@()'1)) -1) ;(test (eval (eval ``(- ,@,@'(,1())))) -1) ;(test (eval (eval ``(,@,@'(- ,1())))) -1) ;(test (eval (eval ``(,- ,@,@'(1())))) -1) (test (eval (eval ``(,- ,@'(,@()1)))) -1) (test (eval (eval ``(- ,@,@',().(1)))) -1) (test (quasiquote quote) 'quote) (test (eval (list quasiquote (list values #t))) (list values #t)) (test (eval (let ((a 'outer)) `(let ((a 'inner)) `(list ,',a ,,'a)))) '(list outer inner)) ; from Gauche devlog (test (quasiquote (unquote (quote (1 2)))) (if immutable-unquote '(unquote (quote (1 2))) '(1 2))) (test (eq? (cadr `(a, b, c,)) 'b,) #t) (test (eq? (cadr '(a, b, c,)) 'b,) #t) (test (let ((b, 32)) `(a , b, c,)) '(a 32 c,)) (test (let ((b, 32)) `(a, , b, c,)) '(a, 32 c,)) (unless immutable-unquote (test (equal? (let ((b, 32)) '(a, , b, c,)) '(a, (unquote b,) c,)) #t) ; comma by itself (no symbol) is an error (test (equal? (let ((b, 32)) '(a, , , b, c,)) '(a, (unquote (unquote b,)) c,)) #t)) (test (equal? (let ((b 32)) (let ((b, b)) ``(a, , , b, c,))) '(#_list-values 'a, 32 'c,)) #t) (unless (or pure-s7 immutable-unquote) (test (let ((func abs)) (quasiquote (sym . (unquote func)))) (cons 'sym abs)) ; guile mailing list (test (eval-string "`(+ (unquote 2 3))") 'error)) (test (eval ``(,@,@())) ()) (test (list (let ((x '(1 2))) `,@x)) '(1 2)) (test (let ((x '(1))) `,@x) 1) (test (let ((x '(1 2))) (list `,@x)) '(1 2)) (test `(1 . "hi") '(1 . "hi")) (test `(f . ,(string-append "h" "i")) '(f . "hi")) (if immutable-unquote (begin (test (let () (define* ,() (abs ))) 'error) (test (let (,'a) unquote) 'error) (test (let (, '1) unquote) 'error) (test (let (, (lambda (x) (+ x 1))) ,,,,'3) 'error) (test (let (,@ '(1)) unquote) 'error) (test (let (,@ ()) ,2) 'error)) (begin (test (let () (define* ,() (abs ))) 'error) (test (let (,'a) unquote) 'a) (test (let (, '1) unquote) 1) (test (let (, (lambda (x) (+ x 1))) ,,,,'3) 7) (test (let (,@ '(1)) unquote) 1) (test (let (,@ ()) ,2) 2))) ;; mostly from gauche (let ((quasi0 99) (quasi1 101) (quasi2 '(a b)) (quasi3 '(c d))) (test `,quasi0 99) (test `,quasi1 101) (test `(,(cons 1 2)) '((1 . 2))) (test `(,(cons 1 2) 3) '((1 . 2) 3)) (test `(,quasi0 3) '(99 3)) (test `(3 ,quasi0) '(3 99)) (test `(,(+ quasi0 1) 3) '(100 3)) (test `(3 ,(+ quasi0 1)) '(3 100)) (test `(,quasi1 3) '(101 3)) (test `(3 ,quasi1) '(3 101)) (test `(,(+ quasi1 1) 3) '(102 3)) (test `(3 ,(+ quasi1 1)) '(3 102)) (test `(1 ,@(list 2 3) 4) '(1 2 3 4)) (test `(1 2 ,@(list 3 4)) '(1 2 3 4)) (test `(,@quasi2 ,@quasi3) '(a b c d)) (test `(1 2 . ,(list 3 4)) '(1 2 3 4)) (test `(,@quasi2 . ,quasi3) '(a b c d)) (test `#() #()) (test `(,@(list 1 2) ,@(list 1 2)) '(1 2 1 2)) (test `(,@(list 1 2) a ,@(list 1 2)) '(1 2 a 1 2)) (test `(a ,@(list 1 2) ,@(list 1 2)) '(a 1 2 1 2)) (test `(,@(list 1 2) ,@(list 1 2) a) '(1 2 1 2 a)) (test `(,@(list 1 2) ,@(list 1 2) a b) '(1 2 1 2 a b)) (test `(,@(list 1 2) ,@(list 1 2) . a) '(1 2 1 2 . a)) (test `(,@(list 1 2) ,@(list 1 2) . ,(cons 1 2)) '(1 2 1 2 1 . 2)) (test `(,@(list 1 2) ,@(list 1 2) . ,quasi2) '(1 2 1 2 a b)) (test `(,@(list 1 2) ,@(list 1 2) a . ,(cons 1 2)) '(1 2 1 2 a 1 . 2)) (test `(,@(list 1 2) ,@(list 1 2) a . ,quasi3) '(1 2 1 2 a c d)) ; (test `(1 `(1 ,2 ,,(+ 1 2)) 1) '(1 `(1 ,2 ,3) 1)) ; (test `(1 `(1 ,,quasi0 ,,quasi1) 1) '(1 `(1 ,99 ,101) 1)) (test `(1 `(1 ,@2 ,@,(list 1 2))) '(1 `(1 ,@2 ,@(1 2)))) (test `(1 `(1 ,@,quasi2 ,@,quasi3)) '(1 `(1 ,@(a b) ,@(c d)))) (test `(1 `(1 ,(,@quasi2 x) ,(y ,@quasi3))) '(1 `(1 ,(a b x) ,(y c d)))) ) (let ((x 3) (y '(a b c))) (test `(1 . ,2) '(1 . 2)) (test `(1 2 . ,3) '(1 2 . 3)) (test `(1 x . ,3) '(1 x . 3)) (test `(1 x . ,x) '(1 x . 3)) (test `(1 . ,(list 2 3)) '(1 2 3)) (test `(1 ,@(list 2 3)) '(1 2 3)) ;;; (test `(1 . ,@('(2 3))) '(1 2 3)) (test `(1 ,(list 2 3)) '(1 (2 3))) (test `(1 . (list 2 3)) '(1 list 2 3)) (test `(x . ,x) '(x . 3)) (test `(y . ,y) '(y a b c)) (test `(,x ,@y ,x) '(3 a b c 3)) (test `(,x ,@y . ,x) '(3 a b c . 3)) (test `(,y ,@y) '((a b c) a b c)) (test `(,@y . ,y) '(a b c a b c)) (test (object->string `(,y . ,y)) "((a b c) a b c)") ; was "(#1=(a b c) . #1#)" (test (object->string `(y ,y ,@y ,y . y)) "(y (a b c) a b c (a b c) . y)") ; was "(y #1=(a b c) a b c #1# . y)" (test (eval ``(1 . ,,2)) '(1 . 2)) (test (eval ``(y . ,,x)) '(y . 3)) (test (eval ``(,y . ,x)) '((a b c) . 3)) (test (eval ``(,@y . x)) '(a b c . x)) (test (eval ``(,x . ,y)) '(3 a b c)) (test (eval ``(,,x . y)) '(3 . y)) (test (eval ``(,,x ,@y)) '(3 a b c)) ;; in clisp `(,y . ,@(y)) -> *** - READ: the syntax `( ... . ,@form) is invalid ) (test (apply ``(x . 1) '(0 1 2)) 'error) ; in qq_append (test (let ((.' '(1 2))) `(,@.')) '(1 2)) (test (let ((hi (lambda (a) `(+ 1 ,a)))) (hi 2)) '(+ 1 2)) (test (let ((hi (lambda (a) `(+ 1 ,@a)))) (hi (list 2 3))) '(+ 1 2 3)) (test (let ((hi (lambda (a) `(let ((b ,a)) ,(+ 1 a))))) (hi 3)) '(let ((b 3)) 4)) (test (let ((x '(a b c))) `(x ,x ,@x foo ,(cadr x) bar ,(cdr x) baz ,@(cdr x))) '(x (a b c) a b c foo b bar (b c) baz b c)) (test (let ((x '(a b c))) `(,(car `(,x)))) '((a b c))) (test (let ((x '(a b c))) `(,@(car `(,x)))) '(a b c)) (test (let ((x '(a b c))) `(,(car `(,@x)))) '(a)) (test (let ((x '(a b c))) ``,,x) '(a b c)) (test (let ((x '(a b c))) `,(car `,x)) 'a) (test (let ((x '(2 3))) `(1 ,@x 4)) '(1 2 3 4)) (test (let ((x '(2 3))) `(1 ,@(map (lambda (a) (+ a 1)) x))) '(1 3 4)) ;;; these are from the scheme bboard (test (let ((x '(1 2 3))) `(0 . ,x)) '(0 1 2 3)) (test (let ((x '(1 2 3))) `(0 ,x)) '(0 (1 2 3))) ;; unbound variable x, but (let ((x '(1 2 3))) (quasiquote #(0 . ,x))) -> #(0 unquote x) ;; so ` and (quasiquote...) are not the same in the vector case (test (let () (define-macro (tryqv . lst) `(map abs ',lst)) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5)) (test (let () (define-macro (tryqv . lst) `(map abs '(,@lst))) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5)) (test (let () (define-macro (tryqv . lst) `(map abs (vector ,@lst))) (tryqv 1 2 3 -4 5)) '(1 2 3 4 5)) (for-each (lambda (str) (let ((val (catch #t (lambda () (eval-string str)) (lambda args 'error)))) (if (not (eqv? val -1)) (format #t "~S = ~S?~%" str val)))) (list "( '(.1 -1)1)" "( - '`-00 1)" "( - .(,`1/1))" "( - .(`1) )" "( -(/ .(1)))" "( / 01 -1 )" "(' '` -1(/ ' 1))" "(' (-01 )0)" "(' `'`` -1 1 01)" "(''-1 .(1))" "('(, -1 )0)" "('(,-1)'000)" "('(,-1)00)" "('(-1 -.0)0)" "('(-1 '1`)0)" "('(-1 .-/-)0)" "('(-1()),0)" "('(-1) 0)" "('(10. -1 )1)" "(- '`1)" "(- `1 1 1)" "(- ' 1)" "(- ' 1)" "(- '1 .())" "(- '` ,``1)" "(- '` 1)" "(- '`, `1)" "(- '`,`1)" "(- '``1)" "(- (''1 1))" "(- (- ' 1 0))" "(- (-(- `1)))" "(- (` (1)0))" "(- ,`, `1)" "(- ,`1 . ,())" "(- . ( 0 1))" "(- . ( `001))" "(- .(', 01))" "(- .('`,1))" "(- .('``1))" "(- .(,,1))" "(- .(01))" "(- .(1))" "(- .(`,1))" "(- .(`,`1))" "(- .(`1))" "(- ` ,'1)" "(- ` -0 '1)" "(- ` 1 )" "(- ` `1)" "(- `, 1)" "(- `,1)" "(- `,`,1)" "(- `,`1)" "(- ``,,1)" "(- ``,1)" "(- ``1 )" "(- ```,1)" "(- ```1)" "(-( / 1))" "(-( - -1 ))" "(-( `,- 1 0))" "(-(' (1)0))" "(-('(,1)00))" "(-(- '`1) 0)" "(-(- -1))" "(-(/(/(/ 1))))" "(-(`'1 '1))" "(-(`(,1 )'0))" "(-(`,/ ,1))" "(/ '-1 '1 )" "(/ ,, `,-1)" "(/ ,11 -11)" "(/ 01 (- '1))" "(/ `1 '`-1)" "(/(- '1) )" "(/(- '1)1)" "(/(- 001)1)" "(/(- 1),,1)" "(/(/ -1))" "(` ,- 1)" "(` `,(-1)0)" "(`' , -1 1)" "(/(- -001(+)))" "(`' -1 '1/1)" "(`','-1 ,1)" "(`(,-1)-00)" "(`(-0 -1)1)" "(`(-1 -.')0)" "(`(-1 1')0)" "(`(` -1)'`0)" "(`, - 1)" "(`,- '1)" "(`,- .(1))" "(`,- 1 )" "(`,- `,1)" "(`,- `1)" "(`,/ . (-1))" "(``,,- `01)" "('''-1 '1 '1)" "(/ `-1 1)" "(/ .( -1))" "(-(+(+)0)1)" "(/ ,`,`-1/1)" "(-(*).())" "(*(- +1))" "(-(`,*))" "(-(+)'1)" "(+(-(*)))" "(-(+(*)))" "(-(+)(*))" "(-(/(*)))" "(*(-(*)))" "(-(*(*)))" "(/(-(*)))" "(-(+(*)))" "(/ .(-1))" "(-(*))" "(- 000(*))" "(-(*(+ 1)))" "(- .((*)))" "(- +0/10(*))" "(-(`,/ .(1)))" "(+ .(' -01))" "(-(''1 01))" "(- -1/1 +0)" "(- `,'0 `01)" "( - `,(+)'1)" "(+(- . (`1)))" "(* '`,``-1)" "(-(+ -0)1)" "(+ +0(-(*)))" "(+(- '+1 ))" "(+ '-01(+))" "(`, -(+)1)" "(`,+ 0 -1)" "(-(/(/(*))))" "(`,* .( -1))" "(-(*(*(*))))" "(`,@(list +)-1)" "(* (- 1) )" "(`, - (* ))" "(/(- (* 1)))" "(- -0/1(*))" "(`(,-1)0)" "(/(-(*).()))" "(* ````-1)" "(-(+(*)0))" "(-(* `,(*)))" "(- +1(*)1)" "(- (` ,* ))" "(/(-(+ )1))" "(`,* -1(*))" "(` ,- .(1))" "(+(`,-( *)))" "( /(`,- 1))" "(`(1 -1)1)" "(*( -(/(*))))" "(- -1(-(+)))" "(* ``,,-1)" "(-(+(+))1)" "( +(*(-(*))))" "(-(+)`0(*))" "(-(+(+(*))))" "(-(+ .(01)))" "(/(*(-(* ))))" "(/ (-(* 1)))" "( /(-(/(*))))" "(+ -1 0/1)" "(/(-( +(*))))" "(*( -(`,*)))" "(* 1(/ 1)-1)" "(+ 0(- ',01))" "(+(-(-(+ -1))))" "(- 0(/(+(* ))))" "(-(+)( *)0)" "(`,- '01/1)" "(`, - ',,1)" "(/ .(`-1 1))" "(- ``,,'`1)" "(- 10 0011)" "(-(- ``1 0))" "( -(/ 01/1))" "(-(- 1)`,0)" "(/(/ -1 .()))" "(/ ,,``-1)" "( `,`, - 1)" "(- .(`1/01 ))" "('(-1) ',``0)" "('( ,/ -1 )1)" "(- ,,`,`0 +1)" "(`(-1) `,0)" "(+(* (-(*))))" "(-(`,* ,,1))" "(+(+ 0)-1)" "(+(-(+ ,1)))" "(* ,`-01/1)" "(*(- '` `1))" "(-(*(* 1 1)))" "(-(*(/ .(1))))" "(-(- 1(*)-1))" "(- -00 (* 1))" "(- (*(+ ,01)))" "(-(*), +1(* ))" "(- `,@'(1))" "`,@`(-1)" "(`'`-1 1)" "`,@(list `,@`(-1))" )) #| (let ((chars (vector #\/ #\. #\0 #\1 #\- #\, #\( #\) #\' #\@ #\` #\space)) (size 14)) (let ((str (make-string size)) (clen (length chars))) (do ((i 0 (+ i 1))) ((= i 10000000)) (let ((parens 0)) (do ((k 0 (+ k 1))) ((= k size)) (set! (str k) (chars (random clen))) (if (char=? (str k) #\() (set! parens (+ parens 1)) (if (char=? (str k) #\)) (begin (set! parens (- parens 1)) (if (negative? parens) (begin (set! (str k) #\space) (set! parens 0))))))) (let ((str1 str) (happy (char=? (str (- size 1)) #\)))) (if (> parens 0) (begin (set! str1 (make-string (+ size parens) #\))) (set! happy #t) (do ((k 0 (+ k 1))) ((= k size)) (set! (str1 k) (str k))))) (if (and happy (not (char=? (str1 1) #\)))) (catch #t (lambda () (let ((num (eval-string str1))) (if (and (number? num) (eqv? num -1)) (format *stderr* "~S ~%" str1)))) (lambda args 'error)))))))) |# (test (= 1 '+1 `+1 '`1 `01 ``1) #t) (test (''- 1) '-) (test (`'- 1) '-) (test (``- 1) '-) (test ('`- 1) '-) (test (''1 '1) 1) (test ((quote (quote 1)) 1) 1) ; (quote (quote 1)) -> ''1 = (list 'quote 1), so ((list 'quote 1) 1) is 1! (test (list quote 1) ''1) ; guile says #t (test (list-ref ''1 1) 1) ; same (test (''1 ```1) 1) (test (cond `'1) 1) (test ```1 1) (test ('''1 1 1) 1) (test (`',1 1) 1) (test (- `,-1) 1) ;;; some weirder cases... (test (begin . `''1) ''1) ;(test (`,@''1) 1) ; (syntax-error ("attempt to apply the ~A ~S to ~S?" "symbol" quote (1))) ?? ; ((apply-values ''values 1)) got error but expected 1 ;(test (`,@ `'1) 1) ; ((apply-values ''values 1)) got error but expected 1 ;(test (`,@''.'.) '.'.) ; ((apply-values ''values .'.)) got error but expected .'. (test (apply . `''1) 'error) ; '(quote quote 1)) ; (apply list-values 'quote (list-values 'quote 1)) -> ;quote: too many arguments '1 (test (apply - 1( )) -1) ; (apply - 1 ()) (num-test (apply - 1.()) -1.0) (num-test (apply - .1()) -0.1) (num-test (apply - .1 .(())) -0.1) (num-test (apply - .1 .('(1))) -0.9) (test (apply - -1()) 1) ; (apply - -1 ()) (test (apply . `(())) 'error) ; (apply list-values ()) (test (apply . ''(1)) 1) ; (apply quote '(1)) (test (apply . '`(1)) 1) ; (apply quote (list-values 1)) (test (apply . `(,())) 'error) ; (apply list-values ()) (test (apply . `('())) 'error) ; (apply list-values (list-values 'quote ())) (test (apply . `(`())) 'error) ; (apply list-values ()) (test (apply - `,1()) -1) ; (apply - 1 ()) (test (apply - ``1()) -1) ; (apply - 1 ()) (test (apply ''1 1()) 1) ; (apply ''1 1 ()) (test (apply .(- 1())) -1) ; (apply - 1 ()) (test (apply - .(1())) -1) ; (apply - 1 ()) (test (apply . `(1())) 'error) ; (apply list-values 1 ()) (test (apply . ''(())) ()) (test (apply . `((()))) 'error) (test (catch #t ; is_simple_code troubles (it's still slow) (lambda () (+((+(0((((((*(((((((*(`((``(`((`((`(`((`((``(`((`(( (((( ((`((`((`(((`((`((``(`(`((`((`(((`((`(` ((`((``((`(`((`((``(`((`(( (((( ((`((`((`(((`((`((``(`(`((`((`((((*(`((`(( (((( ((`((`((`(((`((`( (``(`(`((`(((((*(((``(`((``(`(((`((`((((*(`((`(`((((*(((``(`((``(`(((`((`(((*(((``(`((``(`(((`((` ((((*(`((`((``(`((`(`(( (/(((*`(((`((`(((`((`((``()( )))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) )))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (lambda arg #f)) #f) ;;; comp.lang.lisp (test (with-input-from-string "(a `(aaa ,(/ 0.9)))" read) '(a (list-values 'aaa (/ 0.9)))) (test (defined? 'list-values) #t) (let ((old-list-values list-values)) (test (let () (set! list-values 2)) 2) (test (let ((list-values 2)) list-values) 2) (set! list-values old-list-values)) (test (defined? 'apply-values) #t) (let ((old-apply-values apply-values)) (test (let () (set! apply-values 2)) 2) ; was 'error 9-Nov-23 (test (let ((apply-values 2)) apply-values) 2) ; 'error (set! apply-values old-apply-values)) ;(test (defined? 'append) #t) ;(test (let () (set! append 2)) 'error) ;(test (let ((append 2)) append) 'error) (test (list-values 1 2 (apply-values) 3) '(1 2 3)) (let () (define (consume f . args) (apply f (apply list-values args))) (define (supply . args) (apply-values args)) (test (consume + (supply)) 0) (test (consume + (supply 1 2) (supply 3 4 5) (supply)) 15) (test (consume + (supply 1 2) (supply) (supply 3 4 5)) 15)) (test (object->string (list 'quote 1 2)) "(quote 1 2)") (test (object->string (list 'quote 'quote 1)) "(quote quote 1)") (test (object->string (list 'quote 1 2 3)) "(quote 1 2 3)") (test (object->string (list 'quote 1)) "(quote 1)") (test (equal? (quote 1) '1) #t) (test (equal? (list 'quote 1) ''1) #f) (test (equal? (list 'quote 1) '''1) #f) ;;; see comment s7.c in list_to_c_string -- we're following Clisp here (test (object->string (cons 'quote 1)) "(quote . 1)") (test (object->string (list 'quote)) "(quote)") (let ((lst (list 'quote 1))) (set! (cdr (cdr lst)) lst) (test (object->string lst) "#1=(quote 1 . #1#)")) (let ((lst (list 'quote))) (set! (cdr lst) lst) (test (object->string lst) "#1=(quote . #1#)")) ;; from Guile mailing list -- just a bit strange, even confuses emacs! (if (not with-windows) (test (let ((v '(\()))) ; i.e. '( (symbol "\\") ()) (and (pair? v) (symbol? (car v)) ; \ -> (symbol "\\") (null? (cadr v)))) #t)) (test #(,1) #(1)) (test #(,,,1) #(1)) (test #(`'`1) #((#_quote '1))) (test (',- 1) '-) ; this is implicit indexing #| (',,= 1) -> (unquote =) (test (equal? (car (',,= 1)) 'unquote) #t) ; but that's kinda horrible (',@1 1) -> (apply-values 1) #(,@1) -> #((unquote (apply-values 1))) (quasiquote #(,@(list 1 2 3))) -> #((unquote (apply-values (list 1 2 3)))) (quote ,@(for-each)) -> (unquote (apply-values (for-each))) ;;; when is (quote ...) not '...? |# (test (quasiquote) 'error) (test (quasiquote 1 2 3) 'error) (let ((d 1)) (test (quasiquote (a b c ,d)) '(a b c 1))) (test (let ((a 2)) (quasiquote (a ,a))) (let ((a 2)) `(a ,a))) (test (quasiquote 4) 4) (unless immutable-unquote (test (quasiquote (list (unquote (+ 1 2)) 4)) '(list 3 4))) (test (quasiquote (1 2 3)) '(1 2 3)) (test (quasiquote ()) ()) (test (quasiquote (list ,(+ 1 2) 4)) '(list 3 4)) (test (quasiquote (1 ,@(list 1 2) 4)) '(1 1 2 4)) (test (quasiquote (a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) '(a 3 4 5 6 b)) (test (quasiquote (1 2 ,(* 9 9) 3 4)) '(1 2 81 3 4)) (test (quasiquote (1 ,(+ 1 1) 3)) '(1 2 3)) (test (quasiquote (,(+ 1 2))) '(3)) (test (quasiquote (,@'() . foo)) 'foo) (test (quasiquote (1 , 2)) '(1 2)) (test (quasiquote (,1 ,1)) '(1 1)) (test (quasiquote (,1 ,(quasiquote ,1))) '(1 1)) (test (quasiquote (,1 ,(quasiquote ,@(list 1)))) '(1 1)) (test (quasiquote (,1 ,(quasiquote ,(quasiquote ,1)))) '(1 1)) (test (quasiquote (,1 ,(quasiquote ,@'(1)))) '(1 1)) (test (quasiquote (,1 ,(quasiquote ,@(quasiquote (1))))) '(1 1)) (test (quasiquote (,1 ,(quasiquote ,@(quasiquote (,1))))) '(1 1)) (test (quasiquote (,1 ,@(quasiquote ,@(list (list 1))))) '(1 1)) (test `(+ ,(apply values '(1 2))) '(+ 1 2)) (unless immutable-unquote (test `(apply + (unquote '(1 2))) '(apply + (1 2)))) (test (eval (list (list quasiquote +) -1)) -1) (test (apply quasiquote '((1 2 3))) '(1 2 3)) (test (quasiquote (',,= 1)) 'error) (test (quasiquote (',,@(1 2) 1)) 'error) (test (quasiquote 1.1 . -0) 'error) (test `(1 ,@2) 'error) (test `(1 ,@(2 . 3)) 'error) (test `(1 ,@(2 3)) 'error) (test `(1 , @ (list 2 3)) 'error) ; unbound @ ! (guile also) (test (call-with-exit quasiquote) 'error) (test (call-with-output-string quasiquote) "") (test (map quasiquote '(1 2 3)) '(1 2 3)) ; changed 12-May-14 (test (for-each quasiquote '(1 2 3)) #) (test (sort! '(1 2 3) quasiquote) 'error) (test (quasiquote . 1) 'error) (test (let ((x 3)) (quasiquote . x)) 'error) (num-test `,,,-1 -1) (num-test `,``,1 1) (test (equal? ` 1 ' 1) #t) (test (+ ` 1 ` 2) ` 3) (test ` ( + ,(- 3 2) 2) '(+ 1 2)) (test (quasiquote #(1)) `#(1)) (test `(+ ,@(map sqrt '(1 4 9)) 2) '(+ 1 2 3 2)) (test `(+ ,(sqrt 9) 4) '(+ 3 4)) (test `(+ ,(apply values (map sqrt '(1 4 9))) 2) '(+ 1 2 3 2)) ;; here is the difference between ,@ and apply values: (test (let ((x ())) `(+ ,@x)) '(+)) (test (let ((x ())) (+ (apply values x))) 'error) ; ;+ argument, #, is untyped (test (let ((x ())) (list + (apply values x))) (list + (values))) ;; (apply + (list-values (apply-values ()))) -> 0 -- this is a special quasiquote list handling of ,@ that ;; is not the same as (apply + (list-values (apply values ()))) -> error. quasiquote turns list into list-values ;; and list-values treats (apply values...) specially. ;; ;; (let ((x ())) `(+ ,@x)) -> (+) ;; via (+ (unquote (apply-values x))) -> (list-values '+ (apply-values x)) ;; ;; (let ((x ())) (list + (apply values x))) -> (+ #) ;; via (+ (apply values (unquote x))) -> (list-values '+ (list-values 'apply 'values x)) ;; because (values) -> # but everywhere else ,@x is the same as (apply values x) (test (make-hook (macroexpand (quasiquote (logeqv (blocks3 (imh)))))) 'error) ; qq #_quote used to avoid is_global check (test (let-ref quasiquote 'abs) abs) ; from (rootlet) ;;; -------------------------------------------------------------------------------- ;;; keywords ;;; -------------------------------------------------------------------------------- ;;; keyword? ;;; string->keyword ;;; keyword->symbol ;;; symbol->keyword (for-each (lambda (arg) (test (keyword? arg) #f)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2))) (test (cond ((cond (())) ':)) ':) (test (keyword? :#t) #t) (test (eq? #t :#t) #f) ;(test (keyword? '#:t) #f) ; these 2 are fooled by the Guile-related #: business (which is still supported) ;(test (keyword? '#:#t) #f) ;#:1.0e8 is also a keyword(!) ;#:# is also, so #:#() is interpreted as #:# () (test (keyword? :-1) #t) (test (keyword? :0/0) #t) (test (keyword? :1+i) #t) (test (keyword? :1) #t) (test (keyword? 0/0:) #t) (test (keyword? 1+i:) #t) (test (keyword? 1:) #t) ;;; bizarre... (test (keyword? (symbol ":#(1 #\\a (3))")) #t) (test (keyword? (string->keyword (object->string #(1 #\a (3)) #f))) #t) (test (keyword? begin) #f) (test (keyword? if) #f) (let ((kw (string->keyword "hiho"))) (test (keyword? kw) #t) (test (keyword->symbol kw) 'hiho) (test (symbol->keyword 'hiho) kw) (test (keyword->symbol (symbol->keyword 'key)) 'key) (test (symbol->keyword (keyword->symbol (string->keyword "hi"))) :hi) (test (keyword? :a-key) #t) (test (keyword? ':a-key) #t) (test (keyword? ':a-key:) #t) (test (keyword? 'a-key:) #t) (test (symbol? (keyword->symbol :hi)) #t) (test (keyword? (keyword->symbol :hi)) #f) (test (symbol? (symbol->keyword 'hi)) #t) (test (equal? kw :hiho) #t) (test ((lambda (arg) (keyword? arg)) :hiho) #t) (test ((lambda (arg) (keyword? arg)) 'hiho) #f) (test ((lambda (arg) (keyword? arg)) kw) #t) (test ((lambda (arg) (keyword? arg)) (symbol->keyword 'hiho)) #t) (test (string->keyword "3") :3) (test (keyword? :3) #t) (test (keyword? ':3) #t) (test (eq? (keyword->symbol :hi) (keyword->symbol hi:)) #t) (test (equal? :3 3) #f) (test (equal? (keyword->symbol :3) 3) #f) (test (equal? (symbol->value (keyword->symbol :3)) 3) #f) ; 3 as a symbol has value # (test (keyword? (keyword->symbol :n:)) #t) (test (keyword? (keyword->symbol (keyword->symbol :n:))) #f) (test (symbol->keyword n:) :n:) (test (keyword? (keyword->symbol ::a)) #t) (test (keyword? (keyword->symbol a::)) #t) (test (symbol->keyword a:) :a:) (test (symbol->keyword :a) ::a) #| (let () (apply define (symbol "3") '(32)) (test (symbol->value (symbol "3")) 32) ; hmmm (apply define (list (symbol "3") (lambda () 32))) (test (symbol->value (symbol "3")) 32) (apply define (symbol ".") '(123)) (test (+ (symbol->value (symbol ".")) 321) 444)) |# (test (keyword? '3) #f) (test (keyword? ':) #f) (test (keyword? '::) #t) (test (keyword? ::a) #t) (test (eq? ::a ::a) #t) (test (eq? (keyword->symbol ::a) :a) #t) (test (eq? (symbol->keyword :a) ::a) #t) ; ?? -- :a is already a keyword (test (symbol->string :asdf) ":asdf") ; keyword->string (test (symbol->string ::a) "::a") (test ((lambda* (:a 32) ::a) 0) 'error) ; :a is a constant (test (eq? :::a::: :::a:::) #t) (test (keyword? a::) #t) (test (keyword->symbol '::) ':) (test (symbol->string (keyword->symbol hi:)) "hi") (test (symbol->string (keyword->symbol :hi)) "hi") (test (keyword? (string->keyword (string #\x (integer->char 128) #\x))) #t) (test (keyword? (string->keyword (string #\x (integer->char 200) #\x))) #t) (test (keyword? (string->keyword (string #\x (integer->char 255) #\x))) #t) (test (string->keyword ":") '::) (test (string->keyword (string #\")) (symbol ":\"")) (test (keyword? (string->keyword (string #\"))) #t) (test (keyword->symbol (string->keyword (string #\"))) (symbol "\"")) ) (test (symbol->keyword (symbol "a b c")) (symbol ":a b c")) (test (keyword? (symbol->keyword (symbol "a b c"))) #t) (test (keyword? (symbol ":a b c")) #t) (test (string->keyword "a b") (symbol ":a b")) (test (keyword? : asdf) 'error) (test (keyword? asdf :) 'error) (test (string->keyword "") 'error) (test (keyword? (symbol ":a b")) #t) (test (symbol->keyword 'begin) :begin) (test (symbol->keyword 'quote) :quote) (test (symbol->keyword if) 'error) (test (symbol->keyword quote) 'error) (test (symbol->keyword :a) ::a) (test (keyword->symbol ::a) :a) (test (symbol->keyword (symbol "(a)")) (symbol ":(a)")) (test (keyword->symbol :0) (symbol "0")) (test (symbol->keyword (symbol "-1")) :-1) (test (keyword->symbol :+nan.0) (symbol "+nan.0")) (test (symbol->keyword (symbol "1.5+i")) :1.5+i) (test (keyword? (symbol ":(a)")) #t) (test (keyword? :|) #t) (test (keyword? :,) #t) (when full-s7test (do ((i 1 (+ i 1))) ; not #\null -- : by itself is not a keyword in s7 ((= i 128)) (if (not (keyword? (string->keyword (string (integer->char i))))) (format *stderr* "not key: :~A~%" (integer->char i))) (if (not (keyword? (symbol (string #\: (integer->char i))))) (format *stderr* "not key: (symbol \":~A\")~%" (integer->char i))) (if (not (keyword? (symbol (string (integer->char i) #\:)))) (format *stderr* "not key: (symbol \"~A:\")~%" (integer->char i))))) (test (let ((:hi 3)) :hi) 'error) (test (set! :hi 2) 'error) (test (define :hi 3) 'error) (let ((strlen 8)) (let ((str (make-string strlen))) (do ((i 0 (+ i 1))) ((= i 10)) (do ((k 0 (+ k 1))) ((= k strlen)) (set! (str k) (integer->char (+ 1 (random 255))))) (let ((key (string->keyword str))) (let ((newstr (symbol->string (keyword->symbol key)))) (if (not (string=? newstr str)) (format #t ";string->keyword -> string: ~S -> ~A -> ~S~%" str key newstr))))))) (let () (define* (hi a b) (+ a b)) (test (hi 1 2) 3) (test (hi :b 3 :a 1) 4) (test (hi b: 3 a: 1) 4)) (for-each (lambda (arg) (test (string->keyword arg) 'error)) (list -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (keyword->symbol arg) 'error)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (symbol->keyword arg) 'error)) (list "hi" -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2))) (test (keyword?) 'error) (test (keyword? 1 2) 'error) (test (string->keyword) 'error) (test (string->keyword 'hi 'ho) 'error) (test (keyword->symbol) 'error) (test (keyword->symbol :hi :ho) 'error) (test (symbol->keyword) 'error) (test (symbol->keyword 'hi 'ho) 'error) ;;; troubles (: :: etc -- these need to be cleaned up somehow) (test (keyword->symbol :asd:) 'asd:) (test (keyword->symbol (keyword->symbol :asd:)) 'asd) (test (procedure? (let ((+signature+ '(:all 3 #))) (lambda (a) a))) #t) ; ?? this should be an error somewhere (test (keyword? ::) #t) (test (keyword? ':) #f) (test (keyword->symbol ':) 'error) (test (keyword? :::) #t) (test (keyword->symbol :::) '::) (test ((lambda* ((: 3)) (+ : 1)) :: 4) 5) (test ((lambda* ((:: 3)) (+ :: 1)) ::: 4) 'error) (test (let ((: 3)) :) 3) (test (let ((:: 3)) ::) 'error) (test (let ((::: 3)) :::) 'error) (test ((inlet ': 3) ':) 3) (test (keyword? (keyword->symbol ::asdf)) #t) (test (keyword? (symbol->keyword ':)) #t) (test (keyword? (symbol->keyword '::)) #t) (test (apply let (list (list (symbol "") 3)) (symbol "")) 'error) ; null symbol name (test ((lambda* ((asdf 4)) (+ 1 asdf)) :asdf: 5) 'error) (test (define-constant :rest :allow-other-keys) 'error) (test (define-constant :rest :rest) :rest) ;;; -------------------------------------------------------------------------------- ;;; gensym (for-each (lambda (arg) (test (gensym arg) 'error)) (list -1 #\a 1 'hi _ht_ _undef_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2))) (test (gensym "hi" "ho") 'error) (test (symbol? (gensym)) #t) (test (symbol? (gensym "temp")) #t) (test (eq? (gensym) (gensym)) #f) (test (eqv? (gensym) (gensym)) #f) (test (equal? (gensym) (gensym)) #f) (test (keyword? (gensym)) #f) (test (let* ((a (gensym)) (b a)) (eq? a b)) #t) (test (let* ((a (gensym)) (b a)) (eqv? a b)) #t) (test (keyword? (symbol->keyword (gensym))) #t) (test (let ((g (gensym))) (set! g 12) g) 12) ;(test (string->byte-vector (substring (symbol->string (gensym #u(124 255 127))) 0 5)) #u(123 124 255 127 125)) ;(test (string->byte-vector (substring (symbol->string (gensym #u(124 0 127))) 0 3)) #u(123 124 125)) ; nul->end of symbol string (test (gensym? (string->symbol (symbol->string (gensym)))) #t) (let ((sym (gensym))) (test (eval `(let ((,sym 32)) (+ ,sym 1))) 33)) (let ((sym1 (gensym)) (sym2 (gensym))) (test (eval `(let ((,sym1 32) (,sym2 1)) (+ ,sym1 ,sym2))) 33)) (test (eval (let ((var (gensym "a b c"))) `(let ((,var 2)) (+ ,var 1)))) 3) (test (eval (let ((var (gensym ""))) `(let ((,var 2)) (+ ,var 1)))) 3) (test (eval (let ((var (gensym "."))) `(let ((,var 2)) (+ ,var 1)))) 3) (test (eval (let ((var (gensym "{"))) `(let ((,var 2)) (+ ,var 1)))) 3) (test (eval (let ((var (gensym "}"))) `(let ((,var 2)) (+ ,var 1)))) 3) (test (eval (let ((var (gensym (string #\newline)))) `(let ((,var 2)) (+ ,var 1)))) 3) (test (let ((hi (gensym))) (eq? hi (string->symbol (symbol->string hi)))) #t) (test (let () (define-macro (hi a) (let ((var (gensym ";"))) `(let ((,var ,a)) (+ 1 ,var)))) (hi 1)) 2) (test (let () (define-macro (hi a) (let ((funny-name (string->symbol (string #\;)))) `(let ((,funny-name ,a)) (+ 1 ,funny-name)))) (hi 1)) 2) (test (let () (define-macro (hi a) (let ((funny-name (string->symbol "| e t c |"))) `(let ((,funny-name ,a)) (+ 1 ,funny-name)))) (hi 2)) 3) (let ((funny-name (string->symbol "| e t c |"))) (define-macro (hi a) `(define* (,a (,funny-name 32)) (+ ,funny-name 1))) (hi func) (test (func) 33) (test (func 1) 2) ;(procedure-source func) '(lambda* ((| e t c | 32)) (+ | e t c | 1)) (test (apply func (list (symbol->keyword funny-name) 2)) 3) ) (let ((funny-name (string->symbol "| e t c |"))) (apply define* `((func (,funny-name 32)) (+ ,funny-name 1))) (test (apply func (list (symbol->keyword funny-name) 2)) 3)) (let* ((g0 (gensym "g")) ; test that gensym returns unique symbol (gnum0 (string->number (substring (symbol->string g0) 4)))) (let ((g1 (apply define (list (string->symbol (format #f "{g}-~D" (+ gnum0 1))) 1)))) (define g2 (gensym "g")) (let ((gnum2 (string->number (substring (symbol->string g2) 4)))) ;; (list g0 g2 gnum2): ({g}-4 {g}-6 6) (test gnum2 (+ gnum0 2)) (test (eq? g1 g2) #f) (test (eq? g0 g1) #f) (test (gensym? g1) #f)))) ;;; gensym? (for-each (lambda (arg) (test (gensym? arg) #f)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () car abs (lambda () 1) #2d((1 2) (3 4)) _ht_ _undef_ _null_ _c_obj_ #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi")) (test (gensym?) 'error) (let ((g (gensym))) (test (gensym? g) #t) (test (gensym? g g) 'error)) ;;; -------------------------------------------------------------------------------- ;;; provided? ;;; provide ;;; require (test (provided?) 'error) (test (or (null? *features*) (pair? *features*)) #t) (test (provided? 1 2 3) 'error) (provide 's7test) (test (provided? 's7test) #t) (test (provided? 'not-provided!) #f) (test (provided? 'begin) #f) (test (provided? if) 'error) (test (provided? quote) 'error) (test (provide quote) 'error) (test (provide 1 2 3) 'error) (test (provide) 'error) (test (provide lambda) 'error) (test (require) 'error) (test (require 1) 'error) (test (require _asdf_) 'error) (provide 's7test) ; should be a no-op?? (let ((count 0)) (for-each (lambda (p) (if (eq? p 's7test) (set! count (+ count 1))) (if (not (provided? p)) (format #t ";~A is in *features* but not provided? ~A~%" p *features*))) *features*) (if (not (= count 1)) (format #t ";*features* has ~D 's7test entries? ~A~%" count *features*))) (test (let ((*features* 123)) (provided? 's7)) #t) (for-each (lambda (arg) (test (provide arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (provided? arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (set! (*s7* 'gc-stats) arg) 'error)) (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #(()) (list 1 2 3) '(1 . 2) 31)) (test (*s7* 'gc-stats) 0) (let ((f (sort! (copy *features*) (lambda (a b) (stringstring a #f) (object->string b #f)))))) (let ((last 'not-in-*features*)) (for-each (lambda (p) (if (eq? p last) (format #t ";*features has multiple ~A? ~A~%" p *features*)) (set! last p)) f))) (let () (provide 'locals) (test (provided? 'locals) #t)) (test (provided? 'locals) #f) (let () (provide 'local-stuff) (call-with-output-file tmp-output-file (lambda (p) (format p "(provide 'tmp-output)~%(define (tmp-output-func a) a)~%"))) (load tmp-output-file) (test (provided? 'tmp-output) #t)) (test (provided? 'local-stuff) #f) (test (provided? 'tmp-output) #t) ;;; ---------------- ;;; *features* *load-path* *libraries* (for-each (lambda (arg) (test (set! (*s7* 'safety) arg) 'error) (test (set! *features* arg) 'error) (test (set! *load-path* arg) 'error) (test (set! *#readers* arg) 'error)) (list #\a #(1 2 3) 3.14 3/4 1.0+1.0i abs 'hi #t #f #(()))) (test (let ((*features* 123)) *features*) 123) (test (set! *features* '(1 2 3)) 'error) (test (set! *features* '(a b . c)) 'error) (test (let-temporarily ((*features* #f)) *features*) 'error) (let () ; check that local *features* list has the correct setter (provide 'asdf) ; this creates a local *features* list (test (not (setter '*features*)) #f) (test (set! *features* 123) 'error) ;; (test (fill! *features* 123) 'error) ; yow! this wrecks the global *features* list?? ) ;; there's one bad case here: ;; (test (let () (provide 'asdf) (fill! *features* 12)) 'error) ; or '(12 12 12...) -- how to recognize this case without an extra lookup every time? (test (set! *features* 123) 'error) (test (fill! *features* 'asdf) 'error) ;; (let ((*features* (cons 0 (lambda (a b . c) a))))...) gets through because let doesn't check setters ;; ;; none of these raise an error: ;; (set! (car *features*) #2i((1 2) (3 4))) ;; (set-car! *features* #2i((1 2) (5 6))) ;; (set-cdr! *features* #(1 2)) ;; (set! (cdr *features*) #(1 2)) ;; (let ((*features* #(1 2))) *features*) ;; (copy '(1 2 3) *features*) ;; (reverse! *features*) ;; (list-set! *features* 1 123) ;; (sort! *features* (lambda (x y) (stringstring x) (symbol->string y)))) ;; ;; these raise an error: ;; (fill! *features* 1): error: can't fill! *features* ;; (set! *features* (cons 1 1)): error: can't set *features* to an improper or circular list (1 . 1) (when (pair? *libraries*) (test (fill! *libraries* #f) 'error)) (test (set! *libraries* #f) 'error) (test (set! *libraries* (list 1 2)) 'error) ;(test (copy '(1 2 3) *features*) 'error) ; '(1 2 3 cload.scm write.scm gcc linux aligned ...) (test (set! pi 3) 'error) (test (let-temporarily ((pi 3)) pi) 'error) (test (set! ((rootlet) 'pi) 3) 'error) (test (let-set! (rootlet) 'pi 3) 'error) (test (copy '((pi . 3)) (rootlet)) 'error) (test ((lambda (pi) pi) 3) 'error) (test (set! *load-path* (list 1 2 3)) 'error) (test (set! *#readers* (list 32)) 'error) (test (set! *#readers* (list (list #\a 32))) 'error) (test (set! *#readers* (list (list 32))) 'error) (set! *#readers* old-readers) (define old-safety (*s7* 'safety)) (set! (*s7* 'safety) 2) (let ((v #(1 2 3)) (iv #i(1 2 3)) (rv #r(1.0 2.0 3.0)) (str "123") (pair '(1 2 3))) (test (sort! v <) 'error) (test (sort! iv <) 'error) (test (sort! rv <) 'error) (test (sort! str char a b))) '(3 2 1)) (test (sort! #(2 3) <) #(2 3)) (test (sort! #(12 3) <) #(3 12)) (test (sort! #(1 2 3) <) #(1 2 3)) (test (sort! #(1 3 2) <) #(1 2 3)) (test (sort! #(2 1 3) <) #(1 2 3)) (test (sort! #(2 3 1) <) #(1 2 3)) (test (sort! #(3 1 2) <) #(1 2 3)) (test (sort! #(3 2 1) <) #(1 2 3)) (test (sort! #(1 2 3 4) <) #(1 2 3 4)) (test (sort! #(1 2 4 3) <) #(1 2 3 4)) (test (sort! #(1 3 2 4) <) #(1 2 3 4)) (test (sort! #(1 3 4 2) <) #(1 2 3 4)) (test (sort! #(1 4 2 3) <) #(1 2 3 4)) (test (sort! #(1 4 3 2) <) #(1 2 3 4)) (test (sort! #(2 1 3 4) <) #(1 2 3 4)) (test (sort! #(2 1 4 3) <) #(1 2 3 4)) (test (sort! #(2 3 4 1) <) #(1 2 3 4)) (test (sort! #(2 3 1 4) <) #(1 2 3 4)) (test (sort! #(2 4 3 1) <) #(1 2 3 4)) (test (sort! #(2 4 1 3) <) #(1 2 3 4)) (test (sort! #(3 1 2 4) <) #(1 2 3 4)) (test (sort! #(3 1 4 2) <) #(1 2 3 4)) (test (sort! #(3 2 4 1) <) #(1 2 3 4)) (test (sort! #(3 2 1 4) <) #(1 2 3 4)) (test (sort! #(3 4 1 2) <) #(1 2 3 4)) (test (sort! #(3 4 2 1) <) #(1 2 3 4)) (test (sort! #(4 1 2 3) <) #(1 2 3 4)) (test (sort! #(4 1 3 2) <) #(1 2 3 4)) (test (sort! #(4 2 1 3) <) #(1 2 3 4)) (test (sort! #(4 2 3 1) <) #(1 2 3 4)) (test (sort! #(4 3 2 1) <) #(1 2 3 4)) (test (sort! #(4 3 1 2) <) #(1 2 3 4)) (let ((f (lambda (a b) (< (car a) (car b))))) (test (sort! (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 1 "1") (cons 2 "2") (cons 4 "4") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 1 "1") (cons 3 "3") (cons 2 "2") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 1 "1") (cons 3 "3") (cons 4 "4") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 1 "1") (cons 4 "4") (cons 2 "2") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 1 "1") (cons 4 "4") (cons 3 "3") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 2 "2") (cons 1 "1") (cons 3 "3") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 2 "2") (cons 1 "1") (cons 4 "4") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 2 "2") (cons 3 "3") (cons 4 "4") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 2 "2") (cons 3 "3") (cons 1 "1") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 2 "2") (cons 4 "4") (cons 3 "3") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 2 "2") (cons 4 "4") (cons 1 "1") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 3 "3") (cons 1 "1") (cons 2 "2") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 3 "3") (cons 1 "1") (cons 4 "4") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 3 "3") (cons 2 "2") (cons 4 "4") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 3 "3") (cons 2 "2") (cons 1 "1") (cons 4 "4")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 3 "3") (cons 4 "4") (cons 1 "1") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 3 "3") (cons 4 "4") (cons 2 "2") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 4 "4") (cons 1 "1") (cons 2 "2") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 4 "4") (cons 1 "1") (cons 3 "3") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 4 "4") (cons 2 "2") (cons 1 "1") (cons 3 "3")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 4 "4") (cons 2 "2") (cons 3 "3") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 4 "4") (cons 3 "3") (cons 2 "2") (cons 1 "1")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4"))) (test (sort! (list (cons 4 "4") (cons 3 "3") (cons 1 "1") (cons 2 "2")) f) (list (cons 1 "1") (cons 2 "2") (cons 3 "3") (cons 4 "4")))) (test (sort! #(5 1 2 3 4) <) #(1 2 3 4 5)) (test (sort! #(5 1 2 4 3) <) #(1 2 3 4 5)) (test (sort! #(5 1 3 2 4) <) #(1 2 3 4 5)) (test (sort! #(5 1 3 4 2) <) #(1 2 3 4 5)) (test (sort! #(5 1 4 2 3) <) #(1 2 3 4 5)) (test (sort! #(5 1 4 3 2) <) #(1 2 3 4 5)) (test (sort! #(5 2 1 3 4) <) #(1 2 3 4 5)) (test (sort! #(5 2 1 4 3) <) #(1 2 3 4 5)) (test (sort! #(5 2 3 4 1) <) #(1 2 3 4 5)) (test (sort! #(5 2 3 1 4) <) #(1 2 3 4 5)) (test (sort! #(5 2 4 3 1) <) #(1 2 3 4 5)) (test (sort! #(5 2 4 1 3) <) #(1 2 3 4 5)) (test (sort! #(5 3 1 2 4) <) #(1 2 3 4 5)) (test (sort! #(5 3 1 4 2) <) #(1 2 3 4 5)) (test (sort! #(5 3 2 4 1) <) #(1 2 3 4 5)) (test (sort! #(5 3 2 1 4) <) #(1 2 3 4 5)) (test (sort! #(5 3 4 1 2) <) #(1 2 3 4 5)) (test (sort! #(5 3 4 2 1) <) #(1 2 3 4 5)) (test (sort! #(5 4 1 2 3) <) #(1 2 3 4 5)) (test (sort! #(5 4 1 3 2) <) #(1 2 3 4 5)) (test (sort! #(5 4 2 1 3) <) #(1 2 3 4 5)) (test (sort! #(5 4 2 3 1) <) #(1 2 3 4 5)) (test (sort! #(5 4 3 2 1) <) #(1 2 3 4 5)) (test (sort! #(5 4 3 1 2) <) #(1 2 3 4 5)) (test (sort! #(1 5 2 3 4) <) #(1 2 3 4 5)) (test (sort! #(1 5 2 4 3) <) #(1 2 3 4 5)) (test (sort! #(1 5 3 2 4) <) #(1 2 3 4 5)) (test (sort! #(1 5 3 4 2) <) #(1 2 3 4 5)) (test (sort! #(1 5 4 2 3) <) #(1 2 3 4 5)) (test (sort! #(1 5 4 3 2) <) #(1 2 3 4 5)) (test (sort! #(2 5 1 3 4) <) #(1 2 3 4 5)) (test (sort! #(2 5 1 4 3) <) #(1 2 3 4 5)) (test (sort! #(2 5 3 4 1) <) #(1 2 3 4 5)) (test (sort! #(2 5 3 1 4) <) #(1 2 3 4 5)) (test (sort! #(2 5 4 3 1) <) #(1 2 3 4 5)) (test (sort! #(2 5 4 1 3) <) #(1 2 3 4 5)) (test (sort! #(3 5 1 2 4) <) #(1 2 3 4 5)) (test (sort! #(3 5 1 4 2) <) #(1 2 3 4 5)) (test (sort! #(3 5 2 4 1) <) #(1 2 3 4 5)) (test (sort! #(3 5 2 1 4) <) #(1 2 3 4 5)) (test (sort! #(3 5 4 1 2) <) #(1 2 3 4 5)) (test (sort! #(3 5 4 2 1) <) #(1 2 3 4 5)) (test (sort! #(4 5 1 2 3) <) #(1 2 3 4 5)) (test (sort! #(4 5 1 3 2) <) #(1 2 3 4 5)) (test (sort! #(4 5 2 1 3) <) #(1 2 3 4 5)) (test (sort! #(4 5 2 3 1) <) #(1 2 3 4 5)) (test (sort! #(4 5 3 2 1) <) #(1 2 3 4 5)) (test (sort! #(4 5 3 1 2) <) #(1 2 3 4 5)) (test (sort! #(1 2 5 3 4) <) #(1 2 3 4 5)) (test (sort! #(1 2 5 4 3) <) #(1 2 3 4 5)) (test (sort! #(1 3 5 2 4) <) #(1 2 3 4 5)) (test (sort! #(1 3 5 4 2) <) #(1 2 3 4 5)) (test (sort! #(1 4 5 2 3) <) #(1 2 3 4 5)) (test (sort! #(1 4 5 3 2) <) #(1 2 3 4 5)) (test (sort! #(2 1 5 3 4) <) #(1 2 3 4 5)) (test (sort! #(2 1 5 4 3) <) #(1 2 3 4 5)) (test (sort! #(2 3 5 4 1) <) #(1 2 3 4 5)) (test (sort! #(2 3 5 1 4) <) #(1 2 3 4 5)) (test (sort! #(2 4 5 3 1) <) #(1 2 3 4 5)) (test (sort! #(2 4 5 1 3) <) #(1 2 3 4 5)) (test (sort! #(3 1 5 2 4) <) #(1 2 3 4 5)) (test (sort! #(3 1 5 4 2) <) #(1 2 3 4 5)) (test (sort! #(3 2 5 4 1) <) #(1 2 3 4 5)) (test (sort! #(3 2 5 1 4) <) #(1 2 3 4 5)) (test (sort! #(3 4 5 1 2) <) #(1 2 3 4 5)) (test (sort! #(3 4 5 2 1) <) #(1 2 3 4 5)) (test (sort! #(4 1 5 2 3) <) #(1 2 3 4 5)) (test (sort! #(4 1 5 3 2) <) #(1 2 3 4 5)) (test (sort! #(4 2 5 1 3) <) #(1 2 3 4 5)) (test (sort! #(4 2 5 3 1) <) #(1 2 3 4 5)) (test (sort! #(4 3 5 2 1) <) #(1 2 3 4 5)) (test (sort! #(4 3 5 1 2) <) #(1 2 3 4 5)) (test (sort! #(1 2 3 5 4) <) #(1 2 3 4 5)) (test (sort! #(1 2 4 5 3) <) #(1 2 3 4 5)) (test (sort! #(1 3 2 5 4) <) #(1 2 3 4 5)) (test (sort! #(1 3 4 5 2) <) #(1 2 3 4 5)) (test (sort! #(1 4 2 5 3) <) #(1 2 3 4 5)) (test (sort! #(1 4 3 5 2) <) #(1 2 3 4 5)) (test (sort! #(2 1 3 5 4) <) #(1 2 3 4 5)) (test (sort! #(2 1 4 5 3) <) #(1 2 3 4 5)) (test (sort! #(2 3 4 5 1) <) #(1 2 3 4 5)) (test (sort! #(2 3 1 5 4) <) #(1 2 3 4 5)) (test (sort! #(2 4 3 5 1) <) #(1 2 3 4 5)) (test (sort! #(2 4 1 5 3) <) #(1 2 3 4 5)) (test (sort! #(3 1 2 5 4) <) #(1 2 3 4 5)) (test (sort! #(3 1 4 5 2) <) #(1 2 3 4 5)) (test (sort! #(3 2 4 5 1) <) #(1 2 3 4 5)) (test (sort! #(3 2 1 5 4) <) #(1 2 3 4 5)) (test (sort! #(3 4 1 5 2) <) #(1 2 3 4 5)) (test (sort! #(3 4 2 5 1) <) #(1 2 3 4 5)) (test (sort! #(4 1 2 5 3) <) #(1 2 3 4 5)) (test (sort! #(4 1 3 5 2) <) #(1 2 3 4 5)) (test (sort! #(4 2 1 5 3) <) #(1 2 3 4 5)) (test (sort! #(4 2 3 5 1) <) #(1 2 3 4 5)) (test (sort! #(4 3 2 5 1) <) #(1 2 3 4 5)) (test (sort! #(4 3 1 5 2) <) #(1 2 3 4 5)) (test (sort! #(1 2 3 4 5) <) #(1 2 3 4 5)) (test (sort! #(1 2 4 3 5) <) #(1 2 3 4 5)) (test (sort! #(1 3 2 4 5) <) #(1 2 3 4 5)) (test (sort! #(1 3 4 2 5) <) #(1 2 3 4 5)) (test (sort! #(1 4 2 3 5) <) #(1 2 3 4 5)) (test (sort! #(1 4 3 2 5) <) #(1 2 3 4 5)) (test (sort! #(2 1 3 4 5) <) #(1 2 3 4 5)) (test (sort! #(2 1 4 3 5) <) #(1 2 3 4 5)) (test (sort! #(2 3 4 1 5) <) #(1 2 3 4 5)) (test (sort! #(2 3 1 4 5) <) #(1 2 3 4 5)) (test (sort! #(2 4 3 1 5) <) #(1 2 3 4 5)) (test (sort! #(2 4 1 3 5) <) #(1 2 3 4 5)) (test (sort! #(3 1 2 4 5) <) #(1 2 3 4 5)) (test (sort! #(3 1 4 2 5) <) #(1 2 3 4 5)) (test (sort! #(3 2 4 1 5) <) #(1 2 3 4 5)) (test (sort! #(3 2 1 4 5) <) #(1 2 3 4 5)) (test (sort! #(3 4 1 2 5) <) #(1 2 3 4 5)) (test (sort! #(3 4 2 1 5) <) #(1 2 3 4 5)) (test (sort! #(4 1 2 3 5) <) #(1 2 3 4 5)) (test (sort! #(4 1 3 2 5) <) #(1 2 3 4 5)) (test (sort! #(4 2 1 3 5) <) #(1 2 3 4 5)) (test (sort! #(4 2 3 1 5) <) #(1 2 3 4 5)) (test (sort! #(4 3 2 1 5) <) #(1 2 3 4 5)) (test (sort! #(4 3 1 2 5) <) #(1 2 3 4 5)) (test (sort! #(3 1 2 1 4 1) <) #(1 1 1 2 3 4)) (test (sort! #(1 1 1) <) #(1 1 1)) (test (sort! #(1 2 3) (lambda (a b) (> a b))) #(3 2 1)) (test (sort! #((1 . 3) (1 . 1) (1 . 2) (1 . 1) (1 . 4) (1 . 1)) (lambda (a b) (< (cdr a) (cdr b)))) #((1 . 1) (1 . 1) (1 . 1) (1 . 2) (1 . 3) (1 . 4))) (test (equal? (sort! (list 3 4 8 2 0 1 5 9 7 6) <) (list 0 1 2 3 4 5 6 7 8 9)) #t) (test (equal? (sort! (list 3 4 8 2 0 1 5 9 7 6) (lambda (a b) (< a b))) (list 0 1 2 3 4 5 6 7 8 9)) #t) (test (equal? (sort! (list) <) ()) #t) (test (equal? (sort! (list 1) <) '(1)) #t) (test (equal? (sort! (list 1 1 1) <) '(1 1 1)) #t) (test (equal? (sort! (list 0 1 2 3 4 5 6 7 8 9) <) '(0 1 2 3 4 5 6 7 8 9)) #t) (test (equal? (sort! (list #\a #\l #\o #\h #\a) char) (reverse (list 0 1 2 3 4 5 6 7 8 9))) #t) (test (equal? (sort! '((3 . 1) (2 . 8) (5 . 9) (4 . 7) (6 . 0)) (lambda (a b) (< (car a) (car b)))) '((2 . 8) (3 . 1) (4 . 7) (5 . 9) (6 . 0))) #t) (test (equal? (sort! '((3 . 1) (2 . 8) (5 . 9) (4 . 7) (6 . 0)) (lambda (a b) (< (cdr a) (cdr b)))) '((6 . 0) (3 . 1) (4 . 7) (2 . 8) (5 . 9))) #t) (test (equal? (sort! (list (list 1 2) (list 4 3 2) (list) (list 1 2 3 4)) (lambda (a b) (> (length a) (length b)))) '((1 2 3 4) (4 3 2) (1 2) ())) #t) (test (equal? (sort! '((1 2 3) (4 5 6) (7 8 9)) (lambda (a b) (> (car a) (car b)))) '((7 8 9) (4 5 6) (1 2 3))) #t) (test (equal? (sort! (list #\b #\A #\B #\a #\c #\C) char) <) '(1 2 3)) #t) (test (sort! #2d((1 2) (3 4)) >) #2d((4 3) (2 1))) ; ?!? (test (sort! #2d((1 4) (3 2)) >) #2d((4 3) (2 1))) ; ??!!?? this is not what anyone would expect (test (sort! '(3 2 1) (lambda (a b c) #f)) 'error) (test (sort! '(3 2 1) (lambda* (a b c) (< a b))) '(1 2 3)) (test (sort! '(3 2 1) (lambda (a b . c) (< a b))) '(1 2 3)) (test (sort! '(3 2 1) (lambda (a) #f)) 'error) (test (sort! '(3 2 1) (lambda* (a) #f)) 'error) (test (sort! '(3 1 2 4) (lambda args (< (car args) (cadr args)))) '(1 2 3 4)) (test (sort! (rootlet) <) 'error) (test (sort! () #f) 'error) (test (equal? (sort! (vector 3 4 8 2 0 1 5 9 7 6) <) (vector 0 1 2 3 4 5 6 7 8 9)) #t) (test (equal? (sort! (make-int-vector 3 0) (lambda* (a b) (< a b))) (make-int-vector 3 0)) #t) (test (equal? (sort! (make-float-vector 3 1.0) >) (float-vector 1.0 1.0 1.0)) #t) (test (equivalent? (let ((v (make-int-vector 3 0))) (set! (v 1) 3) (set! (v 2) -1) (sort! v <)) #(-1 0 3)) #t) (test (equivalent? (let ((v (make-int-vector 3 0))) (set! (v 1) 3) (set! (v 2) -1) (sort! v (lambda (a b) (< a b)))) #(-1 0 3)) #t) (test (equivalent? (let ((v (make-int-vector 3 0))) (set! (v 1) 3) (set! (v 2) -1) (sort! v (lambda* (a b) (< a b)))) #(-1 0 3)) #t) (test (equal? (sort! #() <) #()) #t) (test (sort! '(1 2 . 3) <) 'error) (test (sort! #(1 3 8 7 5 6 4 2) (lambda (a b) (if (even? a) (or (odd? b) (< a b)) (and (odd? b) (< a b))))) #(2 4 6 8 1 3 5 7)) (let ((ninf (real-part (log 0.0))) (pinf (- (real-part (log 0.0))))) (test (sort! (list pinf 0.0 ninf) <) (list ninf 0.0 pinf))) (test (sort! '(1 1 1) <) '(1 1 1)) (test (call/cc (lambda (return) (sort! '(1 2 3) (lambda (a b) (return "oops"))))) "oops") (let ((p1 (dilambda (lambda (a b) (< a b)) (lambda (a b c) (error 'oops))))) (test (sort! '(3 1 2 4) p1) '(1 2 3 4))) (let ((p1 (dilambda (lambda* (a (b 2)) (< a b)) (lambda (a b c) (error 'oops))))) (test (sort! '(3 1 2 4) p1) '(1 2 3 4))) (let ((p1 (dilambda (lambda args (< (car args) (cadr args))) (lambda (a b) (error 'oops))))) (test (sort! '(3 1 2 4) p1) '(1 2 3 4))) (let ((imploc (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ())))))))) (test (sort! (cons -1 imploc) >) 'error) (test (sort! (cons -1 imploc) (lambda (a b) (not (<= a b)))) 'error) (test (sort! (cons -1 imploc) (lambda (a b) (call-with-exit (lambda (return) (return (not (<= a b))))))) 'error)) ; vector_into_list (let () ; sort! bug, (x = y) where we intended (x == y) (define (f1) (let ((cs (vector #\a #\f #\d #\c))) (do ((i 0 (+ i 1))) ((= i 1)) (sort! cs char?)) cs)) (test (f2) #(#\f #\d #\c #\a))) (test (let ((v (make-float-vector 1000))) (do ((i 0 (+ i 1))) ((= i 1000)) (float-vector-set! v i (random 100.0))) (set! v (sort! v >)) (call-with-exit (lambda (return) (do ((i 0 (+ i 1))) ((= i 999) #t) (if (< (v i) (v (+ i 1))) (begin (format #t "random vals after sort: ~A ~A~%" (v i) (v (+ i 1))) (return #f))))))) #t) (let ((v ())) (do ((i 0 (+ i 1))) ((= i 1000)) (set! v (cons (random 100.0) v))) (set! v (sort! v >)) (if (not (apply >= v)) (format #t ";sort!: v not sorted by >: ~A~%" ))) (test (sort! (list 3 2 1) (lambda (m n) (let ((vals (sort! (list m n) <))) (< m n)))) '(1 2 3)) (test (let ((lst ())) (do ((i 0 (+ i 1))) ((= i 4)) (set! lst (cons (random 1.0) lst))) (let ((vals (sort! lst (lambda (m n) (let ((lst1 (list 1 2 3))) (sort! lst1 <)) (< m n))))) (apply < vals))) #t) (let ((v (make-vector 8))) (do ((i 0 (+ i 1))) ((= i 10)) (do ((k 0 (+ k 1))) ((= k 8)) (set! (v k) (- (random 1.0) 0.5))) (let ((v1 (copy v))) (sort! v <) (if (not (apply < (vector->list v))) (format #t ";(sort! ~A <) -> ~A?" v1 v))))) (test (sort!) 'error) (test (sort! '(1 2 3) < '(3 2 1)) 'error) (test (sort! '(1 2 3)) 'error) (test (sort! '(1 2 3) 1) 'error) (test (sort! '(1 2 3) < <) 'error) (test (sort! (cons 3 2) <) 'error) (test (sort! (list 1 0+i) <) 'error) (test (sort! (list "hi" "ho") <) 'error) (test (sort! '(1 2 #t) <) 'error) (test (sort! '(1 2 . #t) <) 'error) (test (sort! '(#\c #\a #\b) <) 'error) (test (sort! (begin) if) 'error) (test (let ((v #(1 2 3))) (let ((v1 (sort! v >))) (eq? v v1))) #t) (test (let ((v (float-vector 1 2 3))) (let ((v1 (sort! v >))) (eq? v v1))) #t) (test (let ((v (make-int-vector 3 0))) (let ((v1 (sort! v >))) (eq? v v1))) #t) (test (let ((v #u(0 1 2))) (let ((v1 (sort! v >))) (eq? v v1))) #t) (test (let ((v (list 0 1 2))) (let ((v1 (sort! v >))) (eq? v v1))) #t) (test (let ((v "012")) (let ((v1 (sort! v char>?))) (eq? v v1))) #t) (test (let ((v "adcb")) (sort! v char>?) v) "dcba") (test (let ((v "adcb")) (sort! v <) v) 'error) (test (let ((v "adecb")) (sort! v char)) #u(3 2 1 0)) (test (let ((v #u(3 0 1 2))) (sort! v char>?) v) 'error) (test (let ((v #u(3))) (sort! v >) v) #u(3)) (test (let ((v #u(3 1))) (sort! v <) v) #u(1 3)) (test (let ((v #u())) (sort! v <) v) #u()) (test (let ((v #u(1 4 3 2 0))) (sort! v (lambda (a b) (< a b)))) #u(0 1 2 3 4)) (test (let ((v #("123" "321" "132" "432" "0103" "123"))) (sort! v string>?)) #("432" "321" "132" "123" "123" "0103")) (test (sort! (list) <) ()) (test (sort! (vector) <) #()) (test (sort! (string) char) (< a b))) ov) #(2 1 0)) (for-each (lambda (arg) (test (sort! arg <) 'error) (test (sort! () arg) 'error)) (list -1 #\a 1 0 "hiho" (make-hash-table) :hi 'a-symbol 3.14 3/4 1.0+1.0i #f #t)) (for-each (lambda (arg) (test (sort! '(1 2 3) arg) 'error)) (list -1 #\a 1 0 'a-symbol 3.14 3/4 1.0+1.0i #f #t #(1) '(1) "hi" abs :hi)) (test (sort! '(1 2 "hi" 3) <) 'error) (test (sort! '(1 -2 "hi" 3) (lambda (a b) (let ((a1 (if (number? a) a (length a))) (b1 (if (number? b) b (length b)))) (< a1 b1)))) '(-2 1 "hi" 3)) (let ((ok #f)) (catch #t (lambda () (dynamic-wind (lambda () #f) (lambda () (sort! '(1 2 "hi" 3) <)) (lambda () (set! ok #t)))) (lambda args 'error)) (if (not ok) (format #t "dynamic-wind out of sort! skipped cleanup?~%"))) (test (let ((v (float-vector 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (float-vector 3 2 1)) (test (let ((v (int-vector 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (int-vector 3 2 1)) (test (let ((v (list 1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) (list 3 2 1)) (test (let ((v "123")) (sort! v (lambda (a b) (call-with-exit (lambda (r) (char>? a b))))) v) "321") (test (let ((v #u(1 2 3))) (sort! v (lambda (a b) (call-with-exit (lambda (r) (> a b))))) v) #u(3 2 1)) (let ((lst (list 1 2 3 9 8 7))) (let ((val (catch #t (lambda () (sort! (copy lst) (lambda (a b) (if (< a b) (error 'sort-error "a < b")) #t))) (lambda args (car args))))) (if (not (eq? val 'sort-error)) (format #t ";sort! with error: ~A~%" val))) (let ((val (call-with-exit (lambda (return) (sort! (copy lst) (lambda (a b) (if (< a b) (return 'sort-error)) #t)))))) (if (not (eq? val 'sort-error)) (format #t ";sort! call-with-exit: ~A~%" val))) (let ((val (call/cc (lambda (return) (sort! (copy lst) (lambda (a b) (if (< a b) (return 'sort-error)) #t)))))) (if (not (eq? val 'sort-error)) (format #t ";sort! call/cc: ~A~%" val)))) (let-temporarily (((*s7* 'safety) 1)) (define (f1 x) (let ((y x)) y)) (define (_sort_) (sort! #(1 2 3) (lambda (a b) (f1 (= a b))))) (test (_sort_) 'error)) (let ((size 100)) (define (less a b) (< a b)) (define (car-less a b) (< (car a) (car b))) (define (cdr-less a b) (< (cdr a) (cdr b))) (define (check-numbers vc) (do ((i 1 (+ i 1)) (x (vc 0)) (y (vc 1))) ((or (= i (- size 1)) (and (> x y) (or (format *stderr* "~A > ~A?~%" x y) #t)))) (set! x y) (set! y (vc (+ i 1))))) (define (check-chars vc) (do ((i 1 (+ i 1)) (x (vc 0)) (y (vc 1))) ((or (= i (- size 1)) (and (char>? x y) (or (format *stderr* "~A > ~A?~%" x y) #t)))) (set! x y) (set! y (vc (+ i 1))))) (define (check-strings vc) (do ((i 1 (+ i 1)) (x (vc 0)) (y (vc 1))) ((or (= i (- size 1)) (and (string>? x y) (or (format *stderr* "~A > ~A?~%" x y) #t)))) (set! x y) (set! y (vc (+ i 1))))) (let ((v (make-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (vector-set! v i (random 1.0))) (let ((vc (copy v))) (sort! vc <) (check-numbers vc)) (let ((vc (copy v))) (sort! vc less) (check-numbers vc)) (sort! v (lambda (a b) (< a b))) (check-numbers v)) (let ((v (make-float-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (vector-set! v i (random 100.0))) (let ((vc (copy v))) (sort! vc <) (check-numbers vc)) (let ((vc (copy v))) (sort! vc less) (check-numbers vc)) (sort! v (lambda (a b) (< a b))) (check-numbers v)) (let ((v (make-int-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (vector-set! v i (random 10000000))) (let ((vc (copy v))) (sort! vc <) (check-numbers vc)) (let ((vc (copy v))) (sort! vc less) (check-numbers vc)) (sort! v (lambda (a b) (< a b))) (check-numbers v)) (let ((v (make-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (vector-set! v i (string (integer->char (random 256)) (integer->char (random 256))))) (let ((vc (copy v))) (sort! vc stringchar (random 256)))) (let ((vc (copy v))) (sort! vc char x y) (or (format *stderr* "~A > ~A?~%" x y) #t)))) (set! x y) (set! y (car (vc (+ i 1)))))) (let ((vc (copy v))) (sort! vc car-less) (do ((i 1 (+ i 1)) (x (car (vc 0))) (y (car (vc 1)))) ((or (= i (- size 1)) (and (> x y) (or (format *stderr* "~A > ~A?~%" x y) #t)))) (set! x y) (set! y (car (vc (+ i 1)))))) (sort! v (lambda (a b) (< (cdr a) (cdr b)))) (do ((i 1 (+ i 1)) (x (cdr (v 0))) (y (cdr (v 1)))) ((or (= i (- size 1)) (and (> x y) (or (format *stderr* "~A > ~A?~%" x y) #t)))) (set! x y) (set! y (cdr (v (+ i 1))))) (let ((vc (copy v))) (sort! vc cdr-less) (do ((i 1 (+ i 1)) (x (cdr (v 0))) (y (cdr (v 1)))) ((or (= i (- size 1)) (and (> x y) (or (format *stderr* "~A > ~A?~%" x y) #t)))) (set! x y) (set! y (cdr (v (+ i 1)))))))) ;;; closure_sort coverage: (let () (define (f3 a b) (let ((x (+ a 1)) (y (+ b 1))) (< x y))) (test (sort! '(1 3 2) f3) '(1 2 3))) ;;; closure_sort_begin (let () (define (f4 a b) (display a #f) (let ((x (+ a 1)) (y (+ b 1))) (< x y))) (test (sort! '(1 3 2) f4) '(1 2 3))) ;;; opt_begin_bool_sort_b2 (let () (define (f5 a b) (display a #f) (< a b)) (test (sort! '(1 3 2) f5) '(1 2 3))) ;;; opt_begin_bool_sort_b (let () (define (f6 a b) (display a #f) (display b #f) (< a b)) (test (sort! '(1 3 2) f6) '(1 2 3))) ;;; opt_begin_bool_sort_p (let () (define (f6 a b) (display a #f) (if (< a b) #t #f)) (test (sort! '(1 3 2) f6) '(1 2 3))) ;;; op_closure_fa needs_copied_args bug (let () (define imp (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ()))))))) (define (fop4 x y) (apply x y)) (test (let () ((lambda (a) (sort! a >)) (fop4 (lambda (a . b) (cons a b)) imp))) '(2 1 0)) (test (let () (define (func) (let () ((lambda (a) (sort! a >)) (fop4 (lambda (a . b) (cons a b)) imp)))) (func) (func)) '(2 1 0)) (test (let () ((lambda (a) (sort! a >)) (fop4 (lambda a (copy a)) imp))) '(2 1 0)) (test (let () (define (func) (let () ((lambda (a) (sort! a >)) (fop4 (lambda a (copy a)) imp)))) (func) (func)) '(2 1 0)) (test (let () ((lambda (a) (sort! a >)) (fop4 (lambda (a b . c) (cons a (cons b c))) imp))) '(2 1 0)) (test (let () (define (func) (let () ((lambda (a) (sort! a >)) (fop4 (lambda (a b . c) (cons a (cons b c))) imp)))) (func) (func)) '(2 1 0))) ;;; -------------------------------------------------------------------------------- ;;; catch (define (catch-test sym) (let ((errs ())) (catch 'a1 (lambda () (catch 'a2 (lambda () (catch 'a3 (lambda () (catch 'a4 (lambda () (error sym "hit error!")) (lambda args (set! errs (cons 'a4 errs)) 'a4))) (lambda args (set! errs (cons 'a3 errs)) 'a3))) (lambda args (set! errs (cons 'a2 errs)) 'a2))) (lambda args (set! errs (cons 'a1 errs)) 'a1)) errs)) (test (catch-test 'a1) '(a1)) (test (catch-test 'a2) '(a2)) (test (catch-test 'a3) '(a3)) (test (catch-test 'a4) '(a4)) (define (catch-test-1 sym) (let ((errs ())) (catch 'a1 (lambda () (catch 'a2 (lambda () (catch 'a3 (lambda () (catch 'a4 (lambda () (error sym "hit error!")) (lambda args (set! errs (cons 'a4 errs)) (error 'a3) 'a4))) (lambda args (set! errs (cons 'a3 errs)) (error 'a2) 'a3))) (lambda args (set! errs (cons 'a2 errs)) (error 'a1) 'a2))) (lambda args (set! errs (cons 'a1 errs)) 'a1)) errs)) (test (catch-test-1 'a1) '(a1)) (test (catch-test-1 'a2) '(a1 a2)) (test (catch-test-1 'a3) '(a1 a2 a3)) (test (catch-test-1 'a4) '(a1 a2 a3 a4)) (test (procedure? (catch #t make-hook /)) #t) (test (catch #t (lambda* (:rest a) a) /) ()) (test (catch #t (catch #t (lambda () (lambda () 1)) (lambda args 'oops)) (lambda args 'error)) 1) (test (catch #t (catch #t (lambda () (error 'oops)) (lambda args (lambda () 1))) (lambda args 'error)) 1) (test ((catch #t (lambda () (error 'oops)) (lambda args (lambda () 1)))) 1) (test ((catch #t (lambda () (error 'oops)) (catch #t (lambda () (lambda args (lambda () 1))) (lambda args 'error)))) 1) (test (catch #t (dynamic-wind (lambda () #f) (lambda () (lambda () 1)) (lambda () #f)) (lambda args 'error)) 1) (test (dynamic-wind (catch #t (lambda () (lambda () #f)) (lambda args 'error)) (lambda () 1) (lambda () #f)) 1) (test (dynamic-wind ((lambda () (lambda () #f))) (lambda () 1) (((lambda () (lambda () (lambda () #t)))))) 1) (test (catch #t ((lambda () (lambda () 1))) (lambda b a)) 1) (test (map (catch #t (lambda () abs) abs) '(-1 -2 -3)) '(1 2 3)) (test (catch + (((lambda () lambda)) () 1) +) 1) ;(test (catch #t + +) 'error) ; changed 12-May-14 (test (string? (catch + (lambda () (*s7* 'version)) +)) #t) (test (string? (apply catch + (lambda () (*s7* 'version)) (list +))) #t) (test (catch #t (lambda () (catch '#t (lambda () (error '#t)) (lambda args 1))) (lambda args 2)) 1) (test (catch #t (lambda () (catch "hi" (lambda () (error "hi")) (lambda args 1))) (lambda args 2)) 2) ; guile agrees with this (test (let ((str (list 1 2))) (catch #t (lambda () (catch str (lambda () (error str)) (lambda args 1))) (lambda args 2))) 1) (test (let () (abs (catch #t (lambda () -1) (lambda args 0)))) 1) ;(test (let ((e #f)) (catch #t (lambda () (+ 1 "asdf")) (lambda args (set! e (owlet)))) (eq? e (owlet))) #t) (test (+ (catch 'oops (lambda () (error 'oops)) (lambda args (values 1 2 3)))) 6) (test (catch #t (lambda () (error 1 2 3)) (lambda* ((a 2) (b 3) (c 4)) (list a b c))) '(1 (2 3) 4)) (test (catch #t (lambda () (error 'oops)) require) 'error) (test (let ((x (list 1 2))) (catch #t (lambda () (catch x (lambda () (throw x)) (lambda args x))) (lambda () 'oops))) '(1 2)) (test (let () (define (f) (catch #t (lambda () 1) (lambda (pi pj) #f))) (f)) 'error) (test (let () (define (f) (catch #t (lambda () 1) (lambda (pj pi) #f))) (f)) 'error) (test (catch #f (lambda () (error #f "oops")) (lambda (type info) type)) #f) (test (catch # (lambda () (error # "oops")) (lambda (type info) type)) #) (test (catch () (lambda () (error () "oops")) (lambda (type info) type)) ()) (test (catch #t (lambda () (catch #t #(1 2) (lambda (a b) (apply format #f b)))) (lambda (typ info) (apply format #f info))) "catch second argument, #(1 2), is a vector but should be a thunk") (test (catch #t (lambda () (catch #t (lambda (x . y) x) (lambda (a b) (apply format #f b)))) (lambda (typ info) (apply format #f info))) "# requires 1 argument, but catch's second argument should be a thunk") (let () (define (f) (let ((val (catch #t (lambda () (throw 'oops)) (lambda args #f)))) (if val (format *stderr* "~A should be #f~%" val))) (let ((val (catch #t (lambda () (throw 'oops)) (lambda args 'a)))) (if (not (eq? val 'a)) (format *stderr* "~A should be 'a~%" val))) (let ((val (catch #t (lambda () (throw 'oops)) (lambda args (car args))))) (if (not (eq? val 'oops)) (format *stderr* "~A should be 'oops~%" val))) (let ((val (catch #t (lambda () (throw 'oops)) (lambda args (+ 1 2))))) (if (not (= val 3)) (format *stderr* "~A should be 3~%" val))) (let ((val (catch #t (lambda () (throw 'oops)) (lambda args args)))) (if (not (equal? val '(oops ()))) (format *stderr* "~A should be '(oops ())~%" val))) (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) type)))) (if (not (eq? val 'oops)) (format *stderr* "~A should be 'oops~%" val))) (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) info)))) (if (not (null? val)) (format *stderr* "~A should be ()~%" val))) (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) #f)))) (if val (format *stderr* "~A should be #f~%" val))) (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args #f)))) (if val (format *stderr* "oops ~A should be #f~%" val))) (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args 'a)))) (if (not (eq? val 'a)) (format *stderr* "oops ~A should be 'a~%" val))) (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args (car args))))) (if (not (eq? val 'oops)) (format *stderr* "oops ~A should be 'oops~%" val))) (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args (+ 1 2))))) (if (not (= val 3)) (format *stderr* "oops ~A should be 3~%" val))) (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args args)))) (if (not (equal? val '(oops ()))) (format *stderr* "oops ~A should be '(oops ())~%" val))) (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) type)))) (if (not (eq? val 'oops)) (format *stderr* "oops ~A should be 'oops~%" val))) (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) info)))) (if (not (null? val)) (format *stderr* "oops ~A should be ()~%" val))) (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) #f)))) (if val (format *stderr* "oops ~A should be #f~%" val)))) (f)) ;;; various catch macros from s7.html (let () (define-macro (catch-all . body) `(catch #t (lambda () ,@body) (lambda args args))) (let ((val (catch-all (+ 1 asdf)))) (test (car val) 'unbound-variable) (let ((x 32)) (test (catch-all (set! x (+ x 1)) (* x 2)) 66) (test (car (catch-all (string=? x "hi"))) 'wrong-type-arg)))) (let () (define-macro (catch-case clauses . body) (let ((base `(lambda () ,@body))) (for-each (lambda (clause) (let ((tag (car clause))) (set! base `(lambda () (catch ',(if (eq? tag 'else) #t tag) ,base ,@(cdr clause)))))) clauses) (caddr base))) (test (catch-case ((wrong-type-arg (lambda args (format #t "got a bad arg~%") -1)) (division-by-zero (lambda args 0)) (else (lambda args 123))) (abs -1)) 1) (test (catch-case ((wrong-type-arg (lambda args (format #t "got a bad arg~%") -1)) (division-by-zero (lambda args 0)) (else (lambda args 123))) (let ((x 0)) (/ 32 x))) 0) (test (catch-case ((wrong-type-arg (lambda args -1)) (division-by-zero (lambda args 0)) (else (lambda args 123))) (abs "hi")) -1) (test (catch-case ((wrong-type-arg (lambda args (format #t "got a bad arg~%") -1)) (division-by-zero (lambda args 0)) (else (lambda args 123))) (throw 'oops -1)) 123)) (let () (define (catch-if test func err) (catch #t func (lambda args (if (test (car args)) (apply err args) (apply throw args))))) ; if not caught, re-raise the error (test (catch #t (lambda () (catch-if (lambda (tag) (eq? tag 'oops)) (lambda () (error 'oops 123)) (lambda args 32))) (lambda args 47)) 32) (test (catch #t (lambda () (catch-if (lambda (tag) (eq? tag 'oops)) (lambda () (error 'err 123)) (lambda args 32))) (lambda args (car args))) 'err) (define (catch-member lst func err) (catch-if (lambda (tag) (member tag lst)) func err)) (test (catch-member '(oops err) (lambda () (error 'oops)) (lambda args 47)) 47)) (let () (define-macro (catch* clauses . error) (define (builder lst) (if (null? lst) (apply values error) `(catch #t (lambda () ,(car lst)) (lambda args ,(builder (cdr lst)))))) (builder clauses)) (test (catch* ((+ 1 2) (- 3 4)) 'error) 3) (test (catch* ((+ 1 "hi") (- 3 4)) 'error) -1) (test (catch* ((+ 1 "hi") (- 3 #\a)) 'error) 'error)) (multiple-value-bind (err-type err-data) (call-with-exit (lambda (return) (catch #t (lambda () _asdf_) return))) (test err-type 'unbound-variable)) (test (catch #t (lambda () _asdf_) "asdf") 'error) (when with-block (test (car (catch #t (lambda () _asdf_) blocks)) 'unbound-variable)) ;;; since catch is a function, everything is evaluated: (test (catch (#(0 #t 1) 1) ((lambda (a) (lambda () (+ a "asdf"))) 1) ((lambda (b) (lambda args (format #f "got: ~A" b))) 2)) "got: 2") (let () (define (hi c) (catch c ((lambda (a) (lambda () (+ a "asdf"))) 1) ((lambda (b) (lambda args (format #f "got: ~A" b))) 2))) (test (hi #t) "got: 2")) (test (catch (#(0 #t 1) 1) (values ((lambda (a) (lambda () (+ a "asdf"))) 1) ((lambda (b) (lambda args (format #f "got: ~A" b))) 2))) "got: 2") (test (let ((x #t)) (define (f tag) (catch tag (lambda () (/ 1 0)) (lambda (type info) type))) (f x)) 'division-by-zero) (test (let ((x (list #t))) (catch (car x) (lambda () (/ 1 0)) (lambda (type info) type))) 'division-by-zero) (let ((x 0)) (catch #t (lambda () (catch #t (lambda () (+ 1 __asdf__)) (lambda args (set! x (+ x 1)) (+ 1 __asdf__)))) (lambda args (set! x (+ x 1)))) (test x 2)) (test (let ((x 0)) (catch 'a (lambda () (catch 'b (lambda () (catch 'a (lambda () (error 'a)) (lambda args (set! x 1)))) (lambda args (set! x 2)))) (lambda args (set! x 3))) x) 1) (test (+ (catch #t (lambda () (values 3 4)) (lambda args (values 1 2 3)))) 7) (test (catch) 'error) (test (catch #t (lambda () (*s7* 'version))) 'error) (test (catch #t (lambda () (*s7* 'version)) + +) 'error) (let () (define* (f1 a) a) (define (f2 . args) args) (define* (f3) 1) (define* (f4 (a 1) (b 2)) a) (test (catch #t (lambda () (*s7* 'version)) f2) (*s7* 'version)) (test (catch #t f1 f2) #f) (test (catch #t f3 f2) 1) (test (catch #t f4 f2) 1) (define (f5 a) a) (test (catch #t f5 (lambda args 'local-error)) 'error)) (test (let () (define-macro (m) `(+ 1 2)) (catch #t m (lambda any any))) 3) ;(test (let () (define-macro (m) `(define __asdf__ 3)) (catch #t m (lambda any "__asdf__ must be a constant?"))) '__asdf__) ;25-Jul-14 (test (let () (define-macro* (m (a 1) (b 2)) `(define __asdf__ (+ ,a ,b))) (catch #t m (lambda any any)) __asdf__) 3) ;;; so this is useful where we want to call a macro that defines something in the current environment, ;;; but might hit some error that we want to catch. (test (let () (define-macro (m . args) `(display ,args)) (catch #t (lambda () #f) m)) #f) (test (let () (define-macro (m . args) (apply (car args) (cadr args))) (catch #t (lambda () (error abs -1)) m)) 1) (test (let () (define-macro (m . args) `(apply ,(car args) ',(cadr args))) (catch #t (lambda () (error abs -1)) m)) 1) ;;; throw (test (catch 'xyzzy (lambda () (throw 'xyzzy 123)) (lambda args args)) '(xyzzy (123))) (define (catch-test sym) (let ((errs ())) (catch 'a1 (lambda () (catch 'a2 (lambda () (catch 'a3 (lambda () (catch 'a4 (lambda () (throw sym "hit error!")) (lambda args (set! errs (cons 'a4 errs)) 'a4))) (lambda args (set! errs (cons 'a3 errs)) 'a3))) (lambda args (set! errs (cons 'a2 errs)) 'a2))) (lambda args (set! errs (cons 'a1 errs)) 'a1)) errs)) (test (catch-test 'a1) '(a1)) (test (catch-test 'a2) '(a2)) (test (catch-test 'a3) '(a3)) (test (catch-test 'a4) '(a4)) (define (catch-test-1 sym) (let ((errs ())) (catch 'a1 (lambda () (catch 'a2 (lambda () (catch 'a3 (lambda () (catch 'a4 (lambda () (throw sym "hit error!")) (lambda args (set! errs (cons 'a4 errs)) (throw 'a3) 'a4))) (lambda args (set! errs (cons 'a3 errs)) (throw 'a2) 'a3))) (lambda args (set! errs (cons 'a2 errs)) (throw 'a1) 'a2))) (lambda args (set! errs (cons 'a1 errs)) 'a1)) errs)) (test (catch-test-1 'a1) '(a1)) (test (catch-test-1 'a2) '(a1 a2)) (test (catch-test-1 'a3) '(a1 a2 a3)) (test (catch-test-1 'a4) '(a1 a2 a3 a4)) (test (catch #t (catch #t (lambda () (throw 'oops)) (lambda args (lambda () 1))) (lambda args 'error)) 1) (test ((catch #t (lambda () (throw 'oops)) (lambda args (lambda () 1)))) 1) (test ((catch #t (lambda () (throw 'oops)) (catch #t (lambda () (lambda args (lambda () 1))) (lambda args 'error)))) 1) (test (catch #t (lambda () (catch '#t (lambda () (throw '#t)) (lambda args 1))) (lambda args 2)) 1) (test (catch #t (lambda () (catch "hi" (lambda () (throw "hi")) (lambda args 1))) (lambda args 2)) 2) ; guile agrees with this (test (let ((str (list 1 2))) (catch #t (lambda () (catch str (lambda () (throw str)) (lambda args 1))) (lambda args 2))) 1) (test (throw) 'error) (test (catch #f (lambda () (throw #f 1 2 3)) (lambda args (cadr args))) '(1 2 3)) (for-each (lambda (arg) (catch #t (lambda () (test (catch arg (lambda () (throw arg 1 2 3)) (lambda args (cadr args))) '(1 2 3))) (lambda args (format #t "~A not caught~%" (car args))))) (list #\a 'a-symbol #f #t abs #)) #| (test (let ((e #f)) (catch #t (lambda () (catch #t (lambda () (+ 1 "asdf")) (lambda args (set! e (let->list (owlet)))))) (lambda args #f)) (equal? (caddr e) '(error-file . "s7test.scm"))) ; depends on various compile-time options #t) (let ((e 1)) (catch #t (lambda () (catch #t (lambda () (error 'an-error "an-error")) (lambda args (set! e (let->list (owlet))))) (throw #t "not an error")) (lambda args #f)) (test (caddr e) '(error-file . "s7test.scm"))) |# (let () (define (t1 x) (catch #t (lambda () (throw x)) (lambda args (car args)))) (define (tt) (do ((i 0 (+ i 1))) ((= i 100) i) (t1 'a))) (test (tt) 100)) (test (let ((x #f) (i 0)) (catch #t (lambda () (+ 1 #\a)) (lambda (+t+ +i+) (car)))) 'error) (test (let () (define (f) (let ((x #f) (i 0)) (catch #t (lambda () (+ 1 #\a)) (lambda (+t+ +i+) (car ))))) (f)) 'error) (let () (define g (let ((tag (vector 'tag))) (lambda () (catch tag (lambda () (error tag "error: ~S" tag)) (lambda (type info) (format #f "~S ~A" tag (apply format #f info))))))) (test (string=? (g) "#(tag) error: #(tag)") #t)) ;;; -------------------------------------------------------------------------------- ;;; error (test (catch #t (lambda () (error 'oops 1)) (let () (lambda args (caadr args)))) 1) (test (catch #t (lambda () (error 'oops 1)) (let ((x 3)) (lambda args (+ x (caadr args))))) 4) (test (catch #t (let () (lambda () (error 'oops 1))) (let ((x 3)) (lambda args (+ x (caadr args))))) 4) (test (catch #t (let ((x 2)) (lambda () (error 'oops x))) (let ((x 3)) (lambda args (+ x (caadr args))))) 5) (test (catch #t (let ((x 2)) ((lambda () (lambda () (error 'oops x))))) (let ((x 3)) (lambda args (+ x (caadr args))))) 5) (test (catch #t (lambda () (error 1)) (lambda args #f)) #f) (test (let ((pws (dilambda (lambda () (+ 1 2)) (lambda (a) (+ a 2))))) (catch #t pws (lambda (tag type) tag))) 3) (test (let ((pws (dilambda (lambda () (error 'pws 3) 4) (lambda (a) (+ a 2))))) (catch #t pws (lambda (tag type) tag))) 'pws) (test (let ((pws (dilambda (lambda (a b) a) (lambda (a b c) (+ a 2))))) (catch #t (lambda () (error 'pws-error 3)) pws)) 'pws-error) (for-each (lambda (tag) (let ((val (catch tag (lambda () (error tag "an error") 123) (lambda args (car args))))) (if (not (equal? tag val)) (format #t ";catch ~A -> ~A~%" tag val)))) (list :hi () #() # #f #t # car #\a 32 9/2)) (for-each (lambda (tag) (let ((val (catch #t (lambda () (error tag "an error") 123) (lambda args (car args))))) (if (not (equal? tag val)) (format #t ";catch #t (~A) -> ~A~%" tag val)))) (list :hi () # #f #t # car #\a 32 9/2 '(1 2 3) '(1 . 2) #(1 2 3) #())) (for-each (lambda (tag) (test (catch #t tag (lambda args 'local-error)) 'error) (test (catch #t (lambda () #f) tag) 'error)) (list :hi () # #f #t # #\a 32 9/2)) ;'(1 2 3) '(1 . 2) #(1 2 3) #() ;; (error ...) throws 'no-catch which makes it harder to check (let ((val (catch #t (lambda () (error "hi") 123) (lambda args (car args))))) (if (not (eq? val 'no-catch)) (format #t ";catch #t, tag is string -> ~A~%" val))) (for-each (lambda (tag) (let ((val (catch tag (lambda () (error #t "an error") 123) (lambda args (car args))))) (if (not (equal? #t val)) (format #t ";catch ~A -> ~A (#t)~%" tag val)))) (list :hi () # #f #t # car #\a 32 9/2)) (let ((tag 'tag)) (test (catch (let () 'tag) (lambda () (set! tag 123) (error 'tag "tag") tag) (lambda args (car args))) 'tag)) (let () (define (check-reerror x) (catch #t (lambda () (define (our-func x) (case x ((0) (error 'zero)) ((1) (error 'one)) (else (error 'else)))) (catch #t (lambda () (our-func x)) (lambda args (if (eq? (car args) 'one) (our-func (+ x 1)) (apply error args))))) (lambda args (let ((type (car args))) (case type ((zero) 0) ((one) 1) (else 2)))))) (test (check-reerror 0) 0) (test (check-reerror 1) 2) (test (check-reerror 2) 2)) (test (catch 'hiho (lambda () (define (f1 a) (error 'hiho a)) (* 2 (catch 'hiho (lambda () (f1 3)) (lambda args (caadr args))))) (lambda args (caadr args))) 6) (test (let () (define (f1 a) (error 'hiho a)) (catch 'hiho (lambda () (* 2 (catch 'hiho (lambda () (f1 3)) (lambda args (caadr args))))) (lambda args (caadr args)))) 6) (test (catch 'hiho (lambda () (let ((f1 (catch 'hiho (lambda () (lambda (a) (error 'hiho 3))) (lambda args args)))) (f1 3))) (lambda args (caadr args))) 3) (test (error) 'error) (test (let ((x 1)) (let ((val (catch #\a (lambda () (set! x 0) (error #\a "an error") (set! x 2)) (lambda args (if (equal? (car args) #\a) (set! x (+ x 3))) x)))) (= x val 3))) #t) (test (let ((x 1)) (let ((val (catch 32 (lambda () (catch #\a (lambda () (set! x 0) (error #\a "an error: ~A" (error 32 "another error!")) (set! x 2)) (lambda args (if (equal? (car args) #\a) (set! x (+ x 3))) x))) (lambda args (if (equal? (car args) 32) (set! x (+ x 30))))))) (= x val 30))) #t) (test (list (catch #t (lambda () (call-with-exit (lambda (goto) (values 1 2 3)))) (lambda args 'err))) '(1 2 3)) (test (let () (define (func) (list (catch #t (lambda () (call-with-exit (lambda (goto) (values 1 2 3)))) (lambda args 'err))) '(1 2 3)) (define (hi) (func)) (hi)) '(1 2 3)) (test (list (catch #t (lambda () (call-with-exit (lambda (goto) (goto 1 2 3)))) (lambda args 'err))) '(1 2 3)) (test (let () (define (func) (list (catch #t (lambda () (call-with-exit (lambda (goto) (goto 1 2 3)))) (lambda args 'err))) '(1 2 3)) (define (hi) (func)) (hi)) '(1 2 3)) (when (provided? 'history) (test (catch #t (lambda () (apply when '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_when asdf () #f)") (test (catch #t (lambda () (when asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (when asdf () #f)") (test (catch #t (lambda () (apply with-let '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_with-let asdf () #f)") (test (catch #t (lambda () (with-let asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (with-let asdf () #f)") (test (catch #t (lambda () (apply and '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_and asdf () #f)") (test (catch #t (lambda () (and asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (and asdf () #f)") (test (catch #t (lambda () (apply if '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_if asdf () #f)") (test (catch #t (lambda () (if asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (if asdf () #f)") (test (catch #t (lambda () (apply or '(asdf () #f))) (lambda (t i) (apply format #f i))) "unbound variable asdf in (#_or asdf () #f)") (test (catch #t (lambda () (or asdf () #f)) (lambda (t i) (apply format #f i))) "unbound variable asdf in (or asdf () #f)")) ;;; -------------------------------------------------------------------------------- (define (last-pair l) ; needed also by loop below (if (pair? (cdr l)) (last-pair (cdr l)) l)) (let () ;; from guile-user I think ;; (block LABEL FORMS...) ;; ;; Execute FORMS. Within FORMS, a lexical binding named LABEL is ;; visible that contains an escape function for the block. Calling ;; the function in LABEL with a single argument will immediatly stop ;; the execution of FORMS and return the argument as the value of the ;; block. If the function in LABEL is not invoked, the value of the ;; block is the value of the last form in FORMS. (define-macro (block label . forms) `(let ((body (lambda (,label) ,@forms)) (tag (gensym "return-"))) (catch tag (lambda () (body (lambda (val) (throw tag val)))) (lambda (tag val) val)))) ;; (with-return FORMS...) ;; ;; Equivalent to (block return FORMS...) (define-macro (with-return . forms) `(block return ,@forms)) ;; (tagbody TAGS-AND-FORMS...) ;; ;; TAGS-AND-FORMS is a list of either tags or forms. A TAG is a ;; symbol while a FORM is everything else. Normally, the FORMS are ;; executed sequentially. However, control can be transferred to the ;; forms following a TAG by invoking the tag as a function. That is, ;; within the FORMS, there is a lexical binding for each TAG with the ;; symbol that is the tag as its name. The bindings carry functions ;; that will execute the FORMS following the respective TAG. ;; ;; The value of a tagbody is always `#f'. (define (transform-tagbody forms) (let ((start-tag (gensym "start-")) (block-tag (gensym "block-"))) (let loop ((cur-tag start-tag) (cur-code ()) (tags-and-code ()) (forms forms)) (cond ((null? forms) `(block ,block-tag (letrec ,(reverse! (cons (list cur-tag `(lambda () ,@(reverse! (cons `(,block-tag #f) cur-code)))) tags-and-code)) (,start-tag)))) ((symbol? (car forms)) (loop (car forms) '() (cons (list cur-tag `(lambda () ,@(reverse! (cons `(,(car forms)) cur-code)))) tags-and-code) (cdr forms))) (else (loop cur-tag (cons (car forms) cur-code) tags-and-code (cdr forms))))))) (define-macro (tagbody . forms) (transform-tagbody forms)) (define (first_even l) (with-return (tagbody continue (if (not (not (null? l))) (break)) (let ((e (car l))) (if (not (number? e)) (break)) (if (even? e) (return e)) (set! l (cdr l))) (continue) break) (return #f))) (let ((val (first_even '(1 3 5 6 7 8 9)))) (if (not (equal? val (list 6))) (format #t "first_even (tagbody, gensym, reverse!) (6): '~A~%" val))) ) #| so prog is something like (define-macro (prog vars . body) `(with-return (tagbody (let ,vars ,@body)))) or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (tagbody (let ,vars ,@body))))) |# ;;; -------------------------------------------------------------------------------- ;;; define* ;;; lambda* (let ((hi (lambda* (a) a))) (test (hi 1) 1) (test (hi) #f) ; all args are optional (test (hi :a 32) 32) ; all args are keywords (test (hi a: 32) 32) ; either style (test (hi 1 2) 'error) ; extra args (for-each (lambda (arg) (test (hi arg) arg) (test (hi :a arg) arg) (test (hi a: arg) arg)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2))) (test (hi :b 1) 'error)) (let () (define* (f0) #f) (test (f0) #f) (test (f0 :a) 'error)) (let () (define* (f00 a :allow-other-keys) a) (test (f00) #f) (test (f00 :a) 'error) ; key needs value (test (f00 :a 1) 1) (test (let ((x 0)) (f00 :b (set! x 1)) x) 1) (test (f00 :a 1 :b :c :d 2) 1)) (let () (define* (f000 :rest a) a) ; rest argname is not a keyword argname (test (f000 :a) '(:a)) (test (f000 :a 1) 'error) (test (f000 1) '(1)) (test (f000 1 :a 2) '(1 :a 2))) ; ?? error would be better? (test (let () (define* (f a :rest b) (list a b)) (f :a 1 :b 3))'error) (test (let () (define* (f a . b) (list a b)) (f :a 1 :b 3)) 'error) (let () (define* (f1 (a 0)) a) ;;; (define (f2 x) (f1 x)) (test (f1) 0) (test (f1 :a) 'error) (test (f1 :a 1) 1) (test (f1 :a :b) :b) (test (f1 :a :a) :a) (test (f1 :b) 'error) (test (f1 :a 0 :a) 'error) (test (f1 :a 0 :a 1) 'error) (test (f1 0) 0) (test (f1 0 :a) 'error) (test (f1 0 :a 1) 'error) (test (f1 'a) 'a) (test (f1 ':a) 'error) (test (f1 '':a) '':a) (test (f1 ':a 0) 0) (test (f1 a: 0) 0) (let ((x :a)) (test (f1 x 0) 0) (test (f1 x) 'error) (test (apply f1 (list x 0)) 0) (test (apply f1 '(x)) 'x) (test (apply f1 '(:a)) 'error)) (let ((x :b)) (test (f1 x) 'error)) (let ((mk (lambda () :a))) (test (f1 (mk)) 'error) (test (f1 (mk) 0) 0) (test (f1 (mk) (mk)) (mk)) ;! (test (apply f1 (list (mk) 0)) 0))) (let () (define z 1) (define* (f1* (x (log 32 2)) (y z)) (+ x y)) (test (f1*) 6) (let ((a 1)) (test (f1* (+ a 1)) 3)) (let ((a 1)) (test (f1* :x (+ a 1)) 3)) (let ((a 1)) (test (f1* :y (+ a 1)) 7)) (let ((a 1)) (test (f1* (+ a 1) (- a 1)) 2)) (let ((a 1)) (test (f1* :x (+ a 1) :y (- a 1)) 2)) (define (g a z) (+ (f1*) (f1* (+ a 1)) (f1* :x (+ a 1)) (f1* :y (+ a 1)) (f1* (+ a 1) (- a 1)) (f1* :x (+ a 1) :y (- a 1)))) (test (g 1 2) 23) (test (g 1 2) 23) (define* (f2* (x (values 2)) (y (values))) (list-values x y)) (test (f2*) '(2)) (test (f2* :y 3) '(2 3)) (test (f2* :x 3) '(3)) (test (f2* (+ z 1) 3) '(2 3))) (let () (define* (f1u (a 0)) (car (member a (list a) (lambda (a b) a)))) ;;; (define (f2 x) (f1u x)) (test (f1u) 0) (test (f1u :a) 'error) (test (f1u :a 1) 1) (test (f1u :a :b) :b) (test (f1u :a :a) :a) (test (f1u :b) 'error) (test (f1u :a 0 :a) 'error) (test (f1u :a 0 :a 1) 'error) (test (f1u 0) 0) (test (f1u 0 :a) 'error) (test (f1u 0 :a 1) 'error) (test (f1u 'a) 'a) (test (f1u ':a) 'error) (test (f1u '':a) '':a) (test (f1u ':a 0) 0) (test (f1u a: 0) 0) (let ((x :a)) (test (f1u x 0) 0) (test (f1u x) 'error) (test (apply f1u (list x 0)) 0) (test (apply f1u '(x)) 'x) (test (apply f1u '(:a)) 'error)) (let ((x :b)) (test (f1u x) 'error)) (let ((mk (lambda () :a))) (test (f1u (mk)) 'error) (test (f1u (mk) 0) 0) (test (f1u (mk) (mk)) (mk)) ;! (test (apply f1u (list (mk) 0)) 0))) (let ((x 1)) (define fx (lambda* ((a (+ x 1)) (b (let ((y (+ x 1))) (+ y 1)))) (list a b))) (define* (fy (a (* x 2)) (b (fx :a 1 :b 2))) (list a b)) (test (fx) '(2 3)) (test (fy) '(2 (1 2))) (test (fy :a 0) '(0 (1 2)))) (let () (define* (f a (b :c)) b) (test (f :b 1 :d) 'error)) (let () (define* (f1a (a :a)) a) (test (f1a) :a)) (test ((lambda* ((a (quote . -1))) quote)) 'error) (test ((lambda* ((a (quote 1 1))) a)) 'error) (test ((lambda* ((a (quote))) a)) 'error) (test ((lambda* ((e #)) 1)) 1) (test ((lambda* ((d 1) (e #)) 1)) 1) (let () (define* (f2 (a 0) (b 1)) (list a b)) (test (f2 :a) 'error) (test (f2 :a 1 :b) 'error) (test (f2 :a 1 :b 1 :c) 'error) (test (f2 (car '(:a)) 2) '(2 1)) (test (f2 :b 2) '(0 2)) (test (f2 :a 2) '(2 1)) (test (f2 :a 1 :b 2) '(1 2)) (test (let ((x :a)) (f2 x 2)) '(2 1)) (test (let ((x :a)) (f2 x x)) '(:a 1)) ; (f2 :a :a) so a=:a b=1 (test (let ((x -1) (y :a)) (f2 y x)) '(-1 1)) (test (let ((x 3) (y :b)) (f2 y x)) '(0 3)) (test (let ((x 3) (y :c)) (f2 y x)) 'error) (test (let ((x 3) (y :c)) (f2 x y)) 'error)) (let () (define* (f3 (a :a) (b :a)) (list a b)) (test (f3 :a) 'error) (test (f3) '(:a :a)) (test (f3 :b 1) '(:a 1))) ; default value is a value not a keyword-as-parameter-indicator (let ((hi (lambda* ((a 1)) a))) (test (hi 2) 2) (test (hi) 1) (test (hi :a 2) 2) (for-each (lambda (arg) (test (hi arg) arg) (test (hi :a arg) arg)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2)))) (let ((hi (lambda* (a (b "hi")) (list a b)))) (test (hi) (list #f "hi")) (test (hi 1) (list 1 "hi")) (test (hi 1 2) (list 1 2)) (test (hi :b 1) (list #f 1)) (test (hi :a 1) (list 1 "hi")) (test (hi 1 :b 2) (list 1 2)) (test (hi :b 3 :a 1) (list 1 3)) (test (hi :a 3 :b 1) (list 3 1)) (test (hi 1 :a 3) 'error) (test (hi 1 2 :a 3) 'error) ; trailing (extra) args (test (hi :a 2 :c 1) 'error) (test (hi 1 :c 2) 'error) (for-each (lambda (arg) (test (hi :a 1 :b arg) (list 1 arg)) (test (hi :a arg) (list arg "hi")) (test (hi :b arg) (list #f arg)) (test (hi arg arg) (list arg arg))) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2)))) (let () (define* (f1 (allow-other-keys 32) (rest 4)) (+ rest allow-other-keys)) (test (f1) 36) (test (f1 :rest 3) 35) (test (f1 :allow-other-keys 3) 7) (test (f1 :allow-other-keys 3 :rest 3) 6) (define* (f2 readable) (+ readable 1)) (test (f2 :readable 2) 3)) (let ((x :allow-other-keys)) (define (func) (blocks5 (values x))) (test (func) 'error)) ; no arg for key (let () (define* (f allow-other-keys) (+ allow-other-keys 1)) (test (f 2) 3) (test (f :allow-other-keys 2) 3)) (test (let () (define* (f :allow-other-keys :allow-other-keys) 32)) 'error) (let () (define* (f allow-other-keys :allow-other-keys) (+ allow-other-keys 2)) (test (f 2) 4) (test (f 3 :a 1) 5) (test (f 3 :allow-other-keys 32) 'error)) ; par set twice (let () ; wrapper sharing keyword arg with wrappee (define* (f1 a) a) (define* (f2 a :rest b :allow-other-keys) (+ a (apply f1 b))) (test (f2 :a 3 :a 4) 7) ; b='(:a 4) (let ((c :a)) (test (f2 c 3 c 4) 7))) (let ((hi (lambda* (a (b 3) c) (list a b c)))) (test (hi) (list #f 3 #f)) (test (hi 1) (list 1 3 #f)) (test (hi :c 32) (list #f 3 32)) (test (hi :c 32 :b 43 :a 54) (list 54 43 32)) (test (hi 1 2 3) (list 1 2 3)) (test (hi :b 32) (list #f 32 #f)) (test (hi 1 2 :c 32) (list 1 2 32))) (let ((hi (lambda* (a :rest b) (list a b)))) (test (hi 1 2 3) (list 1 (list 2 3))) (test (hi) (list #f ())) (test (hi :a 2) (list 2 ())) (test (hi :b 3) 'error)) (let ((hi (lambda* (a :rest b :rest c) (list a b c)))) (test (hi 1 2 3 4 5) (list 1 (list 2 3 4 5) (list 3 4 5)))) (let ((hi (lambda* ((a 3) (b #t) (c pi) :rest d) (list a b c d)))) (test (hi) (list 3 #t pi ())) (test (hi 1 2 3 4) (list 1 2 3 (list 4)))) (let ((hi (lambda* ((a 'hi)) (equal? a 'hi)))) (test (hi) #t) (test (hi 1) #f) (test (hi 'hi) #t) (test (hi :a 1) #f)) (let* ((x 32) (hi (lambda* (a (b x)) (list a b)))) (test (hi) (list #f 32)) (test (hi :a 1) (list 1 32))) (let ((hi (lambda* (a . b) (list a b)))) (test (hi 1 2 3) (list 1 (list 2 3))) (test (hi) (list #f ())) (test (hi :a 2) (list 2 ())) (test (hi :b 3) 'error)) (let ((hi (lambda* ((a 0.0) (b 0.0)) (+ a b)))) (num-test (hi 1.0) 1.0) (num-test (hi 1.0 2.0) 3.0) (num-test (hi) 0.0) (num-test (+ (hi) (hi 1.0) (hi 1.0 2.0)) 4.0) (num-test (+ (hi 1.0) (hi) (hi 1.0 2.0)) 4.0) (num-test (+ (hi 1.0) (hi 1.0 2.0) (hi)) 4.0) (num-test (+ (hi 1.0 2.0) (hi) (hi 1.0)) 4.0)) (test (let ((hi (lambda*))) (hi)) 'error) (test (let ((hi (lambda* #f))) (hi)) 'error) (test (let ((hi (lambda* "hi" #f))) (hi)) 'error) (test (let ((hi (lambda* ("hi") #f))) (hi)) 'error) (test (let ((hi (lambda* (a 0.0) a))) (hi)) 'error) (test (let ((hi (lambda* (a . 0.0) a))) (hi)) 'error) (test (let ((hi (lambda* ((a . 0.0)) a))) (hi)) 'error) (test (let ((hi (lambda* ((a 0.0 "hi")) a))) (hi)) 'error) (test (let ((hi (lambda* ((a 0.0 . "hi")) a))) (hi)) 'error) (test (let ((hi (lambda* ((a)) a))) (hi)) 'error) (test (let ((hi (lambda* (a 0.0) (b 0.0) (+ a b)))) (hi)) 'error) (test (lambda (:key) 1) 'error) (test (let () (define hi (let ((x 1)) (lambda* ((y x)) y))) (hi)) 1) (test (let () (define hi (let ((x 1)) (lambda* ((y x)) y))) (let ((x 2)) (hi))) 1) (test ((lambda* (:key) 1)) 'error) (test (let ((akey :a) (bkey :b)) ((lambda* (a b) (list a b)) akey 32)) '(32 #f)) (test (let ((akey :a) (bkey :b)) ((lambda* (a b) (list a b)) bkey 12 akey 43)) '(43 12)) (test (let ((x 0)) (for-each (lambda* (a) (set! x (+ x a))) (list :a :a :a) (list 1 2 3)) x) 'error) (test (let () (define* (hi) 0) (hi)) 0) (test (let () (define* (hi) 0) (hi 1)) 'error) (test (let () (define* (hi a . b) b) (hi 1 2 3)) '(2 3)) (test (let () (define* (hi a . b) b) (hi :a 1 2 3)) '(2 3)) (test (let () (define* (hi a . b) b) (hi 1)) ()) (test (let () (define* (hi a . b) b) (hi :a 1)) ()) (test (let () (define* (hi a . b) b) (hi)) ()) (test (let () (define* (hi a . a) a) (hi)) 'error) (test (let () (define* (hi (a 1) . a) a) (hi)) 'error) (test (let () (define* (hi (a 1) . b) b) (hi 2 3 4)) '(3 4)) (test (let () (define* (hi a :rest b) b) (hi 1 2 3)) '(2 3)) (test (let () (define* (hi a :rest b) b) (hi :a 1 2 3)) '(2 3)) (test (let () (define* (hi a :rest b) b) (hi 1)) ()) (test (let () (define* (hi a :rest b) b) (hi :a 1)) ()) (test (let () (define* (hi a :rest b) b) (hi)) ()) (test ((lambda* (a :rest b :rest c) (list a b c)) 1 2 3 4) '(1 (2 3 4) (3 4))) (test (let () (define* (hi (a 1) . b) b) (hi 1 2 3)) '(2 3)) (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi)) '(#f 22 ())) (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :a 1)) '(1 22 ())) (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1)) '(#f 1 ())) (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :c 1)) 'error) ; was '(#f 22 1)) (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :a 1 2)) '(1 2 ())) (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1 2 3)) 'error) ; b set twice (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :c 1 2 3)) 'error) ; was '(#f 2 (3))) (test (let () (define* (hi a (b 22) . c) (list a b c)) (hi :b 1 :a 2 3)) '(2 1 (3))) (test (let ((ksym :b)) ((lambda* (a b) (list a b)) ksym 2)) (list #f 2)) (test (let ((ksym :b)) ((lambda* (a b) (list a b)) 1 ksym)) 'error) (test (let ((ksym (lambda () :b))) ((lambda* (a b) (list a b)) (ksym) 2)) (list #f 2)) (test (let ((ksym :b)) ((lambda* (a b c) (list a b c)) 1 ksym 2)) (list 1 2 #f)) (test (let ((ksym :b)) (define* (hi a b (c 3)) (list a b c)) (hi 1 ksym 2)) (list 1 2 3)) (test (let ((ksym :b)) (define* (hi a b (c 5) d) (list a b c d)) (hi ksym 3 :d 4)) (list #f 3 5 4)) (let () (define* (f a (b (error 'unset-arg "f's b parameter not set"))) (list a b)) (test (f 1 2) (list 1 2)) (test (f 1) 'error)) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi)) 1) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :b :a :a 3)) 3) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :b 3)) 1) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 3)) 3) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi a: 3)) 3) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3)) 3) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 3 :b 2)) 3) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) 3) (test (let () (define* (hi :rest a :allow-other-keys) a) (hi :c 1 :a 3 :b 2)) '(:c 1 :a 3 :b 2)) (test ((lambda* (a :allow-other-keys) a) 1 :a 2) 'error) (test ((lambda* (a :allow-other-keys) a) 1 :b 2) 1) (test (let () (define* (hi (a 1) (b 2) :allow-other-keys :allow-other-keys) a)) 'error) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi :a 2 32)) 'error) (test (let () (define* (hi (a 1) :allow-other-keys) a) (hi 2 32)) 'error) (test (let () (define* (hi (a 1) :rest c :allow-other-keys) (list a c)) (hi :a 3 :b 2)) '(3 (:b 2))) (test (let () (define* (hi (a 1) :rest c) (list a c)) (hi :a 3 :b 2)) '(3 (:b 2))) (test (let () (define* (hi (a 1) (b 2) :allow-other-keys) (list a b)) (hi :c 21 :b 2)) '(1 2)) (test (let () (define hi (lambda* ((a 1) (b 2) :allow-other-keys) (list a b))) (hi :c 21 :b 2)) '(1 2)) (test (let () (define-macro* (hi (a 1) (b 2) :allow-other-keys) `(list ,a ,b)) (hi :c 21 :b 2)) '(1 2)) (test (let () (define* (f1 :allow-other-keys) 123) (f1 :a 1 :b 2)) 'error) (test (let ((f1 (lambda* (:allow-other-keys) 123))) (f1 :a 1 :b 2)) 'error) (let () (define* (f1 a :allow-other-keys) :allow-other-keys) (test (keyword? (f1 3)) #t) (test (eq? (f1) ':allow-other-keys) #t) (test (keyword? :allow-other-keys) #t)) (test (keyword? :allow-other-keys) #t) (test (eq? :allow-other-keys ':allow-other-keys) #t) (test (keyword? :rest) #t) (test (eq? :rest ':rest) #t) (test (let () (define* (f (a :b)) a) (list (f) (f 1) (f :a :c) (f :a 1) (f))) '(:b 1 :c 1 :b)) (test (let () (define* (f a (b :c)) b) (f :b 1 :d)) 'error) (test ((lambda* (:rest (b 1)) b)) 'error) ; "lambda* :rest parameter can't have a default value." ? (test ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c)))) 7) (test ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c))) :b 3) 10) (test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (* b 3)))) c))) :b a)) 370) (test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ a (let ((a -2)) (* b a))))) c))))) -3) (test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ (let ((a -2)) (* b a)) a))) c))))) -3) (test (let ((a 123)) ((lambda* ((a 1) (b 2)) ((lambda* ((c (+ (let ((a 0)) (/ b a)) a))) c))))) 'error) (test ((lambda* ((c (call/cc (lambda (return) (return 3))))) c)) 3) (test ((lambda* ((a (do ((i 0 (+ i 1)) (sum 0)) ((= i 3) sum) (set! sum (+ sum i))))) (+ a 100))) 103) (test ((lambda* ((a (do ((i 0 (+ i 1)) (sum 0)) ((= i 3) sum) (set! sum (+ sum i)))) b) (+ a b)) 1 2) 3) (test ((lambda* (a (b '(1 2))) (length b)) 1) 2) (test ((lambda* (a (b '(1 2))) (values (length b))) 1) 2) (test (let () (define* (f2 a (b '(1 2))) (let ((c b)) (+ (c 0) 1))) (define (g) (f2 1)) (g)) 2) ; closure_star_a (test (let () (define* (f2 a (b '(1 2))) (+ (list-ref b 0) a)) (define (g) (f2 :a 1)) (g)) 2) ; safe_closure_star_aa (test (let () (define (func) (unsafe-blocks 0 (symbol->value :scaler))) (func)) 'error) (test (let () (define* (f a b (err (lambda () (+ a b)))) (or (eq? a b) (err))) (f 1 2)) 3) ; chicken-users mailing list (test (let ((f1 (lambda (b) 10))) (define* (f1 (a (f1 0))) (+ a 1)) (f1)) 2) ;; some of these are questionable (test ((lambda* ((x (lambda () 1))) (x))) 1) (test ((lambda* ((x x) else) (+ x else)) 1 2) 3) ; this has fluctuated between 3 and 'error (unbound variable 'x) (test (symbol? ((lambda* ((y y)) y))) 'error) ; this used to be #t but now y is undefined (test ((lambda* (:allow-other-keys) 34) :a 32) 'error) (test ((lambda* ((y x) =>) (list y =>)) 1 2) '(1 2)) ; was also 'error (test ((lambda* (=> (y x)) (list y =>)) 1) 'error) ; used to be '(x 1)) (test ((lambda* ((y #2d((1 2) (3 4)))) (y 1 0))) 3) (test ((lambda* ((y (symbol "#(1 #\\a (3))")) x) -1)) -1) (test ((lambda* ((y (symbol "#(1 #\\a (3))")) x) y)) (symbol "#(1 #\\a (3))")) (test ((lambda* ((y #(1 #\a (3)))) (y 0))) 1) (test ((lambda* ((y ()) ()) y)) 'error) (test ((lambda* ((y ()) (x)) y)) 'error) (test ((lambda* ((=> "") else) else) else) #f) (test ((lambda* (x (y x)) y) 1) 1) ; was #f (test ((lambda* (x (y x)) (let ((x 32)) y)) 1) 1) ; was #f (test ((lambda* ((x 1) (y x)) y)) 1) (test ((lambda* ((x 1) (y (+ x 1))) y)) 2) (test ((lambda* ((x y) (y x)) y)) 'error) ; used to be 'y (test (let ((z 2)) ((lambda* ((x z) (y x)) y))) 2) ; hmmm (test (keyword? ((lambda* ((x :-)) x))) #t) (test ((apply lambda* (list (list (list (string->symbol "a") 1)) (string->symbol "a"))) (symbol->keyword (string->symbol "a")) 3) 3) (test ((lambda* (:allow-other-keys) 1) :a 321) 'error) (test ((lambda* (:rest (a 1)) a)) 'error) (test ((lambda* (:rest a) a)) ()) (test ((lambda* (:rest (a 1)) 1)) 'error) (test (let ((b 2)) ((lambda* (:rest (a (let () (set! b 3) 4))) b))) 'error) (test (let ((b 2)) ((lambda* ((a (let () (set! b 3) 4))) b))) 3) (test ((lambda* (:rest hi :allow-other-keys (x x)) x)) 'error) (test ((lambda* (:rest x y) (list x y)) 1 2 3) '((1 2 3) 2)) (test ((lambda* (:rest '((1 2) (3 4)) :rest (y 1)) 1)) 'error) (test ((lambda* (:rest (list (quote (1 2) (3 4))) :rest (y 1)) 1)) 'error) (test ((lambda* ((x ((list 1 2) 1))) x)) 2) (test ((lambda* ((y ("hi" 0))) y)) #\h) (test ((lambda* ((x ((lambda* ((x 1)) x)))) x)) 1) (test ((lambda* (:rest) 3)) 'error) (test ((lambda* (:rest 1) 3)) 'error) (test ((lambda* (:rest :rest) 3)) 'error) (test ((lambda* ((: 1)) :)) 1) ; but there's no keyword name for this parameter! (test ((lambda* ((a 1)) a) a: 21) 21) (test ((lambda* ((a 1)) a) :a: 21) 'error) (test (let ((func (let ((a 3)) (lambda* ((b (+ a 1))) b)))) (let ((a 21)) (func))) 4) (test (let ((a 21)) (let ((func (lambda* ((b (+ a 1))) b))) (let ((a 3)) (func)))) 22) (test (let ((a 21)) (begin (define-macro* (func (b (+ a 1))) b) (let ((a 3)) (func)))) 4) (test ((lambda* (:rest x :allow-other-keys y) x) 1) 'error) (test ((lambda* (:allow-other-keys x) x) 1) 'error) (test ((lambda* (:allow-other-keys . x) x) 1 2) 'error) (test ((lambda* (:rest . (x)) x) 1 2) '(1 2)) (test ((lambda* (:rest . (x 1)) x) 1 2) 'error) (test ((lambda* (:rest . (x)) x)) ()) (test ((lambda* x x) 1) '(1)) (test (lambda* (((x) 1)) x) 'error) (test ((lambda* ((a: 3)) a:) :a: 4) 'error) (test ((lambda* ((a 3)) a) a: 4) 4) (test ((lambda* ((a (lambda* ((b 1)) (+ b 1)))) (a))) 2) ;(define hi (call-with-exit (lambda (return) (lambda* ((a (return "hey I need an argument"))) a)))) -> error call goto outside block? (test (let () (define hi (with-let (inlet 'a 3) (lambda (b) (+ a b)))) (hi 2)) 5) ; but this blocks the local env chain: ;(let ((y 2)) (define hi (with-let (inlet) (lambda (a) (+ a y)))) (hi 1)) -> error y unbound ;quick circular env: (define* (hi (a (curlet))) a) (hi) -- need a lambda equivalent of bacro for defargs (test (let () (define hi (do ((i 0 (+ i 1))) ((= i 3) (lambda (a) (+ a i))))) (hi 1)) 4) (test ((lambda* a (list a)) 1 2 3) '((1 2 3))) (test ((lambda* () #f) 1 2 3) 'error) (test ((lambda* (a ) (list a)) 1) '(1)) (test ((lambda* (a b ) (list a b)) 1 2) '(1 2)) (test ((lambda* (a b :allow-other-keys ) (list a b)) 1 2 :c 3) '(1 2)) (test ((lambda* (a . b ) (list a b)) 1 2 3) '(1 (2 3))) (test ((lambda* (a :rest b ) (list a b)) 1 2 3) '(1 (2 3))) (test ((lambda* (a :rest b :allow-other-keys ) (list a b)) 1 2 :c 3) '(1 (2 :c 3))) (test ((lambda* (a b :allow-other-keys ) (list a b)) 1) '(1 #f)) (test ((lambda* (a :allow-other-keys ) (list a)) :b 2) '(#f)) (test ((lambda* (:rest a ) (list a)) 1 2 3) '((1 2 3))) (test ((lambda* (:rest a b ) (list a b)) 1 2 3) '((1 2 3) 2)) (test ((lambda* (:rest a b :allow-other-keys ) (list a b)) :c 1 2 3) '((:c 1 2 3) 1)) ; seems inconsistent (test ((lambda* (:rest a . b ) (list a b)) 1 2 3) '((1 2 3) (2 3))) (test ((lambda* (:rest a :rest b ) (list a b)) 1 2 3) '((1 2 3) (2 3))) (test ((lambda* (:rest a :rest b :allow-other-keys ) (list a b)) 1 2 3) '((1 2 3) (2 3))) (test ((lambda* (:rest a :allow-other-keys ) (list a)) 1 2 3) '((1 2 3))) (test ((lambda* (:allow-other-keys ) (list)) :a 1 :c 3) 'error) (test (let () (define (f) ((lambda (a b . c) c) (values 1 2 3 4))) (f) (f)) '(3 4)) (test (let () (define (f) ((lambda (a b . c) c) (values 1 2 3) (values 1 2))) (f) (f)) '(3 1 2)) (test (let () (define (f) ((lambda (a b . c) c) (values 1 2 3) 1 2)) (f) (f)) '(3 1 2)) (let () (define* (bpar (lst '(0 1 2 3))) (let ((res (copy lst))) (set! (lst 2) (* 2 (lst 2))) res)) (test (bpar) '(0 1 2 3)) (test (bpar) '(0 1 4 3)) (define* (bpar1 (lst '(0 1 2 3))) (set! (lst 2) (* 2 (lst 2))) lst) (let ((lst (bpar1))) (set! (lst 0) 123)) (test (bpar1) '(123 1 8 3))) (let () (define* (g1 a b) (list a b)) (let-temporarily (((*s7* 'accept-all-keyword-arguments) #t)) (test (g1 :x) '(:x #f)) (test (g1 1 :x) '(1 :x)) (test (g1 :x 1) '(:x 1)) (test (g1 :x :x) '(:x :x))) (test (g1 :x) 'error) (define* (g3 a b c) (list a b c)) (let-temporarily (((*s7* 'accept-all-keyword-arguments) #t)) (test (g3 :x) '(:x #f #f)) (test (g3 :x 1) '(:x 1 #f)) (test (g3 1 :x 1) '(1 :x 1)) (test (g3 :x 1 :y) '(:x 1 :y)) (test (g3 :x :y :z) '(:x :y :z)) (test (g3 1 1 :x) '(1 1 :x)))) (test ((lambda* (:rest a :rest b) (map + a b)) 1 2 3 4 5) '(3 5 7 9)) (test ((lambda* (:rest a c :rest b) (map (lambda (a b) (+ a b c)) a b)) 1 2 3 4 5) '(6 8 10)) (test ((lambda* (a :rest (b 2)) (list a b)) 1 2 3 4) 'error) (test ((lambda* ((x (values 1 2))) (+ x 1))) 'error) (test ((lambda* (x) x) (values)) #) (let () (define* (f x) x) (test (apply f (list (values))) #) (test (apply f (list (values :x))) 'error) (test (f :x (values)) #) ; these two should be the same, and (abs (values)) complains about # as its arg (test (f (values)) #)) (let () (define* (f2 a b) (cons a b)) (test (f2 (values)) (cons # #f)) (test (apply f2 (list (values))) (cons # #f)) (test (f2 :a 1 (values)) (cons 1 #)) (test (f2 :b (values)) (cons #f #))) (let () (define* (f1 (a 0) :allow-other-keys) (+ a 1)) (let ((f2 (copy f1))) (test (f2 :a 1) 2) (test (f2 :b 1) 1))) (let () (define (kw n) (case n ((0) :a) ((1) :b) (else :c))) (define* (f1 a b c) (list a b c)) (test (f1 (kw 0) 1) '(1 #f #f)) (test (f1 (kw 1) 1) '(#f 1 #f)) (test (f1 (kw 2) 1) '(#f #f 1)) (define* (f2 (a 1) (b 2) (c 3)) (list a b c)) (test (f2 (kw 0) -1) '(-1 2 3)) (test (f2 (kw 1) -1) '(1 -1 3)) (test (f2 (kw 2) -1) '(1 2 -1)) (test (let ((a 123)) (let* ((a 1) (a (+ a 1))) a)) 2) (test (let ((a 123)) (let* loop ((a 1) (a (+ a 1))) a)) 'error) (test (let ((a 123)) (define* (loop (a 1) (a (+ a 1))) a)) 'error)) ;;; one place where :rest can't be handled by dotted list: (let () (define* (f1 :rest args :allow-other-keys) args) (test (f1 :a 1 :b 2) '(:a 1 :b 2))) ;;; but its :allow-other-keys isn't needed here anyway: (let () (define* (f1 . args) args) (test (f1 :a 1 :b 2) '(:a 1 :b 2))) ;;; but (let () (define* (f1 (c 0) . args) args) (test (f1 :a 1 :b 2) 'error) ; unknown key (test (f1 :c 1 :b 2) '(:b 2))) (define* (-nxy- gen (fm 0.0)) ; optimizer test (safe_closure_star_s0) (let-set! gen 'fm fm) (with-let gen fm)) (let ((g (inlet 'fm 1.0))) (test (-nxy- g) 0.0) (test (-nxy- g) 0.0) (test (-nxy- g 0.5) 0.5) (test (-nxy- g) 0.0)) (let () (define (fs0) 3) (define (fp0) 3 4) (define (fa0) (+ 1 2)) (define (fu0) (apply + ())) (define (c0) (fs0) (fp0) (fa0) (fu0)) (test (c0) 0)) (let ((ctr 1)) (define (f1) (if (> ctr 0) (begin (set! ctr (- ctr 1)) (f1)) 0)) (define (f2) (f1)) (test (f2) 0)) (let ((ctr 1)) (define (f3) (if (= ctr 0) 0 (begin (set! ctr (- ctr 1)) (+ (f3) 1)))) (define (f4) (f3)) (test (f4) 1)) (let ((ctr 1)) (define (f5) (if (= ctr 0) 0 (begin (set! ctr (- ctr 1)) (apply + (list (f5) 1))))) (define (f6) (f5)) (test (f6) 1)) (let ((ctr 1)) (define (f8) (let f7 () (if (> 0 ctr) (begin (set! ctr (- ctr 1)) (f7)) 0))) (test (f8) 0)) (let ((ctr 1)) (define (f10) (let f9 () (if (= ctr 0) 0 (begin (set! ctr (- ctr 1)) (+ (f9) 1))))) (test (f10) 1)) (let ((ctr 1)) (define (f12) (let f11 () (if (= ctr 0) 0 (begin (set! ctr (- ctr 1)) (apply + (list (f11) 1)))))) (test (f12) 1)) (let ((ctr 1)) (define (f13) (display "f13" #f) (if (= ctr 0) 0 (begin (set! ctr (- ctr 1)) (apply + (list (f13) 1))))) (define (f14) (f13)) (test (f14) 1)) (let ((ctr 1)) ; safe_thunk_l (define (f15) (display "f15" #f) (if (> ctr 0) (begin (set! ctr (- ctr 1)) (f15)) 0)) (define (f16) (f15)) (test (f16) 0)) (test (let ((ctr 1)) (define (f17) (if (> ctr 0) (begin (set! ctr (- ctr 1)) (f17) (f17)) (let ((f17 32)) 7))) (define (f18) (f17)) (f18)) 7) (define (f19 -a-weird-var-) (+ -a-weird-var- 1)) (test (f19 3) 4) (define ctr 1) (define (-a-weird-var-) (if (> ctr 0) (begin (set! ctr (- ctr 1)) (-a-weird-var-)) 0)) (define (f20) (-a-weird-var-)) (test (f20) 0) (define (f22) (let ((ctr 1)) (define (f21) (if (> ctr 0) (begin (set! ctr (- ctr 1)) (f21)) 0)) (f21))) (f22) (test (f22) 0) #| (let () ;; quoted arg default bug (from K Matheussen) ;; why is this sometimes an error and other times not?? (define make-event (lambda* ((patternnum 'must-be-defined) (channel 'must-be-defined)) (if #f (throw "strange")))) (define (call-make-event a b) (make-event a b)) (call-make-event :a 0)) |# (let ((x 1)) (define fx (lambda* ((a (+ x 1)) (b (let ((y (+ x 1))) (+ y 1)))) (list a b))) (define* (fy (a (* x 2)) (b (fx :a 1 :b 2))) (list a b)) (test (fx) '(2 3)) (test (fy) '(2 (1 2))) (test (fy :a 0) '(0 (1 2)))) #| (let ((choices (list "a " "b " " . " ":rest " ":allow-other-keys ")) (args (list "1 " ":a " ":b " ":c "))) (define-bacro (display-abc) `(format #f "~A ~A" (if (defined? 'a) (symbol->value 'a) '?) (if (defined? 'b) (symbol->value 'b) '?))) (define (next-arg str n) (let ((expr (string-append str ")"))) (catch #t (lambda () (let ((val (eval-string expr))) (format #t "~A -> ~A~%" expr val))) (lambda args ;(format #t " ~A: ~A~%" expr (apply format #f (cadr args))) 'error))) (if (< n 6) (for-each (lambda (arg) (next-arg (string-append str arg) (+ n 1))) args))) (define (next-choice str n) (next-arg (string-append str ") (display-abc)) ") 0) (if (< n 4) (for-each (lambda (choice) (next-choice (string-append str choice) (+ n 1))) choices))) (for-each (lambda (choice) (next-arg (string-append "((lambda* " choice "(display-abc)) ") 0)) choices) (next-choice "((lambda* (" 0)) |# (let () (define* (s0-test gen (fm 0.0)) (let-set! gen 'fm fm) (with-let gen (+ fm 1.0))) (define (tst) (let ((g (inlet 'fm 0.0))) (num-test (s0-test g) 1.0)) (let ((g (inlet 'fm 0.0))) (num-test (s0-test g 0.0) 1.0))) (tst)) ;;; here be bugs... (test ((lambda* a a) :a) '(:a)) (test ((lambda* (a . b) (list a b)) :b 1) 'error) (test ((lambda* (a :rest b) (list a b)) :b 1) 'error) (test ((lambda* (:rest a) (list a)) :a 1) 'error) (test ((lambda* (a . b) (list a b)) :b 1 1) 'error) (test ((lambda* (:rest a b ) (list a b)) 1 1) '((1 1) 1)) (test ((lambda* (:rest a :rest b ) (list a b)) :a 1) 'error) (test ((lambda* (:allow-other-keys) #f) :c 1) 'error) (test ((lambda* (a :allow-other-keys) a) :a) 'error) (test ((lambda* (a) a) :a) 'error) (test ((lambda* (a :allow-other-keys) a) :a 1 :a 2) 'error) (test ((lambda* (a :allow-other-keys) a) :c :c :c :c) #f) (test ((lambda* (a :allow-other-keys) a) :c) 'error) (test ((lambda* (a b :allow-other-keys ) (list a b)) :b :a :c 1) '(#f :a)) (test ((lambda* (a :allow-other-keys ) a) :c 1 1) 1) ; ?? (test ((lambda* (:rest b (a 1)) (list a b))) '(1 ())) (test ((lambda* (:rest a b c) (list a b c)) 1 2 3 4) '((1 2 3 4) 2 3)) (test (let ((x 3)) (define* (f (x x)) x) (let ((x 32)) (f))) 3) (test (let ((x 3)) (define-macro* (f (x x)) `,x) (let ((x 32)) (f))) 32) (test (let () (define (x x) x) (x 1)) 1) (test (procedure? (let () (define* (x (x #t)) x) (x x))) #t) (test (procedure? (let () (define* (x (x x)) x) (x (x x)))) #t) ;(test (procedure? (let () (define* (x (x x)) x) (x))) #t) (test (apply + ((lambda* ((x (values 1 2 3))) x))) 'error) ; else mv plugged into every 'x in the body?? (test (let () (define* (f (x (values 1 2))) (+ x 1)) (f)) 'error) (test ((lambda* ((x (lambda* ((y (+ 1 2))) y))) (x))) 3) ;;; define-macro ;;; define-macro* ;;; define-bacro ;;; define-bacro* ;;; macro ;;; macro* ;;; bacro ;;; bacro* (test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ 1 ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((1 0) 0)) (test (let ((x 0)) (define-bacro* (hi (a (let () (set! x (+ x 1)) x))) `(+ 1 ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((1 0) 0)) (test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ x ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((-1 0) 0)) (test (let ((x 0)) (define-bacro* (hi (a (let () (set! x (+ x 1)) x))) `(+ x ,a)) (list (let ((x -1)) (list (hi) x)) x)) '((-1 0) 0)) (test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(let ((x -1)) (+ x ,a))) (list (hi) x)) '(-1 0)) (test (let ((x 0)) (let ((x -1)) (+ x (let () (set! x (+ x 1)) x)))) -1) (test (let ((x 0)) (define-macro (hi a) `(let ((x -1)) (+ x ,a))) (list (hi (let () (set! x (+ x 1)) x)) x)) '(-1 0)) (test (let () (define-macro (hi a) `(let ((b 1)) (+ ,a b))) (hi (+ 1 b))) 3) (test (let ((b 321)) (define-macro (hi a) `(let ((b 1)) (+ ,a b))) (hi b)) 2) (test (let ((b 321)) (define-macro* (hi (a b)) `(let ((b 1)) (+ ,a b))) (hi b)) 2) (test (let ((b 321)) (define-macro* (hi (a b)) `(let ((b 1)) (+ ,a b))) (hi)) 2) ; ??? (test (let ((x 0)) (define-macro* (hi (a (let () (set! x (+ x 1)) x))) `(+ ,a ,a)) (hi)) 3) ; ??? -- default val is substituted directly ;; but (let () (define-macro* (hi a (b a)) `(+ ,a ,b)) (hi 1)) -> "a: unbound variable" -- "a" itself is substituted, but does not exist at expansion(?) ;; can we implement bacros via define-macro* default args? ;; I don't think so -- macro arguments can't be evaluated in that environment because ;; only the default values have been set (on the previous parameters). ;; bacro ignores closure in expansion but macro does not: (test (let ((x 1)) (define-macro (ho a) `(+ ,x ,a)) (let ((x 32)) (ho 3))) 4) (test (let ((x 1)) (define-macro (ho a) `(+ x ,a)) (let ((x 32)) (ho 3))) 35) (test (let ((x 1)) (define-bacro (ho a) `(+ ,x ,a)) (let ((x 32)) (ho 3))) 35) (test (let ((x 1)) (define-bacro (ho a) `(+ x ,a)) (let ((x 32)) (ho 3))) 35) (test (let ((x 1)) (define-macro* (ho (a x)) `(+ ,x ,a)) (let ((x 32)) (ho))) 33) (test (let ((x 1)) (define-macro* (ho (a x)) `(+ x ,a)) (let ((x 32)) (ho))) 64) (test (let ((x 1)) (define-bacro* (ho (a x)) `(+ x ,a)) (let ((x 32)) (ho))) 64) (test (let ((x 1)) (define-bacro* (ho (a x)) `(+ ,x ,a)) (let ((x 32)) (ho))) 64) (test (let ((x 1)) (define-macro* (ho (a (+ x 0))) `(+ ,x ,a)) (let ((x 32)) (ho))) 33) ;; (+ 32 (+ x 0)) !?! macroexpand is confusing? (test (let ((x 1)) (define-macro* (ho (a (+ x 0))) `(+ x ,a)) (let ((x 32)) (ho))) 64) ;; (+ x (+ x 0)) (test (let ((x 1)) (define-bacro* (ho (a (+ x 0))) `(+ x ,a)) (let ((x 32)) (ho))) 64 ) (test (let ((x 1)) (define-bacro* (ho (a (+ x 0))) `(+ ,x ,a)) (let ((x 32)) (ho))) 64 ) (test (let () (define-macro* (hi :rest a) `(list ,@a)) (hi)) ()) (test (let () (define-macro* (hi :rest a) `(list ,@a)) (hi 1)) '(1)) (test (let () (define-macro* (hi :rest a) `(list ,@a)) (hi 1 2 3)) '(1 2 3)) (test (let () (define-macro* (hi a :rest b) `(list ,a ,@b)) (hi 1 2 3)) '(1 2 3)) (test (let () (define-macro* (hi (a 1) :rest b) `(list ,a ,@b)) (hi)) '(1)) (test (let () (define-macro* (hi (a 1) :rest b) `(list ,a ,@b)) (hi 2)) '(2)) (test (let () (define-macro* (hi (a 1) :rest b) `(list ,a ,@b)) (hi :a 2)) '(2)) (test (let () (define-macro* (hi (a 1) :rest b :allow-other-keys) `(list ,a ,@b)) (hi :a 2 :b 3)) 'error) (test (let () (define-macro* (mac1 a :rest b) `(,a ,@b)) (mac1 + 2 3 4)) 9) ; (test (let () (define-macro ,@a 23)) 'error) ; (test (let () (define-macro ,a 23)) 'error) ; maybe this isn't right (let () (define-bacro* (_bac*_ (x 1)) `(+ ,x 1)) (define (f1) (display (_bac*_ #))) (test (f1) 'error)) ; not segfault... (let () (define-macro (dw-fs x) `(values (lambda () #f) (lambda () ,x) (lambda () #f))) (test (dynamic-wind (dw-fs 3)) 3)) (let () (define-macro (flam . args) `(apply format #f "~{~A~^ ~}" '(,args))) (test (flam this is a test) "this is a test")) (test ((lambda* ((a 1) :allow-other-keys) a) :b 1 :a 3) 3) (test (let () (define-macro* (hi (a 1) :allow-other-keys) `(list ,a)) (hi :b 2 :a 3)) '(3)) (test ((lambda* ((a 1) :rest b :allow-other-keys) b) :c 1 :a 3) ()) (test ((lambda* ((a 1) :rest b :allow-other-keys) b) :b 1 :a 3) 'error) ;; that is the rest arg is not settable via a keyword and it's an error to try to ;; do so, even if :allow-other-keys -- ?? (test (let ((mac (macro (a) `(+ ,a `1)))) (macroexpand (mac . 3))) 'error) (test (for-each macroexpand (hash-table (macro (a) `(+ ,a 1)) #i(1 2))) 'error) (test (let ((x 1)) (define* (hi (a x)) a) (let ((x 32)) (hi))) 1) (test (let ((x 1)) (define* (hi (a (+ x 0))) a) (let ((x 32)) (hi))) 1) (test (let ((x 1)) (define* (hi (a (+ x "hi"))) a) (let ((x 32)) (hi))) 'error) (test (let ((x 1)) (define-macro* (ho (a (+ x "hi"))) `(+ x ,a)) (let ((x 32)) (ho))) 'error) (test (let ((x 1)) (define-macro (f1) `(+ x 1)) (f1)) 2) (test (let ((x 1)) (define-macro (add-1 y) `(+ ,y 1)) (add-1 (add-1 (add-1 x)))) 4) (unless (provided? 'tcc) (let () ; wikipedia example of function composition using macros (define-macro (sqrt-1 x) `(sqrt ,x)) (define-macro (negate-1 x) `(- ,x)) (define-macro (square-1 x) `(* ,x ,x)) (let ((val1 (sqrt-1 (negate-1 (square-1 5))))) (define (compose . fs) (if (null? fs) (lambda (x) x) (lambda (x) ((car fs) ((apply compose (cdr fs)) x))))) (test ((compose sqrt-1 negate-1 square-1) 5) val1) (define-macro (compose-1 . fs) `(if (null? ',fs) (lambda (x) x) (lambda (x) ((symbol->value (car ',fs)) ((apply compose-1 (cdr ',fs)) x))))) (test ((compose-1 sqrt-1 negate-1 square-1) 5) val1)) (test ((symbol->value 'negate-1) -4) 4))) (let () (define-macro (until test . body) `(do () (,test) ,@body)) (test (let ((i 0) (sum 0)) (until (= i 4) (set! sum (+ sum i)) (set! i (+ i 1))) sum) 6)) (let () (define-macro (glambda args) ; returns an anonymous macro that will return a function given a body `(define-macro (,(gensym) . body) `(lambda ,',args ,@body))) (test (let ((gf (glambda (a b)))) ; gf is now ready for any body that involves arguments 'a and 'b ((gf (+ a b)) 1 2)) ; apply (lambda (a b) (+ a b)) to '(1 2) 3)) (let () (define-macro (alambda pars . body) `(letrec ((self (lambda* ,pars ,@body))) self)) (test ((alambda (n) (if (<= n 0) () (cons n (self (- n 1))))) 9) '(9 8 7 6 5 4 3 2 1)) (define-macro* (aif test then (else #)) `(let ((it ,test)) (if it ,then ,else))) (test (aif (+ 3 2) it) 5) (test (aif (> 2 3) it) #) (test (aif (> 2 3) #f it) #f) ) (let () (define-macro (enum . args) `(for-each (let ((ctr -1)) (define-macro (m a) (set! ctr (+ ctr 1)) `(apply define ',a ,ctr ()))) ',args)) (enum a b c) (test b 1) (test (+ a b c) 3)) (let () (define-macro (m0 . args) `(apply + ',args)) (apply define-macro '(m1 . args) '(`(+ ,@args))) (test (procedure-source m0) '(macro args (#_list-values 'apply '+ (#_list-values #_quote args)))) (test (procedure-source m1) '(macro args (#_list-values (#_quote +) (#_apply-values args)))) (test (m0 1 2 3) 6) (test (m1 1 2 3) 6)) (let () (define-bacro* (m (a b)) a) (test (let ((b 2)) (m)) 2) (test (let ((b 2)) (let ((b 23)) (m))) 23)) (let () (define-macro* (mac1 (x (+ y 1))) `(+ ,x 2)) (let ((y 12)) (test (mac1) 15)) (define-macro* (mac2 (x (+ y 1))) `(let ((y 5)) (+ ,x 2))) (let ((y 12)) (test (mac2) 8))) (let () (let ((x 1) (y 2)) (define-bacro (bac1 a) `(+ ,x y ,a)) (let ((x 32) (y 64)) (test (bac1 3) 99))) (let ((x 1) (y 2)) (define-bacro (bac2 a) (with-let (sublet (funclet bac2) (cons 'a a)) `(+ ,x y ,a))) (let ((x 32) (y 64)) (test (bac2 3) 68))) (let ((x 1) (y 2)) (define-bacro (bac3 a) (with-let (sublet (funclet bac3) (cons 'a a)) (eval `(+ ,x y ,a)))) (let ((x 32) (y 64)) (test (bac3 3) 6))) (let ((x 1) (y 2)) (define-bacro (bac4 a) (eval `(+ ,x y ,a) (sublet (funclet bac4) (cons 'a a)))) (let ((x 32) (y 64)) (test (bac4 3) 37))) (let ((x 1) (y 2)) (define-bacro (bac1 a) `(+ ,x y ,a)) ; -> (+ 32 y x) (let ((x 32) (y 64)) (test (bac1 x) 128))) ; x=32 (let ((x 1) (y 2)) (define-bacro (bac2 a) (with-let (sublet (funclet bac2) (cons 'a a)) `(+ ,x y ,a))) ; (+ 1 y x) (let ((x 32) (y 64)) (test (bac2 x) 97))) ; x=32 (let ((x 1) (y 2)) (define-bacro (bac3 a) (with-let (sublet (funclet bac3) (cons 'a a)) (eval `(+ ,x y ,a)))) ; (eval (+ 1 2 1)) -> 4 (let ((x 32) (y 64)) (test (bac3 x) 4))) ; x=1 (let ((x 1) (y 2)) (define-bacro (bac4 a) (eval `(+ ,x y ,a) (sublet (funclet bac4) (cons 'a a)))) ; (eval (+ 32 2 1)) -> 35 (let ((x 32) (y 64)) (test (bac4 x) 35))) ; x=1 (let ((x 1) (y 2)) (define-bacro (bac3 a) (let ((e (with-let (sublet (funclet bac3) (cons 'a a)) `(+ ,x y ,a)))) `(with-let ,(sublet (funclet bac3) (cons 'a a)) ,e))) (let ((x 32) (y 64)) (test (bac3 3) 6))) (let ((x 1) (y 2)) (define-bacro (bac4 a) (let ((e `(+ ,x y ,a))) `(with-let ,(sublet (funclet bac4) (cons 'a a)) ,e))) (let ((x 32) (y 64)) (test (bac4 3) 37))) (let () (define (f4) (call-bac 1)) (define call-bac (let ((x 2)) (define-bacro (m a) `(+ ,a ,x)))) (test (f4) 'error))) (let () (define (f1 a b) (list (holler) (+ a b))) (define-bacro (holler) `(format #f "(~S~{ ~S ~S~^~})" (let ((f (*function*))) (if (pair? f) (car f) f)) (map (lambda (slot) (values (symbol->keyword (car slot)) (cdr slot))) (map values ,(outlet (curlet)))))) (test (f1 2 3) '("(f1 :a 2 :b 3)" 5)) (define (f2 a b) (list (holler1 a) (+ a b))) (define-bacro (holler1 x) `(format #f "(~S~{ ~S ~S~^~})" (let ((f (*function*))) (if (pair? f) (car f) f)) (map (lambda (slot) (values (symbol->keyword (car slot)) (cdr slot))) (map values ,(outlet (curlet)))))) (test (let ((two 2)) (f2 two 3)) '("(f2 :a 2 :b 3)" 5)) (define (f3 a b) (list (holler2 a b) (+ a b))) (define-bacro (holler2 x y) `(format #f "(~S~{ ~S ~S~^~})" (let ((f (*function*))) (if (pair? f) (car f) f)) (map (lambda (slot) (values (symbol->keyword (car slot)) (cdr slot))) (map values ,(outlet (curlet)))))) (test (let ((two 2) (three 3)) (f3 two three)) '("(f3 :a 2 :b 3)" 5))) (let () ; need this, else the define-macro below leaks into rootlet (let ((e (inlet 'mac (apply define-macro (list (list (gensym) 'a) '`(+ ,a 1)))))) (test ((e 'mac) 3) 4))) (let () (define mac ; macro with closure (let () (define (mac-1 x) (+ x 1)) (macro (y) `(+ ,y (((funclet mac) 'mac-1) ,y))))) ; funclet to get at mac closure (test (mac 2) 5)) (let ((x 0)) (define-macro (mac a) `(+ ,a 1)) (define (call-m m args) (apply m args)) (let ((x 123)) (test (call-m mac '((* x 2))) 1) (test (apply mac '((* x 2))) 247) (test (call-m mac `((* ,x 2))) 247) ;; qq sees inner x (test (apply mac `((* ,x 2))) 247))) (test (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (unless #t (/ (_mac_ 1 -1)))))) "") ; optimizer s7_macroexpand error (let () (define mac1 (dilambda (macro (a) `(+ ,a 1)) (lambda (a b) b))) (test (mac1 2) 3) (test (set! (mac1 2) 32) 32) (define mac2 (dilambda (macro* (a (b 12)) `(+ ,a ,b)) (lambda* (a b c) (or c b)))) (test (mac2 2) 14) (test (mac2 2 3) 5) (test (set! (mac2 2) 32) 32) (test (set! (mac2 2 3) 32) 32) (let ((mac3 #f)) (define-macro (mac3 a) `(+ ,a 1)) (set! (setter mac3) (lambda (s v) v)) (test (set! (mac3 3) 32) 32))) (let () ; bacro = macro without one layer of quasiquote: (define-macro (1+) `(+ x 1)) (define-bacro (1++) (+ x 1)) ; but returned value is evaluated (define (call1) (let ((x 3)) (1+))) (define (call2) (let ((x 3)) (1++))) (test (call1) (call2))) (let () (define-macro (swap a b) `(with-let (inlet :e (curlet) :tmp ,a) (set! (e ',a) (e ',b)) (set! (e ',b) tmp))) (let ((a 1) (b 2)) (swap b a) (test (list a b) '(2 1))) (let ((tmp 1) (b 2)) (swap b tmp) (test (list tmp b) '(2 1))) (let ((a 1) (tmp 2)) (swap a tmp) (test (list a tmp) '(2 1))) (let ((tmp 1) (b 2)) (swap tmp b) (test (list tmp b) '(2 1))) (let ((a 1) (tmp 2)) (swap tmp a) (test (list a tmp) '(2 1)))) (let () ; a macro with a closure (define mac (let ((counter 0)) (define-macro (mac x) (set! counter (+ counter 1)) `(+ ,x ,counter)))) (test (mac 1) 2) (test (mac 1) 3) (test (format #f "~S" mac) "mac") (test (macro? mac) #t) (test (mac (mac 1)) 8) (let ((counter 32)) (test (macroexpand (mac counter)) '(+ counter 5)) (test (mac counter) 38))) (let () (define-macro (swap a b) `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a) (with-let e (set! ,a ,b)) tmp))) (test (let ((v (vector 1 2))) (swap (v 0) (v 1)) v) #(2 1)) (test (let ((tmp (cons 1 2))) (swap (car tmp) (cdr tmp)) tmp) '(2 . 1)) (define-macro (set-swap a b c) `(set! ,b ,c)) (set! (setter swap) set-swap) (test (let ((a 1) (b 2) (c 3) (d 4)) (swap a (swap b (swap c d))) (list a b c d)) '(2 3 4 1)) (define-macro (rotate . args) `(set! ,(args (- (length args) 1)) (with-let (inlet 'e (curlet) 'tmp ,(car args)) (with-let e ,@(map (lambda (a b) `(set! ,a ,b)) args (cdr args))) tmp))) (test (let ((a 1) (b 2) (c 3)) (rotate a b c) (list a b c)) '(2 3 1)) (define-macro (mac a) `(+ ,a 1)) (define-macro* (mac1 (a 32)) `(+ ,a 1)) (define-macro (fm form) (define (expand form) (if (pair? form) (if (and (symbol? (car form)) (macro? (symbol->value (car form)))) (expand (apply macroexpand (list form))) (if (and (eq? (car form) 'set!) (pair? (cdr form)) (pair? (cadr form)) (macro? (symbol->value (caadr form)))) (expand (apply macroexpand (list (cons (setter (symbol->value (caadr form))) (append (cdadr form) (copy (cddr form))))))) (cons (expand (car form)) (expand (cdr form))))) form)) (list 'quote (expand form))) (test (fm (mac 2)) '(+ 2 1)) (test (fm (mac x)) '(+ x 1)) (test (fm (mac1 2)) '(+ 2 1)) (test (fm (mac1)) '(+ 32 1)) (test (fm (mac (mac1))) '(+ (+ 32 1) 1)) (test (fm (+ (mac x) (mac1 y))) '(+ (+ x 1) (+ y 1))) (test (fm (swap a b)) '(set! b (with-let (inlet 'e (curlet) 'tmp a) (with-let e (set! a b)) tmp))) (test (fm (swap a (swap b c))) '(set! c (with-let (inlet 'e (curlet) 'tmp a) (with-let e (set! a (set! c (with-let (inlet 'e (curlet) 'tmp b) (with-let e (set! b c)) tmp)))) tmp))) (test (fm (rotate a b c)) '(set! c (with-let (inlet 'e (curlet) 'tmp a) (with-let e (set! a b) (set! b c)) tmp))) ) #| ;;; would this work in MIT-scheme? (define-macro (swap a b) `(set! ,b (eval `(let ((e ,(the-environment))) (eval `(set! ,',',a ,',',b) e) tmp) (let ((e (the-environment)) (tmp ,a)) (the-environment))))) |# (test ((macro (x) `(+ ,x 1)) 1) 2) (test (macro? (macro (x) `(+ ,x 1))) #t) (test ((macro (x) `(+ ,x 1)) (* 3 2)) 7) (test (object->string (procedure-source (macro (x) `(+ ,x 1)))) "(macro (x) (list-values '+ x 1))") (test ((macro* (x) `(+ ,x 1)) 1) 2) (test (macro? (macro* (x) `(+ ,x 1))) #t) (test ((macro* (x) `(+ ,x 1)) (* 3 2)) 7) (test (object->string (procedure-source (macro* (x) `(+ ,x 1)))) "(macro* (x) (list-values '+ x 1))") (test ((bacro (x) `(+ ,x 1)) 1) 2) (test (macro? (bacro (x) `(+ ,x 1))) #t) (test ((bacro (x) `(+ ,x 1)) (* 3 2)) 7) (test (object->string (procedure-source (bacro (x) `(+ ,x 1)))) "(bacro (x) (list-values '+ x 1))") (test ((bacro* (x) `(+ ,x 1)) 1) 2) (test (macro? (bacro* (x) `(+ ,x 1))) #t) (test ((bacro* (x) `(+ ,x 1)) (* 3 2)) 7) (test (object->string (procedure-source (bacro* (x) `(+ ,x 1)))) "(bacro* (x) (list-values '+ x 1))") (test (let ((y 10)) (+ 1 ((macro (x) `(+ ,x ,y)) (* 2 3)))) 17) (test (let ((y 10)) (+ 1 ((macro* (x) `(+ ,x ,y)) :x (* 2 3)))) 17) (test (let ((y 10)) (+ 1 ((bacro (x) `(+ ,x ,y)) (* 2 3)))) 17) (test (let ((y 10)) (+ 1 ((bacro* (x) `(+ ,x ,y)) :x (* 2 3)))) 17) (test ((macro () `(+ 1 2))) 3) (let ((dwm (let ((y 10)) (dilambda (macro () `(+ 1 ,y)) (macro (x) `(+ 1 ,x ,y)))))) (test (dwm) 11) (test (set! (dwm) 4) 15)) (test ((macro x `(list ,@x)) 1 2 3) '(1 2 3)) (test (object->string (macro (x y) `(+ ,x ,y))) "#") (test (object->string (macro* (x y) `(+ ,x ,y))) "#") (test (object->string (bacro (x y) `(+ ,x ,y))) "#") (test (object->string (bacro* (x y) `(+ ,x ,y))) "#") (let ((x (macro (x) `(+ ,x 1)))) (let ((y x)) (test (eq? x y) #t))) (let ((f (lambda (m x) (+ x (m x))))) (test (f (macro (y) `(* ,y 2)) 3) 9)) (test (apply (macro (x) `(+ ,x 1)) '(2)) 3) (let () (define-macro (msym1 . a) `(copy ,a)) (define-macro (msym2 a . b) `(cons ,a (copy ,b))) ; these are confusing! (define-macro* (msym4 :rest a) `(copy ,a)) (define-macro* (msym5 a :rest b) `(cons ,a (copy ,b))) (define (fop4 x y) (apply x y)) ; appl_ss (test (let () (define (func) (for-each values (list (msym1 (lambda (a b . c) (reverse! c)) (make-vector 3) (make-weak-hash-table))))) (func) (func)) #) (test (let () (define (func) (let ((x #f) (i 0)) (msym5 3 (lambda (a . b) (cons a b)) (symbol? x)))) (func) (func)) '(3 #f)) ;; (3 #f) from (cons 3 (copy ((lambda (a . b) (cons a b)) (symbol? x)))) -> (3 #f)! (test (let () (define (func) (msym5 1 (lambda (a . b) (cons a b)) 3 4 5)) (func) (func)) '(1 3 4 5)) (test (let () (block-set! (fop4 #_and (let ((L (list 1 2))) (set-cdr! (cdr L) L) L)))) 'error) (let () (define (func) (with-output-to-string (lambda () (msym1 (write #_and))))) (test (func) "#_and") (test (func) "#_and")) (test (msym1) ()) (test (msym1 +) 0) (test (msym1 + 2) 2) (test (msym1 + . 2) 'error) (let ((L (list 1 2))) (set-cdr! (cdr L) L) (test (msym1 L) 'error)) (test (msym4) ()) (test (msym4 +) 0) (test (msym4 + 2) 2) (test (msym4 + . 2) 'error) (test (msym2) 'error) (test (msym2 1) '(1)) (test (msym2 1 +) '(1 . 0)) (test (msym2 1 + 2) '(1 . 2)) (test (msym2 1 + . 2) 'error) (test (msym5) '(#f)) (test (msym5 1) '(1)) (test (msym5 1 +) '(1 . 0)) (test (msym5 1 + 2) '(1 . 2)) (test (msym5 1 + . 2) 'error)) (test (bacro) 'error) (test (bacro . 1) 'error) (test (bacro 1) 'error) (test (bacro ()) 'error) (test (bacro (a)) 'error) (test (bacro (a) . 1) 'error) (test (macro (a 1) 2) 'error) (test (macro* (a :b) 3) 'error) (test (macro (a :rest b) b) 'error) (test (let () (define-macro* (m1 a :rest b :rest c) `(list ,a ,@b ,@c)) (m1 1 2 3 4 5)) '(1 2 3 4 5 3 4 5)) (test (arity (macro (a) `(+ ,a 1))) '(1 . 1)) (test (signature (macro (a) `(+ ,a 1))) #f) (test (procedure? (macro (a) `(+ ,a 1))) #f) (test (macro? (copy (macro (a) `(+ ,a 1)))) #t) (test (catch #t (lambda () (macro)) (lambda (t i) (apply format #f i))) "macro: (macro) has no parameters or body?") (test (catch #t (lambda () (macro . 1)) (lambda (t i) (apply format #f i))) "macro: (macro . 1) has no parameters or body?") (test (catch #t (lambda () (macro (a))) (lambda (t i) (apply format #f i))) "macro: (macro (a)) has no body?") (test (catch #t (lambda () (macro (1) 1)) (lambda (t i) (apply format #f i))) "macro parameter name, 1, is not a symbol") (test (catch #t (lambda () (macro #(0) 1)) (lambda (t i) (apply format #f i))) "macro parameter list is #(0)?") (test (catch #t (lambda () (macro (a) 1 . 2)) (lambda (t i) (apply format #f i))) "macro: macro body messed up, (macro (a) 1 . 2)") (let () (define (g) ((macro (abs) (abs -1)) sin)) (test (g) 'error)) ; sin is a symbol (not evaluated) (let () (define (g) ((macro (abs) ((symbol->value abs) -1)) sin)) (if with-bignums (num-test (g) -8.414709848078965066525023216302989996239E-1) (num-test (g) -0.8414709848078965))) (let () (define-macro (m abs) ((symbol->value abs) -1)) (define (h) (m sin)) (if with-bignums (num-test (h) -8.414709848078965066525023216302989996239E-1) (num-test (h) -0.8414709848078965))) (test (with-output-to-string ((macro (a) `(lambda () (display 3))) 1)) "3") (test (let () (define (ceval x) (eval x)) (let ((i 0)) (ceval (list (define-bacro (_ . args) (null? i)))))) 'error) (test (let () (define (ceval x) (eval x)) (let ((i 0)) (ceval (list (bacro* args (null? i)))))) 'error) (let () ; from lisp bboard (define-macro (circularize . forms) `(begin ,@(let loop ((p forms)) (if (pair? (cdr p)) (loop (cdr p)) (set-cdr! p forms))))) (test (circularize (+ 1 2) (- 3 4)) 'error)) (let () ;; how to protect a recursive macro call from being stepped on ;; (define-macro (mac a b) `(if (> ,b 0) (let ((,a (- ,b 1))) (mac ,a (- ,b 1))) ,b)) ;; (mac mac 1) ;; attempt to apply the integer 0 to (0 1)? ;; (mac mac 1) (define-macro (mac a b) (let ((gmac (gensym))) (set! gmac mac) `(if (> ,b 0) (let ((,a (- ,b 1))) (,gmac ,a (- ,b 1))) ,b))) (test (mac mac 10) 0)) (let () (define-bacro* (incf var (inc 1)) `(set! ,var (+ ,var ,inc))) (define-bacro* (decf var (inc 1)) `(set! ,var (- ,var ,inc))) (test (let ((x 0)) (incf x)) 1) (test (let ((x 1.5)) (incf x 2.5) x) 4.0) (test (let ((x 10)) (decf x (decf x 1)) x) 1) ;; ! -- left to right order I think (let ((x 10)) (set! x (- x (set! x (- x 1))))) so the 3rd x is 10 ;; Clisp and sbcl return 0: (let ((x 10)) (decf x (decf x (decf x))) x) is also 0 ;; but in clisp (let ((x 10)) (setf x (- x (setf x (- x 1)))) x) is 1 ;; I didn't know these cases were different ;; (let ((x 10)) (set! x (- x (let () (set! x (- x 1)) x))) x) 1, Guile also says 1 ;; cltl2 p 134ff is an unreadable discussion of this, but I think it says in this case CL goes right to left ;; weird! in CL (decf x (decf x)) != (setf x (- x (setf x (- x 1)))) ;; and (let ((x 10)) (let ((val (decf x))) (decf x val) x))? (test (let ((x 1+i)) (decf x 0+i)) 1.0)) (let () ;; (define-bacro* (incf var (inc 1)) (set! var (+ (eval var) (eval inc)))) ;; this form does not actually set the incoming variable (it sets the argument) ;; at OP_SET we see set (var (+ (eval var) (eval inc))) ;; set1 var 1 ;; which leaves x unset ;; but below we see set (x 1) ;; set1 x 1 (define-bacro* (incf var (inc 1)) (apply set! var (+ (eval var) (eval inc)) ())) (define-bacro* (decf var (inc 1)) (apply set! var (- (eval var) (eval inc)) ())) (test (let ((x 0)) (incf x)) 1) (test (let ((x 1.5)) (incf x 2.5) x) 4.0) (test (let ((x 10)) (decf x (decf x 1)) x) 1) (test (let ((x 1+i)) (decf x 0+i)) 1.0)) (let () (define-macro (and-call function . args) ;; apply function to each arg, stopping if returned value is #f `(and ,@(map (lambda (arg) `(,function ,arg)) args))) (let ((lst ())) (and-call (lambda (a) (and a (set! lst (cons a lst)))) (+ 1 2) #\a #f (format #t "oops!~%")) (test lst (list #\a 3)))) (let () (define-macro (add a . b) `(if (null? ',b) ,a (+ ,a (add ,@b)))) (test (add 1 2 3) 6) (test (add 1 (add 2 3) 4) 10)) (let () (define mac (let ((var (gensym))) (define-macro (mac-inner b) `(#_let ((,var 12)) (#_+ ,var ,b))) mac-inner)) (test (mac 1) 13) (test (let ((a 1)) (mac a)) 13)) (test (eq? call/cc #_call/cc) #t) (let ((val #f)) (define-macro (add-1 var) `(+ 1 (let () (set! val ',var) ,var))) (define (add-2 var) (set! val var) (+ 1 var)) (let ((free #t)) (let ((res ((if free add-1 add-2) (+ 1 2 3)))) (if (or (not (equal? val '(+ 1 2 3))) (not (= res 7))) (format #t ";mac/proc[#t]: ~A ~A~%" val res))) (set! free #f) (let ((res ((if free add-1 add-2) (+ 1 2 3)))) (if (or (not (equal? val '6)) (not (= res 7))) (format #t ";mac/proc[#f]: ~A ~A~%" val res))))) ;; define-macro* default arg expr does not see definition-time closure: (test (let ((mac #f)) (let ((a 32)) (define-macro* (hi (b (+ a 1))) `(+ ,b 2)) (set! mac hi)) (mac)) 'error) ; ";a: unbound variable, line 4" (test ((lambda* ((x (let () (define-macro (hi a) `(+ ,a 1)) (hi 2)))) (+ x 1))) 4) (test (let () (define-macro* (hi (x (let () (define-macro (hi a) `(+ ,a 1)) (hi 2)))) `(+ ,x 1)) (hi)) 4) (test (let () (define* (hi b) b) (procedure? hi)) #t) (test (let () (define (hi a) a) (let ((tag (catch #t (lambda () (hi 1 2 3)) (lambda args (car args))))) (eq? tag 'wrong-number-of-args))) #t) (test (let () (define (hi a) a) (let ((tag (catch #t (lambda () (hi)) (lambda args (car args))))) (eq? tag 'wrong-number-of-args))) #t) (test (let () (define* (hi a) a) (let ((tag (catch #t (lambda () (hi 1 2 3)) (lambda args (car args))))) (eq? tag 'wrong-number-of-args))) #t) (let () ;; shouldn't this be let-if or let-if-and, not if-let? ;; and why not add short-circuiting to it (at the variable bindings point)? ;; not pretty, but we could do this via and-call + sublet ;; maybe use and-let* instead (define-macro* (if-let bindings true false) (let* ((binding-list (if (and (pair? bindings) (symbol? (car bindings))) (list bindings) bindings)) (variables (map car binding-list))) `(let ,binding-list (if (and ,@variables) ,true ,false)))) (test (if-let ((a 1) (b 2)) (list a b) "oops") '(1 2))) (let () (define-macro (old-and-let* vars . body) ; from guile/1.8/ice-9/and-let-star.scm (define (expand vars body) (cond ((null? vars) (if (null? body) #t `(begin ,@body))) ((pair? vars) (let ((exp (car vars))) (cond ((pair? exp) (cond ((null? (cdr exp)) `(and ,(car exp) ,(expand (cdr vars) body))) (else (let ((var (car exp))) `(let (,exp) (and ,var ,(expand (cdr vars) body))))))) (else `(and ,exp ,(expand (cdr vars) body)))))) (else (error 'wrong-type-arg "not a proper list" vars)))) (expand vars body)) (test (old-and-let* ((hi 3) (ho #f)) (+ hi 1)) #f)) (let () (define-macro (and-let* vars . body) ; bind vars, if any is #f stop, else evaluate body with those bindings `(let () (and ,@(map (lambda (v) `(define ,@v)) vars) (begin ,@body)))) (test (and-let* ((hi 3) (ho #f)) (+ hi 1)) #f) (test (and-let* ((hi 3) (ho #t)) (+ hi 1)) 4)) (let () ; from the pro CL mailing list (define-macro (do-leaves var tree . body) `(let () (define (rec ,var) (if (not (null? ,var)) (if (pair? ,var) (begin (rec (car ,var)) (rec (cdr ,var))) (begin ,@body)))) (rec ,tree))) (test (let ((lst ())) (do-leaves hiho '(+ 1 (* 2 3)) (set! lst (cons hiho lst))) (reverse lst)) '(+ 1 * 2 3))) (test (let () (define (hi :a) :a) (hi 1)) 'error) (test (let () (define* (hi :a) :a) (hi 1)) 'error) (test (let () (define* (hi (:a 2)) a) (hi 1)) 'error) (test (let () (define* (hi (a 1) (:a 2)) a) (hi 1)) 'error) (test (let () (define* (hi (pi 1)) pi) (hi 2)) 'error) (test (let () (define* (hi (:b 1) (:a 2)) a) (hi)) 'error) (test (let () (define* (hi (a 1) (a 2)) a) (hi 2)) 'error) (test (let () (define (hi a a) a) (hi 1 2)) 'error) (test (let () (define hi (lambda (a a) a)) (hi 1 1)) 'error) (test (let () (define hi (lambda* ((a 1) (a 2)) a)) (hi 1 2)) 'error) (test (let () (define (hi (a 1)) a) (hi 1)) 'error) (let () (define* (hi (a #2d((1 2) (3 4)))) (a 1 0)) (test (hi) 3) (test (hi #2d((7 8) (9 10))) 9)) (let () (define* (f :rest a) a) (test (f :a 1) 'error)) (let () (define* (f :rest a :rest b) (list a b)) (test (f :a 1 :b 2) 'error)) (test (lambda :hi 1) 'error) (test (lambda (:hi) 1) 'error) (test (lambda (:hi . :hi) 1) 'error) (test (lambda (i . i) 1 . 2) 'error) (test (lambda (i i i i) (i)) 'error) (test (lambda "hi" 1) 'error) (test (lambda* ((i 1) i i) i) 'error) (test (lambda* ((a 1 2)) a) 'error) (test (lambda* ((a . 1)) a) 'error) (test (lambda* ((0.0 1)) 0.0) 'error) (test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 32) '(32 1 ())) (test ((lambda* ((b 3) :rest x (c 1)) (list b c x)) 1 2 3 4 5) '(1 3 (2 3 4 5))) ;; these are in s7.html (test ((lambda* ((a 1) :rest b :rest c) (list a b c)) 1 2 3 4 5) '(1 (2 3 4 5) (3 4 5))) (test (let () (define-macro (hi a a) `(+ ,a 1)) (hi 1 2)) 'error) (test (let ((c 1)) (define* (a (b c)) b) (set! c 2) (a)) 2) (test (let ((c 1)) (define* (a (b c)) b) (let ((c 32)) (a))) 1) (test (let ((c 1)) (define* (a (b (+ c 1))) b) (set! c 2) (a)) 3) (test (let ((c 1)) (define* (a (b (+ c 1))) b) (set! c 2) (let ((c 123)) (a))) 3) (test (let* ((cc 1) (c (lambda () (set! cc (+ cc 1)) cc))) (define* (a (b (c))) b) (list cc (a) cc)) (list 1 2 2)) (let () (define* (func (val ((lambda (a) (+ a 1)) 2))) val) (test (func) 3) (test (func 1) 1)) (let () (define-macro (mac-free-x y) `(set! x ,y)) (define (mac-y1) (let ((x .1)) (do ((i 0 (+ i 1)) (y 0.5 (+ y x))) ((= i 10) y) (if (= i 2) (mac-free-x 1.1))))) (define (mac-y0) (let ((x .1)) (do ((i 0 (+ i 1)) (y 0.5 (+ y x))) ((= i 10) y) (if (= i 2) (set! x 1.1))))) (define-macro (mac-free-v) `(v 1)) (define-macro (set-mac-free-v z) `(vector-set! v 1 ,z)) (set! (setter mac-free-v) set-mac-free-v) (define (mac-y2) (let ((v (vector 1.0 0.1 1.2))) (do ((i 0 (+ i 1)) (y 0.5 (+ y (vector-ref v 1)))) ((= i 10) y) (if (= i 2) (set! (mac-free-v) 1.1))))) (define (mac-y3) (let ((v (vector 1.0 0.1 1.2))) (do ((i 0 (+ i 1)) (y 0.5 (+ y (vector-ref v 1)))) ((= i 10) y) (if (= i 2) (vector-set! v 1 1.1))))) (let ((y0 (mac-y0)) (y1 (mac-y1)) (y2 (mac-y2)) (y3 (mac-y3))) (if (not (equivalent? y0 y1)) (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y0 y1)) (if (not (equivalent? y2 y3)) (format #t "~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y2 y2 y3))) (let ((y (+ (mac-y0) (mac-y1) (mac-y2) (mac-y3)))) (if (> (abs (- y (* 4 9.5))) 1e-9) (format #t "(2) ~A: ~A got ~S but expected ~S~%~%" (port-line-number) 'mac-y0 y (* 4 9.5))))) (let ((val 0)) (let () (define (f x) (+ x 1)) (let () (define-macro (m x) `(f ,x)) (let () (define (f x) (* x x)) (let () (set! val (m 2)))))) (test val 4)) (let ((val 0)) (let () (define (f x) (+ x 1)) (let () (define-macro (m x) (with-let (inlet 'f f 'x x) `(,f ,x))) (let () (define (f x) (* x x)) (let () (set! val (m 2)))))) (test val 3)) (define-macro (badmac tst) `(let loop ((x 1)) (if (> x 0) (loop (- x 1)) ,tst))) (badmac (vector 0)) (badmac (let ((x (lambda () 1))) (eq? x x))) (define-macro (badmac1 tst) `(let () (define (badf x) (if (> x 0) (badf (- x 1)) ,tst)) (badf 1))) (badmac1 (vector 0)) (badmac1 (let ((x (lambda () 1))) (eq? x x))) (let () (define-macro* (msym4 :rest a) `(copy ,a)) (test (let () (define (func) (with-output-to-string (lambda () (display (msym4 (write and)))))) (func) (func)) "#_and#t")) ; eval_args_no_eval_args bug (test (catch #t (lambda () (lambda :a 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (lambda :a ...)") (test (catch #t (lambda () (define (f . :a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (define (f . :a) ...)") (test (catch #t (lambda () (macro :a 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (macro :a ...)") (test (catch #t (lambda () (bacro :a 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (bacro :a ...)") (test (catch #t (lambda () (define-constant (f . :a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (define-constant (f . :a) ...)") (test (catch #t (lambda () (define-macro (f . :a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter is a constant: (define-macro (f . :a) ...)") (test (catch #t (lambda () (lambda* :a 1)) (lambda (type info) (apply format #f info))) "lambda* parameter is a constant: (lambda* :a ...)") (test (catch #t (lambda () (macro* :a 1)) (lambda (type info) (apply format #f info))) "lambda* parameter is a constant: (macro* :a ...)") (test (catch #t (lambda () (bacro* :a 1)) (lambda (type info) (apply format #f info))) "lambda* parameter is a constant: (bacro* :a ...)") (test (catch #t (lambda () (define-macro* (f . :a) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter is a constant: (define-macro* (f . :a) ...)") (test (catch #t (lambda () (lambda (a :rest c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter is :rest? (lambda (a :rest c) ...), perhaps use lambda*") (test (catch #t (lambda () (lambda (a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter :b is a constant: (lambda (a :b c) ...)") (test (catch #t (lambda () (define (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter :b is a constant: (define (f a :b c) ...)") (test (catch #t (lambda () (define-macro (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter :b is a constant: (define-macro (f a :b c) ...)") (test (catch #t (lambda () (macro (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda parameter :b is a constant: (macro (f a :b c) ...)") (test (catch #t (lambda () (lambda* (a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :b is a constant: (lambda* (a :b c) ...)") (test (catch #t (lambda () (define* (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :b is a constant: (define* (f a :b c) ...)") (test (catch #t (lambda () (define-macro* (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :b is a constant: (define-macro* (f a :b c) ...)") (test (catch #t (lambda () (macro* (f a :b c) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :b is a constant: (macro* (f a :b c) ...)") (test (catch #t (lambda () (lambda (a (b 2)) 1)) (lambda (type info) (apply format #f info))) "lambda parameter (b 2) is a pair (perhaps use lambda*?): (lambda (a (b 2)) ...)") (test (catch #t (lambda () (lambda (a . a) 1)) (lambda (type info) (apply format #f info))) "lambda :rest parameter a is used earlier in the parameter list") ;; old: "lambda parameter a is used twice in the parameter list, (lambda (a . a) ...)") (test (catch #t (lambda () (lambda (a b a) 1)) (lambda (type info) (apply format #f info))) "lambda parameter a is used twice in the parameter list, (lambda (a b a) ...)") (test (catch #t (lambda () (lambda (a . :b) 1)) (lambda (type info) (apply format #f info))) "lambda :rest parameter :b is a constant in (lambda (a . :b) ...)") (test (catch #t (lambda () (lambda* ((:a 1)) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter :a is a constant: (lambda* ((:a 1)) ...)") (test (catch #t (lambda () (lambda* ((a 1) a) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter a is used twice in the parameter list, (lambda* ((a 1) a) ...)") (test (catch #t (lambda () (lambda* ((a)) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter (a) default value missing in (lambda* ((a)) ...)") (test (catch #t (lambda () (lambda* ((a . 0.0)) a)) (lambda (type info) (apply format #f info))) "lambda* parameter (a . 0.0) is a dotted pair in (lambda* ((a . 0.0)) ...)") (test (catch #t (lambda () (lambda* ((a (quote . -1))) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter (a (quote . -1)) default value is not a proper list in (lambda* ((a (quote . -1))) ...)") (test (catch #t (lambda () (lambda* ((a 0.0 'hi)) a)) (lambda (type info) (apply format #f info))) "lambda* parameter (a 0.0 'hi) has multiple default values in (lambda* ((a 0.0 'hi)) ...)") (test (catch #t (lambda () (lambda* (:allow-other-keys x) 1)) (lambda (type info) (apply format #f info))) ":allow-other-keys should be the last parameter: (lambda* (:allow-other-keys x) ...)") (test (catch #t (lambda () (lambda* (:allow-other-keys) 1)) (lambda (type info) (apply format #f info))) ":allow-other-keys can't be the only parameter: (lambda* (:allow-other-keys) ...)") (test (catch #t (lambda () (lambda* (pi) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter pi is a constant: (lambda* (pi) ...)") (test (catch #t (lambda () (lambda (pi) 1)) (lambda (type info) (apply format #f info))) "lambda parameter pi is a constant: (lambda (pi) ...)") (test (catch #t (lambda () (lambda* (a a) 1)) (lambda (type info) (apply format #f info))) "lambda* parameter a is used twice in the parameter list, (lambda* (a a) ...)") (test (catch #t (lambda () (lambda* (a . a) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter a is used earlier in the parameter list") (test (catch #t (lambda () (lambda* (:rest) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter missing in (lambda* (:rest) ...)") (test (catch #t (lambda () (lambda* (:rest 1) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter is not a symbol: (:rest 1) in (lambda* (:rest 1) ...)") (test (catch #t (lambda () (lambda* (:rest '(1 2)) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter can't have a default value: (:rest '(1 2)) in (lambda* (:rest '(1 2)) ...)") (test (catch #t (lambda () (lambda* (a :rest pi) 1)) (lambda (type info) (apply format #f info))) "lambda*: pi is immutable, so it can't be the :rest parameter name: (lambda* (a :rest pi) ...)") (test (catch #t (lambda () (lambda* (a . 0.0) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter 0.0 is a constant, (lambda* (a . 0.0) ...)") (test (catch #t (lambda () (lambda* (a . :b) 1)) (lambda (type info) (apply format #f info))) "lambda* :rest parameter :b is a constant, (lambda* (a . :b) ...)") (test (catch #t (lambda () (define f (lambda (a a) 1))) (lambda (type info) (apply format #f info))) "lambda parameter a is used twice in the parameter list, (lambda (a a) ...)") (test (catch #t (lambda () (define f (lambda* (a a) 1))) (lambda (type info) (apply format #f info))) "lambda* parameter a is used twice in the parameter list, (lambda* (a a) ...)") ;;; -------------------------------------------------------------------------------- ;;; aritable? (for-each (lambda (arg) (if (aritable? arg 0) (format #t ";(aritable? ~A) -> #t?~%" arg))) (list :hi (integer->char 65) 1 #t 3.14 3/4 1.0+1.0i #\f # #)) (for-each (lambda (arg) (let ((val (catch #t (lambda () (aritable? abs arg)) (lambda args 'error)))) (if (not (eq? val 'error)) (format #t ";(aritable? abs ~A) -> ~A?~%" arg val)))) (list :hi (integer->char 65) -1 most-negative-fixnum macroexpand quasiquote (lambda () #f) car #() "hi" (list 1 2) 3.14 3/4 1.0+1.0i #\f # #)) (test (aritable?) 'error) (test (aritable? abs) 'error) (test (aritable? car 0) #f) (test (aritable? car 1) #t) (test (aritable? car 2) #f) (test (aritable? car 3) #f) (test (aritable? car most-negative-fixnum) 'error) (test (aritable? car most-positive-fixnum) #f) (test (aritable? + most-positive-fixnum) #t) (test (aritable? + 0) #t) (test (aritable? log 2) #t) (test (aritable? catch 2) #f) (test (aritable? set! 0) #f) (test (aritable? begin 0) #t) (test (aritable? (random-state 123) 0) #f) (test (aritable? hash-table 1) #f) (test (aritable? hash-table 4) #t) (test (aritable? weak-hash-table 0) #t) (test (aritable? weak-hash-table 2) #t) (test (aritable? weak-hash-table 1) #f) ; (weak-hash-table 'b) ;;; more tests under arity (test (let () (define-macro (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 2)) #f) (test (let () (define-macro (mac1 a b . c) `(+ ,a ,b)) (aritable? mac1 2)) #t) (test (let () (define-bacro (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 1)) #f) (test (let () (define-bacro (mac1 a b . c) `(+ ,a ,b)) (aritable? mac1 3)) #t) (test (let () (define-macro (mac1 a) `(+ 1 ,a)) (aritable? mac1 0)) #f) (test (let () (define-macro* (mac1 . a) `(+ ,a ,b)) (aritable? mac1 3)) #t) (test (let () (define-macro* (mac1 a) `(+ 1 ,a)) (aritable? mac1 0)) #t) (test (let () (define-macro* (mac1 a :rest b) `(+ 1 ,a)) (aritable? mac1 21)) #t) (test (let () (define-macro* (mac1 a . b) `(,a ,@b)) (aritable? mac1 4)) #t) (test (let () (define-macro* (mac1 a b c) `(+ ,a ,b)) (aritable? mac1 2)) #t) (test (aritable? "hiho" 0) #f) (test (aritable? "" 1) #f) (test (aritable? () 0) #f) (test (aritable? #() 1) #f) (test (aritable? #(1 2 3) 0) #f) (test (aritable? #(1 2 3) -1) 'error) (test (aritable? #(1 2 3) 1) #t) (test (aritable? #(1 2 3) 2) #f) (test (aritable? (hash-table 'a 1) 1) #t) (test (aritable? (hash-table 'a 1) 2) #f) (test (aritable? (curlet) 1) #t) (test (let () (call-with-exit (lambda (goto) (aritable? goto 1)))) #t) (test (aritable? (make-iterator (hash-table 'a 1)) 0) #t) (test (aritable? (make-iterator (hash-table 'a 1)) 1) #f) (test (aritable? "" 0) #f) (test (aritable? "12" 2) #f) (test (aritable? "12" 1) #t) (test (aritable? #() 0) #f) ; since (#() 0) or any other arg is an error (test (aritable? #2d((1 2) (3 4)) 0) #f) (test (aritable? #2d((1 2) (3 4)) 1) #t) (test (aritable? #2d((1 2) (3 4)) 2) #t) (test (aritable? #2d((1 2) (3 4)) 3) #f) (test (aritable? '((1 2) (3 4)) 2) #f) (test (aritable? '(1 2 . 3) 9223372036854775806) #f) (test (aritable? #2d((1 3) (2 4)) 9223372036854775807) #f) (test (aritable? '2 1) #f) (test (aritable? ''2 1) #t) (let () (define* (f a b) (eq? a b)) (test (aritable? f 2) #t) (test (aritable? f 3) #f)) ; num=args, key+value=1 arg ;;; -------------------------------------------------------------------------------- ;;; arity (test (arity) 'error) (test (arity abs 1) 'error) (for-each (lambda (arg) (if (arity arg) (format #t ";(arity ~A) -> ~A?~%" arg (arity arg)))) (list :hi (integer->char 65) 1 #t 3.14 3/4 1.0+1.0i #\f # # # () 'a)) #| (let ((choices (list "a " "b " " . " ":rest " ":allow-other-keys "))) (define (next-arg expr) (catch #t (lambda () ;(format #t "expr: ~A~%" expr) (let ((func (eval-string expr))) (let ((min-max (arity func))) (format #t "(test (arity ~A) ~70T'~A)~%" expr min-max) (if (> (cdr min-max) 6) (set! (cdr min-max) 6)) (do ((i 0 (+ i 1))) ((= i (car min-max))) (if (aritable? func i) (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i))) (do ((i (car min-max) (+ i 1))) ((> i (cdr min-max))) (if (not (aritable? func i)) (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i))) (do ((i (+ 1 (cdr min-max)) (+ i 1))) ((>= i 6)) (if (aritable? func i) (format #t ";~A: arity: ~A, arg: ~A?~%" expr min-max i))) ))) (lambda args ;(format #t " ~A: ~A~%" expr (apply format #f (cadr args))) 'error))) (define (next-choice str n) (next-arg (string-append str ") #f)")) (if (< n 6) (for-each (lambda (choice) (next-choice (string-append str choice) (+ n 1))) choices))) (for-each (lambda (choice) (next-arg (string-append "(lambda* " choice "#f)"))) choices) (next-choice "(lambda* (" 0)) |# (test (arity (lambda a a)) (cons 0 *max-arity*)) (test (arity (define (_m_ . a) a)) (cons 0 *max-arity*)) (test (arity (lambda (a . b) a)) (cons 1 *max-arity*)) (test (arity (define (_m_ a . b) a)) (cons 1 *max-arity*)) (test (arity (lambda (a b . c) a)) (cons 2 *max-arity*)) (test (arity (define (_m_ a b . c) a)) (cons 2 *max-arity*)) (test (arity (define* (a b . c) a)) (cons 0 *max-arity*)) (test (arity (define-macro (_m_ a . b) a)) (cons 1 *max-arity*)) (test (arity (lambda* a #f)) (cons 0 *max-arity*)) (test (arity (lambda* () #f)) '(0 . 0)) (test (arity (lambda* (a ) #f)) '(0 . 1)) (test (arity (lambda* (a b ) #f)) '(0 . 2)) (test (arity (lambda* (a b :allow-other-keys ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (a . b ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (a :rest b ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (a :rest b :allow-other-keys ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (a :allow-other-keys ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (:rest a ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (:rest a b ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (:rest a b :allow-other-keys ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (:rest a . b ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (:rest a :rest b ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (:rest a :rest b :allow-other-keys ) #f)) (cons 0 *max-arity*)) (test (arity (lambda* (:rest a :allow-other-keys ) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ . a) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_) #f)) '(0 . 0)) (test (arity (define* (__a_ a) #f)) '(0 . 1)) (test (arity (define* (__a_ a b) #f)) '(0 . 2)) (test (arity (define* (__a_ a b :allow-other-keys) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ a . b) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ a :rest b) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ a :rest b :allow-other-keys) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ a :allow-other-keys) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ :rest a) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ :rest a b) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ :rest a b :allow-other-keys) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ :rest a . b) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ :rest a :rest b) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ :rest a :rest b :allow-other-keys) #f)) (cons 0 *max-arity*)) (test (arity (define* (__a_ :rest a :allow-other-keys) #f)) (cons 0 *max-arity*)) #| (let ((st (symbol-table))) (for-each (lambda (sym) (if (defined? sym) (let ((func (symbol->value sym))) (catch #t (lambda () (let ((min-max (arity func))) (format #t "(test (arity ~A) ~70T'~A)~%" sym min-max) (if min-max (begin (if (> (cdr min-max) 6) (set! (cdr min-max) 6)) (do ((i 0 (+ i 1))) ((= i (car min-max))) (if (aritable? func i) (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i))) (do ((i (car min-max) (+ i 1))) ((> i (cdr min-max))) (if (not (aritable? func i)) (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i))) (do ((i (+ 1 (cdr min-max)) (+ i 1))) ((>= i 6)) (if (aritable? func i) (format #t ";~A: arity: ~A, arg: ~A?~%" sym min-max i))) )))) (lambda args (format #t " ~A: ~A~%" sym (apply format #f (cadr args))) 'error))))) st)) |# (unless pure-s7 (test (arity set-current-input-port) '(1 . 1)) (test (arity string-fill!) '(2 . 4)) (test (arity string->list) '(1 . 3)) (test (arity string-ci<=?) (cons 2 *max-arity*)) (test (arity string-ci>=?) (cons 2 *max-arity*)) (test (arity string-ci?) (cons 2 *max-arity*)) (test (arity char-ci>?) (cons 2 *max-arity*)) (test (arity char-ci=?) (cons 2 *max-arity*)) (test (arity char-ci>=?) (cons 2 *max-arity*)) (test (arity char-ci<=?) (cons 2 *max-arity*)) (test (arity char-cilist) '(1 . 3))) (test (arity *) (cons 0 *max-arity*)) (when (provided? 'autoload) (test (arity *autoload*) '(1 . 1)) (test (arity *autoload-hook*) '(0 . 2))) (test (arity *error-hook*) '(0 . 2)) (test (arity *features*) (cons 1 *max-arity*)) (test (arity *function*) '(0 . 2)) (test (arity *load-hook*) '(0 . 1)) (test (arity *missing-close-paren-hook*) '(0 . 0)) (test (arity *read-error-hook*) '(0 . 2)) (test (arity *rootlet-redefinition-hook*) '(0 . 2)) (test (arity *stderr*) '#f) (test (arity *stdin*) '#f) (test (arity *unbound-variable-hook*) '(0 . 1)) (test (arity +) (cons 0 *max-arity*)) (test (arity -) (cons 1 *max-arity*)) (test (arity /) (cons 1 *max-arity*)) (test (arity :allow-other-keys) '#f) (test (arity :rest) '#f) (test (arity <) (cons 2 *max-arity*)) (test (arity <=) (cons 2 *max-arity*)) (test (arity =) (cons 2 *max-arity*)) (test (arity >) (cons 2 *max-arity*)) (test (arity >=) (cons 2 *max-arity*)) (test (arity abort) '(0 . 0)) (test (arity abs) '(1 . 1)) (test (arity acos) '(1 . 1)) (test (arity acosh) '(1 . 1)) (test (arity and) (cons 0 *max-arity*)) (test (arity angle) '(1 . 1)) (test (arity append) (cons 0 *max-arity*)) (test (arity apply) (cons 1 *max-arity*)) (test (arity apply-values) '(0 . 1)) (test (arity aritable?) '(2 . 2)) (test (arity arity) '(1 . 1)) (test (arity ash) '(2 . 2)) (test (arity asin) '(1 . 1)) (test (arity asinh) '(1 . 1)) (test (arity assoc) '(2 . 3)) (test (arity assq) '(2 . 2)) (test (arity assv) '(2 . 2)) (test (arity atan) '(1 . 2)) (test (arity atanh) '(1 . 1)) (when (provided? 'autoload) (test (arity autoload) '(2 . 2))) (test (arity begin) (cons 0 *max-arity*)) (test (arity bignum) '(1 . 2)) (test (arity bignum?) '(1 . 1)) (test (arity boolean?) '(1 . 1)) (test (arity byte-vector) (cons 0 *max-arity*)) (test (arity byte-vector->string) '(1 . 1)) (test (arity byte-vector-ref) (cons 2 *max-arity*)) (test (arity byte-vector-set!) (cons 3 *max-arity*)) (test (arity byte-vector?) '(1 . 1)) (test (arity byte?) '(1 . 1)) (test (arity c-object-type) '(1 . 1)) (test (arity c-object?) '(1 . 1)) (test (arity c-pointer) '(1 . 5)) (test (arity c-pointer->list) '(1 . 1)) (test (arity c-pointer-info) '(1 . 1)) (test (arity c-pointer-type) '(1 . 1)) (test (arity c-pointer-weak1) '(1 . 1)) (test (arity c-pointer-weak2) '(1 . 1)) (test (arity c-pointer?) '(1 . 2)) (test (arity caaaar) '(1 . 1)) (test (arity caaadr) '(1 . 1)) (test (arity caaar) '(1 . 1)) (test (arity caadar) '(1 . 1)) (test (arity caaddr) '(1 . 1)) (test (arity caadr) '(1 . 1)) (test (arity caar) '(1 . 1)) (test (arity cadaar) '(1 . 1)) (test (arity cadadr) '(1 . 1)) (test (arity cadar) '(1 . 1)) (test (arity caddar) '(1 . 1)) (test (arity cadddr) '(1 . 1)) (test (arity caddr) '(1 . 1)) (test (arity cadr) '(1 . 1)) (test (arity call-with-current-continuation) '(1 . 1)) (test (arity call-with-exit) '(1 . 1)) (test (arity call-with-input-file) '(2 . 2)) (test (arity call-with-input-string) '(2 . 2)) (test (arity call-with-output-file) '(2 . 2)) (test (arity call-with-output-string) '(1 . 1)) (test (arity call-with-values) '(2 . 2)) (test (arity call/cc) '(1 . 1)) (test (arity car) '(1 . 1)) (test (arity case) (cons 2 *max-arity*)) (test (arity catch) '(3 . 3)) (test (arity cdaaar) '(1 . 1)) (test (arity cdaadr) '(1 . 1)) (test (arity cdaar) '(1 . 1)) (test (arity cdadar) '(1 . 1)) (test (arity cdaddr) '(1 . 1)) (test (arity cdadr) '(1 . 1)) (test (arity cdar) '(1 . 1)) (test (arity cddaar) '(1 . 1)) (test (arity cddadr) '(1 . 1)) (test (arity cddar) '(1 . 1)) (test (arity cdddar) '(1 . 1)) (test (arity cddddr) '(1 . 1)) (test (arity cdddr) '(1 . 1)) (test (arity cddr) '(1 . 1)) (test (arity cdr) '(1 . 1)) (test (arity ceiling) '(1 . 1)) (test (arity char->integer) '(1 . 1)) (test (arity char-alphabetic?) '(1 . 1)) (test (arity char-downcase) '(1 . 1)) (test (arity char-lower-case?) '(1 . 1)) (test (arity char-numeric?) '(1 . 1)) (test (arity char-position) '(2 . 3)) (test (arity char-ready?) '(0 . 1)) (test (arity char-upcase) '(1 . 1)) (test (arity char-upper-case?) '(1 . 1)) (test (arity char-whitespace?) '(1 . 1)) (test (arity char<=?) (cons 2 *max-arity*)) (test (arity char=?) (cons 2 *max-arity*)) (test (arity char>?) (cons 2 *max-arity*)) (test (arity char?) '(1 . 1)) (test (arity close-input-port) '(1 . 1)) (test (arity close-output-port) '(1 . 1)) (test (arity complex) '(2 . 2)) (test (arity complex?) '(1 . 1)) (test (arity complex-vector) (cons 0 *max-arity*)) (test (arity complex-vector-ref) (cons 2 *max-arity*)) (test (arity complex-vector-set!) (cons 3 *max-arity*)) (test (arity complex-vector?) '(1 . 1)) (test (arity cond) (cons 1 *max-arity*)) (test (arity cond-expand) (cons 1 *max-arity*)) (test (arity cons) '(2 . 2)) (test (arity constant?) '(1 . 1)) (test (arity continuation?) '(1 . 1)) (test (arity copy) '(1 . 4)) (test (arity cos) '(1 . 1)) (test (arity cosh) '(1 . 1)) (test (arity coverlet) '(1 . 1)) (test (arity curlet) '(0 . 0)) (test (arity current-error-port) '(0 . 0)) (test (arity current-input-port) '(0 . 0)) (test (arity current-output-port) '(0 . 0)) (test (arity cutlet) (cons 2 *max-arity*)) (test (arity cyclic-sequences) '(1 . 1)) (test (arity define) (cons 2 *max-arity*)) (test (arity define*) (cons 2 *max-arity*)) (test (arity define-bacro) (cons 2 *max-arity*)) (test (arity define-bacro*) (cons 2 *max-arity*)) (test (arity define-constant) (cons 2 *max-arity*)) (test (arity define-expansion) (cons 2 *max-arity*)) (test (arity define-expansion*) (cons 2 *max-arity*)) (test (arity define-macro) (cons 2 *max-arity*)) (test (arity define-macro*) (cons 2 *max-arity*)) (test (arity defined?) '(1 . 3)) (test (arity delete-file) '(1 . 1)) (test (arity denominator) '(1 . 1)) (test (arity dilambda) '(2 . 2)) (test (arity dilambda?) '(1 . 1)) (test (arity directory->list) '(1 . 1)) (test (arity directory?) '(1 . 1)) (test (arity display) '(1 . 2)) (test (arity do) (cons 2 *max-arity*)) (test (arity documentation) '(1 . 1)) (test (arity dynamic-unwind) '(2 . 3)) (test (arity dynamic-wind) '(3 . 3)) (test (arity else) '#f) (test (arity emergency-exit) '(0 . 1)) (test (arity eof-object?) '(1 . 1)) (test (arity eq?) '(2 . 2)) (test (arity equal?) '(2 . 2)) (test (arity equivalent?) '(2 . 2)) (test (arity eqv?) '(2 . 2)) (test (arity error) (cons 1 *max-arity*)) (test (arity eval) '(1 . 2)) (test (arity eval-string) '(1 . 2)) (test (arity even?) '(1 . 1)) (test (arity exact->inexact) '(1 . 1)) (test (arity exact?) '(1 . 1)) (test (arity exit) '(0 . 1)) (test (arity exp) '(1 . 1)) (test (arity expt) '(2 . 2)) (test (arity file-exists?) '(1 . 1)) (test (arity file-mtime) '(1 . 1)) (test (arity fill!) '(2 . 4)) (test (arity float-vector) (cons 0 *max-arity*)) (test (arity float-vector-ref) (cons 2 *max-arity*)) (test (arity float-vector-set!) (cons 3 *max-arity*)) (test (arity float-vector?) '(1 . 1)) (test (arity float?) '(1 . 1)) (test (arity floor) '(1 . 1)) (test (arity flush-output-port) '(0 . 1)) (test (arity for-each) (cons 2 *max-arity*)) (test (arity format) (cons 2 *max-arity*)) (test (arity funclet) '(1 . 1)) (test (arity funclet?) '(1 . 1)) (test (arity gc) '(0 . 1)) (test (arity gcd) (cons 0 *max-arity*)) (test (arity gensym) '(0 . 1)) (test (arity gensym?) '(1 . 1)) (test (arity get-output-string) '(1 . 2)) (test (arity getenv) '(1 . 1)) (test (arity goto?) '(1 . 1)) (test (arity hash-code) '(1 . 2)) (test (arity hash-table) (cons 0 *max-arity*)) (test (arity hash-table-entries) '(1 . 1)) (test (arity hash-table-key-typer) '(1 . 1)) (test (arity hash-table-ref) (cons 2 *max-arity*)) (test (arity hash-table-set!) '(3 . 3)) (test (arity hash-table-value-typer) '(1 . 1)) (test (arity hash-table?) '(1 . 1)) (test (arity help) '(1 . 1)) (test (arity hook-functions) '(1 . 1)) (test (arity if) '(2 . 3)) (test (arity imag-part) '(1 . 1)) (test (arity immutable!) '(1 . 2)) (test (arity immutable?) '(1 . 2)) (test (arity inexact->exact) '(1 . 1)) (test (arity inexact?) '(1 . 1)) (test (arity infinite?) '(1 . 1)) (test (arity inlet) (cons 0 *max-arity*)) (test (arity input-port?) '(1 . 1)) (test (arity int-vector) (cons 0 *max-arity*)) (test (arity int-vector-ref) (cons 2 *max-arity*)) (test (arity int-vector-set!) (cons 3 *max-arity*)) (test (arity int-vector?) '(1 . 1)) (test (arity integer->char) '(1 . 1)) (test (arity integer-decode-float) '(1 . 1)) (test (arity integer-length) '(1 . 1)) (test (arity integer?) '(1 . 1)) (test (arity iterate) '(1 . 1)) (test (arity iterator-at-end?) '(1 . 1)) (test (arity iterator-sequence) '(1 . 1)) (test (arity iterator?) '(1 . 1)) (test (arity keyword->symbol) '(1 . 1)) (test (arity keyword?) '(1 . 1)) (test (arity lambda) (cons 2 *max-arity*)) (test (arity lambda*) (cons 2 *max-arity*)) (test (arity lcm) (cons 0 *max-arity*)) (test (arity length) '(1 . 1)) (test (arity let) (cons 2 *max-arity*)) (test (arity let*) (cons 2 *max-arity*)) (test (arity let->list) '(1 . 1)) (test (arity let-ref) '(2 . 2)) (test (arity let-set!) '(3 . 3)) (test (arity let?) '(1 . 1)) (test (arity letrec) (cons 2 *max-arity*)) (test (arity letrec*) (cons 2 *max-arity*)) (test (arity list) (cons 0 *max-arity*)) (test (arity list->string) '(1 . 1)) (test (arity list->vector) '(1 . 1)) (test (arity list-ref) (cons 2 *max-arity*)) (test (arity list-set!) (cons 3 *max-arity*)) (test (arity list-tail) '(2 . 2)) (test (arity list-values) (cons 0 *max-arity*)) (test (arity list?) '(1 . 1)) (test (arity load) '(1 . 2)) (test (arity log) '(1 . 2)) (test (arity logand) (cons 0 *max-arity*)) (test (arity logbit?) '(2 . 2)) (test (arity logior) (cons 0 *max-arity*)) (test (arity lognot) '(1 . 1)) (test (arity logxor) (cons 0 *max-arity*)) (test (arity macro?) '(1 . 1)) (test (arity macroexpand) '(1 . 1)) (test (arity magnitude) '(1 . 1)) (test (arity make-byte-vector) '(1 . 2)) (test (arity make-complex-vector) '(1 . 2)) (test (arity make-float-vector) '(1 . 2)) (test (arity make-hash-table) '(0 . 3)) (test (arity make-hook) (cons 0 *max-arity*)) (test (arity make-int-vector) '(1 . 2)) (test (arity make-iterator) '(1 . 2)) (test (arity make-list) '(1 . 2)) (test (arity make-polar) '(2 . 2)) (test (arity make-rectangular) '(2 . 2)) (test (arity make-string) '(1 . 2)) (test (arity make-vector) '(1 . 3)) (test (arity make-weak-hash-table) '(0 . 3)) (test (arity map) (cons 2 *max-arity*)) (test (arity max) (cons 1 *max-arity*)) (test (arity member) '(2 . 3)) (test (arity memq) '(2 . 2)) (test (arity memv) '(2 . 2)) (test (arity min) (cons 1 *max-arity*)) (test (arity modulo) '(2 . 2)) (test (arity most-negative-fixnum) '#f) (test (arity most-positive-fixnum) '#f) (test (arity multiple-value-bind) (cons 2 *max-arity*)) (test (arity nan?) '(1 . 1)) (test (arity negative?) '(1 . 1)) (test (arity newline) '(0 . 1)) (test (arity not) '(1 . 1)) (test (arity null?) '(1 . 1)) (test (arity number->string) '(1 . 2)) (test (arity number?) '(1 . 1)) (test (arity numerator) '(1 . 1)) (test (arity object->let) '(1 . 1)) (test (arity object->string) '(1 . 3)) (test (arity odd?) '(1 . 1)) (test (arity open-input-file) '(1 . 2)) (test (arity open-input-function) '(1 . 1)) (test (arity open-input-string) '(1 . 1)) (test (arity open-output-file) '(1 . 2)) (test (arity open-output-function) '(1 . 1)) (test (arity open-output-string) '(0 . 0)) (test (arity openlet) '(1 . 1)) (test (arity openlet?) '(1 . 1)) (test (arity or) (cons 0 *max-arity*)) (test (arity outlet) '(1 . 1)) (test (arity output-port?) '(1 . 1)) (test (arity owlet) '(0 . 0)) (test (arity pair-filename) '(1 . 1)) (test (arity pair-line-number) '(1 . 1)) (test (arity pair?) '(1 . 1)) (test (arity peek-char) '(0 . 1)) (test (arity pi) '#f) (test (arity port-closed?) '(1 . 1)) (test (arity port-file) '(1 . 1)) (test (arity port-filename) '(0 . 1)) (test (arity port-line-number) '(0 . 1)) (test (arity port-string) '(1 . 1)) (test (arity port-position) '(1 . 1)) (test (arity positive?) '(1 . 1)) (test (arity procedure-source) '(1 . 1)) (test (arity procedure-arglist) '(1 . 1)) (test (arity procedure?) '(1 . 1)) (test (arity profile-in) '(2 . 2)) (test (arity proper-list?) '(1 . 1)) (test (arity provide) '(1 . 1)) (test (arity provided?) '(1 . 1)) (test (arity quasiquote) '(1 . 1)) (test (arity quote) '(1 . 1)) (test (arity quotient) '(2 . 2)) (test (arity random) '(1 . 2)) (test (arity random-state) (if with-bignums '(0 . 1) '(0 . 2))) (test (arity random-state->list) '(0 . 1)) (test (arity random-state?) '(1 . 1)) (test (arity rational?) '(1 . 1)) (test (arity rationalize) '(1 . 2)) (test (arity read) '(0 . 1)) (test (arity read-byte) '(0 . 1)) (test (arity read-char) '(0 . 1)) (test (arity read-line) '(0 . 2)) (test (arity read-string) '(1 . 2)) (test (arity reader-cond) (cons 1 *max-arity*)) ; was 0 30-Aug-24 (test (arity real-part) '(1 . 1)) (test (arity real?) '(1 . 1)) (test (arity remainder) '(2 . 2)) (test (arity require) (cons 1 *max-arity*)) (test (arity reverse!) '(1 . 1)) (test (arity reverse) '(1 . 1)) (test (arity rootlet) '(0 . 0)) (test (arity round) '(1 . 1)) (test (arity s7-optimize) '(1 . 1)) (test (arity sequence?) '(1 . 1)) (test (arity set!) '(2 . 2)) (test (arity set-car!) '(2 . 2)) (test (arity set-cdr!) '(2 . 2)) (test (arity set-current-error-port) '(1 . 1)) (test (arity set-current-output-port) '(1 . 1)) (test (arity setter) '(1 . 2)) (test (arity signature) '(1 . 1)) (test (arity sin) '(1 . 1)) (test (arity sinh) '(1 . 1)) (test (arity sort!) '(2 . 2)) (test (arity sqrt) '(1 . 1)) (test (arity stacktrace) '(0 . 5)) (test (arity string) (cons 0 *max-arity*)) (test (arity string->byte-vector) '(1 . 1)) (test (arity string->keyword) '(1 . 1)) (test (arity string->number) '(1 . 2)) (test (arity string->symbol) '(1 . 1)) (test (arity string-append) (cons 0 *max-arity*)) (test (arity string-copy) '(1 . 4)) (test (arity string-downcase) '(1 . 1)) (test (arity string-length) '(1 . 1)) (test (arity string-position) '(2 . 3)) (test (arity string-ref) '(2 . 2)) (test (arity string-set!) '(3 . 3)) (test (arity string-upcase) '(1 . 1)) (test (arity string<=?) (cons 2 *max-arity*)) (test (arity string=?) (cons 2 *max-arity*)) (test (arity string>?) (cons 2 *max-arity*)) (test (arity string?) '(1 . 1)) (test (arity sublet) (cons 1 *max-arity*)) (test (arity substring) '(1 . 3)) (test (arity substring-uncopied) '(1 . 3)) (test (arity subvector) '(1 . 4)) (test (arity subvector-position) '(1 . 1)) (test (arity subvector-vector) '(1 . 1)) (test (arity subvector?) '(1 . 1)) (test (arity symbol) (cons 1 *max-arity*)) (test (arity symbol->dynamic-value) '(1 . 1)) (test (arity symbol-initial-value) '(1 . 1)) (test (arity symbol->keyword) '(1 . 1)) (test (arity symbol->string) '(1 . 1)) (test (arity symbol->value) '(1 . 2)) (test (arity symbol-table) '(0 . 0)) (test (arity symbol?) '(1 . 1)) (test (arity syntax?) '(1 . 1)) (test (arity system) '(1 . 2)) (test (arity tan) '(1 . 1)) (test (arity tanh) '(1 . 1)) (test (arity throw) (cons 1 *max-arity*)) (test (arity tree-count) '(2 . 3)) (test (arity tree-cyclic?) '(1 . 1)) (test (arity tree-leaves) '(1 . 1)) (test (arity tree-memq) '(2 . 2)) (test (arity tree-set-memq) '(2 . 2)) (test (arity truncate) '(1 . 1)) (test (arity type-of) '(1 . 1)) (test (arity undefined?) '(1 . 1)) (test (arity unlet) '(0 . 0)) (test (arity unspecified?) '(1 . 1)) (test (arity values) (cons 0 *max-arity*)) (test (arity varlet) (cons 2 *max-arity*)) (test (arity vector) (cons 0 *max-arity*)) (test (arity vector-append) (cons 0 *max-arity*)) (test (arity vector-dimension) '(2 . 2)) (test (arity vector-dimensions) '(1 . 1)) (test (arity vector-length) '(1 . 1)) (test (arity vector-rank) '(1 . 1)) (test (arity vector-ref) (cons 2 *max-arity*)) (test (arity vector-set!) (cons 3 *max-arity*)) (test (arity vector-typer) '(1 . 1)) (test (arity vector?) '(1 . 1)) (test (arity weak-hash-table) (cons 0 *max-arity*)) (test (arity weak-hash-table?) '(1 . 1)) (test (arity with-baffle) (cons 0 *max-arity*)) ; (with-baffle) -> () (test (arity with-input-from-file) '(2 . 2)) (test (arity with-input-from-string) '(2 . 2)) (test (arity with-let) (cons 1 *max-arity*)) (test (arity with-output-to-file) '(2 . 2)) (test (arity with-output-to-string) '(1 . 1)) (test (arity write) '(1 . 2)) (test (arity write-byte) '(1 . 2)) (test (arity write-char) '(1 . 2)) (test (arity write-string) '(1 . 4)) (test (arity zero?) '(1 . 1)) (test (let () (define-macro (mac1 a b c) `(+ ,a ,b)) (arity mac1)) '(3 . 3)) (test (let () (define-macro (mac1 a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*)) (test (let () (define-bacro (mac1 a b c) `(+ ,a ,b)) (arity mac1)) '(3 . 3)) (test (let () (define-bacro (mac1 a b . c) `(+ ,a ,b)) (arity mac1)) (cons 2 *max-arity*)) (test (let () (define-macro (mac1 a) `(+ 1 ,a)) (arity mac1)) '(1 . 1)) (test (let () (define-macro* (mac1 . a) `(+ ,a ,b)) (arity mac1)) (cons 0 *max-arity*)) (test (let () (define-macro* (mac1 a) `(+ 1 ,a)) (arity mac1)) '(0 . 1)) (test (let () (define-macro* (mac1 a :rest b) `(+ 1 ,a)) (arity mac1)) (cons 0 *max-arity*)) (test (let () (define-macro* (mac1 a . b) `(,a ,@b)) (arity mac1)) (cons 0 *max-arity*)) (test (let () (define-macro* (mac1 a b c) `(+ ,a ,b)) (arity mac1)) '(0 . 3)) (test (arity "hiho") '(1 . 1)) (test (arity "") #f) (test (arity ()) #f) (test (arity #()) #f) (test (arity #i()) #f) (test (arity #(1 2 3)) (cons 1 *max-arity*)) (test (arity #u(1 2 3)) (cons 1 1)) (test (arity #r(1 2 3)) (cons 1 1)) (test (arity #r2d((1 2) (3 4))) (cons 1 2)) (test (arity (hash-table 'a 1)) (cons 1 *max-arity*)) (test (arity (curlet)) '(1 . 1)) (test (let () (call-with-exit (lambda (goto) (arity goto)))) (cons 0 *max-arity*)) (test (arity (make-iterator (hash-table 'a 1))) (cons 0 0)) (test (arity (let ((a 1)) (make-iterator (curlet)))) (cons 0 0)) (test (arity (random-state 123)) #f) (when with-block (test (procedure? _c_obj_) #t) (test (procedure? (setter _c_obj_)) #t) (test (signature _c_obj_) '(#t block? integer?)) (test (documentation _c_obj_) "") (test (procedure-source _c_obj_) ()) (test (arity _c_obj_) (cons 1 1)) (test (aritable? _c_obj_ 1) #t) (test (aritable? _c_obj_ 0) #f) (test (aritable? _c_obj_ 2) #f) (let ((tag (make-c-tag))) (test (aritable? tag 1) #f))) (define (for-each-subset func args) (define (subset source dest len) (if (null? source) (if (aritable? func len) (apply func dest)) (begin (subset (cdr source) (cons (car source) dest) (+ len 1)) (subset (cdr source) dest len)))) (subset args () 0)) #| (define (for-each-subset func args) (let ((subsets ())) (define (subset source dest len) (if (null? source) (begin (if (member dest subsets) (format #t ";got ~S twice in for-each-subset: ~S~%" dest args)) (set! subsets (cons dest subsets)) (if (aritable? func len) (apply func dest))) (begin (subset (cdr source) (cons (car source) dest) (+ len 1)) (subset (cdr source) dest len)))) (subset args () 0))) |# (test (let ((ctr 0)) (for-each-subset (lambda args (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 16) (test (let ((ctr 0)) (for-each-subset (lambda (arg) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 4) (test (let ((ctr 0)) (for-each-subset (lambda (arg1 arg2 arg3) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 4) (test (let ((ctr 0)) (for-each-subset (lambda* (arg1 arg2 arg3) (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 15) (test (let ((ctr 0)) (for-each-subset (lambda () (set! ctr (+ ctr 1))) '(1 2 3 4)) ctr) 1) ;; from stackoverflow scheme (let () (define (power-set set) (if (null? set) '(()) (let ((power-set-of-rest (power-set (cdr set)))) (append power-set-of-rest (map (lambda (subset) (cons (car set) subset)) power-set-of-rest))))) (define (for-each-powerset f s) (for-each (lambda (lst) (apply f lst)) (power-set s))) (test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args))) '(1)) sum) 1) (test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args))) '(1 2)) sum) 6) (test (let ((sum 0)) (for-each-powerset (lambda args (set! sum (apply + sum args))) '(1 2 3)) sum) 24)) (define (snarf func lst) ;; (snarf func lst) repeatedly applies func to as many elements of lst as func can take (let ((arity (arity func))) (if (> (cdr arity) 100) (apply func lst) (let ((n (cdr arity)) (lst-len (length lst))) (if (< lst-len (car arity)) (error 'wrong-number-of-args ";snarf func requires ~A args, but got ~A, ~A" (car arity) lst-len lst) (if (<= lst-len n) (apply func lst) (if (not (zero? (modulo (length lst) n))) (error 'wrong-number-of-args ";snarf will take ~A args at a time, but got ~A in ~A" n lst-len lst) ;; ideally this would accept partial lists (i.e. left-over < req), ;; but then we also need to notice that case in the list-tail below (let () (define (snarf-1 len f args) (if (not (null? args)) (let* ((last (list-tail args (- len 1))) (rest (cdr last))) (dynamic-wind (lambda () (set! (cdr last) ())) (lambda () (apply func args)) (lambda () (set! (cdr last) rest))) (snarf-1 len f rest)))) (snarf-1 n func lst))))))))) (test (let ((lst '(1 2 3 4))) (catch #t (lambda () (snarf (lambda (a b) (format #t "~A ~A~%" a b c)) lst)) (lambda args 'error)) lst) '(1 2 3 4)) (test (snarf (lambda (a b) (format #t "~A ~A~%" a b)) '(1 2 3 4 5)) 'error) (test (snarf (lambda (a b) (format #t "~A ~A~%" a b)) '(1)) 'error) (test (let ((x 0)) (snarf (lambda (a) (set! x (+ x a))) '(1 2 3)) x) 6) (test (let ((x 0)) (snarf (lambda (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10) (test (let ((x 0)) (snarf (lambda* (a b) (set! x (+ x a b))) '(1 2 3 4)) x) 10) (test (let ((x 0)) (snarf (lambda a (set! x (apply + a))) '(1 2 3 4)) x) 10) (test (let ((x 0)) (snarf (lambda* (a b (c 0)) (set! x (+ x a b c))) '(1 2)) x) 3) ;;; -------------------------------------------------------------------------------- ;;; procedure-arglist (for-each (lambda (arg) (test (procedure-arglist arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi :hi #(()) (list 1 2 3) '(1 . 2) "hi")) (test (procedure-arglist) 'error) (test (procedure-arglist abs abs) 'error) (test (procedure-arglist quasiquote) 'error) (test (procedure-arglist abs) 'error) ; should be fixed (test (procedure-arglist (lambda a a)) 'a) (test (procedure-arglist (lambda (a) a)) '(a)) (test (procedure-arglist (lambda* (a (b 1)) a)) '(a (b 1))) (test (procedure-arglist (macro a a)) 'a) (test (procedure-arglist (macro (a) a)) '(a)) (test (procedure-arglist (macro* (a (b 1)) a)) '(a (b 1))) (test (procedure-arglist (bacro a a)) 'a) (test (procedure-arglist (bacro (a) a)) '(a)) (test (procedure-arglist (bacro* (a (b 1)) a)) '(a (b 1))) (test (procedure-arglist (lambda* (a :rest b) a)) '(a :rest b)) (test (procedure-arglist (lambda* (a :allow-other-keys) a)) '(a)) (test (procedure-arglist (lambda (a . b) a)) '(a . b)) (let ((dl (dilambda (lambda () 3) (lambda (a b) a)))) (test (procedure-arglist (setter dl)) '(a b))) (test (symbol? (procedure-arglist (lambda a a))) #t) (let* ((f (lambda (a b c) a)) (pars (procedure-arglist f))) ; copies arglist do direct set as below won't change the procedure (bad news if lambda*!) (set-car! pars 'oops) (test (procedure-arglist f) '(a b c))) ;;; -------------------------------------------------------------------------------- ;;; procedure-source (for-each (lambda (arg) (eval-string (format #f "(define (func) ~S)" arg)) (let ((source (procedure-source func))) (let ((val (func))) (test val arg)))) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i #t #f () #(()) ':hi "hi")) (for-each (lambda (arg) (test (procedure-source arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi :hi #(()) (list 1 2 3) '(1 . 2) "hi")) (when (zero? (*s7* 'debug)) (test (let ((hi (lambda (x) (+ x 1)))) (procedure-source hi)) '(lambda (x) (+ x 1)))) (test (procedure-source) 'error) (test (procedure-source abs abs) 'error) (test (procedure-source quasiquote) ()) (test (procedure-source abs) ()) ;(test (let () (define-macro (hi a) `(+ 1 ,a)) (cadr (caddr (procedure-source hi)))) '(lambda (a) (list-values '+ 1 a))) (let () (define (hi a) (+ a x)) (test ((apply let '((x 32)) (list (procedure-source hi))) 12) 44)) ;; i.e. make a closure from (let ((x 32)) ) (let () (define (arg-info f n) ((procedure-source f) 1 n 1 0 2)) ; get the documentation string of f's n-th argument (define* (add-1 (arg ((lambda () "arg should be an integer" 0)))) (+ arg 1)) ; the default value of arg is 0 (test (add-1) 1) (test (add-1 1) 2) (test (arg-info add-1 0) "arg should be an integer")) (test (object->string (procedure-source (lambda (a . b) (cons a b)))) "(lambda (a . b) (cons a b))") (test (object->string (procedure-source (lambda* ((a 3) (b 4)) (cons a b)))) "(lambda* ((a 3) (b 4)) (cons a b))") (test (object->string (procedure-source (macro (a . b) (cons a b)))) "(macro (a . b) (cons a b))") (test (object->string (procedure-source (macro* ((a 3) (b 4)) (cons a b)))) "(macro* ((a 3) (b 4)) (cons a b))") (test (object->string (procedure-source (bacro (a . b) (cons a b)))) "(bacro (a . b) (cons a b))") (test (object->string (procedure-source (bacro* ((a 3) (b 4)) (cons a b)))) "(bacro* ((a 3) (b 4)) (cons a b))") (test (catch #t (lambda () (apply (lambda (a) (+ a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i))) "(lambda (a) (+ a 1)): too many arguments: ((lambda (a) ...) 1 2 3)") (test (catch #t (lambda () (apply (macro (a) `(+ ,a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i))) "(macro (a) (list-values '+ a 1)): too many arguments: ((macro (a) ...) 1 2 3)") (test (catch #t (lambda () (apply (bacro (a) `(+ ,a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i))) "(bacro (a) (list-values '+ a 1)): too many arguments: ((bacro (a) ...) 1 2 3)") (test (catch #t (lambda () (apply (lambda* (a) (+ a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i))) "too many arguments: (lambda* (a) ...) 1 2 3)") (test (catch #t (lambda () (apply (macro* (a) `(+ ,a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i))) "too many arguments: (macro* (a) ...) 1 2 3)") (test (catch #t (lambda () (apply (bacro* (a) `(+ ,a 1)) (list 1 2 3))) (lambda (t i) (apply format #f i))) "too many arguments: (bacro* (a) ...) 1 2 3)") (test (catch #t (lambda () (apply (lambda (a b) (+ a b)) (list 1))) (lambda (t i) (apply format #f i))) "(lambda (a b) (+ a b)): not enough arguments: ((lambda (a b) ...) 1)") (test (catch #t (lambda () (apply (macro (a b) (+ a b)) (list 1))) (lambda (t i) (apply format #f i))) "(macro (a b) (+ a b)): not enough arguments: ((macro (a b) ...) 1)") (test (catch #t (lambda () (apply (bacro (a b) (+ a b)) (list 1))) (lambda (t i) (apply format #f i))) "(bacro (a b) (+ a b)): not enough arguments: ((bacro (a b) ...) 1)") ;;; -------------------------------------------------------------------------------- ;;; setter (test (setter) 'error) (test (setter car cons) 'error) (test (setter car) set-car!) (test (setter vector-ref) vector-set!) (test (setter int-vector-ref) int-vector-set!) (test (setter float-vector-ref) float-vector-set!) (test (setter complex-vector-ref) complex-vector-set!) (test (setter byte-vector-ref) byte-vector-set!) (test (setter make-string) #f) (test (setter quasiquote) #f) (test (setter cdr) set-cdr!) (test (setter hash-table-ref) hash-table-set!) (test (setter list-ref) list-set!) (test (setter let-ref) let-set!) (test (setter string-ref) string-set!) (test (set! (setter 'begin) (lambda args #f)) 'error) (test (set! (setter 'quasiquote) (lambda args #f)) 'error) ; special case (not syntax in s7) (unless pure-s7 (test (setter current-input-port) set-current-input-port) (test (setter current-output-port) set-current-output-port)) (test (setter current-error-port) set-current-error-port) (test (setter (call-with-exit (lambda (quit) quit))) #f) (for-each (lambda (arg) (test (setter arg) #f)) (list -1 #\a #f 1 3.14 3/4 1.0+1.0i ())) (test (setter :hi) #f) ; setter -> setter here (test (setter 'hi) #f) (let ((sym 3)) (set! (setter 'sym) (lambda (s x) x)) (test (procedure? (setter 'sym)) #t)) (test (setter (symbol "a b") `((1))) 'error) (for-each (lambda (arg) (test (set! (setter abs) arg) 'error)) (list -1 #\a #t _ht_ _undef_ 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi 'car "car" :hi #(()) (list 1 2 3) '(1 . 2) "hi" (call/cc (lambda (cc) cc)) (call-with-exit (lambda (goto) goto)))) (let ((dl (dilambda (lambda (x) 1) (lambda (x y) x)))) (define (fes) (for-each (lambda (n a) (set! (n a) 0)) (list car (vector 0) dl) (list (list 1) 0 0))) (fes)) (let () (define (hiho a) a) (define-macro (hiha a) `(+ 1 ,a)) (define-bacro* (hoha a) `(+ 1 ,a)) (define pws (dilambda (lambda () 1) (lambda (x) x))) (test (setter hiho) #f) (test (setter hiha) #f) (test (setter hoha) #f) (test (procedure? (setter pws)) #t) (test ((setter pws) 32) 32) ) (let ((f1 (let ((xx 0)) (lambda (x) (+ x xx))))) (set! (setter f1) (lambda (x v) (* v 2))) (test (set! (f1 3) 12) 24) ;(test (set! (setter f1) (lambda (x v y) (+ x (* v 2)))) 'error) ; can't decide about this (more of these below) (set! (f1 3) 5) (test (f1 0) 0) ; so nothing got set! (set! (setter f1) (lambda (v) (* v 2))) (set! (f1) 3) (test (f1 0) 0) (test (set! (setter f1) (lambda () (* v 2))) 'error)) ;;; similarly: (let () (define f1 (let ((+setter+ 32)) (lambda () 3))) ; error?? (test (setter f1) 'error)) ; g_setter raises this error (let () (set! (setter *) (lambda (a) a)) ;op_set_pws[79080]: not a c function, but a function (type: 39) (define (ff) (set! (*) "asdf")) (test (ff) "asdf") (test (ff) "asdf")) (let ((xx 1)) (set! (setter 'xx) (lambda (s v) (* v 2))) (set! xx 2) (test xx 4) (test (set! (setter 'xx) (lambda (v) (* v 2))) 'error) (set! (setter 'xx) (lambda (s v l) (* v 3))) (set! xx 5) (test xx 15) (test (set! (setter 'xx) (lambda (s v l n) (* v 3))) 'error) (set! (setter 'xx) (define-macro (_m s v) `(* ,v 7))) (set! xx 10) (test xx 70) (test (set! (setter xx) (lambda (s v) v)) 'error) (set! (setter 'xx) #f) (set! xx 1) (test xx 1)) (let ((x 123)) (define (f a b) (+ x a b)) (set! (setter f) (lambda (a b val) (set! x val))) (test (f 1 2) 126) (set! (f 1 2) 32) (test (f 1 2) 35)) (let ((x 1)) (set! (setter 'x) (lambda (name new-value enviroment) (* new-value 2))) (define x 3) (test x 6)) (test (eq? (let ((x 0)) (set! (setter 'x) integer?) (setter 'x)) integer?) #t) ; tricky... (test (let ((x 0)) (set! (setter 'x) integer?) (make-vector (values 1 2) (setter 'x))) #i(2)) (let () (define (f3) (let ((x 128)) (set! (setter 'x) (lambda (s v) (if (and (integer? v) (<= 0 v 128)) v (error 'wrong-type-arg "(set! ~A ~S) but ~S should be an integer between 0 and 128" s v v)))) (do ((i 0 (+ i 1))) ((= i 2) x) (set! x (+ x i))))) (test (f3) 'error) (define (f4) (let ((x 128.0)) (set! (setter 'x) (lambda (s v) (if (and (float? v) (<= 0.0 v 128.0)) v (error 'wrong-type-arg "(set! ~A ~S) but ~S should be a float between 0.0 and 128.0" s v v)))) (do ((i 0 (+ i 1))) ((= i 2) x) (set! x (+ x i))))) (test (f4) 'error) (define (f5) (let ((x 'a)) (set! (setter 'x) symbol?) (do ((i 0 (+ i 1))) ((= i 2) x) (set! x #f)))) (test (f5) 'error)) (test (let ((v #(1 2 3))) ((setter vector-ref) v 0 32) v) #(32 2 3)) (test (let ((v #(1 2 3))) ((setter vector-ref) (let () v) 0 32) v) #(32 2 3)) (let () (define (vref v i) (vector-ref v i)) (set! (setter vref) vector-set!) (test (let ((v (vector 1 2 3))) (set! (vref v 1) 32) v) #(1 32 3))) (let-temporarily (((setter cadr) (lambda (lst val) (set! (car (cdr lst)) val)))) (test (let ((lst (list 1 2 3))) (set! (cadr lst) 4) lst) '(1 4 3)) (test (procedure? (setter cadr)) #t) (gc) (gc) ; lint.scm tests this exhaustively (test (procedure? (setter cadr)) #t) (if (not (procedure? (setter cadr))) (format *stderr* " setter: ~A~%" (setter cadr)))) (let () (define-macro (vref v a) `(vector-ref ,v ,a)) (define-macro (vset! v a x) `(vector-set! ,v ,a ,x)) (set! (setter vref) vset!) (let ((v (vector 1 2 3))) (set! (vref v 1) 32) (test v #(1 32 3))) (define hi 0) (define-macro (xx) `hi) (define-macro (set-xx val) `(set! hi ,val)) (set! (setter xx) set-xx) (set! (xx) 32) (test hi 32)) (let () (set! (setter logbit?) (define-macro (m var index on) ; here we want to set "var", so we need a macro `(if ,on (set! ,var (logior ,var (ash 1 ,index))) (set! ,var (logand ,var (lognot (ash 1 ,index))))))) (test (let ((int #b1010)) (set! (logbit? int 0) #t) int) 11)) (let-temporarily (((setter <) <)) (test (set! (< 3 2) 3) #f) (test (set! (< 1) 2) #t)) (let ((x 1)) ; let-temp = (set! x new) ... (set! x old) so setter is called twice (set! (setter 'x) (lambda (s v) (+ (symbol->value s) v))) ; x = x + v, x is 1, v is 3 below (let ((res (let-temporarily ((x 3)) x))) ; x = 1 + 3, then on exit from let-temp, x = 4 + 1 ! (let-temp is trying to set x back to 1) (set! (setter 'x) #f) (test x 5))) (test (with-let (inlet 'a 1) (set! (setter 'a) (lambda (s v) 123)) (set! a 2) a) 123) ; won't work with *s7* (let ((old-setter (setter abs))) ; check gc protection (set! (setter abs) (define-macro (_m1_ x y) `(+ ,x 1))) (define-macro (_m1_ x) `(- ,x 1)) (gc) (gc) (test (macro? (setter abs)) #t) (set! (setter abs) old-setter)) (when with-block (let ((b (make-block 3))) ((setter b) b 0 1.0) (test b (block 1.0 0.0 0.0)))) (let ((str "123")) ((setter str) str 0 #\a) (test str "a23")) (let ((bv #u(0 1 2))) ((setter bv) bv 0 3) (test bv #u(3 1 2))) (let ((iv #i(0 1 2))) ((setter iv) iv 0 3) (test iv #i(3 1 2))) (let ((v #(0 1 2))) ((setter v) v 0 3) (test v #(3 1 2))) (let ((fv #r(0.0 1.0 2.0))) ((setter fv) fv 0 3.0) (test fv #r(3.0 1.0 2.0))) (let ((lst (list 0 1 2))) ((setter lst) lst 0 3) (test lst '(3 1 2))) (let ((lt (inlet 'a 3))) ((setter lt) lt 'a 4) (test lt (inlet 'a 4))) (let ((ht (hash-table 'a 3))) ((setter ht) ht 'a 4) (test ht (hash-table 'a 4))) (test (setter (make-iterator (list 1 2 3))) #f) (test (setter (inlet)) let-set!) (test (set! (setter (inlet) (lambda (lt sym val) val))) 'error) (test (setter (hash-table)) hash-table-set!) (test (let ((i 0)) (call/cc (lambda (cc) (set! (setter 'i) cc) i))) 'error) ;(test (do ((i 0 (+ i 1))) ((= i 100)) (apply values (set! (setter 'i) (weak-hash-table? 1)) ())) #t) ; expr and setter collide here -- we need at least a warning, ideally a way to fix this (let ((x 0)) (set! (setter 'x) (let ((+documentation+ "x is a variable")) (lambda (s v) v))) (test (documentation (setter 'x)) "x is a variable")) (let () (define flocals (let ((x 1)) (let ((+setter+ (lambda (val) (set! x val))) (+documentation+ (immutable! "this is a test")) (+signature+ '(#t procedure?))) (lambda () x)))) (test (flocals) 1) (test (procedure? (setter flocals)) #t) (set! (flocals) 32) (test (flocals) 32) (test (signature flocals) '(#t procedure?)) (test (documentation flocals) "this is a test")) (let ((_x_ 1)) (define fset (let ((+setter+ (lambda (x) (set! _x_ x)))) (lambda () _x_))) (set! (fset) 2) ; make sure this is found even if we haven't previously looked for it (as above) (if (not (= _x_ 2)) (format *stderr* "fset setter: ~A~%" _x_)) (define (fset1) _x_) (if (setter fset1) (format *stderr* "fset1 setter: ~A~%" (setter fset1))) (set! (setter fset1) (lambda (x) (set! _x_ x))) (set! (fset1) 3) (if (not (= _x_ 3)) (format *stderr* "fset1 setter: ~A~%" _x_)) (define fset3 (let ((+setter+ (lambda (x y) (set! _x_ (+ x y))))) (lambda (y) (+ _x_ y)))) (set! (fset3 3) 4) (if (not (= _x_ 7)) (format *stderr* "fset3 setter: ~A~%" _x_)) (set! (setter fset3) #f) (test (setter fset3) #f) (test (set! (fset3 3) 4) 'error) (set! (setter fset3) (lambda (x y) (set! _x_ (+ x y)))) (test (set! (fset3 3) 4) 7) ) (let ((p (open-output-string))) (define e ; save environment for use below (let ((x 3) ; always an integer (y 3) ; always 3 (z 3)) ; report set! (set! (setter 'x) (lambda (s v) (if (integer? v) v x))) (set! (setter 'y) (lambda (s v) y)) (set! (setter 'z) (lambda (s v) (format p "z ~A -> ~A~%" z v) v)) (set! x 3.3) (set! y 3.3) (set! z 3.3) (curlet))) (test (and (equal? (e 'x) 3) (equal? (e 'y) 3) (equal? (e 'z) 3.3) (string=? (get-output-string p) "z 3 -> 3.3\n")) #t) (close-output-port p)) (for-each (lambda (arg) (test (setter arg) #f) ; was 'error 19-Oct-22 (test (set! (setter _int_) arg) 'error) (let ((x 1)) (if (not (null? arg)) (test (set! (setter 'x arg) (lambda (s v) 1)) 'error))) (let ((_x_ 1)) (set! (setter '_x_) (lambda (s v) v)) (set! _x_ arg) (test _x_ arg))) (list -1 #\a 1 3.14 3/4 1.0+1.0i ())) (let ((_x_ 1)) (set! (setter '_x_) (lambda (s v) v)) (define _x_ 32) (test _x_ 32) (define (_x_) 32) (test (_x_) 32) (let ((_x_ 3)) (test _x_ 3)) (define (hi _x_) _x_) (test (hi 4) 4) (test (do ((_x_ 0 (+ _x_ 1))) ((= _x_ 2) _x_)) 2) (test ((inlet '_x_ -1) '_x_) -1) (set! _x_ 32) (test _x_ 32)) (let ((_x_ 1)) (set! (setter '_x_) (lambda (s v) #f)) (define _x_ 32) (test _x_ #f) (test (set! _x_ 32) #f)) (test (setter) 'error) (let ((xyzzy 1) (_int_ 'xyzzy)) (test (setter 'xyzzy) #f) (test (set! (setter _int_) ()) 'error) (test (set! (setter _int_) '(#f)) 'error)) (let ((_x1_ #f)) (set! (setter '_x1_) (lambda (x y) 'error)) (test (set! _x1_ 32) 'error)) (let ((x 0)) (set! (setter 'x) (lambda (_A _B) (let ((y 2)) ((lambda () (let ((z 1)) (values y z))))))) (test (set! x 1) 'error)) ; mv from setter (let ((x 1)) (set! (setter 'x) (lambda (s v) x)) (let ((x 2)) (set! x 3) (test x 3) (set! (setter 'x (curlet)) (lambda (s v) 32)) (set! x 1) (test x 32)) (test x 1) (set! x 2) (test x 1)) (let () (define (f1 x) (let ((a x) (b 2) (c 3)) (set! (setter 'b) (lambda (s v) (set! a (+ v c)) v)) (set! (setter 'c) (lambda (s v) (set! a (+ b v)) v)) (set! a (+ b c)) (set! b (+ b 1)) (set! c 5) a)) (f1 0) (test (f1 0) 8)) (test (setter :rest) #f) (test (set! (setter :allow-other-keys) #f) 'error) (let () (define v_a_r 32) (let ((x #(1 2 3))) (set! (setter 'v_a_r) (lambda (sym val) (set! (x 1) val) (+ val 2)))) (do ((i 0 (+ i 1))) ((= i 5)) (set! v_a_r (+ i 33)) (test v_a_r (+ i 33 2)) (gc))) (define v_a_r 32) (let ((x #(1 2 3))) (set! (setter 'v_a_r) (lambda (sym val) (set! (x 1) val) (+ val 1)))) (do ((i 0 (+ i 1))) ((= i 5)) (set! v_a_r (+ i 33)) (test v_a_r (+ i 33 1)) (gc)) (let ((x (vector 1 2 3))) (let ((y (list 4 5 6))) (set! (setter 'v_a_r) (lambda (sym val) ;(format *stderr* "~A ~A~%" sym val) (+ (x val) (y val))))) (set! v_a_r 1) (test v_a_r 7)) (set! v_a_r 0) (test v_a_r 5) (gc) (gc) (set! v_a_r 2) (test v_a_r 9) (gc) (gc) (let ((err #f)) (catch #t (lambda () (set! v_a_r 3)) (lambda args (set! err #t))) (test v_a_r 9) (if (not err) (format *stderr* "no error in symbol accessor!"))) (define v_a_r_1 0) (let ((v_a_r_1 43) (x #(1 2 3))) (set! (setter 'v_a_r_1) (lambda (sym val) (x val))) (set! v_a_r_1 0) (test v_a_r_1 1)) (catch #t (lambda () (set! v_a_r_1 2)) (lambda args (apply format *stderr* (cadr args)))) (test v_a_r_1 2) (let ((x (vector 1 2 3))) (let ((y 32)) (let ((e1 (curlet)) (y 31)) (let ((e2 (curlet))) (set! (setter 'y e1) (lambda (sym val) (+ val (x 1))))) (set! y 3) (test y 3)) (set! y 2) (test y 4))) (let () (define (symbol-documentation sym e) (cond ((setter sym e) => documentation) (else #f))) (define (symbol-signature sym e) (cond ((setter sym e) => signature) (else #f))) ; or car? (define (set sym val e) (if (integer? val) val (symbol->value sym e))) (let ((x 3)) (set! (setter 'x) set) (set! x 4) (test x 4)) (let ((x 5)) (define set (let ((+signature+ '(integer? #t)) (+documentation+ "x is an integer")) (lambda (s v e) (if (integer? v) v (symbol->value s e))))) (let ((x 6)) (set! (setter 'x) set) (set! x 7) (test x 7) (test (symbol-documentation 'x (curlet)) "x is an integer") (test (symbol-signature 'x (curlet)) '(integer? #t))) (test x 5))) (let ((x (inlet :a 1 :b 2)) (set1 #f) (set2 #f)) (set! (setter 'a x) (lambda (s v e) (set! set1 v) (+ v 1))) (set! (setter 'b x) (lambda (s v e) (set! set2 v) (* v 2))) (set! (x 'a) 32) (set! (x 'b) (+ (x 'a) 1)) (test x (inlet :a 33 :b 68))) (let ((x 1)) (set! (setter 'x) integer?) (test x 1) (set! x 32) (test (set! x 3.14) 'error) (test x 32)) (let ((x 'a)) (set! (setter 'x) symbol?) (test x 'a) (test (set! x 3.14) 'error) (test x 'a)) (let ((x :a)) (set! (setter 'x) keyword?) (test x :a) (test (set! x 3.14) 'error) (test x :a)) (let ((x #f)) (set! (setter 'x) boolean?) (test (set! x 3.14) 'error) (test x #f)) (let ((x ())) (set! (setter 'x) proper-list?) (test (set! x 3.14) 'error) (test x ())) (unless with-bignums (let ((x (random-state 1234 4321))) (set! (setter 'x) random-state?) (test (set! x 123) 'error))) (test (let ((a (make-vector 3 'a symbol?))) (let ((b (copy a))) (vector-set! b 0 32))) 'error) (test (let ((a (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (let ((b (copy a))) (set! (b 'i) #\a))) 'error) (test (let ((a (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (object->string (copy a) :readable)) "(let ((i 0)) (set! (setter 'i) #_integer?) (curlet))") (let ((imv (immutable! (vector 0 1 2)))) (test ((lambda (x) (type-of (help (setter imv (vector x 0))))) 1) 'error) (test ((lambda* ((x 1)) (type-of (help (setter imv (vector x 0)))))) 'error) (test (let () (define (func) (let ((x 1)) (type-of (help (setter imv (vector 1 0)))))) (func) (func)) 'error)) (let ((x 1)) (set! (setter 'x) integer?) (let ((x 'a)) (set! (setter 'x) symbol?) (let ((x :a)) (set! (setter 'x) keyword?) (let ((x #f)) (set! (setter 'x) boolean?) (let ((x ())) (set! (setter 'x) proper-list?) (test (set! x 3.14) 'error) (test x ())) (test (set! x 3.14) 'error) (test x #f)) (test x :a) (test (set! x 3.14) 'error) (test x :a)) (test x 'a) (test (set! x 3.14) 'error) (test x 'a)) (test x 1) (set! x 32) (test (set! x 3.14) 'error) (test x 32)) (test (set! (setter setter) car) 'error) (test (immutable? (setter setter)) #t) (test (set! (setter values) car) 'error) (test (setter values) #f) ; else we get (set! (values...)...) which is a mess */ (test (immutable? (setter values)) #t) (let ((lst (list 1 2))) (set! (setter (setter car)) (lambda (s v1 v2) (list v1 v2))) (test (set! (set-car! lst 32) 4) '(32 4)) (test lst '(1 2)) (set! (setter (setter car)) #f)) (let ((x 4)) (set! (setter 'x) (lambda (s v) (unless (and (integer? v) (< 2 v 6)) (error 'wrong-type-arg "~S should be an integer between 2 and 6" s)) v)) (test (set! x 3) 3) (test (set! x 32) 'error)) (test (let ((x 1)) (set! (setter 'x) integer?) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x pi))) 'error) (test (let ((x 1)) (set! (setter 'x) integer?) (define (f) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x pi))) (f)) 'error) (test (let ((x 1)) (set! (setter 'x) integer?) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x i))) 0) ;; this can cause s7 to exit immediately (optimizer bug) (let ((x 1)) (set! (setter 'x) (lambda (s v) (catch #t (lambda () (asdf v)) (lambda arg 'error)))) (set! x 0) (test x 'error)) (test (let ((x 3)) (set! (setter 'x) integer?) (set! (setter 'x) #f) (set! x 4.0)) 4.0) (test (let ((x 3)) (set! (setter 'x) integer?) (set! (setter 'x) #f) (let-temporarily ((x 4.0)) x) x) 3) (test (let ((x 3)) (set! (setter 'x) integer?) (let-temporarily (((setter 'x) #f)) (set! x 4.0)) x) 4.0) (test (let ((x 3)) (set! (setter 'x) integer?) (let-temporarily (((setter 'x) #f)) (set! x 4.0)) (set! x 8.0)) 'error) (let () (define-macro (with-immutable objs . body) `(let-temporarily (,@(map (lambda (obj) `((setter ',obj) (lambda (s v) (error 'immutable-object-error "in with-immutable, can't set! ~A" ',obj)))) objs)) ,@body)) ;; (display (macroexpand (with-immutable (x) (set! y x)))) ;; (let-temporarily (((setter 'x) (lambda (s v) (error 'immutable-object-error "in with-immutable, can't set! ~A" 'x)))) (set! y x)) (test (let ((x 21)) (with-immutable (x) (set! x 3)) x) 'error) (test (let ((x 21) (y 0)) (let-temporarily (((setter 'x) (lambda (s v) (error 'oops "nope")))) (set! y x) y)) 21) (test (let ((x 21) (y 0)) (with-immutable (x) (set! y (+ x 1))) (list x y)) '(21 22)) (test (let ((x 21) (y 0)) (with-immutable (x y) (set! y (+ x 1)) (list x y))) 'error) (test (do ((i -10 (+ i 1))) ((= i 0)) (with-immutable (i) 0)) #t) ; do stepper uses pending_value also for setter -- this just barely works... (test (let loop ((x 21)) (with-immutable (x) (loop (set! x 2)))) 'error) (test (let loop ((x 21)) (with-immutable (x) (set! x (- x 1)) (when (positive? x) (loop x)))) 'error) (test (let loop ((x 2)) (set! x (- x 1)) (with-immutable (x) (if (positive? x) (loop x) 0))) 0) (test (let* ((x 0) (y (with-immutable (x) (set! x 0)))) 2) 'error) (test (letrec* ((x 0) (y (with-immutable (x) (set! x 0)))) 2) 'error) (when (defined? 'x) (format *stderr* "x is defined: ~S~%" x)) (test (letrec ((x 0) (y (with-immutable (x) (set! x 0)))) 2) 'error) ; can't set! x (test (let ((x 0) (y (with-immutable (x) (set! x 0)))) 2) 'error) ; x is unbound (test (letrec ((x 1) (y (begin (set! x 2)))) (+ x y)) 3) (test (letrec ((x 1) (y (begin (set! x 2)))) (list x y)) '(1 2)) (test (letrec ((x 1) (y x)) (list x y)) '(1 #)) (test (letrec ((x 1) (y (with-immutable (x) 2))) (list x y)) '(1 2)) ;; so x pending value is ok? slot_value is #, pending_value is 1, with-immutable returns it to 1 (test (letrec ((x 1) (y (begin (set! x 2) 3))) (list x y)) '(1 3)) ; Guile says '(2 3) ;; r7rs: if it is not possible to evaluate each init without assigning or referring to the value of any variable, it is an error. ;; which in spec-speak means both Guile and s7 are correct. ) (test (catch #t (lambda () (set! (#_abs 1) 2)) (lambda (type info) (apply format #f info))) "#_abs (a c-function) does not have a setter: (set! (#_abs 1) 2)") (test (catch #t (lambda () (set! 3 2)) (lambda (type info) (apply format #f info))) "set! can't change 3 (an integer), (set! 3 2)") (let () (define (fset x) 1) (test (catch #t (lambda () (set! (fset 1) 2)) (lambda (type info) (apply format #f info))) "fset (a function) does not have a setter: (set! (fset 1) 2)")) (test (catch #t (lambda () (set! (abs 1) 2)) (lambda (type info) (apply format #f info))) "abs (a c-function) does not have a setter: (set! (abs 1) 2)") (let () ;; (car (signature v)) is v's element type (define (vtype v) (and (integer? v) (>= 4 v 0))) (define iv1 (make-vector 3 0 vtype)) (set! (setter 'iv1) ; if iv1 set, new value should be a vector length 3 of ints between 0 and 3 (element-type vtype) (lambda (s v) (unless (vector? v) (error 'wrong-type-arg "set! ~S: ~S should be a vector" s v)) (unless (= (length v) 3) (error 'wrong-type-arg "set! ~S: new value's length is ~S, not 3" s (length v))) (unless (eq? (car (signature v)) 'vtype) (error 'wrong-type-arg "set! ~S: ~S's element type should be vtype, but it's ~S" s v (car (signature v)))) v)) (test (signature iv1) (let ((sig (list 'vtype 'vector? 'integer?))) ; (vtype vector? . #1=(integer? . #1#)) (set-cdr! (cddr sig) (cddr sig)) sig)) (test (catch #t (lambda () (set! (iv1 0) 'b)) (lambda (t info) (apply format #f info))) "vector-set! third argument 'b, is a symbol, but the vector's element type checker, vtype, rejects it") (define iv2 (make-vector 3 0 vtype)) (set! iv1 iv2) ; iv2 does't have any setter but it's iv1 that matters (test (eq? iv1 iv2) #t) (test (catch #t (lambda () (set! (iv1 0) 'b)) (lambda (t info) (apply format #f info))) "vector-set! third argument 'b, is a symbol, but the vector's element type checker, vtype, rejects it") (define iv3 (make-vector 3 'b)) (test (catch #t (lambda () (set! iv1 iv3)) (lambda (t info) (apply format #f info))) "set! iv1: #(b b b)'s element type should be vtype, but it's #t") (define iv4 (make-vector 4 0)) (test (catch #t (lambda () (set! iv1 iv4)) (lambda (t info) (apply format #f info))) "set! iv1: new value's length is 4, not 3") (define iv5 (make-int-vector 3 3)) (test (catch #t (lambda () (set! iv1 iv5)) (lambda (t info) (apply format #f info))) "set! iv1: #i(3 3 3)'s element type should be vtype, but it's integer?") (test (catch #t (lambda () (set! iv1 123)) (lambda (t info) (apply format #f info))) "set! iv1: 123 should be a vector")) (let () (define (vtype v) (and (integer? v) (>= 4 v 0))) (define h1 (make-hash-table 8 eq? (cons symbol? vtype))) (test (catch #t (lambda () (hash-table-set! h1 "asdf" 1)) (lambda (t info) (apply format #f info))) "hash-table-set! key second argument, \"asdf\", is a string but should be a symbol?") (test (catch #t (lambda () (hash-table-set! h1 'asdf 3.1)) (lambda (t info) (apply format #f info))) "hash-table-set! third argument 3.1, is a real, but the hash-table's value type checker, vtype, rejects it") (define h2 (make-hash-table 8 eq? (cons vtype symbol?))) (test (catch #t (lambda () (hash-table-set! h2 "asdf" 'a)) (lambda (t info) (apply format #f info))) "hash-table-set! second argument \"asdf\", is a string, but the hash-table's key type checker, vtype, rejects it") (test (catch #t (lambda () (hash-table-set! h2 1 3.1)) (lambda (t info) (apply format #f info))) "hash-table-set! third argument, 3.1, is a real but should be a symbol?")) (let () (define ictr (let ((counter 0)) (lambda () (set! counter (+ counter 1))))) (define (fs4) (let ((v (vector (inlet 'a (list 0))))) (set! (v 0 'a 0) (ictr)) (v 0 'a 0))) (define (err t i) (apply format #f i)) (test (catch #t (lambda () (fs4)) err) 1) (test (catch #t (lambda () (fs4)) err) 2) (define (fs4a) (let ((v (vector (inlet 'a (list 0))))) (vector-set! v 0 'a 0 (ictr)) (vector-ref v 0 'a 0))) (test (catch #t (lambda () (fs4a)) err) "too many arguments for vector-set!: (#((inlet 'a (0))) 0 a 0 3)") (test (catch #t (lambda () (fs4a)) err) "too many arguments for vector-set!: (#((inlet 'a (0))) 0 a 0 4)") (define (fs5) (let ((v (vector (inlet 'a 0)))) (set! (v 0 'a) (ictr)) (v 0 'a))) (test (catch #t (lambda () (fs5)) err) 5) (test (catch #t (lambda () (fs5)) err) 6) (define (fs5a) (let ((v (vector (inlet 'a 0)))) (vector-set! v 0 'a (ictr)) (vector-ref v 0 'a))) (test (catch #t (lambda () (fs5a)) err) "too many arguments for vector-set!: (#((inlet 'a 0)) 0 a 7)") (test (catch #t (lambda () (fs5a)) err) "too many arguments for vector-set!: (#((inlet 'a 0)) 0 a 8)") (define (fs6) (let ((v (list (inlet 'a 0)))) (set! (v 0 'a) (ictr)) (v 0 'a))) (test (catch #t (lambda () (fs6)) err) 9) (test (catch #t (lambda () (fs6)) err) 10) (define (fs6a) (let ((v (list (inlet 'a 0)))) (list-set! v 0 'a (ictr)) (list-ref v 0 'a))) (test (catch #t (lambda () (fs6a)) err) "too many arguments for list-set!: (0 a 11)") (test (catch #t (lambda () (fs6a)) err) "too many arguments for list-set!: (0 a 12)") (define (fs7) (let ((v (inlet 'a (vector 0)))) (set! (v 'a 0) (ictr)) (v 'a 0))) (test (catch #t (lambda () (fs7)) err) 13) (test (catch #t (lambda () (fs7)) err) 14) (define (fs7a) (let ((v (inlet 'a (vector 0)))) (let-set! v 'a 0 (ictr)) (let-ref v 'a 0))) (test (catch #t (lambda () (fs7a)) err) "let-set!: too many arguments: (let-set! (inlet 'a #(0)) a 0 15)") (test (catch #t (lambda () (fs7a)) err) "let-set!: too many arguments: (let-set! (inlet 'a #(0)) a 0 16)") (define (fs8) (let ((v (hash-table 'a (vector 0)))) (set! (v 'a 0) (ictr)) (v 'a 0))) (test (catch #t (lambda () (fs8)) err) 17) (test (catch #t (lambda () (fs8)) err) 18) (define (fs8a) (let ((v (hash-table 'a (vector 0)))) (hash-table-set! v 'a 0 (ictr)) (hash-table-ref v 'a 0))) (test (catch #t (lambda () (fs8a)) err) "hash-table-set!: too many arguments: (hash-table-set! (hash-table 'a #(0)) a 0 19)") (test (catch #t (lambda () (fs8a)) err) "hash-table-set!: too many arguments: (hash-table-set! (hash-table 'a #(0)) a 0 20)") (define (f1 a) a) (set! (setter f1) (macro (a b) `(begin ',b))) (test (set! (f1 0) (+ 1 2)) '(+ 1 2)) (test (set! (f1 0) (+ 1 2)) '(+ 1 2)) (define (f2) (set! (f1 0) (+ 1 2))) (test (f2) '(+ 1 2)) (test (f2) '(+ 1 2)) ) (do ((i 30 (+ i 1))) ((begin (set! (setter 'i) (lambda (s v) 32)) (= i 32))) (test (< i 32) #t)) (do ((i 30 (+ i 1)) (k (begin (set! (setter 'i) (lambda (s v) 32)) 0))) ((= i 32)) (test (< i 32) #t)) (do ((i 30 (+ i 1))) ((= i 32)) (set! (setter 'i) (lambda (s v) 32)) (test (< i 32) #t)) (do ((i 30 (+ i 1))) ((>= i 32)) (set! (setter 'i) (lambda (s v) 32)) (test (< i 32) #t) (set! i 0) (test i 32)) (letrec ((i 0) (k 1)) (set! (setter 'i) (lambda (s v) 12)) (set! i 0) (test i 12) (set! (setter 'i) #f) (set! i 0) (test i 0) (set! (setter 'k) (lambda (s v e) (+ v 1))) (set! k 2) (test k 3)) (letrec* ((i 0) (k 0)) (set! (setter 'i) (lambda (s v) 12)) (set! i 0) (test i 12) (set! (setter 'i) #f) (set! i 0) (test i 0) (set! (setter 'k) (lambda (s v e) (+ v 1))) (set! k 2) (test k 3)) (let () (define (f1 i) (test i 123) (set! i 0) (test i 0) (set! (setter 'i) (lambda (s v) (+ v 1))) (set! i 0) (test i 1) (set! (setter 'i) #f) (set! i 0) (test i 0)) (f1 123) (f1 123)) (let () (define (f2) (let ((i 123)) (test i 123) (set! i 0) (test i 0) (set! (setter 'i) (lambda (s v) (+ v 1))) (set! i 0) (test i 1) (set! (setter 'i) #f) (set! i 0) (test i 0))) (f2) (f2)) (let ((i 0)) (define (f3) (let ((i 123)) (set! (setter 'i) (lambda (s v) (+ v 1))) (set! i 11) (test i 12))) (f3) (set! i 11) (test i 11)) (let* ((i 0) (k (begin (set! (setter 'i) (lambda (s v) (+ v 1))) 1))) (set! i 2) (test i 3)) (let ((i 123)) (let f1 ((i 0) (k (begin (set! (setter 'i) (lambda (s v) (+ v 1))) 1))) (set! i 2) (test i 2) (if (> k 0) (f1 i (- k 1)))) (set! i 11) (test i 12)) (let ((i 123)) (let* f1 ((i 0) (k (begin (set! (setter 'i) (lambda (s v) (+ v 1))) 1)) (n 3)) (set! i 2) (test i n) (if (> k 0) (f1 i (- k 1) 2))) (set! i 11) (test i 11)) (let ((i 123)) (let* f1 ((n 1) (i 0) (k (begin (set! (setter 'i) (lambda (s v) (+ v 1))) 1))) (set! i 2) (test i 3) (if (> n 0) (f1 (- n 1)))) (set! i 11) (test i 11)) (let ((x 1)) (set! (setter 'x) (lambda (s v) (+ v 1))) (set! x 2) (test x 3) (set! (setter 'x) #f) (set! x 2) (test x 2) (test (setter 'x) #f) (define (f x) (+ x 1)) (set! (setter f) (lambda (a b) (+ b 1))) (test (set! (f 1) 3) 4) (set! (setter f) #f) (test (setter f) #f) (test (set! (f 1) 3) 'error) (set! (setter 'f) (lambda (a b) (+ b 2))) (test (set! (f 1) 2) 'error) (set! f 2) (test f 4) (set! (setter 'f) #f) (test (setter 'f) #f)) (let-temporarily (((setter cons) abs)) (define (func) (catch #t (lambda () (set! (cons 1 2) 321)) ; set_pair4 safe c_func->safe c_func, but 3 args to abs "set!: three arguments? (abs 1 2 321), abs is (setter cons)" (lambda (type info) 1))) (func) (test (func) 1)) (let-temporarily (((setter cons) list)) (define (func) (catch #t (lambda () (set! (cons 1 2) 321)) ; set_pair4 c_func->c_func, no errors -> '(1 2 321) (lambda (type info) 1))) (func) (test (func) '(1 2 321))) (let-temporarily (((setter cons) catch)) (define (func) (list (catch #t (lambda () (set! (cons 1 +) *)) ; set_pair4 c_func->unsafe c_func, no errors -> #((0)) (lambda (type info) 1)))) (func) (test (vector (func)) #((0)))) (let-temporarily (((setter logand) abs)) (define (func) (list (catch #t (lambda () (set! (logand 11) 12)) ;set_pair3 safe->safe(c_func), 2 args to abs "set!: two arguments? (abs 11 12), abs is (setter logand)" (lambda (type info) 10)))) (func) (test (vector (func)) #((10)))) (let-temporarily (((setter logand) catch)) (define (func) (list (catch #t (lambda () (set! (logand 11) 12)) ;set_pair3 safe->unsafe(c_func), 2 args to catch "catch: not enough arguments: (catch 11 12)" (lambda (type info) 10)))) (func) (test (vector (func)) #((10)))) (let () (define (f1 x) (+ x 1)) (let-temporarily (((setter f1) abs)) (define (func) (catch #t (lambda () (set! (f1 2) 321)) ; clo->c_func -> error: "set!: two arguments? (abs 2 321), abs is (setter f1)" (lambda (type info) 2))) (func) (test (func) 2))) (let () (let-temporarily (((setter +) expt)) (define (func) (catch #t (lambda () (set! (+) 321)) (lambda (type info) 2))) (func) (test (func) 2))) ; "set!: not enough arguments: (expt 321)" (let () (define (f2 x) (+ x 1)) (let-temporarily (((setter cons) f2)) (define (func) (catch #t (lambda () (set! (cons 1 2) 321)) ; set_pair4 safe cfunc -> clo; "f2: too many arguments: ((lambda (x) ...) 1 2 321)" (lambda (type info) 1))) (func) (test (func) 1))) (test (let ((x #f)) (set! x (set! (setter 'x) values))) 'error) ; op_set1 (test (let ((x #f)) (define (f) (set! x (set! (setter 'x) values))) (f)) 'error) (test (let ((x #f)) (define (g . args) (apply values args)) (set! x (set! (setter 'x) g))) 'error) ; splice_in_values etc (let () (define (f) (let ((x 0)) (set! x (set! (setter 'x) (lambda a (copy a)))))) (test (list? (f)) #t) ; #1=(x # (inlet 'x #1#)) -- new setter is called upon outer set! = copy args = (s v e) (test (list? (f)) #t) ; same (define (f1) (let ((x 0)) (set! x (set! (setter 'x) (lambda a (copy a)))) (setter 'x))) (test (procedure? (f1)) #t) ; # (test (procedure? (f1)) #t) ; same (define (f2) (let ((x 0)) (set! x (set! (setter 'x) (lambda a (copy a)))) x)) (test (list? (f2)) #t) ; #1=(x # (inlet 'x #1#)) (test (list? (f2)) #t) ; same ) ;; -------- set! + setter + values -------- (define a2 0) (test (set! (setter a2) (lambda (x y z) (list x y z))) 'error) (let ((a4 (lambda () 32))) (set! (setter a4) (lambda (x) x)) (test (set! (a4) 12) 12) (test (set! (a4 0) 12) 'error) (test (set! (a4 (values 1 2)) 12) 'error) (test (set! (a4) (values 1 2)) 'error) (test (let () (define (f1) (set! (a4) (values 1 2))) (f1)) 'error) (test (set! (a4) (c-function-with-values 1)) 1) (test (set! (a4) (c-function-with-values 1 2)) 'error) (test (set! (a4) (safe-c-function-with-2-values 1 2)) 'error) (test (set! (a4) (c-macro-with-values 1)) 1) (test (set! (a4) (c-macro-with-values 1 2)) 'error) (set! (setter a4) (lambda (x . y) (cons x y))) (test (set! (a4) 12) '(12)) (test (set! (a4 0) 12) '(0 12)) ; ?? not sure about these (test (set! (a4 (values 1 2)) 12) '(1 2 12)) ; ?? (test (set! (a4) (values 1 2)) 'error)) (let () ; use cf00 for safe-c-function (set! (setter cf00) (lambda (x) x)) (test (set! (cf00) 12) 12) (test (set! (cf00 0) 12) 'error) (test (set! (cf00 (values 1 2)) 12) 'error) (test (set! (cf00) (values 1 2)) 'error) (set! (setter cf00) (lambda (x . y) (cons x y))) (test (set! (cf00) 12) '(12)) (test (set! (cf00 0) 12) '(0 12)) ; ?? not sure about these (test (set! (cf00 (values 1 2)) 12) '(1 2 12)) ; ?? (test (set! (cf00) (values 1 2)) 'error)) (let ((a4 (lambda () 32))) (set! (setter a4) (macro (x) `,x)) (test (set! (a4) 12) 12) (test (set! (a4 0) 12) 'error) (test (set! (a4 (values 1 2)) 12) 'error) (test (set! (a4) (values 1 2)) 'error)) (let ((m4 (macro (x) `(+ ,x 2)))) (set! (setter m4) (lambda (x) x)) (test (set! (m4) 12) 12) (test (set! (m4 0) 12) 'error) (test (set! (m4 (values 1 2)) 12) 'error) (test (set! (m4) (values 1 2)) 'error) (test (let () (define (f1) (set! (m4) (values 1 2))) (f1)) 'error) (test (set! (m4) (c-function-with-values 1)) 1) (test (set! (m4) (c-function-with-values 1 2)) 'error) (test (set! (m4) (safe-c-function-with-2-values 1 2)) 'error) (test (set! (m4) (c-macro-with-values 1)) 1) (test (set! (m4) (c-macro-with-values 1 2)) 'error)) (let ((a4 (lambda () 32))) (set! (setter a4) (lambda (x) x)) (test (set! (a4) (call-with-exit (lambda (goto) (goto 1 2)))) 'error) (test (set! (a4) (call/cc (lambda (goto) (goto 1 2)))) 'error) (set! (setter a4) (lambda (a . b) (cons a b))) (test (set! (a4) (call-with-exit (lambda (goto) (goto 1 2)))) 'error) (test (set! (a4) (call/cc (lambda (goto) (goto 1 2)))) 'error)) (let ((a3 (lambda (x) x))) (set! (setter a3) (lambda (x y) (list x y))) (test (set! (a3 1) 2) '(1 2)) (test (set! (a3 1) 2 3) 'error) (test (set! (a3 1) (values 2 3)) 'error) (test (set! (a3 1 2) 3) 'error) (test (set! (a3 (values 1 21)) 3) 'error) (test (set! (a3 1 2 3)) 'error) (test (set! (a3 1 2 3) 4) 'error) (test (set! (a3 1 2) (values 3 4)) 'error) (test (set! (a3) (values 1 2)) 'error) (set! (setter a3) (lambda (x . y) (cons x y))) ;; but (setter 'a3) here says "a3 (a function) does not have a setter: (set! (a3 1 2) 3)" etc (test (set! (a3 1) 2) '(1 2)) (test (set! (a3 1) 2 3) 'error) (test (set! (a3 1) (values 2 3)) 'error) (test (set! (a3 1 2) 3) '(1 2 3)) (test (set! (a3 (values 1 21)) 3) '(1 21 3)) (test (set! (a3 1 2 3)) 'error) (test (set! (a3 1 2 3) 4) '(1 2 3 4)) (test (set! (a3 1 2) (values 3 4)) 'error) (test (set! (a3 1) (call-with-exit (lambda (goto) (goto 1 2)))) 'error) (test (set! (a3 1) (call/cc (lambda (goto) (goto 1 2)))) 'error)) (let () ; use cf10 for safe-c-function (set! (setter cf10) (lambda (x y) (list x y))) (test (set! (cf10 11) 12) '(11 12)) (test (set! (cf10 0 1) 12) 'error) (test (set! (cf10 (values 1 2)) 12) 'error) (test (set! (cf10 1) (values 1 2)) 'error) (test (set! (cf10 (values 1)) (values 2)) (list 1 2)) (test (set! (cf10) (values 1 2)) 'error) (test (set! ((values 'cf10 1)) 2) '(1 2)) (set! (setter cf10) (lambda (x . y) (cons x y))) (test (set! (cf10 1) 12) '(1 12)) (test (set! (cf10 0) 12) '(0 12)) (test (set! (cf10 (values 1 2)) 12) '(1 2 12)) (test (set! (cf10 1) (values 1 2)) 'error)) (let ((a5 (lambda (x y) (list x y))) (vals (lambda () (values 3 4)))) (set! (setter a5) (lambda (x y z) (list x y z))) (test (set! (a5 1 2) 3) '(1 2 3)) (test (set! (a5 1 2) (vals)) 'error) (test (set! (a5 1) (vals)) 'error) (test (set! (a5 1) 2) 'error) (test (set! (a5 (values 1 2)) 3) '(1 2 3)) (test (set! (a5 (vals)) (values 5)) '(3 4 5)) (set! (setter a5) (lambda (x . y) (cons x y))) (test (set! (a5 1 2) (vals)) 'error)) (let ((vals (lambda () (values 3 4)))) (set! (setter cf20) (lambda (x y z) (list x y z))) (test (set! (cf20 10 11) 12) '(10 11 12)) (test (set! (cf20 0 1 2) 12) 'error) (test (set! (cf20 (values 1 2)) 3) '(1 2 3)) (test (set! (cf20 (values 1 2 3)) 3) 'error) (test (set! (cf20 1 2) (values 1 2)) 'error) (test (set! (cf20 (values 1 2)) (values 3)) (list 1 2 3)) (test (set! (cf20) (values 1 2)) 'error) (test (set! (cf20 1 2) (vals)) 'error) (test (set! (cf20 (vals)) 5) '(3 4 5)) (test (set! ((values 'cf20 1 2)) 3) '(1 2 3)) (set! (setter cf20) (lambda (x . y) (cons x y))) (test (set! (cf20 1 2) 12) '(1 2 12)) (test (set! (cf20 0) (vals)) 'error) (test (set! (cf20 (values 1 2)) 12) '(1 2 12)) (test (set! (cf20 1) (values 1 2)) 'error)) (test (let ((a1 (lambda () 32))) (set! (setter a1) (lambda (x . y) x)) (set! (a1) 2)) 2) (test (let ((vals2 (lambda () (values 5 6)))) (let ((a1 (lambda () 32))) (set! (setter a1) (lambda (x . y) x)) (set! (a1) (vals2)))) 'error) (let ((a3 (lambda (x) x))) (set! (setter a3) (lambda (x . y) (cons x y))) (let ((vals (lambda () (values 3 4)))) (let ((func (lambda () (set! (a3 1 2) (vals))))) ; 2 inner args (test (func) 'error) (test (func) 'error)) (let ((func (lambda () (set! (a3 1) (vals))))) (test (func) 'error) (test (func) 'error)))) (test (let ((str "hi")) (set! (str 0 0) #\x) str) 'error) (test (let ((str "hi")) (set! ((values str 0) 0) #\x) str) 'error) (test (let ((a #(1)) (b #(2))) (set! ((if #t 'a 'b) 0) 3) a) #(3)) ; inner expr is evaluated: (test (let ((a #(1)) (b #(2))) (set! ((if #t a b) 0) 3) a) #(3)) (test (let ((v #2d((0 1) (2 3)))) (set! ((values 'v 1 0)) 32) v) #2d((0 1) (32 3))) (test (let ((v #2d((0 1) (2 3)))) (set! ((values v 1 0)) 32) v) #2d((0 1) (32 3))) (test (let ((v #2d((0 1) (2 3)))) (set! ((v 1) 0) 32) v) #2d((0 1) (32 3))) ;(test (let ((v #2d((0 1) (2 3)))) (set! ((values v 1) 0) 32) v) #2d((0 1) (32 3))) ; too many args (test (set! ((values #2d((0 1) (2 3)) 0 0)) 32) 32) (test (let ((v #2d((0 1) (2 3)))) (set! ((values 'v 0 0)) 32) v) #2d((32 1) (2 3))) ;(test (set! ((values #2d((0 1) (2 3)) 0) 0) 33) 33) ; set!: too many arguments: (set! #2d((0 1) (2 3)) 0 0 33) (let () (define _d_ (dilambda (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) (test (set! (_d_ (apply values (make-list 3 1/2)) 2) 3) 'error)) (let () (define _d_ (dilambda (lambda (x y z) (+ x y z)) (lambda (x y z w) (+ x y z w)))) (test (set! (_d_ (apply values (list 1 2)) 3) 4) 10)) ;;; -------------------------------------------------------------------------------- ;;; documentation (test (documentation 'tan) "(tan z) returns tan(z)") (test (let () (define hi (let ((+documentation+ "this is a string")) (lambda () 1))) (documentation hi)) "this is a string") (test (let () (define hi (let ((+documentation+ "this is a string")) (lambda () 1))) (help hi)) "this is a string") (test (let () (define hi (let ((+documentation+ "this is a string")) (lambda () 1))) (#_help hi)) "this is a string") (test (let ((documentation "oops")) (let () (define hi (lambda () 1)) (help hi))) #f) (test (let () (define hi (let ((+documentation+ "ok")) (lambda () 1))) (documentation hi)) "ok") (test (let ((documentation "oops")) (define hi (let () (lambda () 1))) (documentation hi)) 'error) ; it's a string here! (test (let () (define (hi) "this is a string") (hi)) "this is a string") (test (let () (define (hi) "this is a string") (documentation hi)) "this is a string") (test (set! (documentation abs) "X the unknown") 'error) (test (let ((str (documentation abs))) (set! ((documentation abs) 1) #\x) (equal? str (documentation abs))) #t) (test (let ((str (documentation abs))) (fill! (documentation abs) #\x) (equal? str (documentation abs))) #t) (test (let () (define f1 (let ((+documentation+ "f1's doc")) (lambda () (define f2 (lambda () 2)) (documentation f2)))) (f1)) "") (test (let () (define f1 (let ((+documentation+ "f1's doc")) (lambda () (define f2 (let ((+documentation+ "f2's doc")) (lambda () 2))) (documentation f2)))) (f1)) "f2's doc") (let () (define amac (let ((+documentation+ "this is a string")) (define-macro (_ a) `(+ ,a 1)))) (test-wi (documentation amac) "this is a string")) (let () (define amac (let ((+documentation+ "this is a string")) (define-macro* (_ (a 1)) `(+ ,a 1)))) (test-wi (documentation amac) "this is a string")) (let () (define amac (let ((+documentation+ "this is a string")) (define-bacro (_ a) `(+ ,a 1)))) (test-wi (documentation amac) "this is a string")) (let () (define amac (let ((+documentation+ "this is a string")) (define-bacro* (_ (a 1)) `(+ ,a 1)))) (test-wi (documentation amac) "this is a string")) (let () (define-macro (amac a) `(+ ,a 1)) (test (documentation amac) "")) (let () (define-bacro (amac a) ,a) (test (documentation amac) "")) (test-wi (documentation abs) "(abs x) returns the absolute value of the real number x") (test-wi (#_help abs) "(abs x) returns the absolute value of the real number x") (test-wi (documentation 'abs) "(abs x) returns the absolute value of the real number x") (test (let ((hi (let ((+documentation+ "this is a test")) (lambda (x) (+ x 1))))) (list (hi 1) (documentation hi))) (list 2 "this is a test")) (test (documentation (let ((+documentation+ "docs")) (lambda* (a b) a))) "docs") (test (documentation (let ((+documentation+ "")) (lambda* (a b) a))) "") (test (documentation (let ((+documentation+ "args: (a b)")) (lambda* (a b) a))) "args: (a b)") (test (documentation (call-with-exit (lambda (c) c))) "") (test (documentation (call/cc (lambda (c) c))) "") (test (documentation) 'error) (test (documentation abs abs) 'error) (test (help begin) "(begin ...) evaluates each form in its body, returning the value of the last one") (test (help 'tan) "(tan z) returns tan(z)") (test (string? (documentation when)) #t) (if (not (provided? 'snd)) (for-each (lambda (arg) (test (documentation arg) "") (test (help arg) #f)) (list -1 #\a #f _ht_ _undef_ 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi #(()) (list 1 2 3) '(1 . 2) "hi" :hi))) (let ((p (dilambda (lambda (a) (+ a 1)) (lambda (a b) (+ a b))))) (when (zero? (*s7* 'debug)) (test (object->string (procedure-source p)) "(lambda (a) (+ a 1))")) (let ((p1 p) (p2 (dilambda (let ((+documentation+ "pws doc")) (lambda (a) (+ a 1))) (lambda (a b) (+ a b))))) (test (equal? p p1) #t) (test (equal? p1 p2) #f) (test (documentation p2) "pws doc") (test (apply p2 '(2)) 3))) (let ((func (eval '(let ((+documentation+ "this is from eval")) (lambda (a) (+ a 1)))))) (test (func 3) 4) (test-wi (documentation func) "this is from eval")) (test (let ((e (inlet '(x . 3)))) (let ((func (eval '(lambda (a) (+ a x)) e))) (func 2))) 5) (unless (provided? 'snd) (let ((e (openlet (inlet 'help (lambda (obj) "this is helpful"))))) (test-wi (help e) "this is helpful"))) (let () (define fdoc (let ((+documentation+ "this is fdoc's doc")) (lambda (x) (+ x 1)))) (test-wi (documentation fdoc) "this is fdoc's doc") (define fdoc* (let ((+documentation+ "this is fdoc*'s doc")) (lambda* ((x 0)) (+ x 1)))) (test-wi (documentation fdoc*) "this is fdoc*'s doc") (define gdoc (let ((documentation (lambda (f) (format #f "this is gdoc's doc: ~S" (funclet f))))) (lambda (x) (+ x 1)))) (test-wi (documentation gdoc) "this is gdoc's doc: (inlet 'x ())") (test-wi (documentation (let ((documentation (lambda (f) "this is lambda's doc"))) (lambda (x) (+ x 1)))) "this is lambda's doc") (define mdoc (let ((+documentation+ "mdoc's doc")) (define-macro (_m_ x) `(+ 1 ,x)))) (test-wi (documentation mdoc) "mdoc's doc") ;; there is no built-in setter for 'documentation ) ;;; -------------------------------------------------------------------------------- ;;; signature (test (signature test) #f) (test (signature round abs) 'error) (test (signature) 'error) (test (signature :rest) #f) (for-each (lambda (arg) (test (signature arg) #f)) (list -1 #\a #f _undef_ 1 3.14 3/4 1.0+1.0i () 'hi :hi #)) (let ((iter (make-iterator '(1 2)))) (test (make-iterator iter) 'error)) (test (signature (make-iterator '(1 2))) '(#t)) (test (signature (make-iterator #i(1 2))) '(integer?)) (test (signature (make-iterator #r(1 2))) '(float?)) (test (signature (make-iterator #u(1 2))) '(byte?)) (test (signature (make-iterator #(1 2))) '(#t)) (test (signature (make-iterator (inlet 'a 1))) '(pair?)) (test (signature (make-iterator (hash-table 'a 1))) '(pair?)) (test (signature (make-iterator "hi")) '(char?)) (test (signature (make-iterator (let ((+signature+ '(integer? integer?)) (+iterator+ #t)) (lambda () 1)))) '(integer?)) (test (signature (make-iterator (let ((+iterator+ #t)) (lambda () 1)))) '(#t)) (test (signature "hi") '(char? string? integer?)) (test (signature (c-pointer 0)) #f) (test (signature (hash-table 'a 1)) (let ((sig (list #t 'hash-table? #t))) (set-cdr! (cddr sig) (cddr sig)) sig)) (test (equal? (let ((L (list 1 2 3))) (set-cdr! (cddr L) (cddr L)) L) (cons 1 (cons 2 (let ((L (list 3))) (set-cdr! L L))))) #t) (test (signature (list 1 2)) (cons #t (cons 'pair? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (vector 1 2)) (cons #t (cons 'vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (float-vector 1 2)) (cons 'float? (cons 'float-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (complex-vector 1+2i)) (cons 'complex? (cons 'complex-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (int-vector 1 2)) (cons 'integer? (cons 'int-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (byte-vector 1 2)) (cons 'byte? (cons 'byte-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature (inlet 'a 1)) (let ((sig (list #t 'let? 'symbol?))) (set-cdr! (cddr sig) (cddr sig)) sig)) (test (signature #()) #f) (test (signature #i()) #f) (test (signature #r()) #f) (test (signature #u()) #f) (when with-block (test (signature (block 1 2)) '(#t block? integer?)) (test (signature block-ref) '(#t block? integer?)) (test (signature block-set!) '(real? block? integer? float?)) (test (signature block?) '(boolean? #t))) (let () (define f1 (let ((+signature+ '(real? boolean?))) (lambda (x) (if x 1.0 2.0)))) (test (signature f1) '(real? boolean?)) (define f2 f1) (test (signature f1) '(real? boolean?)) (test (signature f2) '(real? boolean?)) (test (f1 #t) (f2 #t)) (define f3 f1) (test (signature f1) '(real? boolean?)) (test (signature f2) '(real? boolean?)) (define f4 f2) (test (signature f1) '(real? boolean?)) (test (signature f2) '(real? boolean?))) (let () (define fsig (let ((+signature+ '(integer? integer?))) (lambda (x) (+ x 1)))) (test (signature fsig) '(integer? integer?)) (define fsig* (let ((+signature+ '(integer? integer?))) (lambda* ((x 0)) (+ x 1)))) (test (signature fsig*) '(integer? integer?)) (define gsig (let ((signature (lambda (f) (list 'integer? 'integer?)))) (lambda (x) (+ x 1)))) (test (signature gsig) '(integer? integer?)) (test (signature (let ((signature (lambda (f) (list 'integer? 'integer?)))) (lambda (x) (+ x 1)))) '(integer? integer?)) (define msig (let ((+signature+ '(number? #t))) (define-macro (_m_ x) `(+ 1 ,x)))) (test (signature msig) '(number? #t)) ;; there is no built-in setter for 'signature ) (unless pure-s7 (test (signature char-ci<=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature char-ci=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature char-ci>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature char-ready?) '(boolean? input-port?)) (test (signature exact->inexact) '(number? number?)) (test (signature exact?) '(boolean? number?)) (test (signature inexact->exact) '(real? real?)) (test (signature inexact?) '(boolean? number?)) (test (signature integer-length) (let ((L (list 'integer?))) (set-cdr! L L) L)) (test (signature let->list) '(pair? let?)) (test (signature list->string) '(string? proper-list?)) (test (signature list->vector) '(vector? proper-list?)) (test (signature make-polar) '(number? real? real?)) (test (signature set-current-error-port) '((output-port? not) (output-port? not))) (test (signature set-current-input-port) '(input-port? input-port?)) (test (signature set-current-output-port) '((output-port? not) (output-port? not))) (test (signature string->list) (let ((L (list 'proper-list? 'string? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature string-ci<=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature string-ci=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature string-ci>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature string-fill!) (list '(char? integer?) 'string? 'char? 'integer? 'integer?)) (test (signature string-length) '(integer? string?)) (test (signature vector->list) (list 'proper-list? 'vector? 'integer? 'integer?)) (test (signature vector-append) (let ((L (list 'vector?))) (set-cdr! L L) L)) (test (signature vector-fill!) (let ((L (list #t 'vector? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L)) (test (signature vector-length) '(integer? vector?)) ) (test (signature boolean?) '(boolean? #t)) (test (signature round) '(integer? real?)) (test (signature #_exit) '(#t #t)) (test (signature (symbol "(c-object set)")) #f) (test (signature *) (let ((L (list 'number?))) (set-cdr! L L) L)) (test (signature +) (let ((L (list 'number?))) (set-cdr! L L) L)) (test (signature -) (let ((L (list 'number?))) (set-cdr! L L) L)) (test (signature /) (let ((L (list 'number?))) (set-cdr! L L) L)) (test (signature <) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature <=) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature =) (let ((L (list 'boolean? 'number?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature >) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature >=) (let ((L (list 'boolean? 'real?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature abs) '(real? real?)) (test (signature acos) '(number? number?)) (test (signature acosh) '(number? number?)) (test (signature angle) '(real? number?)) (test (signature append) (let ((L (list #t))) (set-cdr! L L) L)) (test (signature apply) (let ((L (list 'values '(procedure? sequence?) #t))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature apply-values) '(#t list?)) (test (signature aritable?) '(boolean? #t integer?)) (test (signature arity) '((pair? not) #t)) (test (signature ash) (let ((L (list 'integer?))) (set-cdr! L L) L)) (test (signature asin) '(number? number?)) (test (signature asinh) '(number? number?)) (test (signature assoc) '((pair? boolean?) #t list? procedure?)) (test (signature assq) '((pair? not) #t list?)) (test (signature assv) '((pair? not) #t list?)) (test (signature atan) '(number? number? real?)) (test (signature atanh) '(number? number?)) (when (provided? 'autoload) (test (signature autoload) '(#t symbol? #t)) (test (signature *autoload*) '(#t symbol?))) (test (signature bignum) (if with-bignums '(bignum? (number? string?) integer?) '((number? not) (number? string?) integer?))) (test (signature boolean?) '(boolean? #t)) (test (signature byte-vector) (let ((L (list 'byte-vector? 'byte?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature byte-vector-ref) (let ((L (list '(byte? byte-vector?) 'byte-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature byte-vector-set!) (let ((L (list 'byte? 'byte-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature byte-vector?) '(boolean? #t)) (test (signature byte-vector->string) '(string? byte-vector?)) (test (signature c-object?) '(boolean? #t)) (test (signature c-object-type) '(integer? c-object?)) (test (signature c-pointer) (let ((L (list 'c-pointer? 'integer? #t))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature c-pointer?) '(boolean? #t #t)) (test (signature c-pointer-info) '(#t c-pointer?)) (test (signature c-pointer-type) '(#t c-pointer?)) (test (signature c-pointer-weak1) '(#t c-pointer?)) (test (signature c-pointer-weak2) '(#t c-pointer?)) (test (signature caaaar) '(#t pair?)) (test (signature caaadr) '(#t pair?)) (test (signature caaar) '(#t pair?)) (test (signature caadar) '(#t pair?)) (test (signature caaddr) '(#t pair?)) (test (signature caadr) '(#t pair?)) (test (signature caar) '(#t pair?)) (test (signature cadaar) '(#t pair?)) (test (signature cadadr) '(#t pair?)) (test (signature cadar) '(#t pair?)) (test (signature caddar) '(#t pair?)) (test (signature cadddr) '(#t pair?)) (test (signature caddr) '(#t pair?)) (test (signature cadr) '(#t pair?)) (test (signature call-with-current-continuation) '(values procedure?)) (test (signature call-with-exit) '(values procedure?)) (test (signature call-with-input-file) '(#t string? (procedure? macro?))) (test (signature call-with-input-string) '(#t string? (procedure? macro?))) (test (signature call-with-output-file) '(#t string? (procedure? macro?))) (test (signature call-with-output-string) '(string? (procedure? macro?))) (test (signature call/cc) '(values procedure?)) (test (signature car) '(#t pair?)) (test (signature catch) '(values (symbol? boolean?) procedure? procedure?)) (test (signature cdaaar) '(#t pair?)) (test (signature cdaadr) '(#t pair?)) (test (signature cdaar) '(#t pair?)) (test (signature cdadar) '(#t pair?)) (test (signature cdaddr) '(#t pair?)) (test (signature cdadr) '(#t pair?)) (test (signature cdar) '(#t pair?)) (test (signature cddaar) '(#t pair?)) (test (signature cddadr) '(#t pair?)) (test (signature cddar) '(#t pair?)) (test (signature cdddar) '(#t pair?)) (test (signature cddddr) '(#t pair?)) (test (signature cdddr) '(#t pair?)) (test (signature cddr) '(#t pair?)) (test (signature cdr) '(#t pair?)) (test (signature ceiling) '(integer? real?)) (test (signature char->integer) '(integer? char?)) (test (signature char-alphabetic?) '(boolean? char?)) (test (signature char-downcase) (let ((L (list 'char?))) (set-cdr! L L) L)) (test (signature char-lower-case?) '(boolean? char?)) (test (signature char-numeric?) '(boolean? char?)) (test (signature char-position) '((integer? not) (char? string?) string? integer?)) (test (signature char-upcase) (let ((L (list 'char?))) (set-cdr! L L) L)) (test (signature char-upper-case?) '(boolean? char?)) (test (signature char-whitespace?) '(boolean? char?)) (test (signature char<=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature char=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature char>?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature char?) '(boolean? #t)) (test (signature close-input-port) '(unspecified? input-port?)) (test (signature close-output-port) '(unspecified? (output-port? not))) (test (signature complex) '(number? real? real?)) (test (signature complex?) '(boolean? #t)) (test (signature complex-vector) (let ((L (list 'complex-vector? 'complex?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature complex-vector-ref) (let ((L (list '(complex? complex-vector?) 'complex-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature complex-vector-set!) (let ((L (list 'complex? 'complex-vector? 'integer? 'integer:number?))) (set-cdr! (cdddr L) (cdddr L)) L)) (test (signature complex-vector?) '(boolean? #t)) (test (signature cons) '(pair? #t #t)) (test (signature continuation?) '(boolean? #t)) (test (signature copy) (let ((L (list #t #t #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L)) (test (signature cos) '(number? number?)) (test (signature cosh) '(number? number?)) (test (signature coverlet) (let ((L (list (list 'let? 'procedure? 'macro? 'c-object?)))) (set-cdr! L L) L)) (test (signature curlet) '(let?)) (test (signature current-error-port) '((output-port? not))) (test (signature current-input-port) '(input-port?)) (test (signature current-output-port) '((output-port? not))) (test (signature cutlet) (let ((L (list 'let? 'let? 'symbol?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature cyclic-sequences) '(proper-list? #t)) (test (signature defined?) '(boolean? symbol? (let? procedure? macro? c-object? c-pointer?) boolean?)) ; macro? includes bacro? (test (signature delete-file) '(integer? string?)) (test (signature denominator) '(integer? rational?)) (test (signature dilambda) '(procedure? procedure? procedure?)) (test (signature dilambda?) '(boolean? #t)) (test (signature directory->list) '(list? string?)) (test (signature directory?) '(boolean? string?)) (test (signature display) '(#t #t (output-port? not))) (test (signature dynamic-wind) '(values (procedure? not) procedure? (procedure? not))) (test (signature dynamic-unwind) '(procedure? procedure? #t boolean?)) (test (signature emergency-exit) '(#t #t)) (test (signature eof-object?) '(boolean? #t)) (test (signature eq?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature equal?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature eqv?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature error) (let ((L (list 'values #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature eval) '(values #t let?)) (test (signature eval-string) '(values string? let?)) (test (signature even?) '(boolean? integer?)) (test (signature exp) '(number? number?)) (test (signature expt) (let ((L (list 'number?))) (set-cdr! L L) L)) (test (signature file-exists?) '(boolean? string?)) (test (signature file-mtime) '(integer? string?)) (test (signature fill!) (let ((L (list #t 'sequence? #t 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L)) (test (signature float-vector) (let ((L (list 'float-vector? 'real?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature float-vector-ref) (let ((L (list '(float? float-vector?) 'float-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature float-vector-set!) (let ((L (list 'real? 'float-vector? 'integer? 'integer:real?))) (set-cdr! (cdddr L) (cdddr L)) L)) (test (signature float-vector?) '(boolean? #t)) (test (signature float?) '(boolean? #t)) (test (signature floor) '(integer? real?)) (test (signature flush-output-port) '(#t (output-port? not))) (test (signature for-each) (let ((L (list 'unspecified? 'procedure? 'sequence?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature format) (let ((L (list 'string? '(output-port? boolean? null?) #t))) (set-cdr! (cddr L) (cddr L)) L)) ; changed 19-Mar-24 (test (signature funclet) '((let? null?) (procedure? macro? symbol?))) (test (signature funclet?) '(boolean? #t)) (test (signature gc) '(#t boolean?)) (test (signature gcd) (let ((L (list 'rational?))) (set-cdr! L L) L)) (test (signature gensym) '(gensym? string?)) (test (signature gensym?) '(boolean? #t)) (test (signature get-output-string) '(string? (output-port? not) boolean?)) (test (signature getenv) '((string? not) string?)) (test (signature hash-table) (let ((L (list 'hash-table? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature hash-table-entries) '(integer? hash-table?)) (test (signature hash-table-key-typer) '((not procedure?) hash-table?)) (test (signature hash-table-ref) (let ((L (list #t 'hash-table? #t))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature hash-table-set!) '(#t hash-table? #t #t)) (test (signature hash-table-value-typer) '((not procedure?) hash-table?)) (test (signature hash-table?) '(boolean? #t)) (test (signature imag-part) '(real? number?)) (test (signature immutable!) '(#t #t let?)) (test (signature immutable?) '(boolean? #t let?)) (test (signature infinite?) '(boolean? #t)) ; was number? but we want to use this in signatures (test (signature inlet) (let ((L (list 'let? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature input-port?) '(boolean? #t)) (test (signature int-vector) (let ((L (list 'int-vector? 'integer?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature int-vector-ref) (let ((L (list '(integer? int-vector?) 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature int-vector-set!) (let ((L (list 'integer? 'int-vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature int-vector?) '(boolean? #t)) (test (signature integer->char) '(char? integer?)) (test (signature integer-decode-float) '(pair? float?)) (test (signature integer?) '(boolean? #t)) (test (signature iterate) '(#t iterator?)) (test (signature iterator-at-end?) '(boolean? iterator?)) (test (signature iterator-sequence) '(sequence? iterator?)) (test (signature iterator?) '(boolean? #t)) (test (signature keyword->symbol) '(symbol? keyword?)) (test (signature keyword?) '(boolean? #t)) (test (signature lcm) (let ((L (list 'rational?))) (set-cdr! L L) L)) (test (signature length) '((integer? infinite? not) #t)) (test (signature let-ref) '(#t let? symbol?)) (test (signature let-set!) '(#t let? symbol? #t)) (test (signature let?) '(boolean? #t)) (test (signature list) (let ((L (list 'proper-list? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature list-ref) (let ((L (list #t 'pair? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature list-set!) (let ((L (list #t 'pair? 'integer? 'integer:any?))) (set-cdr! (cdddr L) (cdddr L)) L)) (test (signature list-tail) '(#t pair? integer?)) (test (signature list?) '(boolean? #t)) ;(test (signature #) '(list? list? #t)) (test (signature load) '(values string? let?)) (test (signature log) (let ((L (list 'number?))) (set-cdr! L L) L)) (test (signature logand) (let ((L (list 'integer?))) (set-cdr! L L) L)) (test (signature logbit?) (let ((L (list 'boolean? 'integer?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature logior) (let ((L (list 'integer?))) (set-cdr! L L) L)) (test (signature lognot) (let ((L (list 'integer?))) (set-cdr! L L) L)) (test (signature logxor) (let ((L (list 'integer?))) (set-cdr! L L) L)) (test (signature macro?) '(boolean? #t)) (test (signature magnitude) '(real? number?)) (test (signature make-byte-vector) '(byte-vector? (integer? pair?) byte?)) (test (signature make-complex-vector) '(complex-vector? (integer? pair?) complex?)) (test (signature make-float-vector) '(float-vector? (integer? pair?) real?)) (test (signature make-hash-table) '(hash-table? integer? (procedure? pair? not) (pair? not))) (test (signature make-weak-hash-table) '(weak-hash-table? integer? (procedure? pair? not) (pair? not))) (test (signature make-int-vector) '(int-vector? (integer? pair?) integer?)) (test (signature make-iterator) '(iterator? sequence? (boolean? pair?))) (test (signature make-list) '(proper-list? integer? #t)) (test (signature make-rectangular) '(number? real? real?)) (test (signature make-string) '(string? integer? char?)) (test (signature make-vector) '(vector? (integer? pair?) #t (procedure? boolean?))) ; boolean? here should be #t -- #f == #t currently (test (signature map) (let ((L (list 'proper-list? 'procedure? 'sequence?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature max) (let ((L (list 'real?))) (set-cdr! L L) L)) (test (signature member) '((pair? not) #t list? procedure?)) (test (signature memq) '((pair? not) #t list?)) (test (signature memv) '((pair? not) #t list?)) (test (signature min) (let ((L (list 'real?))) (set-cdr! L L) L)) (test (signature modulo) (let ((L (list 'real?))) (set-cdr! L L) L)) (test (signature equivalent?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature nan?) '(boolean? #t)) ; see infinite? (test (signature negative?) '(boolean? real?)) (test (signature newline) '(char? (output-port? not))) (test (signature not) '(boolean? #t)) (test (signature null?) '(boolean? #t)) (test (signature number->string) '(string? number? integer?)) (test (signature number?) '(boolean? #t)) (test (signature numerator) '(integer? rational?)) (test (signature object->string) '(string? #t (boolean? keyword?) integer?)) (test (signature odd?) '(boolean? integer?)) (test (signature open-input-file) '(input-port? string? string?)) (test (signature open-input-function) '(input-port? (procedure? macro?))) (test (signature open-input-string) '(input-port? string?)) (test (signature open-output-function) '(output-port? (procedure? macro?))) (test (signature open-output-file) '(output-port? string? string?)) (test (signature open-output-string) '(output-port?)) (test (signature openlet) (let ((L (list (list 'let? 'procedure? 'macro? 'c-object?)))) (set-cdr! L L) L)) (test (signature openlet?) '(boolean? #t)) (test (signature outlet) '(let? let?)) (test (signature output-port?) '(boolean? #t)) (test (signature owlet) '(let?)) (test (signature pair-filename) '((string? not) pair?)) (test (signature pair-line-number) '((integer? not) pair?)) (test (signature pair?) '(boolean? #t)) (test (signature peek-char) '((char? eof-object?) input-port?)) (test (signature port-closed?) '(boolean? (input-port? output-port? not))) (test (signature port-file) '(c-pointer? (input-port? output-port?))) (test (signature port-filename) '(string? (input-port? output-port?))) (test (signature port-line-number) '(integer? input-port?)) (test (signature port-string) '(string? (input-port? output-port?))) (test (signature port-position) '(integer? input-port?)) (test (signature positive?) '(boolean? real?)) (test (signature documentation) '(string? #t)) (test (signature procedure-source) '(list? (procedure? macro?))) (test (signature procedure-arglist) '((list? symbol?) (procedure? macro?))) (test (signature procedure?) '(boolean? #t)) (test (signature proper-list?) '(boolean? #t)) (test (signature provide) '(symbol? symbol?)) (test (signature provided?) '(boolean? symbol?)) (test (signature quasiquote) #f) (test (signature quotient) (let ((L (list 'real?))) (set-cdr! L L) L)) (test (signature random) '(number? number? random-state?)) (test (signature random-state) (let ((L (list 'random-state? 'integer?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature random-state->list) (if with-bignums '(list? random-state?) '(pair? random-state?))) (test (signature random-state?) '(boolean? #t)) (test (signature rational?) '(boolean? #t)) (test (signature rationalize) '(rational? real? real?)) ; maybe return type: (real? boolean?) but I can't find a case for either (test (signature read) '(#t input-port?)) (test (signature read-byte) '((byte? eof-object?) input-port?)) (test (signature read-char) '((char? eof-object?) input-port?)) (test (signature read-line) '((string? eof-object?) input-port? boolean?)) (test (signature read-string) '((string? eof-object?) integer? input-port?)) (test (signature real-part) '(real? number?)) (test (signature real?) '(boolean? #t)) (test (signature remainder) (let ((L (list 'real?))) (set-cdr! L L) L)) (test (signature reverse!) '(sequence? sequence?)) (test (signature reverse) '(sequence? sequence?)) (test (signature rootlet) '(let?)) (test (signature round) '(integer? real?)) (test (signature *function*) '(#t let? symbol?)) (test (signature sequence?) '(boolean? #t)) (test (signature set-car!) '(#t pair? #t)) (test (signature set-cdr!) '(#t pair? #t)) (test (signature setter) '((not procedure?) #t (let? null?))) (test (signature signature) '((pair? boolean?) #t)) (test (signature sin) '(number? number?)) (test (signature sinh) '(number? number?)) (test (signature sort!) '(sequence? sequence? procedure?)) (test (signature sqrt) '(number? number?)) (test (signature stacktrace) '(string? integer? integer? integer? integer? boolean?)) (test (signature string) (let ((L (list 'string? 'char?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature string->byte-vector) '(byte-vector? string?)) (test (signature string-copy) '(string? string? string? integer? integer?)) (test (signature string->keyword) '(keyword? string?)) (test (signature string->number) '((number? not) string? integer?)) (test (signature string->symbol) '(symbol? string?)) (test (signature string-append) (let ((L (list 'string?))) (set-cdr! L L) L)) (test (signature string-downcase) (let ((L (list 'string?))) (set-cdr! L L) L)) (test (signature string-position) '((integer? not) string? string? integer?)) (test (signature string-ref) '(char? string? integer?)) (test (signature string-set!) '(char? string? integer? char?)) (test (signature string-upcase) (let ((L (list 'string?))) (set-cdr! L L) L)) (test (signature string<=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature string=?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature string>?) (let ((L (list 'boolean? 'string?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature string?) '(boolean? #t)) (test (signature sublet) (let ((L (list 'let? 'let? '(pair? symbol? let?) #t))) (set-cdr! (cdddr L) (cddr L)) L)) (test (signature substring) '(string? string? integer? integer?)) (test (signature substring-uncopied) '(string? string? integer? integer?)) (test (signature subvector) '(subvector? vector? integer? integer? pair?)) (test (signature subvector?) '(boolean? #t)) (test (signature subvector-position) '(integer? subvector?)) (test (signature subvector-vector) '(vector? subvector?)) (test (signature symbol) (let ((L (list 'symbol? 'string?))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature symbol->dynamic-value) '(#t symbol?)) (test (signature symbol-initial-value) '(#t symbol?)) (test (signature symbol->keyword) '(keyword? symbol?)) (test (signature symbol->string) '(string? symbol?)) (test (signature symbol->value) '(#t symbol? (let? procedure? c-pointer? continuation? goto? macro?))) ;(test (signature setter) '((boolean? procedure?) symbol? let?)) (test (signature symbol-table) '(vector?)) (test (signature symbol?) '(boolean? #t)) (test (signature system) '((integer? string?) string? boolean?)) (test (signature tan) '(number? number?)) (test (signature tanh) '(number? number?)) (test (signature throw) (let ((L (list 'values #t))) (set-cdr! (cdr L) (cdr L)) L)) ; was pcl_t (test (signature tree-count) '(integer? #t list? integer?)) (test (signature tree-leaves) '(integer? list?)) (test (signature tree-memq) '(boolean? #t list?)) (test (signature tree-set-memq) '(boolean? list? list?)) (test (signature tree-cyclic?) '(boolean? #t)) (test (signature truncate) '(integer? real?)) (test (signature type-of) '((symbol? not) #t)) (test (signature unlet) '(let?)) (test (signature values) (let ((L (list 'values #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature varlet) (let ((L (list 'let? 'let? '(pair? symbol? let?) #t))) (set-cdr! (cdddr L) (cddr L)) L)) (test (signature vector) (let ((L (list 'vector? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature vector-dimensions) '(pair? vector?)) (test (signature vector-dimension) '(integer? vector? integer?)) (test (signature vector-rank) '(integer? vector?)) (test (signature vector-ref) (let ((L (list #t 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L)) (test (signature vector-set!) (let ((L (list #t 'vector? 'integer? 'integer:any?))) (set-cdr! (cdddr L) (cdddr L)) L)) (test (signature vector-typer) '((not procedure?) vector?)) (test (signature vector?) '(boolean? #t)) (test (signature with-input-from-file) '(#t string? (procedure? macro?))) (test (signature with-input-from-string) '(#t string? (procedure? macro?))) (test (signature with-output-to-file) '(#t string? (procedure? macro?))) (test (signature with-output-to-string) '(string? (procedure? macro?))) (test (signature write) '(#t #t (output-port? not))) (test (signature write-byte) '(byte? byte? (output-port? not))) (test (signature write-char) '(char? char? (output-port? not))) (test (signature write-string) (let ((L (list 'string? 'string? '(output-port? not) 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L)) (test (signature zero?) '(boolean? number?)) (test (signature object->let) '(let? #t)) (test (signature undefined?) '(boolean? #t)) (test (signature constant?) '(boolean? #t)) (test (signature help) '((string? boolean?) #t)) (test (signature profile-in) '(#t integer? let?)) (test (signature unspecified?) '(boolean? #t)) (test (signature c-pointer->list) '(pair? c-pointer?)) (test (signature exit) '(#t #t)) (test (signature bignum?) '(boolean? #t)) (test (signature weak-hash-table?) '(boolean? #t)) (test (signature weak-hash-table) (let ((L (list 'hash-table? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature goto?) '(boolean? #t)) (test (signature byte?) '(boolean? #t)) (test (signature hash-code) '(integer? #t #t)) (test (signature syntax?) '(boolean? #t)) (test (signature list-values) (let ((L (list 'list? #t))) (set-cdr! (cdr L) (cdr L)) L)) (test (signature make-hook) #f) (test (signature hook-functions) '(list? procedure?)) (test (signature 'abs) #f) (test (signature #(1 2)) (let ((lst (list #t 'vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst)) (test (signature #i(1 2)) (let ((lst (list 'integer? 'int-vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst)) (test (signature #r(1.0 2.0)) (let ((lst (list 'float? 'float-vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst)) (test (signature #c(1.0+i 2.0-i)) (let ((lst (list 'complex? 'complex-vector? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst)) (test (signature #u(1 2)) (cons 'byte? (cons 'byte-vector? (let ((L (list 'integer?))) (set-cdr! L L))))) (test (signature "12") '(char? string? integer?)) (test (signature '(1 2)) (let ((lst (list #t 'pair? 'integer?))) (set-cdr! (cddr lst) (cddr lst)) lst)) (test (signature (openlet (inlet 'a 1 'signature (lambda (obj) (list 'integer? 'let? 'symbol?))))) '(integer? let? symbol?)) (test (signature (make-hash-table 8 #f (cons symbol? integer?))) '(integer? hash-table? symbol?)) (let ((var 1)) (set! (setter 'var) (let ((+signature+ '(integer?))) (lambda (s v) 1))) (test (signature 'var) '(integer?))) (let ((var 1)) (set! (setter 'var) (let ((+signature+ '(integer?))) (lambda (s v) 1))) (let ((var 2)) (test (signature 'var) #f))) (test (s7-optimize '((vector-ref +signature+ (make-byte-vector '(4 32) 255) (* 2 x 3.0 4) (car)))) #) (define (symbol->value-anywhere sym) (if (defined? sym) (symbol->value sym) (letrec ((libsearch (lambda (sym libs) (if (pair? libs) (if (defined? sym (cdar libs)) (symbol->value sym (cdar libs)) (libsearch sym (cdr libs))) #)))) (libsearch sym *libraries*)))) (let ((st (symbol-table))) (for-each (lambda (s) (catch #t (lambda () (let ((f (symbol->value-anywhere s))) (if (procedure? f) (let ((sig (signature f)) (ari (arity f))) (if (and sig (not (pair? sig))) (format *stderr* "signature ~A: ~A~%" s sig)) (when (pair? sig) (if (and (pair? ari) (> (cdr ari) (- (length sig) 1)) (or (< (cdr ari) 20) (< (length sig) 10)) (not (eq? s 'make-hook))) (format *stderr* "signature is missing arg type: ~A: ~A ~A~%~%" s ari sig)) (when (and (pair? sig) (pair? (car sig)) (or (null? (cdar sig)) (memq #t (car sig)) (let search ((lst (car sig))) (and (pair? lst) (or (memq (car lst) (cdr lst)) (search (cdr lst))))))) (format *stderr* "arity/sig mismatch? ~A: ~A?~%" s sig))))))) (lambda args #f))) st)) ;;; -------------------------------------------------------------------------------- ;;; funclet (let ((f1 (lambda (a) (+ a 1))) (f2 (lambda* ((a 2)) (+ a 1)))) (define (hi a) (+ a 1)) (define* (ho (a 1)) (+ a 1)) (test (let? (funclet hi)) #t) (test (let? (funclet ho)) #t) (test (let? (funclet f1)) #t) (test (let? (funclet f2)) #t) (test (let? (funclet abs)) #t) (test (> (length (funclet abs)) 100) #t) (test (fill! (funclet abs) 0) 'error) (test (reverse (funclet abs)) 'error) ; was rootlet 14-Feb-19 (test (fill! (funclet ho) 0) 'error) (test (reverse (funclet ho)) 'error)) ; changed to error as above (test (funclet quasiquote) (rootlet)) (test (funclet lambda) 'error) (test (funclet abs) (rootlet)) (test (funclet cond-expand) (rootlet)) (test ((rootlet) 'memcpy) #) ; see *libc* below -- memcpy should be in *libc* and not in (rootlet) (let () (define func (let ((lst (list 1 2 3))) (lambda (a) (((funclet func) 'lst) a)))) (test (func 1) 2)) (let () (define func (let ((lst (list 1 2 3))) (lambda (a) ((funclet func) 'lst a)))) (test (func 1) 2)) (let ((lt (inlet 'a #(1 2 3)))) (test (lt 'a 1) 2)) (let () (define func (let ((lst (list 1 2 3))) (lambda (a) ((list (funclet func)) 0 'lst)))) (test (func 1) '(1 2 3))) (let () (define f1 (let ((private-var 1)) (lambda () private-var))) (define (f2) (+ ((funclet f1) 'private-var) 1)) (test (list (f1) (f2)) '(1 2))) (let ((f1 #f) (f2 #f)) (let ((private-var 1)) (set! f1 (lambda () private-var)) (set! f2 (lambda () (+ private-var 1)))) (test (list (f1) (f2)) '(1 2))) (for-each (lambda (arg) (test (funclet arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi #(()) (list 1 2 3) '(1 . 2) "hi")) (test (let () (define (hi a) (let ((func (*function* (curlet)))) (list (if (symbol? func) func (car func)) a))) (hi 1)) (list 'hi 1)) (set! (hook-functions *unbound-variable-hook*) ()) (catch #t (lambda () (let () (define (f1 e) (with-let e (hash-table-set! ht :a (abs x)))) (f1 (inlet :ht (make-hash-table) :x -1)) (f1 (inlet :ht (make-hash-table) :x -1)) (test (f1 (inlet :ht (make-hash-table))) 'error))) (lambda args #f)) (catch #t (lambda () (let () (let ((x 1)) (let ((ht (make-hash-table))) (define (f1) (hash-table-set! ht :a (abs x))) (f1) (set! (outlet (curlet)) (inlet)) (test (f1) 'error))))) (lambda args #f)) (let () (define (f1) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 3)) (with-let (inlet 'x 1) (display x)))))) (test (f1) "111")) (let () (define (f1 e) (do ((i 0 (+ i 1))) ((= i 3)) (with-let e (hash-table-set! ht :a (abs x))))) (f1 (inlet :ht (make-hash-table) :x -1)) (test (f1 (inlet :ht (make-hash-table) :x -1)) #t)) (test (let () (define hi (let ((a 32)) (lambda (b) (+ a b)))) (define ho (with-let (funclet hi) (lambda (b) (+ a b)))) (list (hi 1) (ho 1))) (list 33 33)) (test (let () (define (hi a) (+ a 1)) (with-let (funclet hi) ((eval (procedure-source hi)) 2))) 3) (let () (define (where-is func) (let ((addr (with-let (funclet func) (*function* (curlet))))) (if (not (pair? addr)) "" (list (format #f "~A[~D]" (cadr addr) (caddr addr)) addr)))) (let ((e (where-is ok?))) (test (and (pair? (cadr e)) (< ((cadr e) 2) 1000)) ; this depends on where ok? is in this file #t) (test (and (pair? (cadr e)) (string=? (symbol->string (car (cadr e))) "ok?")) #t) (test (and (pair? (cadr e)) (let ((name (cadr (cadr e)))) (and (string? name) (call-with-exit (lambda (oops) (let ((len (length name))) (do ((i 0 (+ i 1))) ((= i len) #t) (if (and (not (char-alphabetic? (name i))) (not (char=? (name i) #\/)) (not (char=? (name i) #\\)) (not (char=? (name i) #\.)) (not (char=? (name i) #\-)) (not (char-numeric? (name i)))) (begin (format #t "ok? file name: ~S~%" name) (oops #f)))))))))) #t))) (test (let () (define (f1 a) (*function* (curlet))) (let ((fe (f1 1))) (if (pair? fe) (car fe) fe))) 'f1) (test (let () (define (f1 a) (define (f2 b) (*function* (curlet))) (f2 a)) (let ((fe (f1 1))) (if (pair? fe) (car fe) fe))) 'f2) (test (let () (define (f1 a) (define (f2 b) (define (f3 c) (*function* (curlet))) (f3 b)) (f2 a)) (let ((fe (f1 2))) (if (pair? fe) (car fe) fe))) 'f3) (test (let () (define (f1 a) (define (f2 b) (define (f3 c) (define (f4 d) (*function* (curlet))) (f4 c)) (f3 b)) (f2 a)) (let ((fe (f1 1))) (if (pair? fe) (car fe) fe))) 'f4) (test (let () (define (f1 a) (let () (define (f2 b) (*function* (curlet))) (f2 a))) (let ((fe (f1 1))) (if (pair? fe) (car fe) fe))) 'f2) (test (with-let (funclet abs) (*function* (curlet))) #f) (test (with-let (funclet quasiquote) (*function* (curlet))) #f) (test (with-let (funclet reader-cond) (*function* (curlet))) #f) (test (with-let (funclet *error-hook*) (*function*)) 'make-hook) (let () (define-macro (window func beg end . body) `(call-with-exit (lambda (quit) (do ((notes ',body (cdr notes))) ((null? notes)) (let* ((note (car notes)) (note-beg (cadr note))) (if (<= ,beg note-beg) (if (> note-beg (+ ,beg ,end)) (quit) (,func note)))))))) (test (let ((n 0)) (window (lambda (a-note) (set! n (+ n 1))) 0 1 (fm-violin 0 1 440 .1) (fm-violin .5 1 550 .1) (fm-violin 3 1 330 .1)) n) 2) (test (let ((notes 0) (env #f)) (set! env (curlet)) (window (with-let env (lambda (n) (set! notes (+ notes 1)))) 0 1 (fm-violin 0 1 440 .1) (fm-violin .5 1 550 .1) (fm-violin 3 1 330 .1)) notes) 2)) (test (let () (define-macro (window func beg end . body) `(let ((e (curlet))) (call-with-exit (lambda (quit) (do ((notes ',body (cdr notes))) ((null? notes)) (let* ((note (car notes)) (note-beg (cadr note))) (if (<= ,beg note-beg) (if (> note-beg (+ ,beg ,end)) (quit) ((with-let e ,func) note))))))))) (let ((notes 0)) (window (lambda (n) (set! notes (+ notes 1))) 0 1 (fm-violin 0 1 440 .1) (fm-violin .5 1 550 .1) (fm-violin 3 1 330 .1)) notes)) 2) (let () (define ff (let ((x 1)) (let ((y 2)) (let ((f (let ((z 3)) (lambda (a) (+ a x y z))))) (set! (outlet (funclet f)) (inlet 'x 10 'y 11 'z 12)) f)))) (test (ff 20) 44)) ; (funclet f): (inlet 'z 3), funclet can't be set #| ;;; this checks existing procedures (let ((st (symbol-table)) (p (open-output-file "pinfo"))) (for-each (lambda (sym) (if (defined? sym) (let ((val (symbol->value sym))) (format p "---------------- ~A ----------------~%" sym) (catch #t (lambda () (let ((str (documentation val)) (sym-name (symbol->string sym))) (if (procedure? val) (if (= (length str) 0) (format p "~A: [no doc]~%" sym) (let ((pos (substring? sym-name str))) (if (and (not pos) (not (char-upper-case? (sym-name 0))) (not (char=? (sym-name 0) #\.)) (not (char=? (sym-name 0) #\[))) (format p "~A documentation [no matched name]: ~A~%" sym str))))))) (lambda args (if (procedure? val) (format p "~A documentation: error: ~A~%" sym (apply format #f (cadr args)))))) (catch #t (lambda () (let ((lst (procedure-source val))) (if (not lst) (if (procedure? val) (format p "~A: [no source]~%" sym)) (if (and (not (pair? lst)) (not (null? lst))) (format p "~A source: ~A~%" sym lst))))) (lambda args (if (procedure? val) (format p "~A source: error: ~A~%" sym (apply format #f (cadr args)))))) (catch #t (lambda () (let ((pe (funclet val))) (if (not pe) (if (procedure? val) (format p "~A: [no environment]~%" sym)) (if (not (let? pe)) (format p "~A environment:~%" sym pe) (if (not (eq? (rootlet) pe)) (format p "~A env: ~A~%" sym (let->list pe))))))) (lambda args (if (procedure? val) (format p "~A environment: error: ~A~%" sym (apply format #f (cadr args)))))) ))) st) (close-output-port p)) |# ;;; -------------------------------------------------------------------------------- ;;; funclet? (for-each (lambda (arg) (test (funclet? arg) #f)) (list -1 #\a 1 #f _ht_ _undef_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) "hi" (lambda () 1))) (test (funclet?) 'error) (test (funclet? 1 2) 'error) (test (funclet? (rootlet)) #f) (let () (define (f) (funclet? (curlet))) (test (f) #f)) ; changed 24-Sep-21 (let () (define (f) (funclet? (outlet (curlet)))) (test (f) #t)) ;;; -------------------------------------------------------------------------------- ;;; *function* (for-each (lambda (arg) (test (*function* arg) 'error)) (list -1 #\a 1 #f _ht_ _undef_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) "hi" (lambda () 1))) (let () (define (f) (*function* (inlet 'a 1) #f)) (test (f) 'error)) (unless (> (*s7* 'debug) 0) (let () (define (func x) (*function* (curlet) x)) (test (func :name) 'func) (test (func :arity) '(1 . 1)) (test (func :signature) #f) (test (func :source) '(lambda (x) (*function* (curlet) x))) (test (procedure? (func :value)) #t) (test (func :arglist) '(x)) (test (integer? (func :line)) #t) (test (string? (func :file)) #t) (test (let? (func :funclet)) #t) (test (func :documentation) "") (define func1 (let ((+signature+ '(integer? integer? integer?)) (+documentation+ "a function")) (lambda (x y . z) (list (*function* (curlet) :name) (*function* (curlet) :arity) (*function* (curlet) :signature) (*function* (curlet) :source) (procedure? (*function* (curlet) :value)) (*function* (curlet) :arglist) (*function* (curlet) :documentation) (integer? (*function* (curlet) :line)) (string? (*function* (curlet) :file)) (let? (*function* (curlet) :funclet)))))) (test (func1 1 2 3 4) (list 'func1 '(2 . 536870912) '(integer? integer? integer?) '(lambda (x y . z) (list (*function* (curlet) :name) (*function* (curlet) :arity) (*function* (curlet) :signature) (*function* (curlet) :source) (procedure? (*function* (curlet) :value)) (*function* (curlet) :arglist) (*function* (curlet) :documentation) (integer? (*function* (curlet) :line)) (string? (*function* (curlet) :file)) (let? (*function* (curlet) :funclet)))) #t '(x y . z) "a function" #t #t #t)) (test ((define f (lambda (a) (*function* (curlet) 'arglist))) 1) '(a)) (test ((define f (lambda (a) (*function* (curlet) 'name))) 1) 'f) (test ((define f (lambda (a) (*function* (curlet) 'signature))) 1) #f) (test ((define f (lambda (a) (*function* (curlet) 'arity))) 1) '(1 . 1)) (test ((define f (lambda (a) (*function* (curlet) 'documentation))) 1) "") (test (let ((val ((define f (lambda (a) (*function* (curlet) 'line))) 1))) (integer? val)) #t) (test ((define f (lambda (a) (*function* (curlet) 'file))) 1) "s7test.scm") (test (let? ((define f (lambda (a) (*function* (curlet) 'funclet))) 1)) #t) (test ((define f (lambda (a) (*function* (curlet) 'source))) 1) '(lambda (a) (*function* (curlet) 'source))) (test((define f (lambda (a) (*function* (curlet) 'f))) 1) #f) ; perhaps #?? or an error )) ;;; it's possible to fool *function*: (test ((lambda (a) (*function*)) 1) #f) (test (let () (define (f1 a) ((lambda (b) (*function*)) a)) (let ((val (f1 1))) (if (pair? val) (car val) val))) 'f1) ;;; -------------------------------------------------------------------------------- ;;; continuation? (for-each (lambda (arg) (test (continuation? arg) #f)) (list -1 #\a 1 #f _ht_ _undef_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) "hi" (lambda () 1))) (test (let ((cont #f)) (and (call/cc (lambda (x) (set! cont x) (continuation? x))) (continuation? cont))) #t) (test (let ((cont #f)) (or (call-with-exit (lambda (x) (set! cont x) (continuation? x))) (continuation? cont))) #f) ; x is not a continuation (test (continuation?) 'error) (test (continuation? 1 2) 'error) ;;; -------------------------------------------------------------------------------- ;;; eval ;;; eval-string ;(test (eval-string "(list #b)") 'error) (test (eval-string "(char? #\\spaces)") #f) (test (eval-string "(car '( . 1))") 'error) (test (eval-string "(car '(. ))") 'error) (test (eval-string "(car '( . ))") 'error) (test (eval-string "(car '(. . . ))") 'error) (test (eval-string "#( . 1)") 'error) (test (eval-string "'(1 2 . )") 'error) (test (eval-string "#(1 2 . )") 'error) ;(test (eval-string "#'(1 2)") 'error) ;(test (eval-string "#`(1 2)") 'error) ;(test (eval-string "#,(1 2)") 'error) ;(test (eval-string "#`,(1 2)") 'error) ;(test (eval-string "#1(2)") 'error) (test (eval-string "(+ 1 . . )") 'error) (test (eval-string "(car '(1 . ))") 'error) (test (eval-string "(car '(1 . . 2))") 'error) (test (eval-string "#( . )") 'error) (test (eval-string "#(1 . )") 'error) (test (eval-string "#(. . . )") 'error) (test (eval-string "#(1 . . 2)") 'error) (test (eval-string "'(. 1)") 'error) (test (eval-string "#(. 1)") 'error) (test (eval-string "'(. )") 'error) (test (eval-string "#(. )") 'error) (test (eval-string "(list 1 . 2)") 'error) (test (eval-string "(+ 1 . 2)") 'error) (test (eval-string "(car '@#`')") 'error) (test (eval-string "(list . )") 'error) (test (eval-string "#( .)") 'error) (test (eval-string "(car '( .))") 'error) (test (eval-string "(let ((. 3)) .)") 'error) (test (eval-string "`#0d()") 'error) ;(test (eval-string "'#t:") 'error) ; guile interprets this as #t : and complains unbound variable : ;(test (eval-string "#t1") 'error) ; similarly this is #t 1 in guile (test (eval-string "#(1 . 2)") 'error) (test (eval-string "#(1 2 . 3)") 'error) ;(test (eval-string "'#'") 'error) ;(test (eval-string "#b") 'error) (test (eval-string "(+ 123") 'error) (test (eval-string "(+ 123 0000000000") 'error) (test (eval-string "(+ 1 2) a mistake") 'error) (test (eval-string "(+ 1 2) ; a comment") 3) (test (eval-string "(+ 1 2) #| a block \n comment |# ; a normal comment\n") 3) (test (eval-string "(+ 1 2) ()") 'error) (test (eval-string "(+ 1 2) ; a comment\n a mistake") 'error) (test (eval-string "(+ 1 2) ") 3) (unless with-bignums (test (undefined? (eval-string "-922337203685477580121")) #t) ; check overflow flag is set (test (undefined? (eval-string "922337203685477580121")) #t) (test (undefined? (eval-string "-92233720368547758081")) #t) (test (undefined? (eval-string "#xffffffffffffffff1")) #t)) (test (undefined? (eval-string "#special#")) #t) (test (object->string (eval-string "#special#")) "#special#") (test (eq? (eval-string "#special#") (eval-string "#special#")) #f) (test (let ((x 2)) (eval-string "(+ x 1)")) 3) (test (let ((x 1)) (let ((x 2)) (eval-string "(+ x 1)"))) 3) (test (let ((x 2) (lt (inlet 'x 3))) (eval-string "(+ x 1)")) 3) (test (let ((x 2) (lt (inlet 'x 3))) (eval-string "(+ x 1)" lt)) 4) (test (let* ((x 2) (lt (inlet 'y x))) (let ((x 4)) (eval-string "(+ y 1)" lt))) 3) (test (eval-string "(+ 1 2)") 3) (test (eval '(+ 1 2)) 3) (test (eval `(,+ ,1 ,2)) 3) (test (eval (list + 1 2)) 3) (test (eval `(+ 1 (eval `(* 2 3)))) 7) (test (eval `(+ 1 (eval-string "(* 2 3)"))) 7) (test (eval-string "(+ 1 (eval-string \"(* 2 3)\"))") 7) (test (eval `(+ 1 2 . 3)) 'error) (test (eval-string) 'error) (test (eval) 'error) ; or #f in the repl (test (eval-string "") #f) (test (eval-string "(reader-cond ((provided? 'surreals) 1))") #f) ; op_eval_string as stack_top_op in op_finish_expansion (test (eval-string (object->string (with-input-from-string "(reader-cond ((provided? 'surreals) 123))" read))) #f) ; op_read_done (test (eval-string "'") #) (test (eval ()) ()) (test (eval ()) ()) (test (eval-string "1" () ()) 'error) (test (eval () () ()) 'error) (test (eval "1") "1") (test (eval-string #t) 'error) (test (eval #(+ 1 2)) #(+ 1 2)) (test (+ 1 (values (eval-string "(catch #t (lambda () asdf) (lambda args 2))") (eval-string "(catch #t (lambda () asdf) (lambda args 3))"))) 6) (test (call-with-exit (lambda (go) (eval-string "(go 3)"))) 3) (test (let () (define (func) (eval-string (substring "ho" 0 0))) (func)) #f) (let () (define e1 (let ((a 10)) (curlet))) (test (eval 'a e1) 10)) ; from andy wingo (let () (define e1 (let ((a 10)) (curlet))) (eval '(set! a 32) e1) (test (eval 'a e1) 32)) (test (eval '(begin (define __eval_var__ 1) __eval_var__) (rootlet)) 1) (test (let () __eval_var__) 1) (test (eval-string "(begin (define __eval_var1__ 12) __eval_var1__)" (rootlet)) 12) (test (let () __eval_var1__) 12) (test (let () (eval '(begin (define __eval_var2__ 123) __eval_var__) (curlet)) __eval_var2__) 123) (test (let () __eval_var2__) 'error) (test (let ((x 1) (y 2)) (eval-string "(begin (set! x 3) (set! y 4))") (list x y)) '(3 4)) (test (let () (define-macro (mac1 x) `(+ ,x 1)) ((lambda () (do ((__i__ 0 (+ __i__ 1))) ((= __i__ 1) 3) ((eval-string (object->string mac1 :readable)) 1))))) 3) ;; from scheme wg (let ((x (list 'cons 1 2)) (y (list (list 'quote 'cons) 1 2))) (set-car! x cons) (set-car! (cdar y) cons) (test (eval x) (eval y))) (test (eval (list 'cons 1 2)) (eval (list cons 1 2))) (let ((f (lambda (a) (+ a 1)))) (test (eval (list 'f 2)) (eval (list f 2)))) (test (apply "hi" 1 ()) #\i) (test (eval ("hi" 1)) #\i) (test (apply + 1 1 (cons 1 (quote ()))) 3) (test (eq? (eval (quote (quote ()))) ()) #t) (test (apply (cons (quote cons) (cons 1 (quote ((quote ()))))) 1 ()) 1) ; essentially ((list 'cons 1 ...) 1) => 1 (test (eval ((cons (quote cons) (cons 1 (quote ((quote ()))))) 1)) 1) (test (eval (eval (list '+ 1 2))) 3) (test (eval if) if) (test (eval quote) quote) (test (eval (eval (list define* #(1)))) 'error) (test (eval (eval (list lambda* ()))) 'error) (test (eval (eval (list letrec "hi"))) 'error) (test (eval (eval (cons define-macro 1))) 'error) (test (eval (eval (cons quote "hi"))) 'error) (test (eval (eval (list and "hi"))) "hi") (let-temporarily (((*s7* 'safety) 1)) (test (eval (cdr (signature /))) 'error)) (test (apply + (+ 1) ()) 1) (test (apply #(1) (+) ()) 1) (test (apply + (+) ()) 0) (test (eval #()) #()) (test (apply (lambda () #f)) #f) (test (eval '(if #f #f)) (if #f #f)) (test (let ((ho 32)) (symbol? (eval (eval (eval (eval '''''ho)))))) #t) (test (eval '(case 0 ((1) 2) ((0) 1))) 1) (test (eval '(cond ((= 1 2) 3) (#t 4))) 4) (test (eval-string (string-append "(list 1 2 3)" (string #\newline) (string #\newline))) (list 1 2 3)) (eval-string (string-append "(begin (define evalstr_1 32)" (string #\newline) "(define evalstr_2 2))")) (test (eval-string "(+ evalstr_1 evalstr_2)") 34) (eval-string (string-append "(begin (set! evalstr_1 3)" "(set! evalstr_2 12))")) (test (eval-string "(+ evalstr_1 evalstr_2)") 15) (test (+ (eval `(values 1 2 3)) 4) 10) (test (+ (eval-string "(values 1 2 3)") 4) 10) (test (+ 1 (eval-string "(+ 2 3)") 4) 10) (test ((eval-string "(lambda (a) (+ a 1))") 2) 3) (test (eval ((eval-string "(lambda (a) (list '+ a 1))") 2)) 3) (test (eval-string "(+ 1 (eval (list '+ 1 2)))") 4) (test (eval _undef_) _undef_) (test (eq? (eval-string "else") else) #t) (test (eq? (with-input-from-string "else" read) else) #t) (test (eq? (with-input-from-string "lambda" read) lambda) #f) (test (eq? (eval-string "lambda") lambda) #t) (test (((eval-string "lambda") () (+ 1 2))) 3) (test (symbol? (eval-string "lambda")) #f) (test (symbol? (with-input-from-string "lambda" read)) #t) (test (eq? (with-input-from-string "else" (lambda () (eval (read)))) else) #t) (test (eval-string "'___a ; b") '___a) (test (eval-string "'___a #| b |#") '___a) (for-each (lambda (arg) (test (eval-string arg) 'error)) (list -1 0 1 512 #\a #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi :hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1))) (for-each (lambda (arg) (test (eval-string "(+ 1 2)" arg) 'error)) (list -1 0 1 512 #\a #(1 2 3) 3.14 2/3 1.5+0.3i 1+i 'hi abs "hi" :hi #(()) (lambda () 1))) (test (let () (define-macro (hiho a) `(+ ,a 1)) (hiho 3)) 4) (test (let () (define-macro (hiho) `(+ 3 1)) (hiho)) 4) (test (let () (define-macro (hiho) `(+ 3 1)) (hiho 1)) 'error) (test (let () (define-macro (hi a) `(+ ,@a)) (hi (1 2 3))) 6) (test (let () (define-macro (hi a) `(+ ,a 1) #f) (hi 2)) #f) (test (let () (define-macro (mac1 a) `',a) (equal? (mac1 (+ 1 2)) '(+ 1 2))) #t) (test (let () (define-macro (hi . a) `,@a) (hi 1)) 1) (test (let () (define-macro (hi a) `(+ , a 1)) (hi 1)) 2) (test (let () (define-macro (hi a) `(eval `(+ ,,a 1))) (hi 1)) 2) (test (let () (define-macro (hi a) `(eval (let ((a 12)) `(+ ,,a 1)))) (hi 1)) 2) (test (let () (define-macro (hi a) `(eval (let ((a 12)) `(+ ,a 1)))) (hi 1)) 13) (test (let () (define-macro (hi a) `(eval (let ((a 12)) `(let ((a 100)) (+ ,a 1))))) (hi 1)) 13) (test (let () (define-macro (hi a) `(eval (let ((a 12)) `(let ((a 100)) (+ a 1))))) (hi 1)) 101) (test (let () (define-macro (hi q) ``(,,q)) (hi (* 2 3))) '(6)) (test (let () (define-macro (hi q) `(let ((q 32)) `(,,q))) (hi (* 2 3))) '(6)) (test (let () (define-macro (hi q) `(let ((q 32)) `(,q))) (hi (* 2 3))) '(32)) (test (let () (define-macro (hi q) `(let () ,@(list q))) (hi (* 2 3))) 6) (test (let () (define-macro (tst a) ``(+ 1 ,,a)) (tst 2)) '(+ 1 2)) (test (let () (define-macro (tst a) ```(+ 1 ,,,a)) (eval (tst 2))) '(+ 1 2)) (test (let () (define-macro (tst a) ``(+ 1 ,,a)) (tst (+ 2 3))) '(+ 1 5)) (test (let () (define-macro (tst a) ``(+ 1 ,@,a)) (tst '(2 3))) '(+ 1 2 3)) (test (let () (define-macro (tst a) ``(+ 1 ,,@a)) (tst (2 3))) '(+ 1 2 3)) (test (let () (define-macro (tst a) ```(+ 1 ,,,@a)) (eval (tst (2 3)))) '(+ 1 2 3)) (test (let () (define-macro (tst a) ```(+ 1 ,,@,@a)) (eval (tst ('(2 3))))) '(+ 1 2 3)) (test (let () (define-macro (tst a) ````(+ 1 ,,,,@a)) (eval (eval (eval (tst (2 3)))))) 6) (test (let () (define-macro (tst a) ``(+ 1 ,@,@a)) (tst ('(2 3)))) '(+ 1 2 3)) (test (let () (define-macro (tst a b) `(+ 1 ,a (apply * `(2 ,,@b)))) (tst 3 (4 5))) 44) (test (let () (define-macro (tst . a) `(+ 1 ,@a)) (tst 2 3)) 6) (test (let () (define-macro (tst . a) `(+ 1 ,@a (apply * `(2 ,,@a)))) (tst 2 3)) 18) (test (let () (define-macro (tst a) ```(+ 1 ,@,@,@a)) (eval (tst ('('(2 3)))))) '(+ 1 2 3)) (test (let () (define-macro (hi a) `(+ ,a 1)) (procedure? hi)) #f) (test (let () (define-macro (hi a) `(let ((@ 32)) (+ @ ,a))) (hi @)) 64) (test (let () (define-macro (hi @) `(+ 1 ,@@)) (hi (2 3))) 6) ; ,@ is ambiguous (test (let () (define-macro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4) (test (let () (define-macro (hi a) (if (list? a) `(+ 1 ,@a) `(+ 1 ,a))) (* (hi 1) (hi (2 3)))) 12) (test (let ((x 1)) (eval `(+ 3 ,x))) 4) (test (let ((x 1)) (eval (eval `(let ((x 2)) `(+ 3 ,x ,,x))))) 6) (test (let ((x 1)) (eval (eval (eval `(let ((x 2)) `(let ((x 3)) `(+ 10 ,x ,,x ,,,x))))))) 16) (test (let ((x 1)) (eval (eval (eval (eval `(let ((x 2)) `(let ((x 3)) `(let ((x 30)) `(+ 100 ,x ,,x ,,,x ,,,,x))))))))) 136) (test (let () (define-bacro (hiho a) `(+ ,a 1)) (hiho 3)) 4) (test (let () (define-bacro (hiho) `(+ 3 1)) (hiho)) 4) (test (let () (define-bacro (hiho) `(+ 3 1)) (hiho 1)) 'error) (test (let () (define-bacro (hi a) `(+ ,@a)) (hi (1 2 3))) 6) (test (let () (define-bacro (hi a) `(+ ,a 1) #f) (hi 2)) #f) (test (let () (define-bacro (mac1 a) `',a) (equal? (mac1 (+ 1 2)) '(+ 1 2))) #t) (test (let () (define-bacro (tst a) ``(+ 1 ,,a)) (tst 2)) '(+ 1 2)) (test (let () (define-bacro (tst a) ```(+ 1 ,,,a)) (eval (tst 2))) '(+ 1 2)) (test (let () (define-bacro (tst a) ``(+ 1 ,,a)) (tst (+ 2 3))) '(+ 1 5)) (test (let () (define-bacro (tst a) ``(+ 1 ,@,a)) (tst '(2 3))) '(+ 1 2 3)) (test (let () (define-bacro (tst a) ``(+ 1 ,,@a)) (tst (2 3))) '(+ 1 2 3)) (test (let () (define-bacro (tst a) ```(+ 1 ,,,@a)) (eval (tst (2 3)))) '(+ 1 2 3)) (test (let () (define-bacro (tst a) ```(+ 1 ,,@,@a)) (eval (tst ('(2 3))))) '(+ 1 2 3)) (test (let () (define-bacro (tst a) ````(+ 1 ,,,,@a)) (eval (eval (eval (tst (2 3)))))) 6) (test (let () (define-bacro (tst a) ``(+ 1 ,@,@a)) (tst ('(2 3)))) '(+ 1 2 3)) (test (let () (define-bacro (tst a b) `(+ 1 ,a (apply * `(2 ,,@b)))) (tst 3 (4 5))) 44) (test (let () (define-bacro (tst . a) `(+ 1 ,@a)) (tst 2 3)) 6) (test (let () (define-bacro (tst . a) `(+ 1 ,@a (apply * `(2 ,,@a)))) (tst 2 3)) 18) (test (let () (define-bacro (tst a) ```(+ 1 ,@,@,@a)) (eval (tst ('('(2 3)))))) '(+ 1 2 3)) (test (let () (define-bacro (hi a) `(+ ,a 1)) (procedure? hi)) #f) (test (let () (define-bacro (hi a) `(let ((@ 32)) (+ @ ,a))) (hi @)) 64) (test (let () (define-bacro (hi @) `(+ 1 ,@@)) (hi (2 3))) 6) ; ,@ is ambiguous (test (let () (define-bacro (tst a) `(+ 1 (if (> ,a 0) (tst (- ,a 1)) 0))) (tst 3)) 4) (test (let () (define-bacro (hi a) (if (list? a) `(+ 1 ,@a) `(+ 1 ,a))) (* (hi 1) (hi (2 3)))) 12) (test (let () (define-bacro (hiho a) `(+ ,a 1)) (macro? hiho)) #t) (test (let () (define-bacro* (hiho (a 1)) `(+ ,a 1)) (macro? hiho)) #t) (test (let () (define-macro (hiho a) `(+ ,a 1)) (macro? hiho)) #t) (test (let () (define-macro* (hiho (a 1)) `(+ ,a 1)) (macro? hiho)) #t) #| (define-macro (when2 test . body) `((apply lambda (list '(test) '(if test (let () ,@body)))) ,test)) (define-macro (when2 test . body) `(if ,test (let () ,@body))) (define-macro (when2 test . body) `((lambda (test) (if test (let () ,@body))) ,test)) (define-macro (when2 test . body) `(let ((func (apply lambda `(() ,,@body)))) (if ,test (func)))) |# (test (define-macro) 'error) (test (define-macro 1) 'error) (test (define-macro . 1) 'error) (test (apply define-macro '(1)) 'error) (test (define-macro (1 2 3)) 'error) (test (define-macro (1 2) 3) 'error) (test (define-macro (a)) 'error) (test (define-macro (a)) 'error) (test (define-macro (a 1) 2) 'error) (test (define-macro . a) 'error) (test (define :hi 1) 'error) (test (define hi: 1) 'error) (test (define-macro (:hi a) `(+ ,a 1)) 'error) (test (define-macro (:hi a) `(+ ,a 1)) 'error) (test (define-macro (hi 1 . 2) 1) 'error) (test (define-macro (hi) 1 . 2) 'error) (test (define-macro (:) "" . #(1)) 'error) (test (define-macro hi ()) 'error) (test (define-macro (hi)) 'error) (test (define-macro (mac . 1) 1) 'error) (test (define-macro (mac 1) 1) 'error) (test (define-macro (a #()) 1) 'error) (test (define-macro (i 1) => (j 2)) 'error) (test (define hi 1 . 2) 'error) (test (define-macro (hi hi) . hi) 'error) (test (((lambda () (define-macro (hi a) `(+ 1 ,a)) hi)) 3) 4) (test (let () (define-macro (hi a b) `(list ,@a . ,@b)) (hi (1 2) ((2 3)))) '(1 2 2 3)) (test (let () (define-macro (hi a b) `(list ,@a . ,b)) (hi (1 2) (2 3))) '(1 2 2 3)) (test (let () (define-macro (hi a b) `(list ,@a ,@b)) (hi (1 2) (2 3))) '(1 2 2 3)) (let ((vals #(0 0))) #| (let () (define (hi a) (+ 1 a)) (define (use-hi b) (hi b)) (set! (vals 0) (use-hi 1)) (define (hi a) (+ 2 a)) (set! (vals 1) (use-hi 1)) (test vals #(2 3))) ; hmmm, or possibly #(2 2)... see comment above (line 13494 or thereabouts) |# (let () (define-macro (hi a) `(+ 1 ,a)) (define (use-hi b) (hi b)) (set! (vals 0) (use-hi 1)) (define-macro (hi a) `(+ 2 ,a)) (set! (vals 1) (use-hi 1)) (test vals #(2 3))) (let () (define (use-hi b) (hhi b)) (define-macro (hhi a) `(+ 1 ,a)) (set! (vals 0) (use-hi 1)) (define-macro (hhi a) `(+ 2 ,a)) (set! (vals 1) (use-hi 1)) (test vals #(2 3)))) (test (let () (define-macro (hanger name-and-args) `(define ,(car name-and-args) (+ ,@(map (lambda (arg) arg) (cdr name-and-args))))) (hanger (hi 1 2 3)) hi) 6) (test (let () (define-macro (hanger name-and-args) `(define-macro (,(car name-and-args)) `(+ ,@(map (lambda (arg) arg) (cdr ',name-and-args))))) (hanger (hi 1 2 3)) (hi)) 6) (let () ;; inspired by Doug Hoyte, "Let Over Lambda" (define (mcxr path lst) (define (cxr-1 path lst) (if (null? path) lst (if (char=? (car path) #\a) (cxr-1 (cdr path) (car lst)) (cxr-1 (cdr path) (cdr lst))))) (let ((p (string->list (symbol->string path)))) (if (char=? (car p) #\c) (set! p (cdr p))) (let ((p (reverse p))) (if (char=? (car p) #\r) (set! p (cdr p))) (cxr-1 p lst)))) (test (mcxr 'cr '(1 2 3)) '(1 2 3)) (test (mcxr 'cadddddddr '(1 2 3 4 5 6 7 8)) 8) (test (mcxr 'caadadadadadadadr '(1 (2 (3 (4 (5 (6 (7 (8))))))))) 8) (define-macro (cxr path lst) (let ((p (string->list (symbol->string path)))) (if (char=? (car p) #\c) (set! p (cdr p))) (let ((p (reverse p))) (if (char=? (car p) #\r) (set! p (cdr p))) (let ((func 'arg)) (for-each (lambda (f) (set! func (list (if (char=? f #\a) 'car 'cdr) func))) p) `((lambda (arg) ,func) ,lst))))) (test (cxr car '(1 2 3)) 1) (test (cxr cadddddddr '(1 2 3 4 5 6 7 8)) 8) (test (cxr caadadadadadadadr '(1 (2 (3 (4 (5 (6 (7 (8))))))))) 8) ) ;; this is the best of them! (let () (define-macro (c?r path) ;; here "path" is a list and "X" marks the spot in it that we are trying to access ;; (a (b ((c X)))) -- anything after the X is ignored, other symbols are just placeholders ;; c?r returns a function that gets X ;; maybe ... for cdr? (c?r (a ...); right now it's using dot: (c?r (a . X)) -> cdr ;; (c?r (a b X)) -> caddr, ;; (c?r (a (b X))) -> cadadr ;; ((c?r (a a a X)) '(1 2 3 4 5 6)) -> 4 ;; ((c?r (a (b c X))) '(1 (2 3 4))) -> 4 ;; ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 6 ;; ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) -> 4 ;; (procedure-source (c?r (((((a (b (c (X (e f))))))))))) -> (lambda (lst) (car (car (cdr (car (cdr (car (cdr (car (car (car (car lst)))))))))))) (define (X-marks-the-spot accessor tree) (if (pair? tree) (or (X-marks-the-spot (cons 'car accessor) (car tree)) (X-marks-the-spot (cons 'cdr accessor) (cdr tree))) (if (eq? tree 'X) accessor #f))) (let ((accessor (X-marks-the-spot () path))) (if (not accessor) (error 'test-error "can't find the spot! ~A" path) (let ((len (length accessor))) (if (< len 5) ; it's a built-in function (let ((name (make-string (+ len 2)))) (set! (name 0) #\c) (set! (name (+ len 1)) #\r) (do ((i 0 (+ i 1)) (a accessor (cdr a))) ((= i len)) (set! (name (+ i 1)) (if (eq? (car a) 'car) #\a #\d))) (string->symbol name)) (let ((body 'lst)) ; make a new function to find the spot (for-each (lambda (f) (set! body (list f body))) (reverse accessor)) `(lambda (lst) ,body))))))) (test ((c?r (a b X)) (list 1 2 3 4)) 3) (test ((c?r (a (b X))) '(1 (2 3) ((4)))) 3) (test ((c?r (a a a X)) '(1 2 3 4 5 6)) 4) (test ((c?r (a (b c X))) '(1 (2 3 4))) 4) (test ((c?r (((((a (b (c (d (e X)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 6) (test ((c?r (((((a (b (c (X (e f)))))))))) '(((((1 (2 (3 (4 (5 6)))))))))) 4)) (let () (define-macro (nested-for-each args func . lsts) (let ((body `(,func ,@args))) (for-each (lambda (arg lst) (set! body `(for-each (lambda (,arg) ,body) ,lst))) args lsts) body)) ;;(nested-for-each (a b) + '(1 2) '(3 4)) -> ;; (for-each (lambda (b) (for-each (lambda (a) (+ a b)) '(1 2))) '(3 4)) (define-macro (nested-map args func . lsts) (let ((body `(,func ,@args))) (for-each (lambda (arg lst) (set! body `(map (lambda (,arg) ,body) ,lst))) args lsts) body)) ;;(nested-map (a b) + '(1 2) '(3 4)) ;; ((4 5) (5 6)) ;;(nested-map (a b) / '(1 2) '(3 4)) ;; ((1/3 2/3) (1/4 1/2)) (test (nested-map (a b) + '(1 2) '(3 4)) '((4 5) (5 6))) (test (nested-map (a b) / '(1 2) '(3 4)) '((1/3 2/3) (1/4 1/2))) ) (let () (define-macro (define-curried name-and-args . body) `(define ,@(let ((newlst `(begin ,@body))) (define (rewrap lst) (if (pair? (car lst)) (begin (set! newlst (cons 'lambda (cons (cdr lst) (list newlst)))) (rewrap (car lst))) (list (car lst) (list 'lambda (cdr lst) newlst)))) (if (symbol? name-and-args) (list name-and-args newlst) (rewrap name-and-args))))) (define-curried (((((f a) b) c) d) e) (* a b c d e)) (test (((((f 1) 2) 3) 4) 5) 120) (define-curried (((((f a b) c) d e) f) g) (* a b c d e f g)) (test (((((f 1 2) 3) 4 5) 6) 7) 5040) (define-curried (((foo)) x) (+ x 34)) (test (((foo)) 300) 334) (define-curried ((foo-1) x) (+ x 34)) (test ((foo-1) 200) 234) (define-curried (f1 a b) (+ a b)) (test (f1 2 3) 5) (define-curried f2 32) (test f2 32) ) (test (let () (define (set-cadr! a b) (set-car! (cdr a) b) b) (let ((lst (list 1 2 3))) (set-cadr! lst 32) lst)) '(1 32 3)) ;;; macro? (test (macro? pi) #f) (test (macro? quasiquote) #t) ; s7_define_macro in s7.c (test (let ((m quasiquote)) (macro? m)) #t) (test (macro? macroexpand) #f) ; it's now syntactic (test (macro? cond) #f) (test (macro? letrec) #f) (for-each (lambda (arg) (test (macro? arg) #f)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () car abs (lambda () 1) #2d((1 2) (3 4)) _ht_ _undef_ _null_ _c_obj_ #f 'hi #(()) (list 1 2 3) '(1 . 2) "hi")) (test (macro?) 'error) (define-macro (fully-expand form) (define (expand form) (if (pair? form) (if (and (symbol? (car form)) (macro? (symbol->value (car form)))) (expand (apply macroexpand (list form))) (cons (expand (car form)) (expand (cdr form)))) form)) (expand form)) ; use (list 'quote (expand form)) to get fully-macroexpand of s7.html (see below) (define fe1-called #f) (define-macro (fe1 a) (set! fe1-called #t) `(+ ,a 1)) (define fe2-called #f) (define-macro (fe2 b) (set! fe2-called #f) `(+ (fe1 ,b) 2)) (fully-expand (define (fe3 c) (+ (fe2 c) (fe1 (+ c 1))))) (set! fe1-called #f) (set! fe2-called #f) (let ((val (fe3 3))) (if (or (not (= val 11)) fe1-called fe2-called) (format #t "fully-expand: ~A ~A ~A ~A~%" val (procedure-source fe3) fe1-called fe2-called))) (let () (define-macro (swap a b) `(set! ,b (with-let (inlet 'e (curlet) 'tmp ,a) (with-let e (set! ,a ,b)) tmp))) ;; this doesn't know when to use the setter (define-macro (fully-macroexpand form) (define (expand form) (if (pair? form) (if (and (symbol? (car form)) (macro? (symbol->value (car form)))) (expand (apply macroexpand (list form))) (cons (expand (car form)) (expand (cdr form)))) form)) (list 'quote (expand form))) (define-macro (define-with-macros name&args . body) `(apply define ',name&args (fully-macroexpand `(begin ,,@body)))) (define-with-macros (call3 x) (let ((a 1) (b x)) (swap a b) (list a b))) (test (call3 4) '(4 1))) (test (let () (define-macro (pop sym) (let ((v (gensym "v"))) `(let ((,v (car ,sym))) (set! ,sym (cdr ,sym)) ,v))) (test (macro? pop) #t) (let ((lst (list 1 2 3))) (let ((val (pop lst))) (and (= val 1) (equal? lst (list 2 3)))))) #t) (define-macro (destructuring-bind lst expr . body) `(let ((ex ,expr)) (define (flatten lst) (cond ((null? lst) ()) ((pair? lst) (if (pair? (car lst)) (append (flatten (car lst)) (flatten (cdr lst))) (cons (car lst) (flatten (cdr lst))))) (#t lst))) (define (structures-equal? l1 l2) (if (pair? l1) (and (pair? l2) (structures-equal? (car l1) (car l2)) (structures-equal? (cdr l1) (cdr l2))) (not (pair? l2)))) (if (not (structures-equal? ',lst ex)) (error 'test-error "~A and ~A do not match" ',lst ex)) (let ((names (flatten ',lst)) (vals (flatten ex))) (apply (eval (list 'lambda names ',@body)) vals)))) (test (destructuring-bind (a b) (list 1 2) (+ a b)) 3) (test (destructuring-bind ((a) b) (list (list 1) 2) (+ a b)) 3) (test (destructuring-bind (a (b c)) (list 1 (list 2 3)) (+ a b c)) 6) (test (let ((x 1)) (destructuring-bind (a b) (list x 2) (+ a b))) 3) (when full-s7test (define-macro (destructuring-bind lst expr . body) `(let ,(letrec ((flatten (lambda (lst1 lst2 args) (cond ((null? lst1) args) ((not (pair? lst1)) (cons (list lst1 lst2) args)) (#t (flatten (car lst1) (car lst2) (flatten (cdr lst1) (cdr lst2) args))))))) (flatten lst expr ())) ,@body)) (test (destructuring-bind (a b) (1 2) (+ a b)) 3) (test (destructuring-bind (a (b)) (1 (2)) (+ a b)) 3) (test (destructuring-bind ((a b)) ((1 2)) (+ a b)) 3) (test (destructuring-bind ((a (b c))) ((1 (2 1))) (+ a b)) 3) (test (destructuring-bind (a b) (0 (+ 1 2)) (+ a b)) 3) (test (destructuring-bind (a ((b))) ((+ 1 3) (((- 1 2)))) (+ a b)) 3) (test (destructuring-bind (a ((b c)) d e) (1 ((2 3)) (+ 4 5) 6) (list a b c d e)) '(1 2 3 9 6)) ;; CL version: (define-macro (destructuring-bind-1 lst expr . body) `(let ,(letrec ((flatten (lambda (lst1 lst2 args) (cond ((null? lst1) args) ((not (pair? lst1)) (cons (list lst1 (list 'quote lst2)) args)) (#t (flatten (car lst1) (car lst2) (flatten (cdr lst1) (cdr lst2) args))))))) (flatten lst (eval expr) ())) ,@body)) (test (destructuring-bind-1 (a b) '(1 2) (list a b)) '(1 2)) (test (destructuring-bind-1 (a (b)) '(1 (2)) (list a b)) '(1 2)) (test (destructuring-bind-1 ((a b)) '((1 2)) (list a b)) '(1 2)) (test (destructuring-bind-1 ((a (b c))) '((1 (2 1))) (list a b)) '(1 2)) (test (destructuring-bind-1 (a b) '(0 (+ 1 2)) (list a b)) '(0 (+ 1 2))) (test (destructuring-bind-1 (a ((b))) '((+ 1 3) (((- 1 2)))) (list a b)) '((+ 1 3) (- 1 2))) (test (destructuring-bind-1 (a ((b c)) d e) '(1 ((2 3)) (4 5) 6) (list a b c d e)) '(1 2 3 (4 5) 6)) ;; CL version but values not quoted (I like this one) (define-macro (destructuring-bind-2 lst expr . body) `(let ,(letrec ((flatten (lambda (lst1 lst2 args) (cond ((null? lst1) args) ((not (pair? lst1)) (cons (list lst1 lst2) args)) (#t (flatten (car lst1) (car lst2) (flatten (cdr lst1) (cdr lst2) args))))))) (flatten lst (eval expr) ())) ,@body)) (test (destructuring-bind-2 (a b) (list 1 2) (+ a b)) 3) (test (destructuring-bind-2 (a (b)) '(1 (2)) (+ a b)) 3) (test (destructuring-bind-2 ((a b)) '((1 2)) (+ a b)) 3) (test (destructuring-bind-2 ((a (b c))) '((1 (2 1))) (+ a b)) 3) (test (destructuring-bind-2 (a b) '(0 (+ 1 2)) (+ a b)) 3) (test (destructuring-bind-2 (a ((b))) '((+ 1 3) (((- 1 2)))) (+ a b)) 3) (test (destructuring-bind-2 (a ((b c)) d e) '(1 ((2 3)) (+ 4 5) 6) (list a b c d e)) '(1 2 3 9 6)) (test (let ((x 1)) (destructuring-bind-2 (a ((b))) '((+ x 3) (((- x 2)))) (+ a b))) 3)) (define-macro (once-only names . body) (let ((gensyms (map (lambda (n) (gensym)) names))) `(let (,@(map (lambda (g) `(,g (gensym))) gensyms)) `(let (,,@(map (lambda (g n) ``(,,g ,,n)) gensyms names)) ,(let (,@(map (lambda (n g) `(,n ,g)) names gensyms)) ,@body))))) (let () (define-macro (hiho start end) (once-only (start end) `(list ,start ,end (+ 2 ,start) (+ ,end 2)))) (test (let ((ctr 0)) (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr) (let () (set! ctr (+ ctr 1)) ctr)))) (list ctr lst))) '(2 (1 2 3 4)))) (define-macro (once-only-2 names . body) (let ((gensyms (map (lambda (n) (gensym)) names))) `(let (,@(map (lambda (g) (list g '(gensym))) gensyms)) `(let (,,@(map (lambda (g n) (list list g n)) gensyms names)) ,(let (,@(map (lambda (n g) (list n g)) names gensyms)) ,@body))))) (let () (define-macro (hiho start end) (once-only-2 (start end) `(list ,start ,end (+ 2 ,start) (+ ,end 2)))) (test (let ((ctr 0)) (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr) (let () (set! ctr (+ ctr 1)) ctr)))) (list ctr lst))) '(2 (1 2 3 4)))) ;;; (define-bacro (once-only-1 names . body) ;;; `(let (,@(map (lambda (name) `(,name ,(eval name))) names)) ;;; ,@body)) ;;; can't be right: (let ((names 1)) (once-only (names) (+ names 1))) ;;; if define-macro used here: syntax-error ("~A: unbound variable" start) in the example below (define once-only-1 (let ((names (gensym)) (body (gensym))) (apply define-bacro `((once ,names . ,body) `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names)) ,@,body))) once)) (let () (define-bacro (hiho start end) ; note the bacro! not a macro here (once-only-1 (start end) `(list ,start ,end (+ 2 ,start) (+ ,end 2)))) (test (let ((ctr 0)) (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr) (let () (set! ctr (+ ctr 1)) ctr)))) (list ctr lst))) '(2 (1 2 3 4))) (test (let ((names 1)) (once-only-1 (names) (+ names 1))) 2) (test (let ((body 1)) (once-only-1 (body) (+ body 1))) 2) ; so body above also has to be gensym'd ) (define once-only-3 (let ((names (gensym)) (body (gensym))) (apply define-bacro `((,(gensym) ,names . ,body) `(let (,@(map (lambda (name) `(,name ,(eval name))) ,names)) ,@,body))))) (let () (define-bacro (hiho start end) ; note the bacro! not a macro here (once-only-3 (start end) `(list ,start ,end (+ 2 ,start) (+ ,end 2)))) (test (let ((ctr 0)) (let ((lst (hiho (let () (set! ctr (+ ctr 1)) ctr) (let () (set! ctr (+ ctr 1)) ctr)))) (list ctr lst))) '(2 (1 2 3 4))) (test (let ((names 1)) (once-only-3 (names) (+ names 1))) 2) (test (let ((body 1)) (once-only-3 (body) (+ body 1))) 2) ; so body above also has to be gensym'd ) (let () #| (define setf (let ((args (gensym))) (apply define-bacro `((setf-1 . ,args) (if (not (null? ,args)) (begin (apply set! (car ,args) (cadr ,args) ()) (apply setf (cddr ,args)))))) ; not setf-1 -- it's not defined except during the definition setf-1)) |# (define setf (let ((args (gensym)) (name (gensym))) (apply define-bacro `((,name . ,args) (unless (null? ,args) (apply set! (car ,args) (cadr ,args) ()) (apply setf (cddr ,args))))))) (define-macro (psetf . args) (let ((bindings ()) (settings ())) (do ((arglist args (cddr arglist))) ((null? arglist)) (let* ((g (gensym))) (set! bindings (cons (list g (cadr arglist)) bindings)) (set! settings (cons `(set! ,(car arglist) ,g) settings)))) `(let ,bindings ,@settings))) (test (let ((a 1) (b 2)) (setf a b b 3) (list a b)) '(2 3)) (test (let ((a 1) (b 2)) (setf a b b (+ a 3)) (list a b)) '(2 5)) (test (let ((a #(1)) (b 2)) (setf (a 0) b b (+ (a 0) 3)) (list a b)) '(#(2) 5)) (test (let ((a 1) (b 2)) (setf a b b a) (list a b)) '(2 2)) (test (let ((a 1) (b 2)) (setf a '(+ 1 2) b a) (list a b)) '((+ 1 2) (+ 1 2))) (test (let ((args 1) (arg 1)) (setf args 2 arg 3) (list args arg)) '(2 3)) (test (let ((args 1) (arg 1)) (setf args (+ 2 3) arg args) (list args arg)) '(5 5)) (test (let ((args 1) (arg 1)) (setf args '(+ 2 3) arg (car args)) (list args arg)) '((+ 2 3) +)) (test (let ((a 1) (b 2)) (psetf a b b a) (list a b)) '(2 1)) (test (let ((a #(1)) (b 2)) (psetf (a 0) b b (+ (a 0) 3)) (list a b)) '(#(2) 4)) (test (let ((a 1) (b 2)) (psetf a '(+ 1 2) b a) (list a b)) '((+ 1 2) 1)) (test (let ((new-args 1)) (psetf new-args (+ new-args 1)) new-args) 2) (test (let ((args 1) (arg 1)) (psetf args 2 arg 3) (list args arg)) '(2 3)) (test (let ((args 1) (arg 1)) (psetf args (+ 2 3) arg args) (list args arg)) '(5 1)) (test (let ((args 1) (arg 1)) (psetf args '(+ 2 3) arg (car args)) (list args arg)) 'error) (test (let ((args '(1 2)) (arg 1)) (psetf args '(+ 2 3) arg (car args)) (list args arg)) '((+ 2 3) 1)) ) (define-macro (with-gensyms names . body) `(let ,(map (lambda (n) `(,n (gensym))) names) ,@body)) (define-macro (define-clean-macro name-and-args . body) ;; the new backquote implementation breaks this slightly -- it's currently confused about unquoted nil in the original (let ((syms ())) (define (walk func lst) (if (and (func lst) (pair? lst)) (begin (walk func (car lst)) (walk func (cdr lst))))) (define (car-member sym lst) (if (null? lst) #f (if (eq? sym (caar lst)) (cdar lst) (car-member sym (cdr lst))))) (define (walker val) (if (pair? val) (if (eq? (car val) 'quote) (or (car-member (cadr val) syms) (and (pair? (cadr val)) (or (and (eq? (caadr val) 'quote) ; 'sym -> (quote (quote sym)) val) (append (list 'list) (walker (cadr val))))) (cadr val)) (cons (walker (car val)) (walker (cdr val)))) (or (car-member val syms) val))) (walk (lambda (val) (if (and (pair? val) (eq? (car val) 'quote) (symbol? (cadr val)) (not (car-member (cadr val) syms))) (set! syms (cons (cons (cadr val) (gensym (symbol->string (cadr val)))) syms))) (or (not (pair? val)) (not (eq? (car val) 'quote)) (not (pair? (cadr val))) (not (eq? (caadr val) 'quote)))) body) (let* ((new-body (walker body)) (new-syms (map (lambda (slot) (list (cdr slot) '(gensym))) syms)) (new-globals (let ((result ())) (for-each (lambda (slot) (if (defined? (car slot)) (set! result (cons (list 'set! (cdr slot) (car slot)) result)))) syms) result))) `(define-macro ,name-and-args (let ,new-syms ,@new-globals `(begin ,,@new-body)))))) (define-macro (define-immaculo name-and-args . body) (let* ((gensyms (map (lambda (g) (gensym)) (cdr name-and-args))) (args (cdr (copy name-and-args))) (name (car name-and-args)) (set-args (map (lambda (a g) `(list ',g ,a)) args gensyms)) (get-args (map (lambda (a g) `(quote (cons ',a ,g))) args gensyms)) (blocked-args (map (lambda (a) `(,a ',a)) args)) (new-body (list (apply let blocked-args body)))) `(define-macro ,name-and-args `(let ,(list ,@set-args) ,(list 'with-let (append (list 'sublet) (list (list 'funclet ,name)) (list ,@get-args)) ',@new-body))))) ;;; this is not perfect: if unquote is on expr involving an arg, it's going to be unhappy, ;;; but we can always move the unquote in, so it's purely stylistic. Another way would ;;; be to remove one level of unquotes throughout -- then the blocked-args and new-body ;;; would be unneeded. ;;; in fact, it's wrong -- in the body we need to make explicit let refs to avoid collisions ;;; these tests are pointless (test (let () (define-clean-macro (hi a) `(+ ,a 1)) (hi 1)) 2) (test (let () (define-immaculo (hi a) `(+ ,a 1)) (hi 1)) 2) (test (let () (define-immaculo (hi a) `(let ((b 23)) (+ b ,a))) (hi 2)) 25) (test (let () (define-immaculo (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d)))) (mac 2 3)) 360) (test (let () (define-immaculo (mac a b) `(let ((c (+ ,a ,b))) (let ((d 12)) (* ,a ,b c d)))) (let ((c 2) (d 3)) (mac c d))) 360) (test (let () (define-clean-macro (mac a . body) `(+ ,a ,@body)) (mac 2 3 4)) 9) (test (let () (define-clean-macro (mac) (let ((a 1)) `(+ ,a 1))) (mac)) 2) (test (let () (define-immaculo (mac) (let ((a 1)) `(+ ,a 1))) (mac)) 2) (test (let () (define-immaculo (hi a) `(list 'a ,a)) (hi 1)) (list 'a 1)) (test (let () (define-macro (hi a) `(+ 1 (if ,(= a 0) 0 (hi ,(- a 1))))) (hi 3)) 4) (test (let () (define-macro (hi a) `(+ 1 ,a)) ((if #t hi abs) -3)) -2) (test (let () (apply define-macro '((m a) `(+ 1 ,a))) (m 2)) 3) (test (let () (apply (eval (apply define-macro '((m a) `(+ 1 ,a)))) '(3))) 4) (test (let () (apply (eval (apply define '((hi a) (+ a 1)))) '(2))) 3) (test (let () ((eval (apply define '((hi a) (+ a 1)))) 3)) 4) (test (let () ((eval (apply define-macro '((m a) `(+ 1 ,a)))) 3)) 4) (test (let () ((apply define '((hi a) (+ a 1))) 3)) 4) (test (let () ((apply define-macro '((m a) `(+ 1 ,a))) 3)) 4) (test (let () (define-macro (mu args . body) (let ((m (gensym))) `(apply define-macro '((,m ,@args) ,@body)))) ((mu (a) `(+ 1 ,a)) 3)) 4) (test (let () (define-macro (hi a) `(+ 1 ,a)) (map hi '(1 2 3))) '(2 3 4)) (test (let () (define-macro (hi a) `(+ ,a 1)) (apply hi '(4))) 5) (test (let () (define-macro (hi a) `(+ ,a 1)) (define (fmac mac) (apply mac '(4))) (fmac hi)) 5) (test (let () (define (make-mac) (define-macro (hi a) `(+ ,a 1)) hi) (let ((x (make-mac))) (x 2))) 3) (define-macro* (_mac1_) `(+ 1 2)) (test (_mac1_) 3) (define-macro* (_mac2_ a) `(+ ,a 2)) (test (_mac2_ 1) 3) (test (_mac2_ :a 2) 4) (define-macro* (_mac3_ (a 1)) `(+ ,a 2)) (test (_mac3_) 3) (test (_mac3_ 3) 5) (test (_mac3_ :a 0) 2) (define-macro* (_mac4_ (a 1) (b 2)) `(+ ,a ,b)) (test (_mac4_) 3) (test (_mac4_ :b 3) 4) (test (_mac4_ 2 :b 3) 5) (test (_mac4_ :b 10 :a 12) 22) (test (_mac4_ :a 4) 6) (define-bacro* (_mac21_) `(+ 1 2)) (test (_mac21_) 3) (define-bacro* (_mac22_ a) `(+ ,a 2)) (test (_mac22_ 1) 3) (test (_mac22_ :a 2) 4) (define-bacro* (_mac23_ (a 1)) `(+ ,a 2)) (test (_mac23_) 3) (test (_mac23_ 3) 5) (test (_mac23_ :a 0) 2) (define-bacro* (_mac24_ (a 1) (b 2)) `(+ ,a ,b)) (test (_mac24_) 3) (test (_mac24_ :b 3) 4) (test (_mac24_ 2 :b 3) 5) (test (_mac24_ :b 10 :a 12) 22) (test (_mac24_ :a 4) 6) (define-macro* (_mac11_) `(+ 1 2)) (test (_mac11_) 3) (define-macro* (_mac12_ a) `(+ ,a 2)) (test (_mac12_ 1) 3) (test (_mac12_ :a 2) 4) (define-macro* (_mac13_ (a 1)) `(+ ,a 2)) (test (_mac13_) 3) (test (_mac13_ 3) 5) (test (_mac13_ :a 0) 2) (define-macro* (_mac14_ (a 1) (b 2)) `(+ ,a ,b)) (test (_mac14_) 3) (test (_mac14_ :b 3) 4) (test (_mac14_ 2 :b 3) 5) (test (_mac14_ :b 10 :a 12) 22) (test (_mac14_ :a 4) 6) (define-bacro (symbol-set! var val) `(set! ,(symbol->value var) ,val)) (test (let ((x 32) (y 'x)) (symbol-set! y 123) (list x y)) '(123 x)) (define-bacro (symbol-eset! var val) `(set! ,(eval var) ,val)) (test (let ((x '(1 2 3)) (y `(x 1))) (symbol-eset! y 123) (list x y)) '((1 123 3) (x 1))) (test (let ((x #(1 2 3)) (y `(x 1))) (symbol-eset! y 123) (list x y)) '(#(1 123 3) (x 1))) (let () (define-macro (hi a) `````(+ ,,,,,a 1)) (test (eval (eval (eval (eval (hi 2))))) 3) (define-macro (hi a) `(+ ,@@a)) (test (hi (1 2 3)) 'error) (define-macro (hi @a) `(+ ,@@a)) (test (hi (1 2 3)) 6)) ;;; -------------------------------------------------------------------------------- ;;; # readers ;;; *#readers* ;;; ;;; #\; reader: (let-temporarily ((*#readers* ())) ;; testing *#readers* is slightly tricky because the reader runs before we evaluate the test expression ;; so in these cases, the new reader use is always in a string (set! *#readers* (list (cons #\s (lambda (str) 123)))) (let ((val (eval-string "(+ 1 #s1)"))) ; force this into the current reader (test val 124)) (set! *#readers* ()) (set! *#readers* (cons (cons #\t (lambda (str) (string->number (substring str 1) 12))) *#readers*)) (num-test (string->number "#tb") 11) (num-test (string->number "#t11.3") 13.25) (num-test (string->number "#t#t1a") 22.0) (num-test (string->number "#t#t#t1a") 22.0) (test (eval-string "#t") #t) ; (test (eval-string "#T1") 'error) (set! *#readers* (cons (cons #\. (lambda (str) (if (string=? str ".") (eval (read)) #f))) *#readers*)) (test (eval-string "'(1 2 #.(* 3 4) 5)") '(1 2 12 5)) (num-test (string->number "#t1a") 22) (test (eval-string "'(1 #t(2))") '(1 #t (2))) (test (string->number "#t1r") #f) (set! *#readers* (list (cons #\t (lambda (str) ;; in the duplicated case: "t#t..." (if (< (length str) 3) (string->number (substring str 1) 12) (and (not (char=? (str 1) #\#)) (not (char=? (str 2) #\t)) (string->number (substring str 1) 12))))))) (test (string->number "#t#t1a") #f) (set! *#readers* (cons (cons #\x (lambda (str) (or (if (< (length str) 3) (string->number (substring str 1) 7) (and (not (char=? (str 1) #\#)) (not (char=? (str 2) #\x)) (string->number (substring str 1) 7))) 'error))) *#readers*)) (num-test (string->number "#x12") 9) (num-test (string->number "#x-142.1e-1") -11.30612244898) (num-test (string->number "#t460.88") 648.72222222222) (num-test (string->number "#x1") 1) (test (string->number "#te") #f) (num-test (string->number "#x10") 7) (test (string->number "#x17") #f) (num-test (string->number "#x106") 55) (test (string->number "#x#t1") #f) (let () (define (read-in-radix str radix) ;; no error checking, only integers (define (char->digit c) (cond ((char-numeric? c) (- (char->integer c) (char->integer #\0))) ((char-lower-case? c) (+ 10 (- (char->integer c) (char->integer #\a)))) (#t (+ 10 (- (char->integer c) (char->integer #\A)))))) (let* ((negative (char=? (str 0) #\-)) (len (length str)) (j (if (or negative (char=? (str 0) #\+)) 2 1))) ; first char is "z" (do ((sum (char->digit (str j)) (+ (* sum radix) (char->digit (str j))))) ((= j (- len 1)) sum) (set! j (+ j 1))))) (set! *#readers* (list (cons #\z (lambda (str) (read-in-radix str 32))))) (num-test (string->number "#z1p") 57) ) (let ((p1 (dilambda (lambda (str) (string->number (substring str 1) 12)) (lambda (a b) a)))) (set! *#readers* (list (cons #\t p1))) (num-test (string->number "#ta") 10) (num-test (string->number "#t11.6") 13.5))) (let-temporarily ((*#readers* (list (cons #\A (lambda (s) (and (string=? s "A") let))) (cons #\B (lambda (s) (and (string=? s "B") `((x 1))))) (cons #\C (lambda (s) (and (string=? s "C") `(+ x 1))))))) (test (eval-string "(#A #B #C)") 2)) (num-test (string->number "#x106") 262) (num-test (string->number "#x17") 23) (let ((old-readers *#readers*) (reader-file tmp-output-file)) ;; to test readers in a file, we need to write the file and load it, so here we go... (set! *#readers* ()) (define circular-list-reader (let ((known-vals #f) (top-n -1)) (lambda (str) (define (replace-syms lst) ;; walk through the new list, replacing our special keywords ;; with the associated locations (define (replace-sym tree getter) (if (keyword? (getter tree)) (let ((n (string->number (symbol->string (keyword->symbol (getter tree)))))) (if (integer? n) (let ((lst (assoc n known-vals))) (if lst (set! (getter tree) (cdr lst)) (format *stderr* "#~D# is not defined~%" n))))))) (define (walk-tree tree) (if (pair? tree) (begin (if (pair? (car tree)) (walk-tree (car tree)) (replace-sym tree car)) (if (pair? (cdr tree)) (walk-tree (cdr tree)) (replace-sym tree cdr)))) tree) (walk-tree (cdr lst))) ;; str is whatever followed the #, first char is a digit (let* ((len (length str)) (last-char (str (- len 1)))) (and (memq last-char '(#\= #\#)) ; is it #n= or #n#? (let ((n (string->number (substring str 0 (- len 1))))) (and (integer? n) (begin (if (not known-vals) (begin (set! known-vals ()) (set! top-n n))) (if (char=? last-char #\=) ; #n= (and (char=? (peek-char) #\() (let ((cur-val (assoc n known-vals))) ;; associate the number and the list it points to ;; if cur-val, perhaps complain? (#n# redefined) (let ((lst (catch #t (lambda () (read)) (lambda args ; a read error (set! known-vals #f) ; so clear our state (apply throw args))))) ; and pass the error on up (if (not cur-val) (set! known-vals (cons (set! cur-val (cons n lst)) known-vals)) (set! (cdr cur-val) lst))) (if (= n top-n) ; replace our special keywords (let ((result (replace-syms cur-val))) (set! known-vals #f) result) (cdr cur-val)))) ; #n=? ;; else it's #n# -- set a marker for now since we may not ;; have its associated value yet. We use a symbol name that ;; string->number accepts. (symbol->keyword (symbol (string-append (number->string n) (string #\null) " "))))))) ; #n? ))))) ; #n? (define (sharp-plus str) ;; str here is "+", we assume either a symbol or a expression involving symbols follows (let* ((e (if (string=? str "+") (read) ; must be #+(...) (string->symbol (substring str 1)))) ; #+feature (expr (read))) (if (symbol? e) (if (provided? e) expr (values)) (if (pair? e) (begin (define (traverse tree) (if (pair? tree) (cons (traverse (car tree)) (if (null? (cdr tree)) () (traverse (cdr tree)))) (if (memq tree '(and or not)) tree (and (symbol? tree) (provided? tree))))) (if (eval (traverse e)) expr (values))) (error 'test-error "strange #+ chooser: ~S~%" e))))) (set! *#readers* (cons (cons #\+ sharp-plus) (cons (cons #\. (lambda (str) (if (string=? str ".") (eval (read)) #f))) (cons (cons #\; (lambda (str) (if (string=? str ";") (read)) (values))) *#readers*)))) (when pure-s7 (set! *#readers* (append *#readers* old-readers))) (do ((i 0 (+ i 1))) ((= i 10)) (set! *#readers* (cons (cons (integer->char (+ i (char->integer #\0))) circular-list-reader) *#readers*))) (call-with-output-file reader-file (lambda (port) (format port "(define x #.(+ 1 2 3))~%") (format port "(define xlst '(1 2 3 #.(* 2 2)))~%") (format port "(define y '#1=(2 . #1#))~%") (format port "(define y1 '#1=(2 #2=(3 #3=(#1#) . #3#) . #2#))~%") (format port "(define y2 #2d((1 2) (3 4)))~%") (format port "#+s7 (define z 32)~%#+asdf (define z 123)~%") (format port "#+(and complex-numbers (or snd s7)) (define z1 1)~%#+(and (not complex-numbers) (or asdf s7)) (define z1 123)~%") (format port "(define x2 (+ 1 #;(* 2 3) 4))~%") (format port "(define x3 (+ #;32 1 2))~%") (format port "(define x4 (+ #; 32 1 2))~%") (format port "(define y3 (+ 1 (car '#1=(2 . #1#))))~%") (format port "(define y4 #.(+ 1 (car '#1=(2 . #1#))))~%") (format port "(define y5 (+ 1 #.(* 2 3) #.(* 4 #.(+ 5 6))))~%") (format port "(define r1 '(1 #. #;(+ 2 3) 4))~%") (format port "(define r2 '(1 #. #;(+ 2 3) (* 2 4)))~%") (format port "(define r3 '(1 #; #.(+ 2 3) (* 2 4)))~%") (format port "(define r4 '(1 #. #1=(+ 2 3) (* 2 4)))~%") (format port "(define r5 '(1 #. #1=(+ 2 #. 3) (* 2 4)))~%") ;; but #.3 is ambiguous: '(1 #. #1=(+ 2 #.3) (* 2 4)) (format port "(define r6 '(1 #. #1=(+ 2 #+pi 3) (* 2 4)))~%") (format port "(define r7 '(1 #. #1=(+ 2 #+pi #1#) (* 2 4)))~%") (format port "(define r8 '(1 #+s7 #1=(1 2) 3))~%") (format port "(define r9 '(1 #+asdf #1=(1 2) 3))~%") (format port "(define r10 #. #1#)~%") (format port "(define r14 #. #o1)~%") (format port "(define r15 #. #_-)~%") (format port "(define r17 (#. #_- #o1))~%") (format port "(define r18 (#. #. #_+))~%") (format port "(define r19 (#. #+s7 #_+))~%") (format port "(define r20 (#+s7 #+s7 #_+))~%") (format port "(define r21 (#_-(#_+ 1 2)3))~%") (format port "(define r22 (#(#_+ 1 2)#o1))~%") (format port "(define r23 (+ #;#1.##+asdf ))~%") (format port "(define r24 (+ #. #;(#_+ 1 2)))~%") (format port "(define r25 (+ #;#1=#2=))~%") (format port "(define r26 (+ #;#2#(#_+ 1 2)))~%") (format port "(define r27 (+ #;#1=.))~%") (format port "(define r28 (+ #; #; #; ()))~%") (format port "(define r29 (+ 3(#_+ 1 2)#;#. ))~%") (format port "(define r30 (+ #;#2=#+asdf#+s7))~%") (format port "(define r31 (+ #;#f#=#\\))~%") (format port "(define r32 (#. + (#_-(#_+ 1 2))))~%") (format port "(define r33 (+ 1 #+asdf #\\a 2))~%") (format port "(define r34 (+ #++(#. #\\a)))~%") (format port "(define r35 (+ #+s7 #; (33)))~%") (format port "(define r36 (cos #. #. #. `(string->symbol \"pi\")))~%") )) (catch #t (lambda () (let () (load reader-file (curlet)) (if (not (= x 6)) (format #t ";#.(+ 1 2 3) -> ~A~%" x)) (if (not (equal? xlst '(1 2 3 4))) (format #t ";#.(* 2 2) -> ~A~%" xlst)) (if (not (equal? (object->string y) "#1=(2 . #1#)")) (format #t ";'#1=(2 . #1#) -> ~S~%" (object->string y))) (if (not (equal? (object->string y1) "#1=(2 #3=(3 #2=(#1#) . #2#) . #3#)")) (format #t ";'#1=(2 #2=(3 #3=(#1#) . #3#) . #2#) -> ~S~%" (object->string y1))) (if (not (equal? y2 #2d((1 2) (3 4)))) (format #t ";#2d((1 2) (3 4)) -> ~A~%" y2)) (if (not (= z 32)) (format #t ";#+asdf? -> ~A~%" z)) (if (not (= z1 1)) (format #t ";#(or ... +asdf)? -> ~A~%" z1)) (if (not (= x2 5)) (format #t ";(+ 1 #;(* 2 3) 4) -> ~A~%" x2)) (if (not (= x3 3)) (format #t ";(+ #;32 1 2) -> ~A~%" x3)) (if (not (= x4 3)) (format #t ";(+ #; 32 1 2) -> ~A~%" x4)) (if (not (= y3 3)) (format #t ";(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y3)) (if (not (= y4 3)) (format #t ";#.(+ 1 (car '#1=(2 . #1#))) -> ~A~%" y4)) (if (not (= y5 51)) (format #t ";(+ 1 #.(* 2 3) #.(* 4 #.(+ 5 6))) -> ~A~%" y5)) (if (not (equal? r1 '(1 4))) (format #t ";'(1 #. #;(+ 2 3) 4) -> ~A~%" r1)) (if (not (equal? r2 '(1 (* 2 4)))) (format #t ";'(1 #. #;(+ 2 3) (* 2 4)) -> ~A~%" r2)) (if (not (equal? r3 '(1 (* 2 4)))) (format #t ";'(1 #; #.(+ 2 3) (* 2 4)) -> ~A~%" r3)) (if (not (equal? r4 '(1 5 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 3) (* 2 4)) -> ~A~%" r4)) (if (not (equal? r5 '(1 5 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #. 3) (* 2 4)) -> ~A~%" r5)) (if (not (equal? r6 '(1 2 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #+pi 3) (* 2 4)) -> ~A~%" r6)) (if (not (equal? r7 '(1 2 (* 2 4)))) (format #t ";'(1 #. #1=(+ 2 #+pi #1#) (* 2 4)) -> ~A~%" r7)) (if (not (equal? r8 '(1 (1 2) 3))) (format #t ";'(1 #+s7 #1=(1 2) 3) -> ~A~%" r8)) (if (not (equal? r9 '(1 3))) (format #t ";'(1 #+asdf #1=(1 2) 3)) -> ~A~%" r9)) (if (not (equal? r10 ':1)) (format #t ";#. #1# -> ~A~%" r10)) (if (not (equal? r14 1)) (format #t ";#. #o1 -> ~A~%" r14)) (if (not (equal? r15 -)) (format #t ";#. #_- -> ~A~%" r15)) (if (not (equal? r17 -1)) (format #t ";(#. #_- #o1) -> ~A~%" r17)) (if (not (equal? r18 0)) (format #t ";(#. #. #_+) -> ~A~%" r18)) (if (not (equal? r19 0)) (format #t ";(#. #+s7 #_+) -> ~A~%" r19)) (if (not (equal? r20 0)) (format #t ";(#+s7 #+s7 #_+) -> ~A~%" r20)) (if (not (equal? r21 0)) (format #t ";(#_-(#_+ 1 2)3) -> ~A~%" r21)) (if (not (equal? r22 1)) (format #t ";(#(#_+ 1 2)#o1) -> ~A~%" r22)) (if (not (equal? r23 0)) (format #t ";(+ #;#1.##+asdf ) -> ~A~%" r23)) (if (not (equal? r24 0)) (format #t ";(+ #. #;(#_+ 1 2)) -> ~A~%" r24)) (if (not (equal? r25 0)) (format #t ";(+ #;#1=#2=) -> ~A~%" r25)) (if (not (equal? r26 3)) (format #t ";(+ #;#2#(#_+ 1 2)) -> ~A~%" r26)) (if (not (equal? r27 0)) (format #t ";(+ #;#1=.) -> ~A~%" r27)) (if (not (equal? r28 0)) (format #t ";(+ #; #; #; ()) -> ~A~%" r28)) (if (not (equal? r29 6)) (format #t ";(+ 3(#_+ 1 2)#;#. ) -> ~A~%" r29)) (if (not (equal? r30 0)) (format #t ";(+ #;#2=#+asdf#+s7) -> ~A~%" r30)) (if (not (equal? r31 0)) (format #t ";(+ #;#f#=#\\) -> ~A~%" r31)) (if (not (equal? r32 -3)) (format #t ";(#. + (#_-(#_+ 1 2))) -> ~A~%" r32)) (if (not (equal? r33 3)) (format #t ";(+ 1 #+asdf #\\a 2) -> ~A~%" r33)) (if (not (equal? r34 0)) (format #t ";(+ #++(#. #\\a)) -> ~A~%" r34)) (if (not (equal? r35 0)) (format #t ";(+ #+s7 #; (33)) -> ~A~%" r35)) (if (not (equivalent? r36 -1.0)) (format #t ";(cos #. #. #. `(string->symbol \"pi\")) -> ~A~%" r36)) )) (lambda (type info) (format *stderr* "reader test: ~A ~A~%" type info))) (set! *#readers* old-readers)) (define *old-#readers* *#readers*) (set! *#readers* ; #[...] -> '(...) (cons (cons #\[ (lambda (str) (if (char=? (str 1) #\]) ; #[] -> () () (let ((pos (char-position #\] str))) (if pos ; #[1] -> '(1) (with-input-from-string (string-append "'(" (substring str 1 (- (length str) 1)) ")") read) (do ((S (string-append "'(" (substring str 1))) ; or #( for vector (E (read-char) (read-char))) ((char=? E #\]) (with-input-from-string (string-append S ")") read)) (set! S (string-append S (string E))))))))) ())) (test #[1 2] '(1 2)) (test #[] ()) (test #[a b (1 2 3)] '(a b (1 2 3))) (test #[ab (1 2 3)] '(ab (1 2 3))) (test (pair? #[1 2]) #t) (test #[1] '(1)) (set! *#readers* *old-#readers*) (let-temporarily ((*#readers* (cons (cons #\& (lambda (str) (if (= (string-length str) 1) ; #& followed by a reader delimiter (read) (begin (set! (port-position (current-input-port)) (- (port-position (current-input-port)) (string-length str) -2)) ;-1)) (string (string-ref str 1)))))) ()))) (with-input-from-string "#&Newton" (lambda () (test (read) "N") (test (read) 'ewton) (test (read) #))) (with-input-from-string "#&N#&123" (lambda () (test (read) "N") (test (read) "1") (test (read) 23) (test (read) #))) (with-input-from-string "#&(123)" (lambda () (test (read) '(123)) (test (read) #)))) (set! *#readers* (list (cons #\s (lambda (str) (let ((len (length str))) (and (string=? (substring str 0 7) "symbol<") (if (char=? (str (- len 1)) #\>) ; pointless use of #symbol! (symbol (substring str 7 (- len 1))) (do ((sym (substring str 7)) (c (read-char) (read-char))) ((memq c (list #\> #)) (string->symbol sym)) (set! sym (string-append sym (string c))))))))))) (test (let ((#symbol 32)) (+ #symbol 1)) 33) (test (let ((#symbol 32)) #symbol) 32) (test (let ((#symbol< a b c > 32)) #symbol< a b c >) 32) (test (let ((#symbol 3) (#symbol 4) (#symbol< a b c > 5)) (+ #symbol #symbol #symbol< a b c >)) 12) (test (symbol->string '#symbol) "a b") (let () (define (f #symbol) (+ #symbol 3)) (test (f 2) 5)) (let () (define* (f (#symbol 1)) (+ #symbol 3)) (test (f 2) 5) (test (f) 4) (test (f #symbol<:a b> 3) 6)) (define #symbol 12) (let-temporarily ((#symbol 3)) (test #symbol 3)) (test #symbol 12) (test (let () (define #symbol 32) (set! #symbol (+ #symbol 1)) #symbol) 33) (test (let () (define #symbol 32) (immutable! '#symbol) (set! #symbol 1)) 'error) ; can't set! (symbol "a b") (it is immutable) (let ((abc 12) (#symbol 14)) (test #symbol 12) ; same as abc (test efg 14)) ; same as #symbol (unless (> (*s7* 'debug) 0) (let () (define f (apply lambda (list () (list 'let (list (list (symbol "a b") 3)) (symbol "a b"))))) ; (f) -> 3 ;; prints "readably" as "(lambda () (let (((symbol \"a b\") 3)) (symbol \"a b\")))" (let-temporarily (((*s7* 'symbol-printer) (lambda (obj) (string-append "#symbol<" (symbol->string obj) ">")))) (test (object->string f :readable) "(lambda () (let ((#symbol 3)) #symbol))")) (let-temporarily (((*s7* 'symbol-printer) (lambda (obj) 312))) (test (object->string f :readable) 'error)))) (test (set! (*s7* 'symbol-printer) 3) 'error) (test (set! (*s7* 'symbol-printer) (lambda () 'oops)) 'error) (test (set! (*s7* 'symbol-printer) #f) #f) ;;; use eval-string here because otherwise the (premature) #, confuses thash.scm s7test-reader (set! *#readers* (list (cons #\, (lambda (str) (eval (read)))))) (test (eval-string "#r(1.0 #,(+ 3 1.5))") #r(1.0 4.5)) (define (log3 x) (log x 3)) (test (eval-string "#i(#,(log3 (+ 7 2)))") #i(2)) (set! *#readers* *old-#readers*) ;;; -------------------------------------------------------------------------------- (begin (define-macro (hi a) `(+ ,a 1)) (test (hi 2) 3) (let () (define (ho b) (+ 1 (hi b))) (test (ho 1) 3)) (let ((hi 32)) (test (+ hi 1) 33)) (letrec ((hi (lambda (a) (if (= a 0) 0 (+ 2 (hi (- a 1))))))) (test (hi 3) 6)) (letrec* ((hi (lambda (a) (if (= a 0) 0 (+ 2 (hi (- a 1))))))) (test (hi 3) 6)) (test (equal? '(hi 1) (quote (hi 1))) #t) (test (list? '(hi 1)) #t) (test (list? '(((hi 1)))) #t) (test (equal? (vector (hi 1)) #(2)) #t) (test (symbol? (vector-ref #(hi) 0)) #t)) (define-macro (define-with-goto name-and-args . body) ;; run through the body collecting label accessors, (label name) ;; run through getting goto positions, (goto name) ;; tie all the goto's to their respective labels (via set-cdr! essentially) (define (find-accessor type) (let ((labels ())) (define (gather-labels accessor tree) (if (pair? tree) (if (equal? (car tree) type) (begin (set! labels (cons (cons (cadr tree) (let ((body 'lst)) (for-each (lambda (f) (set! body (list f body))) (reverse (cdr accessor))) (dilambda (apply lambda '(lst) (list body)) (apply lambda '(lst val) `((set! ,body val)))))) labels)) (gather-labels (cons 'cdr accessor) (cdr tree))) (begin (gather-labels (cons 'car accessor) (car tree)) (gather-labels (cons 'cdr accessor) (cdr tree)))))) (gather-labels () body) labels)) (let ((labels (find-accessor 'label)) (gotos (find-accessor 'goto))) (if (not (null? gotos)) (for-each (lambda (goto) (let* ((name (car goto)) (goto-accessor (cdr goto)) (label (assoc name labels)) (label-accessor (and label (cdr label)))) (if label-accessor (set! (goto-accessor body) (label-accessor body)) (error 'bad-goto "can't find label: ~S" name)))) gotos)) `(define ,name-and-args (let ((label (lambda (name) #f)) (goto (lambda (name) #f))) ,@body)))) (let () (define-with-goto (g1 a) (let ((x 1)) (if a (begin (set! x 2) (goto 'the-end) (set! x 3)) (set! x 4)) (label 'the-end) x)) (define-with-goto (g2 a) (let ((x a)) (label 'start) (if (< x 4) (begin (set! x (+ x 1)) (goto 'start))) x)) (test (g1 #f) 4) (test (g1 #t) 2) (test (g2 1) 4) (test (g2 32) 32)) (let ((sum 0)) (define-macro (define-with-goto-and-come-froms name-and-args . body) (let ((labels ()) (gotos ()) (come-froms ())) (define (collect-jumps tree) (when (pair? tree) (when (pair? (car tree)) (case (caar tree) ((label) (set! labels (cons tree labels))) ((goto) (set! gotos (cons tree gotos))) ((come-from) (set! come-froms (cons tree come-froms))) (else (collect-jumps (car tree))))) (collect-jumps (cdr tree)))) (collect-jumps body) (for-each (lambda (goto) (let* ((name (cadr (cadar goto))) (label (member name labels (lambda (a b) (eq? a (cadr (cadar b))))))) (if label (set-cdr! goto (car label)) (error 'bad-goto "can't find label: ~S" name)))) gotos) (for-each (lambda (from) (let* ((name (cadr (cadar from))) (label (member name labels (lambda (a b) (eq? a (cadr (cadar b))))))) (if label (set-cdr! (car label) from) (error 'bad-come-from "can't find label: ~S" name)))) come-froms) `(define ,name-and-args (let ((label (lambda (name) #f)) (goto (lambda (name) #f)) (come-from (lambda (name) #f))) ,@body)))) (define-with-goto-and-come-froms (hi) (set! sum (+ sum 1)) (goto 'the-end) (set! sum (+ sum 2)) (label 'the-end) (set! sum (+ sum 4)) (label 'not-done) (set! sum (+ sum 8)) (come-from 'not-done) (set! sum (+ sum 16)) (newline) sum) (test (hi) 21) (define-with-goto-and-come-froms (ho i) (label 'the-start) (if (= i 0) (begin (goto 'the-end)) (begin (set! i (- i 1)) (goto 'the-start))) (label 'the-end) 0) (let-temporarily (((*s7* 'safety) 1)) (test (object->string ho :readable) "#") ; changed 12-Mar-19 (test (equivalent? ho hi) #f)) (test (ho 2) 0)) ;;; ---------------------------------------- #| ;;; these tests are problematic -- they might not fail as hoped, or they might generate unwanted troubles (let ((bad-ideas " (define (bad-idea) (let ((lst '(1 2 3))) (let ((result (list-ref lst 1))) (list-set! lst 1 (* 2.0 16.6)) (gc) result))) (define (bad-idea-1) (let ((lst #(1 2 3))) (let ((result (vector-ref lst 1))) (vector-set! lst 1 (* 2.0 16.6)) (gc) result))) ")) (with-output-to-file tmp-output-file (lambda () (display bad-ideas))) (load tmp-output-file)) (num-test (bad-idea) 2) (let ((val (bad-idea))) (if (equal? val 33.2) (set! val (bad-idea))) (if (equal? val 33.2) (format #t ";bad-idea 3rd time: ~A~%" val))) (num-test (bad-idea-1) 2) (let ((val (bad-idea-1))) (if (equal? val 33.2) (set! val (bad-idea-1))) (if (equal? val 33.2) (format #t ";bad-idea-1 3rd time: ~A~%" val))) (set! (*s7* 'safety) 1) (load tmp-output-file) (num-test (bad-idea) 2) (num-test (bad-idea) 33.2) (num-test (bad-idea) 33.2) (num-test (bad-idea-1) 2) (num-test (bad-idea-1) 33.2) (num-test (bad-idea-1) 33.2) (set! (*s7* 'safety) 0) |# ;(test (quit 0) 'error) ;;; ---------------------------------------- ;;; macroexpand (let () (define-macro (hi a) `(+ ,a 1)) (test (macroexpand (hi 2)) '(+ 2 1)) (test (macroexpand (hi (abs 2))) '(+ (abs 2) 1)) (define-macro (ho a) `(+ ,@a 1)) (test (macroexpand (ho (2 3 4))) '(+ 2 3 4 1)) (define-macro* (hi1 a (b 2)) `(+ ,a ,b)) (test (macroexpand (hi1 3)) '(+ 3 2)) (define-bacro* (hi2 a (b 2)) `(+ ,a ,b)) (test (macroexpand (hi2 3)) '(+ 3 2)) ) (let () (define-macro (Let vars . body) `(with-let (sublet (curlet) ,@(map (lambda (var) (values (symbol->keyword (car var)) (cadr var))) vars)) ,@body)) (test (Let ((c 4)) (Let ((a 2) (b (+ c 2))) (+ a b c))) 12) (test (macroexpand (Let ((a 2) (b (+ c 2))) (+ a b c))) '(with-let (sublet (curlet) :a 2 :b (+ c 2)) (+ a b c)))) (let () (define-macro (m1 . args) `(begin ,@args)) (test (macroexpand (m1 (display 1) (newline))) '(begin (display 1) (newline)))) (test (let ((a 3) (b (list 2 3 4))) (quasiquote (+ ,a 1 ,@b))) '(+ 3 1 2 3 4)) (test (let ((a 3) (b (list 2 3 4))) (macroexpand (quasiquote (+ ,a 1 ,@b)))) (list #_list-values ''+ 'a 1 (list #_apply-values 'b))) (let () (define-macro* (m2 (a 3) (b 2)) `(+ ,a ,b)) (test (macroexpand (m2)) '(+ 3 2)) (test (macroexpand ((symbol->value 'm2) (* 2 3))) '(+ (* 2 3) 2))) (let () (define-bacro (m3 b) `(+ ,a ,b)) (test (let ((a 3)) (macroexpand (m3 2))) '(+ 3 2))) (let () (define-macro (progv vars vals . body) `(apply (apply lambda ,vars ',body) ,vals)) (test (macroexpand (progv '(one two) '(1 2) (+ one two))) '(apply (apply lambda '(one two) '((+ one two))) '(1 2)))) (let () (define-macro (Letrec* bindings . body) (if (null? body) (error 'syntax-error "letrec* has no body") (if (not (list? bindings)) (error 'syntax-error "letrec* variables are messed up") `(let (,@(map (lambda (var&init) (list (car var&init) #)) bindings)) ,@(map (lambda (var&init) (if (not (null? (cddr var&init))) (error 'syntax-error "letrec* variable has more than one value")) (list 'set! (car var&init) (cadr var&init))) bindings) ,@body)))) (test (macroexpand (Letrec* ((p (lambda (x) (+ 1 (q (- x 1))))) (q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (x (p 5)) (y x)) y)) '(let ((p #) (q #) (x #) (y #)) (set! p (lambda (x) (+ 1 (q (- x 1))))) (set! q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (set! x (p 5)) (set! y x) y))) (let () (define-macro (m5 a) `(define-macro (m6 b) `(+ 1 ,b ,,a))) (test (macroexpand ((m5 3) 4)) '(+ 1 4 3))) (let () (define* (fgh2 (!x (let () (define-macro (m5 a) `(define-macro (m6 b) `(+ 1 ,b ,,a))) (macroexpand ((m5 3) 4)) '(+ 1 4 3)))) !x) (test (fgh2) '(+ 1 4 3))) (test (macroexpand) 'error) (test (macroexpand 1) 'error) (test (macroexpand . 1) 'error) (test (macroexpand (* 1 2)) 'error) (test (macroexpand (* 1 2) . 3) 'error) (test (macroexpand (* 1 2) 3) 'error) (test (macroexpand ((symbol->value 'abs) -1)) 'error) (test (macroexpand (1 2)) 'error) (let () (define-macro (rmac . args) (if (null? args) () (if (null? (cdr args)) `(display ',(car args)) (append (list 'begin `(display ',(car args))) (append (list (apply macroexpand (list (append '(rmac) (cdr args)))))))))) (test (with-output-to-string (lambda () (rmac a b c (+ 1 2) d))) "abc(+ 1 2)d")) ;;; define-expansion (define-expansion (_expansion_ a) `(+ ,a 1)) (test (_expansion_ 3) 4) (test (macroexpand (_expansion_ 3)) `(+ 3 1)) (test '(_expansion_ 3) (quote (_expansion_ 3))) (test (_expansion_ (+ (_expansion_ 1) 2)) 5) (test (let ((x _expansion_)) (x 3)) (+ 3 1)) (test (let ((x 3)) (define (hi a) (a x)) (hi _expansion_)) 4) (define-expansion (whatever->zero . whatever) 0) (let ((val (+ 1 (whatever->zero 2 3) 4))) (if (not (= val 5)) (format *stderr* "whatever->zero: ~A?" val))) (define (make-instrument-conf6) ()) (define-expansion () `(+ 2 3)) (test (make-instrument-conf6) 5) (define (make-instrument-conf5) ()) (define-macro () `(+ 2 3)) (test (make-instrument-conf5) 5) (define-expansion () `(+ 2 3)) (define (make-instrument-conf4) ()) (test (make-instrument-conf4) 5) (define-expansion* ( (x 32)) `(+ ,x 1)) (let () (define (f2) (+ 2 ())) (when (zero? (*s7* 'debug)) (test (procedure-source f2) '(lambda () (+ 2 (+ 32 1))))) (test (f2) 35)) (let () (define-macro (_mac_ x) `(+ ,x 1)) (test (member 1 (list 3 2) (lambda (a b) (null? (macroexpand (_mac_ (make-hash-table)))))) #f)) (let () (define-macro (c-define-macro2 def . body) `(define-macro ,def ,@body)) (c-define-macro2 (*testexp* a . b) `(list ,a ,@b)) (test (*testexp* 1 2 3) '(1 2 3)) (test (macroexpand (c-define-macro2 (*testexp* a . b) `(list ,a ,@b))) '(define-macro (*testexp* a . b) (#_list-values (#_quote list) a (#_apply-values b))))) (define-expansion (__add-1__ x) (+ x 1)) ; needs to be global for it to be seen at read-time (let () (define v #((__add-1__ 1) (__add-1__ 2))) (test v #(2 3))) ; ! (test (__add_1__) 'error) (test (__add_1__ 1 2) 'error) (define-expansion (__read_vec__ x) (eval-string "#i3d(((0 1)) ((2 3)))") (+ x 1)) (let () (define v #i2d(((__add-1__ 1) (__read_vec__ 2)))) (test v #i2d((2 3)))) (let () (define v #i2d(((__add-1__ 1) (__read_vec__ 2) (__add-1__ (__add-1__ 3))))) (test v #i2d((2 3 5)))) ;;; -------------------------------------------------------------------------------- ;;; define-constant (test (let () (define-constant __c1__ 32) __c1__) 32) (test (let () (define-constant __c1__ 32) (let ((__c1__ 3)) __c1__)) 'error) (test (let () (define-constant __c1__ 32) (letrec ((__c1__ 3)) __c1__)) 'error) (test (let () (define-constant __c1__ 32) (letrec* ((__c1__ 3)) __c1__)) 'error) (test (let () (define-constant __c1__ 32) (let* ((__c1__ 3)) __c1__)) 'error) (test (let () (define-constant __c1__ 32) (let () (define __c1__ 3) __c1__)) 'error) (test (let () (define-constant __c1__ 32) (let () (set! __c1__ 3) __c1__)) 'error) (test (let () (define-constant __c1__ 32) (do ((__c1__ 3)) (#t) __c1__)) 'error) (test (let () (define-constant __c1__ 32) (let ((x (inlet :__c1__ 34))) x)) 'error) (let () (define (df1 a) (set! pi a)) (test (df1 3.0) 'error) (test (df1 #\a) 'error) (define (df2 a b) (set! pi (+ a b))) (test (df2 1.0 2.0) 'error) (define (df3 a) (set! pi (+ pi 1))) (test (df3 1) 'error) (test (set! pi (abs pi)) pi) ; ok 2-Nov-23 (test (set! pi pi) pi) ; was 'error 24-Oct-23 (test (define-constant pi pi) pi) ; but this is ok -- define-constant can be a no-op (test (define-constant pi 3.0) 'error) (test (define pi 3.0) 'error) (test (define (pi a) a) 'error) (test (define (f1 pi) pi) 'error) (test (let ((pi 3.0)) pi) 'error) (test (let* ((pi 3.0)) pi) 'error) (test (letrec ((pi 3.0)) pi) 'error) (test (letrec* ((pi 3.0)) pi) 'error) (test (do ((pi 0 (+ pi 1))) ((= pi 3))) 'error) ) (let ((xc 3)) (let () (define-constant xc 32) (test (constant? 'xc) #t) (test (let ((xc 3)) xc) 'error) (test (let* ((y 1) (xc y)) xc) 'error) (test (let ((y (lambda (xc) xc))) (y 1)) 'error) (test (let ((y (lambda (a . xc) xc))) (y 1 2)) 'error) (test (let ((y (lambda* (a :rest xc) xc))) (y 1 2)) 'error) (test (do ((xc 0 (+ xc 1))) ((= xc 2) xc) xc) 'error) (test (inlet 'xc 1) 'error) (test (varlet (inlet) 'xc 1) 'error) (test (set! xc 4) 'error) (test xc 32) (test (let () (define xc 5) xc) 'error) (test (let () (define-constant xc 5) xc) 'error) (test (let () (define* (xc y) 5) (xc)) 'error) (test (let () (define-macro (xc y) `(+ ,y 1)) (xc 2)) 'error) ) (test xc 3) (test (constant? 'xc) #f) (test (let ((xc 3)) xc) 3) (test (let* ((y 1) (xc y)) xc) 1) (test (let ((y (lambda (xc) xc))) (y 1)) 1) (test (let ((y (lambda (a . xc) xc))) (y 1 2)) '(2)) (test (let ((y (lambda* (a :rest xc) xc))) (y 1 2)) '(2)) (test (do ((xc 0 (+ xc 1))) ((= xc 2) xc) xc) 2) (test (inlet 'xc 1) (inlet 'xc 1)) (test (varlet (inlet) 'xc 1) (inlet 'xc 1)) (test (set! xc 4) 4) (test xc 4) (test (let () (define xc 5) xc) 5) (test (let () (define-constant xc 5) xc) 5) (test (let () (define* (xc y) 5) (xc)) 5) (test (let () (define-macro (xc y) `(+ ,y 1)) (xc 2)) 3) (test xc 4) ) (test (let ((z (let () (define-constant xc 3) (lambda (y) (let ((xc y)) xc))))) (z 1)) 'error) (test (let ((xc 1)) (define z (let () (define-constant xc 3) (lambda (y) (let ((xc y)) xc)))) (z 1)) 'error) (test (let () (define-constant (xc xc) xc) (xc 1)) 1) (let () (define (f) (define-constant xxx 3) (constant? 'xxx)) ; op_define_constant_unchecked (test (f) #t) (test (f) #t)) (let () (define (g) (define-constant (xyx x) (+ x 1)) (constant? 'xyx)) (test (g) #t) (test (g) #t)) (let () (define-constant (func) 1) (test (immutable? func) #t)) (unless (> (*s7* 'profile) 0) (let () (with-output-to-file tmp-output-file (lambda () (display "(define-constant _s7test_xxx 32)\n") (display "(define-constant (_s7test_yyy a) (+ a 1))\n") (display "(define-constant _s7test_zzz _s7test_yyy)\n"))) (load tmp-output-file) (test _s7test_xxx 32) (test (_s7test_yyy 2) 3) (test (_s7test_zzz 2) 3) (load tmp-output-file) (test _s7test_xxx 32) (test (_s7test_yyy 2) 3) (test (_s7test_zzz 2) 3))) #| (let ((old-stdin *stdin*) (old-closed (port-closed? *stdin*))) (let ((tag (catch #t (lambda () (set! *stdin* #f)) (lambda args 'error)))) (when (or (not (eq? *stdin* old-stdin)) (not (eq? old-closed (port-closed? *stdin*)))) (set! *stdin* old-stdin) (format *stderr* ";*stdin* mutable?~%")) (if (not (eq? tag 'error)) (format *stderr* ";set! *stdin* no error? ~A~%" tag)))) (let ((old-stdout *stdout*) (old-closed (port-closed? *stdout*))) (let ((tag (catch #t (lambda () (set! *stdout* #f)) (lambda args 'error)))) (when (or (not (eq? *stdout* old-stdout)) (not (eq? old-closed (port-closed? *stdout*)))) (set! *stdout* old-stdout) (format *stderr* ";*stdout* mutable?~%")) (if (not (eq? tag 'error)) (format *stderr* ";set! *stdout* no error? ~A~%" tag)))) (let ((old-stderr *stderr*) (old-closed (port-closed? *stderr*))) (let ((tag (catch #t (lambda () (set! *stderr* #f)) (lambda args 'error)))) (when (or (not (eq? *stderr* old-stderr)) (not (eq? old-closed (port-closed? *stderr*)))) (set! *stderr* old-stderr) (format *stderr* ";*stderr* mutable?~%")) (if (not (eq? tag 'error)) (format *stderr* ";set! *stderr* no error? ~A~%" tag)))) |# (let ((old-pi pi)) (let ((tag (catch #t (lambda () (set! pi #f)) (lambda args 'error)))) (if (not (eq? pi old-pi)) (format pi ";pi mutable?~%")) (if (not (eq? tag 'error)) (format pi ";set! pi no error? ~A~%" tag)))) (let ((old-with-let with-let)) (let ((tag (catch #t (lambda () (set! with-let #f)) (lambda args 'error)))) (if (not (eq? with-let old-with-let)) (format with-let ";with-let mutable?~%")) (if (not (eq? tag 'error)) (format with-let ";set! with-let no error? ~A~%" tag)))) (let ((old-*s7* *s7*)) (let ((tag (catch #t (lambda () (set! *s7* #f)) (lambda args 'error)))) (if (not (eq? *s7* old-*s7*)) (format *s7* ";*s7* mutable?~%")) (if (not (eq? tag 'error)) (format *s7* ";set! *s7* no error? ~A~%" tag)))) (let () (define-constant (c_f1 c) (define-constant (c_g1) (if (= c 0) 0 (- c 1))) (c_g1)) (test (c_f1 1) 0) (test (c_f1 2) 1) (define (c_f2 c) (define (c_g2) (if (= c 0) 0 (- c 1))) (c_g2)) (test (c_f2 1) 0) (test (c_f2 2) 1) (define-constant (c_f3 c) (define (c_g3) (if (= c 0) 0 (- c 1))) (c_g3)) (test (c_f3 1) 0) (test (c_f3 2) 1) (define (c_f4 c) (define-constant (c_g4) (if (= c 0) 0 (- c 1))) (c_g4)) (test (c_f4 1) 0) (test (c_f4 2) 1) (define c_f5 (let ((c 0)) (define-constant (c_g5) (if (= c 0) 0 (- c 1))) (lambda (d) (set! c d) (c_g5)))) (test (c_f5 1) 0) (test (c_f5 2) 1) (define-constant (c_f6 c) (define-constant (c_g6) (call/cc (lambda (x) (if (= c 0) 0 (- c 1))))) (c_g6)) (test (c_f6 1) 0) (test (c_f6 2) 1) (define (c_f7 c) (define (c_g7) (call/cc (lambda (x) (if (= c 0) 0 (- c 1))))) (c_g7)) (test (c_f7 1) 0) (test (c_f7 2) 1) (define-constant (c_f8 c) (define (c_g8) (call/cc (lambda (x) (if (= c 0) 0 (- c 1))))) (c_g8)) (test (c_f8 1) 0) (test (c_f8 2) 1) (define (c_f9 c) (define-constant (c_g9) (call/cc (lambda (x) (if (= c 0) 0 (- c 1))))) (c_g9)) (test (c_f9 1) 0) (test (c_f9 2) 1)) ;;; -------------------------------------------------------------------------------- ;;; constant? (test (constant? '__c1__) #f) (test (constant? pi) #t) (test (constant? 'pi) #t) ; take that, Clisp! (test (constant? 12345) #t) (test (constant? 3.14) #t) (test (constant? :asdf) #t) (test (constant? 'asdf) #f) (test (constant? "hi") #t) (test (constant? #\a) #t) (test (constant? #f) #t) (test (constant? #t) #t) (test (constant? ()) #t) (test (constant? '(a)) #t) (test (constant? '*features*) #f) (test (let ((a 3)) (constant? 'a)) #f) (test (constant? 'abs) #f) (test (constant? abs) #t) (test (constant? most-positive-fixnum) #t) (test (constant? (/ (log 0))) #t) ; +nan.0 is a constant as a number I guess (test (constant? 1/0) #t) (test (constant? (log 0)) #t) (test (constant?) 'error) (test (constant? 1 2) 'error) (test (constant? #) #t) ; ? (test (constant? #) #t) (test (constant? _undef_) #t) (test (constant? #) #t) (test (constant? '-) #f) (test (constant? ''-) #t) (test (constant? '''-) #t) (test (constant? '1) #t) (test (constant? 1/2) #t) (test (constant? 'with-let) #t) (test (constant? with-let) #t) (test (constant? (cons 1 2)) #t) (test (constant? #(1 2)) #t) (test (constant? (list 1 2)) #t) (test (constant? (vector 1 2)) #t) (test (let ((v (vector 1 2))) (constant? v)) #t) ;!! ;; it's returning #t unless the arg is a symbol that is not a keyword or a defined constant ;; (it's seeing the value of v, not v): (test (let ((v (vector 1 2))) (constant? 'v)) #f) ;; that is something that can be set! is not a constant? (when with-bignums (test (constant? 1624540914719833702142058941) #t) (test (constant? 1624540914719833702142058941.4) #t) (test (constant? 7151305879464824441563197685/828567267217721441067369971) #t)) (test (constant? lambda) #t) ; like abs? (test (constant? (lambda () 1)) #t) (test (constant? ''3) #t) (test (constant? (if #f #f)) #t) (test (constant? 'x) #f) (test (let ((x 'x)) (and (not (constant? x)) (equal? x (eval x)))) #t) (test (and (constant? (list + 1)) (not (equal? (list + 1) (eval (list + 1))))) #t) ;;; -------------------------------------------------------------------------------- ;;; immutable! ;;; immutable? (test (immutable? ()) #t) (test (immutable? (list 1)) #f) (test (immutable? (immutable! (list 1))) #t) (test (immutable? '__c1__) #f) (test (immutable? pi) #t) (test (immutable? 'pi) #t) (test (immutable? :asdf) #t) (test (immutable? ':asdf) #t) (test (immutable? 'asdf) #f) (test (immutable? "hi") #f) (test (immutable? #\a) #t) (test (immutable? #f) #t) (test (immutable? #t) #t) (test (immutable? ()) #t) (test (immutable? #()) #t) (test (immutable? #i()) #t) (test (immutable? #u()) #t) (test (immutable? #r()) #t) (test (immutable? #(1)) #f) (test (immutable? #i(1)) #f) (test (immutable? #u(1)) #f) (test (immutable? #r(1.0)) #f) (test (immutable? (hash-table)) #f) (test (immutable? (inlet)) #f) (test (immutable? (c-pointer 0)) #f) (test (immutable? *stdin*) #t) (test (immutable? *stdout*) #t) (test (immutable? *stderr*) #t) (test (immutable? (random-state 1234)) #f) ; a c-function without a setter, but perhaps this makes sense (test (immutable?) 'error) (test (immutable? 1 2) 'error) (test (immutable? #) #t) (test (immutable? 'with-let) #t) ;(test (immutable? (format #t #u())) #f) (test (immutable? (format #t "")) #f) (test (immutable? "") #f) ; ?? (test (immutable? '"") #f) (test (immutable? #) #t) (test (immutable? _undef_) #t) (test (immutable? #) #t) (test (immutable? 123123) #t) (test (immutable? (bignum 123123)) #t) (test (immutable? 123/2) #t) (test (immutable? (bignum 123/2)) #t) (test (immutable? 123.0) #t) (test (immutable? (bignum 123.0)) #t) (test (immutable? 123.0+i) #t) (test (immutable? (bignum 123.0+i)) #t) (test (immutable? when) #t) (test (immutable? abs) #t) (test (immutable? #_abs) #t) (test (immutable? with-let) #t) (test (immutable? apply-values) #t) (test (immutable? quasiquote) #t) (test (immutable? (rootlet)) #f) ;(test (immutable? (unlet)) #t) ; unlet as a function returns a new let that restores changed unlet values (test (immutable? :a (inlet 'a 1)) #t) (test (immutable? :a (let ((a 1)) (immutable! 'a) (curlet))) #t) (test (immutable? 'a #f) 'error) (test (immutable? :allow-other-keys (rootlet)) #t) ;; Clisp: ;; (constantp (cons 1 2)) ->NIL ;; (constantp #(1 2)) -> T ;; (constantp '(1 . 2)) -> NIL ;; (constantp (vector 1)) -> T (let ((e (inlet 'a 1))) (test (with-let e (immutable? 'a)) #f) (test (set! (e 'a) 2) 2) (test e (inlet 'a 2)) (with-let e (immutable! 'a)) (test (with-let e (immutable? 'a)) #t) (test (set! (e 'a) 4) 'error)) ;error: can't let-set! a (it is immutable) (test (sort! (immutable! (string #\a #\b #\c)) char>?) 'error) (test (sort! (immutable! (vector #\a #\b #\c)) char>?) 'error) (test (sort! (immutable! #(3 2 1) <)) 'error) ;(test (let-temporarily (((*s7* 'safety) 2)) (sort! #(2 4 1) >)) 'error) -- safety must be set at read-time, so this is #(4 2 1) (test (sort! (immutable! (byte-vector 0 1 2)) >) 'error) (test (sort! (immutable! (int-vector 0 1 2)) >) 'error) (test (sort! (immutable! (float-vector 0 1 2)) >) 'error) (test (sort! (immutable! (list 0 1 2)) >) 'error) (test (sort! () >) ()) (test (sort! (vector) >) #()) (test (reverse! (immutable! (string #\a #\b #\c))) 'error) (test (reverse! (immutable! (vector #\a #\b #\c))) 'error) (test (reverse! (immutable! (byte-vector 0 1 2))) 'error) (test (reverse! (immutable! (int-vector 0 1 2))) 'error) (test (reverse! (immutable! (float-vector 0 1 2))) 'error) (test (reverse! (immutable! (hash-table :a 1 :b 2))) 'error) (test (reverse! (immutable! (inlet :a 1 :b 2))) 'error) (test (reverse! (immutable! (list 1 2 3))) 'error) (test (reverse! (vector)) #()) (test (let ((e (inlet 'a 1))) (immutable! :a e) (immutable? 'a e)) #t) (test (let ((e (inlet 'a 1))) (immutable! 'b e) (immutable? 'b e)) #f) ; #f because it is not defined in e (test (immutable! :a) :a) (test (set-car! (immutable! (cons 1 2)) 3) 'error) (test (set-cdr! (immutable! (cons 1 2)) 3) 'error) (test (let ((c (immutable! (list 1 2)))) (set-car! c 0)) 'error) (test (let ((c (cons 1 (immutable! (cons 2 ()))))) (set-car! (cdr c) 0)) 'error) (test (let ((c (cons 1 (immutable! (cons 2 ()))))) (set-car! c 0) c) '(0 2)) (test (fill! (immutable! (string #\a #\b #\c)) #\a) 'error) (test (string-fill! (immutable! (string #\a #\b #\c)) #\a) 'error) (test (fill! (immutable! (vector #\a #\b #\c)) 1) 'error) (test (vector-fill! (immutable! (vector #\a #\b #\c)) 1) 'error) (test (fill! (immutable! (byte-vector 0 1 2)) 0) 'error) (test (fill! (immutable! (int-vector 0 1 2)) 1) 'error) (test (fill! (immutable! (float-vector 0 1 2)) 1.0) 'error) (test (fill! (immutable! (hash-table :a 1 :b 2)) #f) 'error) (test (fill! (immutable! (inlet :a 1 :b 2)) #f) #f) ; was 'error 8-Jun-20 (test (fill! (immutable! (list 1 2 3)) 0) 'error) (test (let () (define (func) (immutable? (string-append (get-output-string (open-output-string))))) (func)) #f) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (immutable! 'i)))) (func)) 'error) (test (reverse! (copy (immutable! (string #\a #\b #\c)))) "cba") (test (immutable? (copy (immutable! (list 1 2)))) #f) (test (immutable? (copy (immutable! "123"))) #f) (test (object->string (copy (immutable! (cons 0 (immutable! (cons 1 (immutable! (cons 2 ()))))))) :readable) "(list 0 1 2)") ; copy drops the immutable bit (test (immutable? (copy (immutable! (cons 1 ())))) #f) (define (vars-immutable! L) ;; (for-each (lambda (f) (with-let (sublet L :f f) (immutable! (car f)))) L) (with-let L (for-each (lambda (f) (immutable! (car f))) (curlet))) L) (test (let ((str (immutable! (string #\1 #\2)))) (string-set! str 0 #\a)) 'error) (test (let ((str (immutable! (string #\1 #\2)))) (set! (str 0) #\a)) 'error) (test (let ((bv (immutable! (byte-vector 1 2)))) (byte-vector-set! bv 0 2)) 'error) (test (let ((lt (vars-immutable! (inlet :a 1)))) (let-set! lt :a 2)) 'error) (test (let ((lt (vars-immutable! (inlet :a 1)))) (set! (lt :a) 2)) 'error) (test (let ((lt (vars-immutable! (inlet :a 1)))) (with-let lt (set! a 2))) 'error) (test (let ((lt (immutable! (hash-table :a 1)))) (hash-table-set! lt :a 2)) 'error) (test (let ((lt (immutable! (hash-table :a 1)))) (set! (lt :a) 2)) 'error) (test (let () (immutable! (curlet)) (define hi 3) hi) 'error) (test (let () (immutable! (curlet)) (immutable? (curlet))) #t) (let ((L (immutable! (inlet 'a 1)))) (test (with-let L (define b 3)) 'error) (test (varlet L 'b 32) 'error) (test (with-let L (set! a 12)) 12) (test (let-set! L 'a 32) 32)) (test (let ((p (immutable! (list 1 2)))) (list-set! p 0 2)) 'error) (test (let ((p (immutable! (list 1 2)))) (set! (p 0) 2)) 'error) (test (let ((p (immutable! (vector 1 2)))) (vector-set! p 0 2)) 'error) (test (let ((p (immutable! (vector 1 2)))) (set! (p 0) 2)) 'error) (test (let ((p (immutable! (int-vector 1 2)))) (int-vector-set! p 0 2)) 'error) (test (let ((p (immutable! (int-vector 1 2)))) (set! (p 0) 2)) 'error) (test (let ((p (immutable! (float-vector 1 2)))) (float-vector-set! p 0 2)) 'error) (test (let ((p (immutable! (float-vector 1 2)))) (set! (p 0) 2)) 'error) (test (let ((ht (immutable! (hash-table 'a 1)))) (hash-table-set! ht 'a #f)) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (varlet lt 'b 2)) 'error) (test (let ((lt (immutable! (inlet 'a 1 'b 2)))) (cutlet lt 'b)) 'error) (let ((src (vector 0 0))) (test (let ((p1 (immutable! (list 1 2)))) (copy src p1)) 'error) (test (let ((p1 (immutable! (string #\a #\b)))) (copy src p1)) 'error) (test (let ((p1 (immutable! (byte-vector 1 2)))) (copy src p1)) 'error) (test (let ((p1 (immutable! (vector 1 2)))) (copy src p1)) 'error) (test (let ((p1 (immutable! (int-vector 1 2)))) (copy src p1)) 'error) (test (let ((p1 (immutable! (float-vector 1 2)))) (copy src p1)) 'error) (test (let ((p1 (immutable! (hash-table 'a 1)))) (copy src p1)) 'error) (test (let ((p1 (immutable! (inlet 'a 1)))) (copy src p1)) 'error)) (test (copy (inlet 'a 1) (immutable! (inlet 'b 2))) 'error) (test (copy (inlet 'a 1) (immutable! (vector 0 0))) 'error) (test (copy (hash-table 'a 1) (immutable! (vector 0 0))) 'error) (test (let ((lt (vars-immutable! (inlet 'a 1)))) (let-set! lt 'a 2)) 'error) (test (let ((lt (vars-immutable! (inlet 'a 1)))) (set! (lt 'a) 2)) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (let-set! lt 'b 2)) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (set! (lt 'b) 2)) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (define b 2))) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (define* (b x) (+ x 2)))) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (apply define '(b 2)))) 'error) (test (let ((a 1)) (immutable! (curlet)) (define b 2)) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (define-macro (b x) `(+ ,x 2)))) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (with-let lt (provide 'hiho))) 'error) (test (let ((a 1)) (immutable! (curlet)) (provide 'hiho)) 'error) (test (let () (let ((x 0)) (immutable! 'x)) (let ((x 0)) x)) 0) (test (let () (let ((x 0)) (set! x 3) x)) 3) (test (let () (let ((x 3)) (immutable! 'x) (set! x 31))) 'error) (test (let ((a (openlet (immutable! (inlet 'asdf 1))))) (a 'asdf)) 1) (let ((caught 0)) (immutable! 'caught) ; op_set_s_constant|symbol|expression (define (func) (catch #t (lambda () (set! caught 1)) (lambda (type info) 'error))) (test (func) 'error) (test (func) 'error)) (let ((one 1) (caught 0)) (immutable! 'caught) (define (func) (catch #t (lambda () (set! caught one)) (lambda (type info) 'error))) (test (func) 'error) (test (func) 'error)) (let ((caught 0)) (immutable! 'caught) (define (func)(catch #t (lambda () (set! caught (abs 1))) (lambda (type info) 'error))) (test (func) 'error) (test (func) 'error)) (let ((caught 1)) (immutable! 'caught) ; op_set_s_constant|symbol|expression (define (func) (catch #t (lambda () (set! caught 1)) (lambda (type info) 'error))) (test (func) 1) (test (func) 1)) (let ((one 1) (caught 1)) (immutable! 'caught) (define (func) (catch #t (lambda () (set! caught one)) (lambda (type info) 'error))) (test (func) 1) (test (func) 1)) (let ((caught 1)) (immutable! 'caught) (define (func)(catch #t (lambda () (set! caught (abs 1))) (lambda (type info) 'error))) (test (func) 1) (test (func) 1)) (let () (define-macro (im-test expr result) `(let ((res (catch #t (lambda () ,expr) (lambda (type info) type)))) (unless (equal? res ,result) (format *stderr* "~S: got ~S, but expected ~S~%" ',expr res ',result)))) (define L1 (inlet 'a1 (list 1))) (define L2 (inlet 'a2 (list 2))) (define L3 (inlet 'a3 (list 3))) (define L4 (let ((a4 (list 4))) (immutable! 'a4) (curlet))) (define L5 (inlet 'a5 (list 5))) (for-each (lambda (f) (with-let (sublet L1 :f f) (immutable! (car f)))) L1) (with-let L2 (for-each (lambda (f) (immutable! (car f))) (curlet))) (with-let L3 (immutable! 'a3)) (immutable! (L5 'a5)) ; this is the value (im-test (let ((a1 32)) a1) 32) (im-test (let ((a2 32)) a2) 32) (im-test (let ((a3 32)) a3) 32) (im-test (let ((a4 32)) a4) 32) (im-test (let ((a5 32)) a5) 32) (im-test (immutable? 'a1) #f) (im-test (immutable? 'a2) #f) (im-test (immutable? 'a3) #f) (im-test (immutable? 'a4) #f) (im-test (immutable? 'a5) #f) (im-test (immutable? L1) #f) (im-test (immutable? L2) #f) (im-test (immutable? L3) #f) (im-test (immutable? L4) #f) (im-test (immutable? L5) #f) (im-test (immutable? (L1 'a1)) #f) ; this is the value ; (im-test (with-let L1 (immutable? 'a1)) #t) (im-test (let ((a8 (list 8))) (immutable! a8) (immutable? a8)) #t) (im-test (with-let L1 (set! a1 32)) 'immutable-error) (im-test (with-let L2 (set! a2 32)) 'immutable-error) (im-test (with-let L3 (set! a3 32)) 'immutable-error) (im-test (with-let L4 (set! a4 32)) 'immutable-error) (im-test (with-let L5 (set! a5 32)) 32) (im-test (let-set! L1 'a1 32) 'immutable-error) (im-test (let-set! L2 'a2 32) 'immutable-error) (im-test (let-set! L3 'a3 32) 'immutable-error) (im-test (let-set! L4 'a4 32) 'immutable-error) (im-test (let-set! L5 'a5 32) 32) (im-test (set! (L1 'a1) 32) 'immutable-error) (im-test (set! (L2 'a2) 32) 'immutable-error) (im-test (set! (L3 'a3) 32) 'immutable-error) (im-test (set! (L4 'a4) 32) 'immutable-error) (im-test (set! (L5 'a5) 32) 32) (im-test (fill! L1 #f) 'immutable-error) (im-test (fill! L2 #f) 'immutable-error) (im-test (fill! L3 #f) 'immutable-error) (im-test (fill! L4 #f) 'immutable-error) (im-test (fill! L5 #f) #f) (im-test (with-let L1 (define a7 7)) 7) (im-test L1 (inlet 'a1 (list 1) 'a7 7)) (define L8 (copy L1)) (im-test (immutable? L8) #f) (im-test (with-let L8 (set! a1 12)) 12) ; new slot not immutable (define L6 (immutable! (inlet 'a6 (list 6)))) (im-test (immutable? L6) #t) (im-test (immutable? (L6 'a6)) #f) (im-test (with-let L6 (set! a6 32)) 32) (im-test (let-set! L6 'a6 321) 321) (im-test (set! (L6 'a6) 123) 123) (im-test (with-let L6 (define a7 7)) 'immutable-error) (im-test (varlet L6 'a7 7) 'immutable-error) (im-test (cutlet L6 'a6) 'immutable-error) (im-test (fill! L6 123) 123) (im-test (L6 'a6) 123) (im-test (fill! L6 #) #) (im-test (set! L6 32) 32) (define L61 (immutable! (inlet 'a6 (list 6)))) (im-test (immutable? L61) #t) (define L9 (copy L61)) (im-test (immutable? L9) #f) ; new let not immutable (im-test (with-let L9 (set! a6 12)) 12)) (let ((f2 (let ((+documentation+ "hiho") (+signature+ (list integer? integer?)) (+setter+ (lambda (val) val))) (lambda (x) (+ x 1))))) (set! ((funclet 'f2) '+documentation+) "new docs") (set! ((funclet 'f2) '+signature+) (list #t #t)) (set! ((funclet 'f2) '+setter+) (lambda (val) (+ val 1))) (with-let (funclet 'f2) (immutable! '+setter+)) (with-let (funclet 'f2) (immutable! '+documentation+)) (with-let (funclet 'f2) (immutable! '+signature+)) (test (set! ((funclet 'f2) '+documentation+) "newer docs") 'error) (test (set! ((funclet 'f2) '+signature+) (list #f #f)) 'error) (test (set! ((funclet 'f2) '+setter+) (lambda (val) (+ val 2))) 'error)) (test (let ((+setter+ abs)) (set! +setter+ #f)) #f) (test (let () (define (fstr) "fstr result") (let ((str (fstr))) (string-set! str 1 #\!) (fstr))) "f!tr result") (test (let () (define (fstr) (immutable! "fstr result")) (let ((str (fstr))) (string-set! str 1 #\!) (fstr))) 'error) (when (zero? (*s7* 'debug)) (test (let () (define (fstr) "fstr result") (object->string fstr :readable)) "(lambda () \"fstr result\")") (test (let () (define (fstr) (immutable! "fstr result")) (object->string fstr :readable)) "(lambda () (immutable! \"fstr result\"))")) (test (let ((str (immutable! "1234"))) (object->string str :readable)) "(immutable! \"1234\")") (test (let ((seq (immutable! (list 1 2 3)))) (object->string seq :readable)) "(immutable! (cons 1 (cons 2 (cons 3 ()))))") (test (let ((seq (immutable! (vector 1 2 3)))) (object->string seq :readable)) "(immutable! (vector 1 2 3))") (test (let ((seq (immutable! (int-vector 1 2 3)))) (object->string seq :readable)) "(immutable! #i(1 2 3))") (test (let ((seq (immutable! (float-vector 1 2 3)))) (object->string seq :readable)) "(immutable! #r(1.0 2.0 3.0))") (test (let ((seq (immutable! (inlet :a 1)))) (object->string seq :readable)) "(immutable! (inlet :a 1))") (test (let ((seq (immutable! (hash-table :a 1)))) (object->string seq :readable)) "(immutable! (hash-table :a 1))") (test (let ((seq (immutable! (byte-vector 1 2 3)))) (object->string seq :readable)) "(immutable! #u(1 2 3))") (test (let ((seq (immutable! (cons 1 2)))) (object->string seq :readable)) "(immutable! (cons 1 2))") (test (let ((seq (immutable! '(1 2)))) (object->string seq :readable)) "(immutable! (cons 1 (cons 2 ())))") (test (let ((seq (immutable! (list 1)))) (object->string (list seq 2) :readable)) "(list (immutable! (cons 1 ())) 2)") (test (let ((str (immutable! 1234))) (object->string str :readable)) "1234") (test (let ((str (immutable! #\a))) (object->string str :readable)) "#\\a") (test (object->string (immutable! (cons 1 (immutable! (cons 2 ())))) :readable) "(immutable! (cons 1 (immutable! (cons 2 ()))))") (test (object->string (cons 1 (immutable! (list 2))) :readable) "(cons 1 (immutable! (cons 2 ())))") (test (object->string (list 1 (immutable! (list 2))) :readable) "(list 1 (immutable! (cons 2 ())))") (test (object->string (immutable! '(1 2 . 3)) :readable) "(immutable! (cons 1 (cons 2 3)))") (test (object->string (cons 0 (immutable! (cons 1 (immutable! (cons 2 3))))) :readable) "(cons 0 (immutable! (cons 1 (immutable! (cons 2 3)))))") (test (object->string (list (list (immutable! (cons 1 2)))) :readable) "(list (list (immutable! (cons 1 2))))") (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (string-set! str 0 #\a)) str) (f (immutable! "1234"))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (string-set! str 0 #\a)) str) (f (immutable! (vector 1 2 3)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str 0) #\a)) str) (f (immutable! "1234"))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (do ((j 0 (+ j 1))) ((= j 2)) (string-set! str 0 #\a))) str) (f (immutable! "1234"))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (let-set! str :a 2)) str) (f (vars-immutable! (inlet :a 1)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str :a) 2)) str) (f (vars-immutable! (inlet :a 1)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (hash-table-set! str 'a 1)) str) (f (immutable! (hash-table 'a 1)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str 'a) 1)) str) (f (immutable! (hash-table 'a 1)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (list-set! str 1 2)) str) (f (immutable! (list 0 1 2)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str 1) 2)) str) (f (immutable! (list 0 1 2)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set-car! str 1)) str) (f (immutable! (list 0 1 2)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set-cdr! str 1)) str) (f (immutable! (list 0 1 2)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (vector-set! str 1 2)) str) (f (immutable! (vector 0 1 2)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! (str 1) 2)) str) (f (immutable! (vector 0 1 2)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (byte-vector-set! str 1 2)) str) (f (immutable! (byte-vector 0 1 2)))) 'error) (test (let ((lt (immutable! (inlet 'a 1)))) (set! (outlet lt) (curlet))) 'error) (test (let ((c (immutable! (cons 1 (immutable! (cons 2 ())))))) (set-car! (cdr c) 3)) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (float-vector-set! str 1 2)) str) (f (immutable! (float-vector 0 1 2)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (int-vector-set! str 1 2)) str) (f (immutable! (int-vector 0 1 2)))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (string-set! (car str) 0 #\a)) str) (f (list (immutable! "1234")))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) 0) #\a)) str) (f (list (immutable! "1234")))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (do ((j 0 (+ j 1))) ((= j 2)) (string-set! (car str) 0 #\a))) str) (f (list (immutable! "1234")))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (let-set! (car str) :a 2)) str) (f (list (vars-immutable! (inlet :a 1))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) :a) 2)) str) (f (list (vars-immutable! (inlet :a 1))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (hash-table-set! (car str) 'a 1)) str) (f (list (immutable! (hash-table 'a 1))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) 'a) 1)) str) (f (list (immutable! (hash-table 'a 1))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (list-set! (car str) 1 2)) str) (f (list (immutable! (list 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) 1) 2)) str) (f (list (immutable! (list 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set-car! (car str) 1)) str) (f (list (immutable! (list 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set-cdr! (car str) 1)) str) (f (list (immutable! (list 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (vector-set! (car str) 1 2)) str) (f (list (immutable! (vector 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (set! ((car str) 1) 2)) str) (f (list (immutable! (vector 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (float-vector-set! (car str) 1 2)) str) (f (list (immutable! (float-vector 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (int-vector-set! (car str) 1 2)) str) (f (list (immutable! (int-vector 0 1 2))))) 'error) (test (let () (define (f str) (do ((i 0 (+ i 1))) ((= i 2)) (byte-vector-set! (car str) 1 2)) str) (f (list (immutable! (byte-vector 0 1 2))))) 'error) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (get-output-string (immutable? (abs x)))))) (func)) 'error) (test (immutable? (subvector (immutable! (vector 1 2 3 4)) 0 1)) #t) (let ((lst (subvector (immutable! (vector 1 2 3 4)) 0 1))) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (vector-set! lst 1 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "vector-set! immutable ~S~%" lst)) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (fill! lst 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "fill! immutable ~S~%" lst)) ;; (reverse! #(1)) is no longer an error 9-Oct-23 (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (set! (lst 1) 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "set! immutable ~S~%" lst)) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (sort! lst >)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "sort! immutable ~S~%" lst))) #| ;; can't decide about this (let ((lst (cons 1 (immutable! (cons 2 (immutable! (cons 3 ()))))))) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (list-set! lst 1 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "list-set! ~S~%" lst)) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (fill! lst 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "fill! ~S~%" lst)) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (reverse! lst)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "reverse! ~S~%" lst)) ; ok (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (set! (lst 1) 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "set! ~S~%" lst)) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (sort! lst >)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "sort! ~S~%" lst)) (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (set-car! (cdr lst) 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "set-car! ~S~%" lst)) ; ok (when (not (eq? 'error (let () (define (f) (catch #t (lambda () (set-cdr! (cdr lst) 32)) (lambda args 'error))) (define (h) (f)) (h)))) (format *stderr* "set-cdr! ~S~%" lst))) ; ok |# (let-temporarily (((*s7* 'safety) 2)) (test (immutable? (eval (with-input-from-string "'(1 2)" read))) #t)) (define old-safety (*s7* 'safety)) (set! (*s7* 'safety) 2) (let () (define* (bpar1 (lst #(0 1 2 3))) ; safety needs to be set before this is read (set! (lst 2) (* 2 (lst 2))) lst) (test (bpar1) 'error)) (set! (*s7* 'safety) old-safety) (test (catch #t (lambda () (catch #t 1 (lambda (type info) (set-cdr! (cdr info) info)))) (lambda args 'error)) 'error) (test (catch #t (lambda () (catch #t 1 (lambda (type info) (reverse! info)))) (lambda args 'error)) 'error) (test (let ((lst (immutable! (cons 1 2)))) (define (f) (set! (cdr lst) 3)) (define (h) (f)) (h)) 'error) #| ;;; it's possible to clobber the built-in error cases: (let () (copy (catch #t 1 (lambda (type info) info)) (catch #t 1 cons)) (catch #t 1 (lambda (type info) (apply format #f info)))) |# ;;; does this make sense?: (test (let ((x 1)) (immutable! 'x) (let ((x x)) (set! x 2))) 2) (test (let () (define-constant x 1) (let ((x x)) (set! x 2))) 'error) (let () (define (f0 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10) b) (set! (b i) x))) (define (f1 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10) b) (float-vector-set! b i x))) (test (let ((b1 (make-float-vector 10))) (f0 b1) (immutable! b1) (f0 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-float-vector 10))) (f1 b1) (immutable! b1) (f1 b1) (display b1) (newline)) 'error) (define (f2 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) 1))) (define (f3 b) (do ((i 0 (+ i 1))) ((= i 10) b) (int-vector-set! b i 1))) (test (let ((b1 (make-int-vector 10))) (f2 b1) (immutable! b1) (f2 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-int-vector 10))) (f3 b1) (immutable! b1) (f3 b1) (display b1) (newline)) 'error) (define (f4 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) 20))) (define (f5 b) (do ((i 0 (+ i 1))) ((= i 10) b) (byte-vector-set! b i 20))) (test (let ((b1 (make-byte-vector 10))) (f4 b1) (immutable! b1) (f4 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-byte-vector 10))) (f5 b1) (immutable! b1) (f5 b1) (display b1) (newline)) 'error) (when with-block (define (f) ; opt_cell_set -> opt_d_7pid_sff (let ((iv (make-block 10))) (do ((i 0 (+ i 1))) ((= i 10) iv) (set! (iv (- (+ i 1) 1)) (* 3.0 2.0))))) (test (f) (block 6 6 6 6 6 6 6 6 6 6)) (define (g) ; d_7pid_ok -> opt_d_7pid_sff (let ((iv (make-block 10))) (do ((i 0 (+ i 1))) ((= i 10) iv) (block-set! iv (- (+ i 1) 1) (* 3.0 2.0))))) (test (g) (block 6 6 6 6 6 6 6 6 6 6)) (test (let ((b (block 1))) (define (f) (+ 1 (block-set! b 0 (logand)))) (f)) 0) ; block-set! sig bug float? -> real? (define (f6 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10) b) (set! (b i) x))) (define (f7 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 10) b) (block-set! b i x))) (test (let ((b1 (make-block 10))) (f6 b1) (immutable! b1) (f6 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-block 10))) (f7 b1) (immutable! b1) (f7 b1) (display b1) (newline)) 'error)) (define (f8 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) #\a))) (define (f9 b) (do ((i 0 (+ i 1))) ((= i 10) b) (string-set! b i #\a))) (test (let ((b1 (make-string 10))) (f8 b1) (immutable! b1) (f8 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-string 10))) (f9 b1) (immutable! b1) (f9 b1) (display b1) (newline)) 'error) (define (f10 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) #\a))) (define (f11 b) (do ((i 0 (+ i 1))) ((= i 10) b) (vector-set! b i #\a))) (test (let ((b1 (make-vector 10))) (f10 b1) (immutable! b1) (f10 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-vector 10))) (f11 b1) (immutable! b1) (f11 b1) (display b1) (newline)) 'error) (define (f12 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) 1))) (define (f13 b) (do ((i 0 (+ i 1))) ((= i 10) b) (list-set! b i 1))) (test (let ((b1 (make-list 10))) (f12 b1) (immutable! b1) (f12 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-list 10))) (f13 b1) (immutable! b1) (f13 b1) (display b1) (newline)) 'error) (define (f14 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b i) 1))) (define (f15 b) (do ((i 0 (+ i 1))) ((= i 10) b) (hash-table-set! b i 1))) (test (let ((b1 (make-hash-table))) (f14 b1) (immutable! b1) (f14 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-hash-table))) (f15 b1) (immutable! b1) (f15 b1) (display b1) (newline)) 'error) (define (f16 b) (do ((i 0 (+ i 1))) ((= i 10) b) (set! (b 'a) i))) (define (f17 b) (do ((i 0 (+ i 1))) ((= i 10) b) (let-set! b 'a i))) (test (let ((b1 (inlet 'a 0))) (f16 b1) (vars-immutable! b1) (f16 b1) (display b1) (newline)) 'error) (test (let ((b1 (inlet 'a 0))) (f17 b1) (vars-immutable! b1) (f17 b1) (display b1) (newline)) 'error)) (let () ;; these are similar but involve saved-optlist incompatible length changes (and non-constant set value to avoid optimization to fill!) (define (f0 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 100) b) (set! (b i) x))) (define (f1 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 100) b) (float-vector-set! b i x))) (test (let ((b1 (make-float-vector 100))) (f0 b1) (set! b1 (make-float-vector 10)) (f0 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-float-vector 100))) (f1 b1) (set! b1 (make-float-vector 10)) (f1 b1) (display b1) (newline)) 'error) (define (f2 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) i))) (define (f3 b) (do ((i 0 (+ i 1))) ((= i 100) b) (int-vector-set! b i i))) (test (let ((b1 (make-int-vector 100))) (f2 b1) (set! b1 (make-int-vector 10)) (f2 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-int-vector 100))) (f3 b1) (set! b1 (make-int-vector 10)) (f3 b1) (display b1) (newline)) 'error) (define (f4 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) (logand i 255)))) (define (f5 b) (do ((i 0 (+ i 1))) ((= i 100) b) (byte-vector-set! b i (logand i 255)))) (test (let ((b1 (make-byte-vector 100))) (f4 b1) (set! b1 (make-byte-vector 10)) (f4 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-byte-vector 100))) (f5 b1) (set! b1 (make-byte-vector 10)) (f5 b1) (display b1) (newline)) 'error) (define (f6 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 100) b) (set! (b i) x))) (define (f7 b) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 100) b) (block-set! b i x))) (test (let ((b1 (make-block 100))) (f6 b1) (set! b1 (make-block 10)) (f6 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-block 100))) (f7 b1) (set! b1 (make-block 10)) (f7 b1) (display b1) (newline)) 'error) (define (f8 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) (integer->char 65)))) (define (f9 b) (do ((i 0 (+ i 1))) ((= i 100) b) (string-set! b i (integer->char 65)))) (test (let ((b1 (make-string 100))) (f8 b1) (set! b1 (make-string 10)) (f8 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-string 100))) (f9 b1) (set! b1 (make-string 10)) (f9 b1) (display b1) (newline)) 'error) (define (f10 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) i))) (define (f11 b) (do ((i 0 (+ i 1))) ((= i 100) b) (vector-set! b i i))) (test (let ((b1 (make-vector 100))) (f10 b1) (set! b1 (make-vector 10)) (f10 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-vector 100))) (f11 b1) (set! b1 (make-vector 10)) (f11 b1) (display b1) (newline)) 'error) (define (f12 b) (do ((i 0 (+ i 1))) ((= i 100) b) (set! (b i) i))) (define (f13 b) (do ((i 0 (+ i 1))) ((= i 100) b) (list-set! b i i))) (test (let ((b1 (make-list 100))) (f12 b1) (set! b1 (make-list 10)) (f12 b1) (display b1) (newline)) 'error) (test (let ((b1 (make-list 100))) (f13 b1) (set! b1 (make-list 10)) (f13 b1) (display b1) (newline)) 'error)) (test (let () (define-constant bigcmp 1+2i) (define (func) (let ((_x_ 1)) (do ((i 0 (+ i _x_))) ((= i _x_)) (set! bigcmp (bignum 0+i))))) (func)) 'error) ; op_dox 81337 (test (let ((lim 1)) (define-constant x 1) (define (f) (let ((y 1)) (do ((i 0 (+ i y))) ((= i lim)) (set! x 3)))) (f)) 'error) (test (let ((lim 1)) (define (f) (let ((y 1)) (do ((i 0 (+ i y))) ((= i lim)) (set! xxx 3)))) (f)) 'error) ; unbound variable op_dox 81345 (test (let () (define (f) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((= i 1) y))) (f)) 'error) ; op_dox 81181 (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (immutable! 'x) (set! x 32))) (func)) 'error) ; op_set1 79220 (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (immutable! 'x)))) (func)) 'error) ; op_set1 79220 (test (let ((x 0)) (immutable! 'x) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x i))) (func)) 0) ; 79220 was error 2-Nov-23 (test (let ((x 0)) (define (func) (do ((i 0 (+ i 1))) ((= i 2) x) (set! x i) (immutable! 'x))) (func)) 'error) ; op_set_s_s 78767 (test (let ((x 0)) (define (func) (do ((j 0 (+ j 1))) ((= j 1) x) (do ((i 0 (+ i 1))) ((= i 2)) (set! x i) (immutable! 'x)))) (func)) 'error) ; op_set_s_s 78767 (test (let ((x 0)) (define (func) (do ((j 0 (+ j 1))) ((= j 1) x) (do ((i 0 (+ i 1))) ((= i 2)) (set! x (immutable! 'x))))) (func)) 'error) ; op_set1 79220 (test (let ((x #f) (i 0)) (let-temporarily ((x (list (define xx (immutable! 'x)) (byte-vector)))) x)) 'error) ; op_set_from_let_temp 78803 ;;; -------------------------------------------------------------------------------- ;;; defined? (test (defined? 'pi) #t) (test (defined? 'pi (rootlet)) #t) (test (defined? 'abs (rootlet)) #t) (test (defined? 'abs (rootlet) #f) #t) (test (defined? 'abs (rootlet) #t) #f) ;! #t=ignore rootlet (test (defined? 'abs (curlet)) #t) (test (defined? 'abs (curlet) #f) #t) (test (defined? 'abs (curlet) #t) #f) (test (let ((sabs :abs)) (defined? sabs (rootlet))) #t) (test (let ((sabs 1)) (defined? sabs (rootlet))) 'error) (test (let ((sabs :abs)) (defined? sabs (unlet))) #f) ; keyword does not currently have an initial_value (test (let ((sabs 1)) (defined? sabs (unlet))) 'error) (test (let ((__c2__ 32)) (defined? '__c2__)) #t) (test (let ((__c2__ 32)) (defined? '__c2__ (curlet))) #t) (test (let ((__c2__ 32)) (defined? '__c3__ (curlet))) #f) (test (let ((__c2__ 32)) (defined? '__c2__ (rootlet))) #f) (test (let ((__c2__ 32)) (defined? '__c3__ (rootlet))) #f) (test (let ((__c2__ 32)) (defined? '__c2__ (unlet))) #f) (test (let ((__c2__ 32)) (defined? '__c3__ (unlet))) #f) (test (let () (define (f) (let-ref (rootlet) '_x_ho)) (f)) #) (test (let () (define (f) (let-ref (unlet) '_x_ho)) (f)) #) ; fx_chooser for fx_c_ac redirects to g_let_ref via fx_c_ac_direct! (test (let () (define (f) (let-set! (unlet) _x_ho 32)) (f)) 'error) ; _x_ho is unbound (test (let ((ge (rootlet))) (ge 'abs)) abs) (test (let ((ge (rootlet))) (ge 'rootlet)) rootlet) (test (let ((ge (rootlet))) (ge 'define)) define) (test (let ((ge (rootlet))) (ge 'if)) if) (test (let ((ge (rootlet))) (let ((abc 1)) (ge 'abc))) #) (test (defined?) 'error) (test (defined? 'a 'b) 'error) (test (defined? 'abs (curlet) #()) 'error) (test (defined? 'abs 0) 'error) (test (defined? 'undef_x (dilambda (lambda () 1) (lambda (a) a)) #t) #f) (test (let () (defined? 'abs (curlet) #())) 'error) (test (let ((lt (inlet 'a 1))) (defined? lt (unlet))) 'error) (for-each (lambda (arg) (test (defined? arg) 'error) (test (defined? arg (rootlet)) 'error) (test (defined? arg (unlet)) 'error) (test (defined? 'abs arg) 'error)) (list -1 #\a 1 _ht_ _undef_ #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi")) (test (defined? 'lambda car) #t) (test (defined? lambda gensym) 'error) (test (defined? 'lambda defined?) #t) (test (defined? 'define car) #t) (test (defined? lambda) 'error) (test (defined? 'lambda) #t) (test (defined? 'dynamic-wind) #t) (test (defined? 'asdaf) #f) (test (defined? ':asdaf) #t) ; keywords are defined in the sense that they evaluate to themselves (test (defined? :asdaf) #t) (test (defined? 'ok?) #t) (test (defined? 'test-t) #t) (test (defined? 'quasiquote) #t) (test (defined? (symbol "123")) #f) (test (defined? (symbol "+")) #t) (test (defined? ''+) 'error) (test (defined? 'if) #t) (test (defined? if) 'error) (test (defined? quote) 'error) (test (let () (defined? 'abs (curlet) #t)) #f) (test (let () (defined? 'abs (curlet))) #t) (test (let () (defined? 'abs (curlet) #f)) #t) (test (let () (define (func) (defined? _!asdf!_ (rootlet))) (func)) 'error) (test (let () (define (func) (defined? '_!asdf!_ (rootlet))) (func)) #f) (test (let ((v1 #())) (define (func) (defined? v1 (rootlet))) (func)) 'error) (test (let ((b 2)) (let ((e (curlet))) (let ((a 1)) (if (defined? 'a e) (format #f "a: ~A in ~{~A ~}" (symbol->value 'a e) e))))) #) ; not "a: 1 in (b . 2)") (test (let ((b 2)) (let ((e (curlet))) (let ((a 1)) (format #f "~A: ~A" (defined? 'abs e) (eval '(abs -1) e))))) "#t: 1") (test (defined? '#) 'error) ; arg should be a symbol... (test (defined? :ho (rootlet)) #t) ; changed 21-Nov-23 (test (let ((xx :ho)) (defined? xx (rootlet))) #t) (test (let () (define (func) (defined? 'else (rootlet))) (func)) #t) (test (let ((hih 3)) (define (func) (defined? 'hih (rootlet))) (func)) #f) (test (let ((hi 'abs)) (define (func) (defined? hi (rootlet))) (func)) #t) (test (let ((hi 'asdf)) (define (func) (defined? hi (rootlet))) (func)) #f) (test (let () (define (func) (defined? :ho (rootlet))) (func)) #t) ; changed 21-Nov-23 (test (let () (define (func) (defined? ... (rootlet))) (func)) 'error) (test (let () (do () ((not #f) (defined? :hi8)))) #t) (test (let ((xx8 :hi8)) (define (func) (do () ((not #f) (defined? xx8)))) (func)) #t) (test (let () (define (func) (do () ((not #f) (defined? :hi8)))) (func)) #t) (test (defined? :hi8) #t) (test (let ((xx8 :hi8)) (define (func) (defined? xx8)) (func)) #t) (test (let () (define (func) (defined? :hi8)) (func)) #t) (test (let () (do () ((not #f) (defined? :hi8 (rootlet))))) #t) (test (let ((xx8 :hi8)) (define (func) (do () ((not #f) (defined? xx8 (rootlet))))) (func)) #t) (test (let () (define (func) (do () ((not #f) (defined? :hi8 (rootlet))))) (func)) #t) (test (defined? :hi8 (rootlet)) #t) (test (let ((xx8 :hi8)) (define (func) (defined? xx8 (rootlet))) (func)) #t) (test (let () (define (func) (defined? :hi8 (rootlet))) (func)) #t) (test (defined? 'abs (unlet)) #t) (test (defined? 123 (unlet)) 'error) (test (defined? 'asdf (unlet)) #f) (test (defined? 123 (rootlet)) 'error) (test (defined? :a (inlet :a 1)) #t) (test (defined? 'a (inlet :a 1)) #t) (test (defined? 'a (inlet 'b 2)) #f) (test (let ((a 1)) (defined? 'a (lambda () a))) #t) (test (let ((a 1)) (defined? 'b (lambda () a))) #f) (when with-block (test (defined? 'a (block)) #f) (test (defined? 'float-vector-ref (block)) #t)) (test (defined? 'a3 (openlet (c-pointer 3 'asdf (inlet 'a3 (lambda (val) 12))))) #t) ;;; -------------------------------------------------------------------------------- ;;; undefined? (for-each (lambda (arg) (test (undefined? arg) #f)) (list # # -1 #\a 1 _ht_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi")) (test (undefined? #) #t) (test (undefined? _undef_) #t) (test (undefined?) 'error) (test (undefined? 1 2) 'error) (test (object->let _undef_) (inlet 'value _undef_ 'type 'undefined?)) (test (object->let #) (inlet 'value # 'type 'undefined?)) (let ((a1 (with-input-from-string "#feed" read))) (test (undefined? a1) #t) (test (equal? # a1) #f) (test (eq? a1 a1) #t) (test (equal? a1 (with-input-from-string "#feed" read)) #t) (test (equal? a1 (with-input-from-string "#xfeedback" read)) 'error) (test (equivalent? a1 (with-input-from-string "#feed" read)) #t) (test (equivalent? a1 (with-input-from-string "#xfeedback" read)) 'error) (test (object->string a1) "#feed") (test (object->string a1 :readable) "(with-input-from-string \"#feed\" read)") (test (undefined? (copy a1)) #t) (test (equal? a1 (copy a1)) #t)) (test (with-input-from-string "#b32" read) 'error) (test (with-input-from-string "#o98" read) 'error) (test (undefined? #<>) #t) (test (equal? #<> #<>) #t) (test (eq? #<> #<>) #f) ; currently anyway (test (equal? # #) #t) (test (equal? #<> (cdr (cons 1 #<>))) #t) (test (undefined? #) #t) (test (undefined? #) #t) ;;; -------------------------------------------------------------------------------- ;;; unspecified? (for-each (lambda (arg) (test (unspecified? arg) #f)) (list -1 #\a 1 _ht_ _undef_ # _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi")) (test (unspecified? (values)) #t) (test (unspecified?) 'error) (test (unspecified? 1 2) 'error) (test (object->let #) (inlet 'value # 'type 'unspecified?)) (test (object->let (values)) (inlet 'value (values) 'type 'unspecified?)) ;;; -------------------------------------------------------------------------------- ;;; let? ;;; inlet ;;; rootlet ;;; curlet ;;; sublet ;;; with-let ;;; let->list ;;; outlet ;;; let-ref ;;; let-set! ;;; varlet ;;; cutlet ;;; coverlet ;;; openlet ;;; unlet (test (let () (length (curlet))) 0) (test (let ((a 1) (b 2) (c 3)) (length (curlet))) 3) (for-each (lambda (arg) (test (let? arg) #f)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))) (let () (test (let? (unlet)) #t)) (test (let? (curlet)) #t) (test (let? (rootlet)) #t) (test (let? (sublet ())) 'error) (test (let? (varlet ())) 'error) (test (let? (sublet (sublet ()) '(a . 1))) 'error) (test (let? (sublet (rootlet) '(a . 1))) #t) (test (eq? abs ((rootlet) 'abs)) #t) (test (eq? abs (with-let (unlet) abs)) #t) (test ((sublet (rootlet) '(asdf . 32)) 'asdf) 32) (test ((sublet (rootlet) '(asdf . 32)) 'asd) #) (test (let? (sublet (curlet))) #t) ; no bindings is like (let () ...) ;(test (varlet (rootlet) '(quote . 1)) 'error) ;(test (varlet (rootlet) 'if 3) 'error) ;(test (let-set! (rootlet) 'if 3) 'error) (test (inlet 'let-set! (lambda (a b c) c)) 'error) ; currently immutable (test (inlet 'let-ref (lambda (a b c) c)) 'error) ; currently immutable (test (set! (outlet (curlet)) 32) 'error) (test (set! (outlet 32) (curlet)) 'error) (test (eq? (curlet) (let ((a (curlet))) a)) #t) (test (eq? (curlet) (let* ((a (curlet))) a)) #t) (test (eq? (curlet) (letrec ((a (curlet))) a)) #f) (test (eq? (curlet) (letrec* ((a (curlet))) a)) #f) (test (let ((a (curlet))) (eq? a (curlet))) #f) (test (letrec ((a (curlet))) (eq? a (curlet))) #t) (test (let ((e (inlet 'e (inlet '+ -)))) (((e 'e) '+) 2 3)) -1) (test (let ((confused (inlet '+ -))) ((confused '+) 2 3)) -1) ;;; (with-let (inlet '+ -) (+ 2 3)) -> 5 ;;; (with-let (inlet '+ -) (((curlet) '+) 2 3)) -> -1 ;;; (with-let (inlet 'plus -) (plus 2 3)) -> -1 ;;; which is consistent, so to speak, with the (set! gcd +) example mentioned in s7.html (test (let ((i 0)) ((lambda* ((x 1)) (with-let (rootlet) (= i 2))))) 'error) (test (let ((i 0)) (with-output-to-string (lambda () (with-let (rootlet) (cons i i))))) 'error) (test (eq? #_abs ((rootlet) 'abs)) #t) (test (eq? ((rootlet) 'abs) (with-let (rootlet) abs)) #t) ;(display (object->let (rootlet))) (newline) ; (inlet 'alias rootlet 'value (rootlet) 'type let? 'size 438 'open #f 'outlet () 'mutable? #t) ;(display (object->string (rootlet))) (newline) ; (rootlet) ;(display (let->list (rootlet))) (newline) ; ... tons of output (test (coverlet (rootlet)) 'error) ; error: out-of-range ("can't coverlet rootlet") (test (openlet (rootlet)) 'error) ; error: out-of-range ("can't openlet rootlet") ;(display (varlet (rootlet) 'a 1)) (newline) ; (rootlet) ;(display (cutlet (rootlet) 'abs)) (newline) ; (rootlet) (test (eval '(abs -1) (rootlet)) 1) (test (eval-string "(abs -1)" (rootlet)) 1) ;(display (immutable! (rootlet))) (newline) ; (rootlet) -- actually works... (test (immutable? 'abs (rootlet)) #f) (test (immutable? (rootlet)) #f) ;(display (load "stuff.scm" (rootlet))) (newline) ; sandbox (test (outlet (rootlet)) (rootlet)) (test (sublet (rootlet) 'a 1) (inlet 'a 1)) (test (((let ((x (lambda (y) (+ y 1)))) (curlet)) 'x) 2) 3) (test (let ((h (inlet 'a (inlet 'b 2)))) (h 'a 'b)) 2) (test (equal? (inlet 'a 1) (inlet 'a 1)) #t) (test (equivalent? (inlet 'a 1) (inlet 'a 1)) #t) (test (equal? (inlet 'a 1) (inlet 'a 2 'a 1)) #f) (test (equal? (inlet 'a 3 'a 1) (inlet 'a 2 'a 1)) #f) (test (equivalent? (inlet 'a 1) (inlet 'a 2 'a 1)) #f) (test (equal? (inlet 'a 1 'b "hi") (inlet 'a 1 'b "hi")) #t) (test (equivalent? (inlet 'a 1 'b "hi") (inlet 'a 1 'b "hi")) #t) (test (equal? (inlet 'b "hi" 'a 1) (inlet 'a 1 'b "hi")) #t) (test (equivalent? (inlet 'b "hi" 'a 1) (inlet 'a 1 'b "hi")) #t) (test (equal? (inlet 'a 2 'b "hi" 'a 1) (inlet 'b "hi" 'a 2 'a 1)) #t) (test (equal? (inlet 'a (vector 1.0)) (inlet 'a (float-vector 1.0))) #t) (test (equivalent? (inlet 'a (vector 1.0)) (inlet 'a (float-vector 1.0))) #t) (test (equal? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1.0)) #f) (test (equivalent? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1.0)) #t) (test (equal? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1/2)) #f) (test (equivalent? (inlet 'b "hi" 'a 1) (inlet 'b "hi" 'a 1/2)) #f) (test (equal? (inlet 'a 1) (inlet 'b "hi" 'a 1)) #f) (test (equal? (inlet 'a 1 'b "hi") (inlet 'a 1)) #f) (test (equal? (inlet 'a 1 'a 1) (inlet 'a 1)) #t) (test (equal? (inlet 'a (inlet 'b 1)) (inlet 'a (inlet 'b 1))) #t) (test (equal? (inlet 'a (inlet 'b 1)) (inlet 'a (inlet 'b 1))) #t) (test (equal? (inlet 'b (inlet 'b 1)) (inlet 'b (inlet 'b 1))) #t) (test (equal? (inlet) (inlet)) #t) (test (equal? (inlet 'a 1) (inlet)) #f) (test (equal? (inlet) (inlet 'a 1)) #f) (test (object->string (inlet 'a 1 'a 3)) "(inlet 'a 1 'a 3)") (test ((inlet 'a 1 'a 3) 'a) 3) ; so the print form follows the input order, but the earlier entries (as printed) are shadowed (test (equal? (inlet) (sublet (inlet))) #t) (test (equal? (inlet 'a 1) (inlet 'a 2)) #f) (test (equal? (inlet 'a 1) (inlet 'b 1)) #f) (test (equal? (inlet 'a 1) (inlet 'a 1 'b 1)) #f) (test (equal? (inlet 'a 1 'b 1) (inlet 'a 1 'c 1)) #f) (test (equal? (inlet 'a 1 'b 1) (inlet 'a 1 'b 1)) #t) (test (equal? (inlet 'a 1) (inlet 'a 1 'a 1)) #t) (test (equal? (inlet 'a 1) (inlet 'a 1 'a 2)) #t) (test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1) 'b 2)) #t) (test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 2) 'b 2)) #f) (test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1) 'b 1)) #f) (test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1))) #f) (test (equal? (sublet (inlet 'a 1)) (sublet (inlet))) #f) (test (equal? (sublet (inlet 'a 1)) (inlet 'a 1)) #t) (test (equal? (sublet (sublet (inlet 'a 1))) (sublet (inlet 'a 1))) #t) (test (let ((e (inlet 'a 1))) (equal? (sublet e 'a 1) (sublet e 'a 1))) #t) (test (equal? (inlet 'a 1 'b 2 'c 3) (inlet 'c 3 'b 2 'a 1)) #t) (test (equal? (inlet 'a 1 'b 2 'c 3) (inlet 'c 3 'b 1 'a 1)) #f) (test (equal? (inlet 'a 1 'a 2) (inlet 'a 3 'a 2)) #f) (test (equal? (inlet 'a 2 'a 1) (inlet 'a 2 'a 3)) #t) (test (equal? (sublet (inlet 'a 1 'a 3) 'a 2) (sublet (inlet 'a 3) 'a 2)) #t) (test (equal? (inlet 'a 1) (inlet 'a 1 'b 2)) #f) (test (equal? (inlet 'a 1) (sublet (inlet 'a 1))) #t) (test (equal? (sublet (inlet 'a 1)) (inlet 'a 1)) #t) (test (let () (eq? (curlet) (outlet (inlet)))) #f) (test (let () (eq? (rootlet) (outlet (inlet)))) #t) (test (let () (copy (inlet '_rootlet_var_ 32) (rootlet)) _rootlet_var_) 32) (test (equal? (inlet (cons 'a 1)) (inlet 'a 1)) #t) (test (equal? (inlet (cons :a 1)) (inlet 'a 1)) #t) (test (equal? (inlet :a 1) (inlet 'a 1)) #t) (test (equal? (inlet a: 1) (inlet :a 1)) #t) (test (inlet 'pi 3) 'error) (test (inlet 'let-ref (lambda (obj val) val)) 'error) (test (inlet 'let-set! (lambda (obj arg val) val)) 'error) (test (let ((incr (lambda (val) (+ val 1)))) (let ((e1 (curlet)) (incr (lambda (val) (+ val 2)))) (+ (with-let e1 (incr 2)) (incr 5)))) 10) (let () (define (f) (inlet 'value (inlet 'a (inlet 'b 1)) :a (list (list 1 2)))) (test (f) (inlet 'value (inlet 'a (inlet 'b 1)) 'a '((1 2))))) (test (varlet (immutable! (inlet 'a 1)) 'b 2) 'error) (test (cutlet (immutable! (inlet 'a 1)) 'a) 'error) (test (let ((abc 123)) (immutable! 'abc) (cutlet (curlet) 'abc)) 'error) (test (cutlet (rootlet) 'with-let) 'error) (test (with-let (immutable! (inlet 'a 1)) (define b 2)) 'error) (test (length (openlet (inlet 'length 8))) 'error) (test (openlet (rootlet)) 'error) (test (with-let (rootlet) (openlet (lambda (x) x))) 'error) (test (coverlet (rootlet)) 'error) (test (outlet (rootlet)) (rootlet)) (let ((x (let ((a 1)) (immutable! 'a) (curlet)))) (test (set! (x 'a) 3) 'error) (let ((y (sublet x))) (test (set! (y 'a) 3) 'error))) (test (let ((e (inlet 'a 2 'a 1))) (let ((c (copy e))) (list (e 'a) (c 'a)))) '(2 2)) (test (equal? (inlet 'a 1) (sublet (inlet 'a 1))) #t) (test (equal? (sublet (inlet 'a 1) 'b 2) (sublet (inlet 'a 1 'b 2) 'b 2)) #t) (test (equal? (sublet (inlet 'a 3) 'a 2) (sublet (inlet 'a 1) 'a 2)) #t) ; ((sublet (inlet 'a 1) 'a 2) 'a) -> 2 (test (equal? (sublet (inlet) 'a 2) (sublet (inlet 'a 1) 'a 2)) #t) (test (equal? (inlet 'a 1) (inlet 'a 1 'a 2 'a 3)) #t) (test (equal? (sublet (rootlet) 'a 1) (inlet 'a 1)) #t) (test (let () (define (func) (inlet :b 3 :a (inlet 'a 1))) (func)) (inlet :b 3 :a (inlet :a 1))) ; symbol_id in fx_inlet_ca (test (let ((L (sublet (sublet (inlet 'x 1) 'y 2) 'z 3))) (with-let L (+ x y z))) 6) (test (let () (define (func) (with-let (inlet 'a 1) else)) (func) (func)) else) (test (defined? 'else (inlet 'a 1) #t) #f) (test (let ((a (inlet))) (define (func) (catch #t (lambda () (with-let a _!asdf!_) :oops) (lambda (type info) 'error))) (func) (func)) 'error) (test (with-let (let ((+documentation+ "hiho")) (curlet)) (define (f) 1) (documentation f)) "hiho") (test (with-let (rootlet) +signature+) 'error) ; unbound variable (test (let () (with-let (rootlet) +signature+)) 'error) ; unbound variable (test (let () (define (f) (with-let (rootlet) +signature+)) (f) (f)) 'error) ; unbound variable (test (with-let (rootlet) (and #t +iterator+)) 'error) ; let_symbol_is_safe T_Lsd bug (test (let ((mlet (inlet 'a 1))) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! mlet with-let 0))) (f)) 'error) (test (let ((mlet (inlet 'a 1)) (nsym :a)) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! mlet nsym 0))) (f)) #t) ; do loop return (test (let ((mlet (inlet 'a 1)) (nsym 'a)) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! mlet nsym 0))) (f)) #t) (test (let ((mlet (inlet 'a 1)) (nsym 32)) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! mlet nsym 0))) (f)) 'error) (test (let ((L (inlet 'a 1)) (V (make-vector 8 'a symbol?))) (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (let-set! L V (append)))) (f)) 'error) (test (let ((imb (block 0.0 1.0 2.0))) (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (hash-table? (memq imb `(+ x 1))))) (f)) #t) (test (let ((clet (inlet 'a 1))) (define (f) (do ((i 0 (+ i 1))) ((= i 3)) (let? (inlet 'value clet)))) (f)) #t) (if with-block (test (let ((mlet (openlet (inlet 'abs cycle-ref)))) (abs mlet)) 'error)) ; wrong-type-arg "object passed to cycle-ref is not a cycle object" (test (let ((mlet (openlet (inlet 'abs list)))) (abs mlet)) (list (inlet 'abs list))) (test (let ((mlet (openlet (inlet 'abs with-let)))) (abs mlet)) 'error) ; with-let has no body (test (let ((mlet (openlet (inlet 'abs #)))) (abs mlet)) 'error) ; abs method is not defined in openlet (test (let ((mlet (openlet (inlet 'abs catch)))) (abs mlet)) 'error) ; catch: function missing: (catch (inlet 'abs catch)) (test (let ((mlet (openlet (inlet 'abs string-ref)))) (abs mlet)) 'error) ; string-ref method is not defined in openlet? (inlet 'abs string-ref) (test (let ((mlet (openlet (inlet 'abs let-ref)))) (abs mlet)) 'error) ; let-ref: symbol missing: (let-ref (inlet 'abs let-ref)) (test (let ((mlet (openlet (inlet 'abs owlet)))) (abs mlet)) 'error) ; owlet: too many arguments: ((inlet 'abs owlet)) ;; (let ((mlet (openlet (inlet 'abs abs)))) (abs mlet)) ; infinite loop in find_and_apply_method (test (let ((mlet (openlet (inlet 'abs map)))) (abs mlet)) 'error) ; map: 0 arguments for (inlet 'abs map)? (test (equivalent? (sublet (inlet) 'a 1 (inlet 'b 2)) (inlet 'b 2 'a 1)) #t) (test (equivalent? (sublet (inlet) (inlet 'b 2)) (inlet 'b 2)) #t) (test (equivalent? (sublet (inlet) (inlet 'b 2) 'a 1) (inlet 'a 1 'b 2)) #t) (test (equivalent? (sublet (inlet) (inlet 'b 2) 'a 1 'c 3) (inlet 'b 2 'a 1 'c 3)) #t) (test (equivalent? (sublet (inlet 'd 4) (inlet 'b 2) 'a 1 'c 3) (sublet (inlet 'd 4) 'b 2 'a 1 'c 3)) #t) (test (equivalent? (sublet (inlet 'd 4) (inlet 'b 2 'e 5) 'a 1 'c 3) (sublet (inlet 'd 4) 'e 5 'b 2 'a 1 'c 3)) #t) (test (equivalent? (sublet (inlet) 'a 1 (inlet 'b 2) 'c 3) (inlet 'b 2 'a 1 'c 3)) #t) (test (equivalent? (sublet (inlet) 'a 1 'c 3 (inlet 'b 2)) (inlet 'b 2 'a 1 'c 3)) #t) (let ((f (inlet 'sym 'sam 'sam 'sym)) (g (inlet 'sam 'sym 'sym 'sam))) (test (f (g 'sym)) 'sym) (test (f (f 'sym)) 'sym) (test (g (f 'sam)) 'sam) (test (g (f (g (f (f 'sym))))) 'sam)) (let ((f (inlet :a 1 :b 2))) (test (length f) 2) (fill! f #) (test (length f) 2) ; was 0, 8-Jun-20 (test (f 'b) #) (test (let-ref f 'a) #)) (let () (define (f a) (curlet)) (define (g) (let ((cpa (f 32))) (f 12) (cpa 'a))) (test (g) 32)) ; if curlet safe by accident, this returns 12 (funclets are the same in that case?) (test (apply inlet (map values (hash-table 'a 1 'b 2))) (inlet 'b 2 'a 1)) (test (apply hash-table (map (lambda (x) (values (car x) (cdr x))) (inlet 'a 1 'b 2))) (hash-table 'a 1 'b 2)) (let ((e (inlet 'a 1 'a 2))) (test (e 'a) ((copy e) 'a))) (let ((e1 (inlet 'a 1 'a 2))) (let ((e2 (copy e1))) (test (list (equal? e1 e2) (equal? (e1 'a) (e2 'a))) '(#t #t)))) (let () (define-bacro (let/ e . body) `(with-let (sublet (curlet) ,e) ,@body)) (test (let ((a 1)) (let/ (inlet 'b 2) (+ a b))) 3)) (let ((e (inlet 'a (inlet 'b 1 'c 2) 'b (inlet 'b 3 'c 4)))) (test (e 'a 'b) 1) (test (e 'b 'b) 3) (test (e 'b 'c) 4)) (let () (define (f1) (let ((e (inlet 'a 1))) (e '(1)))) (test (f1) 'error)) (test (equal? (inlet 'a 1) (cutlet (inlet 'a 1 'b 2) 'b)) #t) (test (equal? (inlet 'a 1) (inlet 'a 1 'b 2)) #f) (test (length (cutlet (inlet 'a 1 'b 2 'c 3) 'b 'a)) 1) (test (length (cutlet (inlet 'a 1 'b 2 'c 3) 'd)) 3) (test (let->list (cutlet (inlet 'a 1 'b 2 'c 3) 'b 'a)) '((c . 3))) (test ((cutlet (inlet 'a 1 'b 2) 'a) 'a) #) (test ((cutlet (inlet 'a 1 'b 2 'c 3) 'a) 'b) 2) (test ((cutlet (inlet 'a 1 'b 2) 'a) 'b) 2) (test ((cutlet (inlet 'a 1 'b 2 'c 3) 'a 'b 'c) 'a) #) (test ((cutlet (inlet 'a 1 'b 2 'c 3 'a 4) 'a) 'a) 4) (test (cutlet (inlet)) 'error) (test (cutlet (inlet 'a 1) 'a) (inlet)) (test ((cutlet (inlet 'a 1 'a 2) 'a) 'a) 2) (test (let ((g (gensym))) (cutlet (inlet g '1) g)) (inlet)) (test (cutlet (sublet (inlet 'a 1) 'b 2) 'a) (sublet (inlet 'a 1) 'b 2)) (test (let ((b 2)) (cutlet (curlet) 'b) b) 'error) ; unbound variable (test (let ((b 1)) (let ((b 2)) (cutlet (curlet) 'b)) b) 1) (test (openlet? (sublet (openlet (inlet 'a 1)))) #t) (test (cutlet (rootlet) :scaler) 'error) (test (cutlet (rootlet) 'scaler) 'error) (test (cutlet (rootlet) '_asdf_) 'error) (test (let ((#_+ 3)) #_+) 'error) (test (define #_+ 3) 'error) (test (set! #_+ 3) 'error) (test (with-let (inlet :rest 3) rest) 3) (test (with-let (inlet :allow-other-keys 32) allow-other-keys) 32) (test (with-let (sublet (rootlet)) (with-let (rootlet) :display)) :display) (test (with-let (lambda (x) (fill! (copy x) 0)) :if) :if) (test (let ((a 21)) (let ((e (inlet (curlet)))) (set! a 32) (with-let e a))) 21) (test (let ((a 21)) (let ((e (sublet (curlet)))) (set! a 32) (with-let e a))) 32) (test (with-let (block 1 2 3) ((curlet) 0)) 'error) (test (with-let (c-pointer 0) (curlet)) (rootlet)) (test (let () (define (f sym ?x) (with-let (inlet sym ?x) a)) (f 'a 123)) 123) (test (integer? (let () ((sublet (curlet) *s7*) 'gc-freed))) #t) ; append_let coverage ;(test (let () (sublet (curlet) (rootlet))) (inlet)) (let ((lt (inlet 'a 3 'b 2))) (test (with-let lt :a) :a) (test (with-let lt a) 3) (test (lt :a) 3) (test (let ((a 3)) :a) :a) (test (let () (define (func) (with-let lt :a)) (func) (func)) :a) (test (let () (define (func) (let ((a 3)) :a)) (func) (func)) :a) (test (let () (define (func) (with-let lt a)) (func) (func)) 3)) (test (let () (define (f) (with-let (unlet) abs)) (f) (f)) abs) (catch #t (lambda () (let () (define hi (inlet 'x 12)) (let ((x 32) (y 1)) (let ((old-out (outlet hi))) (set! (outlet hi) (curlet)) (with-let hi ; x 12 y 1 (test (+ x y) 13)) (set! (outlet hi) old-out) ; x 32 y 1 (test (+ x y) 33) (with-let hi ; x 12 y # (test x 12) (test (defined? 'y) #f)))))) (lambda (type info) (format *stderr* "unbound in local inlet: ~A ~A~%" type info))) (test (let ((L (inlet 'a 1))) (set! (outlet L) L) (L 'abs)) 'error) (test (let ((a 1)) (set! (outlet (curlet)) (curlet)) abs) 'error) (test (let () (with-let (curlet) (define hiho 43)) hiho) 43) (let () (define-macro (define! env . args) `(with-let ,env (define ,@args))) (test (let () (define! (curlet) (hiho x) (+ x 1)) (hiho 2)) 3)) (test (let () (with-let (curlet) (define (f3 a) (+ a 2))) (f3 1)) 3) (let () (with-let (rootlet) (define (this-is-global a) (+ a 1)))) (test (this-is-global 2) 3) (let () (with-let (inlet) (define (this-is-not-global a) (+ a 1)))) (test (this-is-not-global 2) 'error) (test (let ((b 2)) (varlet (curlet) 'a 1) (+ a b)) 3) (let () (apply varlet (curlet) (with-let (unlet) (let () (define (lognor n1 n2) (lognot (logior n1 n2))) (define (logit n1) n1) (map (lambda (binding) (cons (string->symbol (string-append "library:" (symbol->string (car binding)))) (cdr binding))) (curlet))))) (test (library:lognor 1 2) -4)) (let () (define (f1) (let ((a 0) (v (make-vector 3))) (do ((i 0 (+ i 1))) ((= i 3) v) (vector-set! v i a) (varlet (curlet) 'a i)))) (test (f1) #(0 0 1)) (define (f2) (let ((v (make-vector 3))) (do ((i 0 (+ i 1))) ((= i 3) v) (varlet (curlet) 'a i) (vector-set! v i a)))) (test (f2) #(0 1 2))) (let () (varlet (curlet) ((lambda (a b) (define (f1 x) (+ x a)) (define (f2 x) (+ x a b)) (curlet)) 1 2)) (test (f1 3) 4) (test (f2 3) 6)) (test (null? (let->list (rootlet))) #f) (test (let? (inlet)) #t) (test (length (inlet)) 0) (test (length (inlet '(a . 2))) 1) (test (with-let (inlet '(a . 2)) a) 2) (test (with-let (inlet '(a . 2) '(b . 3)) (+ a b)) 5) (test (eq? (inlet) (rootlet)) #f) (test ((inlet (inlet '(a . 1))) 'a) 1) (test ((inlet (inlet '(a . 1)) '(b . 2)) 'b) 2) (test ((inlet '(b . 3) (inlet '(a . 1))) 'b) 3) (test (let ((a 1)) ((inlet (curlet)) 'a)) 1) (test (let ((a 1)) ((inlet '(b . 2)) 'a)) #) (test (let ((a (inlet 'b 2))) (set! (let-ref a 'b) 3) (a 'b)) 3) ; let-ref setter is let-set! (let ((let1 (inlet 'a 1))) (varlet let1 'let1 let1) (with-let let1 (with-let let1 (define b 2))) (test (let1 'b) 2)) (test (let ((lt (inlet 'a 1))) (set! (with-let lt a) (values 1 2))) 'error) (let ((a 123.0)) (define (f) (set! (let-ref) a)) (catch #t f (lambda args #f)) (test (f) 'error)) (test (let () (define (func) (catch #t (lambda () (set! (let-ref (list 1)) 1)) (lambda args 'error))) (func) (func)) 'error) (for-each (lambda (arg) (test (sublet arg) 'error) (test (varlet arg) 'error) (test (cutlet arg) 'error) (test (cutlet (curlet) arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand # # #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))) (test (let ((e (inlet '(a . 1)))) ((lambda (x) (x *)) e)) 'error) (test (let ((e (inlet '(a . 1)))) ((lambda (x) (x pi)) e)) 'error) (test (let () (inlet (cons pi 1))) 'error) (test (let () (inlet (cons "hi" 1))) 'error) (test (let () (define (f) (eq? # (inlet 'quasiquote 1))) (f)) 'error) (test (let? (inlet)) #t) (test (length (inlet)) 0) (test (length (inlet 'a 2)) 1) (test (with-let (inlet 'a 2) a) 2) (test (with-let (inlet 'a 2 'b 3) (+ a b)) 5) (test (eq? (inlet) (rootlet)) #f) (test ((inlet (inlet 'a 1)) 'a) 1) (test ((inlet (inlet 'a 1) '(b . 2)) 'b) 2) (test (let ((c 1)) (set! (with-let (curlet) c) 32) c) 32) (test (let ((c (list 1 2))) (set! (with-let (curlet) (c 1)) 32) c) '(1 32)) (test (let ((c (list 1 2))) (set! (with-let (curlet) (c 3)) 32) c) 'error) (test (let ((a (inlet 'b #(0 1)))) (set! (with-let a (b 0)) 1) ((a 'b) 0)) 1) (test (set! (with-let (curlet) 3) 2) 'error) (test (let ((c (list 1 2))) (set! (with-let (curlet) (c 3)) 32 0)) 'error) (test (let () (define (func) (let ((lt (inlet 'a 1))) (set! (with-let lt a) 32))) (func) (func)) 32) (test (abs (let ((abs (lambda (x) 32))) (openlet (curlet)))) 32) (test (let ((i 0)) ; check bugfix: in_with_let set in optimize_syntax to warn optimize_c_func_one_arg that 'i in (null i) is trouble (let loop ((i 1) (x (lambda () (set! (with-let (inlet) ((null? i) i)) 0)))) (if (> i 0) (loop (- i 1) x) (x)))) 'error) ; unbound variable i (let ((a (inlet 'abc (let ((inx 0)) (dilambda (lambda () inx) (lambda (y) (set! inx y))))))) (set! ((a 'abc)) 32) (test ((a 'abc)) 32) (with-let a (set! (abc) 1)) (test (with-let a (abc)) 1) (set! (with-let a (abc)) 3) (test ((a 'abc)) 3)) (let ((lt1 (inlet 'a 1 'b 2))) (set! (with-let lt1 a) 32) (test (lt1 'a) 32) (set! (with-let lt1 a) (with-let lt1 (+ a b))) (test (lt1 'a) 34) (set! (with-let (curlet) (*s7* 'print-length)) 16) (test (*s7* 'print-length) 16) (set! (*s7* 'print-length) 40) (varlet lt1 'c (vector 1 2 3)) (set! (with-let lt1 (c 1)) 12) (test ((lt1 'c) 1) 12) (let ((lt2 (list lt1))) (set! (with-let (car lt2) (c 0)) 11) (test ((lt1 'c) 0) 11)) (let ((lt2 (list lt1)) (d 100)) (set! (with-let (car lt2) (c (sqrt 4))) (sqrt d)) (test ((lt1 'c) 2) 10)) (let ((lt3 (inlet 'a (vector 1 2 3)))) (set! (with-let lt3 a) '(1 2)) (test (lt3 'a) '(1 2))) (let ((lt3 (inlet 'a (vector 1 2 3) 'b 1))) (set! (with-let lt3 a) 'b) (test (lt3 'a) 'b))) (test (let ((v (vector 1 2))) (set! (with-let (curlet) (v 0)) 'a) v) #(a 2)) (test (set! (with-let (inlet :v (vector 1 2)) (v 0)) '(3 4)) '(3 4)) (test (let ((v (vector 1 2))) (set! (with-let (curlet) (v 0)) 32) v) #(32 2)) (test (catch #t (lambda () (set! (with-let (inlet :a 1) 3) 2)) (lambda (type info) (apply format #f info))) "can't set 3 in (#_set! 3 2)") (test (catch #t (lambda () (set! (with-let (inlet :a 1) :asdf) (+ 1 1))) (lambda (type info) (apply format #f info))) "let-set!: asdf is not defined in (inlet 'a 1)") (test (catch #t (lambda () (set! (with-let (inlet :a 1) (symbol->keyword 'asdf)) (+ 1 1))) (lambda (type info) (apply format #f info))) "symbol->keyword (a c-function) does not have a setter: (set! (symbol->keyword 'asdf) 2)") (test (catch #t (lambda () (set! (with-let (inlet :a 1) 3) 'a)) (lambda (type info) (apply format #f info))) "can't set 3 in (#_set! 3 'a)") (test (catch #t (lambda () (let ((e (inlet :v (vector 1 2)))) (set! (with-let e (let ((z 0)) (v z))) 'a) (e 'v))) (lambda (type info) (apply format #f info))) "let (syntactic) does not have a setter: (set! (let ((z 0)) (v z)) 'a)") (test (catch #t (lambda () (set! (with-let) 1)) (lambda (type info) (apply format #f info))) "with-let needs a let and a symbol: (set! (with-let) 1)") (test (catch #t (lambda () (set! (with-let (curlet)) 'a)) (lambda (type info) (apply format #f info))) "with-let in (set! (with-let (curlet)) 'a) has no symbol to set?") (test (catch #t (lambda () (set! ((unlet) 'abs) 1)) (lambda (type info) (apply format #f info))) "abs is immutable in (unlet)") (let () (define-macro* (msym6 a b :rest c) `(list ,a ,b (copy ,c))) (define-macro* (msym4 :rest a) `(copy ,a)) (define _dilambda_ (dilambda (lambda (x) (+ x 1)) (lambda (x y) (+ x y)))) (define (func) (let ((i 0)) (((vector msym6) 0) 1 2 with-let (inlet 'a 1) (zero? i)))) ; inline_op_safe_c_s[87021]: i unbound (test (func) 'error) (test (let ((i 0)) (let _L_ ((x 1)) (if (> x 0) (_L_ (- x 1)) ((let () msym6) 1 2 with-let (inlet 'a 1) (vector x i))))) ; inline_op_safe_c_ss[87031]: x unbound 'error) (test (let () (define (func1) (((vector msym4) 0) cond (_dilambda_ (flush-output-port)))) (func1)) *stdout*)) (for-each (lambda (arg) (test (inlet arg) 'error) (test (apply inlet arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand # # #f #(()) (list 1 2 3) '(1 . 2) "hi")) (test (inlet 'a) 'error) (test (inlet 1 2) 'error) (test (inlet 'a 2 'b) 'error) (test (with-let (inlet 'a (let ((p (open-output-string))) (display "32" p) p)) (get-output-string a)) "32") (test (set! (with-let) 1) 'error) (test (set! (with-let (curlet)) 1) 'error) (test (let ((a3 (inlet 'a 1))) (define (func) (procedure? (a3 ':abs))) (func)) #t) (test (let ((a3 (inlet 'a 1))) (define (func) (procedure? (a3 :abs))) (func)) #t) (test (let ((a3 (inlet 'a 1))) (define (func) (procedure? (a3 'abs))) (func)) #t) (test (let ((a3 (inlet 'a 1)) (asdf :abs)) (define (func) (procedure? (a3 asdf))) (func)) #t) (test (let ((a3 (inlet 'a 1)) (asdf abs)) (define (func) (procedure? (a3 asdf))) (func)) 'error) (for-each (lambda (arg) (test (let->list arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))) (for-each (lambda (arg) (test (openlet arg) 'error) (test (coverlet arg) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand () # # #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))) (test (coverlet (rootlet)) 'error) (let () (let ((_xxx_ 0)) (let ((e (curlet))) (for-each (lambda (arg) (let-set! e '_xxx_ arg) (test (let-ref e '_xxx_) arg)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi abs macroexpand () # # #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))))) (test (let-ref) 'error) (test (let-ref (curlet)) 'error) (test (let-ref a b c) 'error) (test (let-ref (sublet (rootlet)) '_asdf_) #) (test (let-ref (sublet (rootlet) '(a . 3)) 'a) 3) (test (let-ref (sublet (rootlet) '(a . 3)) 'A) #) (test (let-ref (rootlet) '+) +) (test (let-ref (rootlet) +) 'error) (test (let-ref () '+) 'error) (test (let-ref (funclet (let ((a 2)) (lambda (b) (+ a b)))) 'a) 2) (test (#_let-ref (lambda* ((a 1) (b 2)) (+ a b)) else) else) (let ((etest (let ((a 2)) (lambda (b) (+ a b))))) (let-set! (funclet etest) 'a 32) (test (etest 1) 33)) (test (let-set!) 'error) (test (let-set! a b) 'error) (let ((e (inlet 'a 1))) (test (let-set! e 'b 2) 'error)) (let ((e (inlet (cons 'a 1)))) (define (eref a) (e a)) (define (eset a b) (set! (e a) b)) (for-each (lambda (arg) (test (let-ref arg 'a) 'error) (test (let-set! arg 'a 1) 'error) (test (let-ref e arg) 'error) (test (let-set! e arg #f) 'error) (test (e arg) 'error) (test (set! (e arg) #f) 'error) (test (eref arg) 'error) (test (eset (e arg) #f) 'error)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i pi () # # #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1))))) (test (let () (define (func) (set! (let-ref) (vector))) (func))'error) (test (let ((L (inlet 'a 1))) (define (func) (set! (let-ref) L :a (vector))) (func)) 'error) (test (let ((L (inlet 'a 1))) (define (func) (set! (let-ref L) (vector))) (func)) 'error) (test (catch #t (lambda () (let ((x #f)) (let-temporarily ((x 1)) (set! (setter 'x) (macro (a b . c) `(list ,a ,b ,c)))))) (lambda (type info) (apply format #f info))) "implicit let-ref needs a symbol to lookup: ((inlet 'x 1))") (let () (define (ft) (let ((a (vector #f)) (b 0)) (*s7* (vector-ref a b)))) (test (ft) 'error)) (let () (define f2 (let ((plus1 (lambda (x) (* x 2)))) ; "p0" (let ((L (inlet 'plus1 (lambda (x) (if (< x 3) (plus1 (+ x 1)) x))))) ; "p1" calls "p0" (lambda () (with-let L (plus1 2)))))) ; "p1" (test (f2) 6)) (let () (define (f5) (let ((L (inlet 'a 1)) (H (hash-table 'a 2)) (res ())) (do ((i 0 (+ i 1))) ((= i 1) (reverse res)) (set! res (cons (L 'a) res)) (set! L H) (set! res (cons (L 'a) res))))) (test (f5) '(1 2)) (define (f6) (let ((L (inlet 'a 1)) (V (vector 2)) (res ())) (do ((i 0 (+ i 1))) ((= i 1) (reverse res)) (set! res (cons (L 'a) res)) (set! L V) (set! res (cons (L 'a) res))))) (test (f6) 'error)) (test (inlet :a 1) (inlet (cons 'a 1))) (test (inlet :a 1 :b 2) (inlet 'a 1 'b 2)) (test (inlet 'pi 3.0) 'error) (for-each (lambda (arg) (test (openlet? arg) #f)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () abs macroexpand # # #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))) (test (openlet) 'error) (test (openlet 1 2) 'error) (test (openlet?) 'error) (test (openlet? 1 2) 'error) (test (openlet (rootlet)) 'error) (test (catch #t (lambda () (openlet 3) #f) (lambda (type info) type)) 'wrong-type-arg) (test (openlet ()) 'error) (test (catch #t (lambda () (openlet (rootlet)) #f) (lambda (type info) type)) 'out-of-range) (let ((e (openlet (inlet 'a 1)))) (test (openlet? (sublet e '(b . 2))) #t)) (let () (let ((f (lambda (x) (+ x 1)))) (test (openlet? f) #f) (openlet f) (test (openlet? f) #t) (coverlet f) (test (openlet? f) #f)) (let ((f (lambda* (x) (+ x 1)))) (test (openlet? f) #f) (openlet f) (test (openlet? f) #t) (coverlet f) (test (openlet? f) #f)) (let ((f (sublet (rootlet)))) (test (openlet? f) #f) (openlet f) (test (openlet? f) #t) (coverlet f) (test (openlet? f) #f)) (let ((e1 (openlet (inlet 'f1 (define-macro (f1 a) `(+ ,a 1)))))) (test ((e1 'f1) 3) 4)) (let () (define-macro (f x) `(+ ,x 1)) (test (openlet? f) #f) (test (openlet f) f) (test (openlet? f) #t) (test (coverlet f) f)) (let () (define-bacro* (f x) `(+ ,x 1)) (test (openlet? f) #f) (test (openlet f) f) (test (openlet? f) #t) (test (coverlet f) f)) ) (test (with-let (openlet (sublet (curlet) 'let-set-fallback (lambda (obj key val) 32))) (set! basf (* 2 3))) 32) (test (let () (define (f2) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (openlet (sublet (curlet) 'let-set-fallback (lambda (obj key val) 32))) (set! basf (* 2 3))))) (f2) (f2)) #t) (let () ; inspired by bug-guile (define p0 (openlet (inlet 'method (lambda (x) (+ x 1))))) (define p1 (openlet (sublet p0 'value 32))) (test ((p0 'method) (p1 'value)) 33) (let-set! p0 'method (lambda (x) (set! x (+ x 1)) (+ x 1))) (test ((p0 'method) (p1 'value)) 34) (test ((p1 'method) (p1 'value)) 34) ; same thing -- (outlet p1) == p0 (define p2 (openlet (sublet p0 'value 3))) (test ((p2 'method) (p2 'value)) 5)) ; (p0 'method) is the same (let () ; setf-method (define f9 (dilambda (lambda (x) (if (let? x) ((x 'f9) x) (+ x 1))) (lambda (x y) (if (let? x) ((x 'set-f9) x y) (error 'oops "no set!"))))) (define (f9-1) (let ((obj (openlet (inlet 'value -1 'f9 (lambda (x) (+ (x 'value) 1)) 'set-f9 (lambda (x y) (set! (x 'value) y)))))) (test (f9 obj) 0) (set! (f9 obj) 32) (test (f9 obj) 33))) (f9-1) (define (f10) (let ((obj (openlet (inlet 'value -1 'abs (lambda (x) (magnitude (x 'value))) 'set-abs (lambda (x y) (set! (x 'value) y)))))) (set! (setter abs) (lambda (x y) (if (let? x) ((x 'set-abs) x y) 'oops))) (test (abs obj)1) (set! (abs obj) 32) (test (abs obj) 32))) (f10) (set! (setter abs) #f)) (let () ; let_set_p_ppp_2 from snd-test.scm (define (fv157) (do ((g0 (inlet 'a 0 'b 1 'c 2 'd 3)) (syms (vector 'a 'b 'c 'd)) (v (inlet 'a -1 'b -1 'c -1 'd -1)) (i 0 (+ i 1))) ((= i 4) v) (set! (v (syms i)) (g0 (syms i))))) (test (fv157) (inlet 'a 0 'b 1 'c 2 'd 3))) (test (curlet 1) 'error) (test (rootlet 1) 'error) (test (unlet 1) 'error) (test (unlet 'abs) 'error) (test (rootlet 'abs) 'error) (test (set! (curlet) 1) 'error) (test (set! (rootlet) 1) 'error) (test (set! (unlet) 1) 'error) (test (let () (set! unlet 2)) 'error) (test (let ((unlet 2)) unlet) 'error) (test (let ((e (sublet (rootlet) '(a . 1)))) ((lambda (x) (x *)) e)) 'error) (test (let ((e (sublet (rootlet) '(a . 1)))) ((lambda (x) (x pi)) e)) 'error) (test (let () (sublet (rootlet) (cons pi 1))) 'error) (test (let () (sublet (rootlet) (cons "hi" 1))) 'error) (test (let () (varlet (rootlet) (cons pi 1))) 'error) (test (let () (varlet (rootlet) (cons "hi" 1))) 'error) (test (catch 'wrong-type-arg (lambda () (define-constant asdf 1) (varlet (curlet) 'asdf 3) asdf) (lambda (t info) (apply format #f info))) "varlet second argument, asdf, is a symbol but should be a non-constant symbol") ; argnum is what we're trying to check here (test (varlet (inlet 'a 1) (rootlet)) (inlet 'a 1)) (test (let ((lt (openlet (inlet 'x (list 1 2 3) 'make-iterator (let ((+iterator+ #t)) (lambda (e) (#_make-iterator (e 'x)))))))) (format #f "~{~A~^ ~}" lt)) "1 2 3") (unless pure-s7 (test (let ((lt (openlet (inlet 'x (list 1 2 3) 'let->list (lambda (e) (e 'x)))))) (format #f "~{~A~^ ~}" lt)) "1 2 3")) (test (eq? (rootlet) ()) #f) (test (eq? (rootlet) (unlet)) #f) (test (eqv? (rootlet) (rootlet)) #t) (test (eqv? (rootlet) (unlet)) #f) (test (equal? (rootlet) (rootlet)) #t) (test (equal? (rootlet) (unlet)) #f) ;(test (equal? (curlet) (unlet)) #f) (let ((e #f) (g #f)) (set! e (curlet)) (set! g (rootlet)) (if (not (equal? e (curlet))) ; test here introduces a new environment (format #t ";(equal? e (curlet)) -> #f?~%")) (test g (rootlet)) (test (equal? e g) #f) (let () (if (not (equal? e (curlet))) (format #t ";2nd case (equal? e (curlet)) -> #f?~%")))) (let () (define global-env (rootlet)) (test (equal? global-env (rootlet)) #t) (test (equal? (list global-env) (list (rootlet))) #t) (test (equivalent? global-env (rootlet)) #t) (test (equivalent? (list global-env) (list (rootlet))) #t)) (test (pair? (member (let ((a 1) (b 2)) (map cdr (curlet))) '((1 2) (2 1)))) #t) (test (let () (map cdr (curlet))) ()) (test (pair? (member (let ((vals ())) (let ((a 1) (b 2)) (for-each (lambda (slot) (set! vals (cons (cdr slot) vals))) (curlet))) vals) '((2 1) (1 2)))) #t) (test (let ((a '(1 2 3)) (b '(3 4 5)) (c '(6 7 8))) (map + a b c (apply values (map cdr (curlet))))) '(20 26 32)) (test (pair? (member (let ((a 1) (b 2) (c 3)) (map (lambda (a b) (+ a (cdr b))) (list 1 2 3) (curlet))) '((2 4 6) (4 4 4)))) #t) (test (let () (format #f "~A" (curlet))) "(inlet)") ;(test (let ((a 32) (b '(1 2 3))) (format #f "~A" (curlet))) "(inlet)") ;(test (let ((a 1)) (object->string (curlet))) "(inlet)") (test (let ((a 1)) (object->string (rootlet))) "(rootlet)") (test (format #f "~A" (rootlet)) "(rootlet)") (test (let ((a 32) (b #(1 2 3))) (format #f "~{~A~^ ~}" (curlet))) "(a . 32) (b . #(1 2 3))") (test (object->string (rootlet)) "(rootlet)") (test (let () (object->string (curlet))) "(inlet)") (test (let ((a 3)) (object->string (curlet))) "(inlet 'a 3)") (test (let ((a 3) (b "hi")) (object->string (curlet))) "(inlet 'a 3 'b \"hi\")") (let () (define (hi a b) (curlet)) (let ((str (object->string (hi 3 4)))) (or (string=? str "(inlet 'a 3 'b 4)") (string=? str "(inlet 'b 4 'a 3)")))) (test (let () (varlet (unlet) (cons 'a 32)) (symbol->value 'a (unlet))) #) (test (let ((abs 32)) (with-let (unlet) (abs -1))) 1) (test (let ((caar 123)) (+ caar (with-let (unlet) (caar '((2) 3))))) 125) (test (let () (+ (let ((caar 123)) (+ caar (with-let (unlet) (let ((val (caar '((2) 3)))) (set! caar -1) (+ val caar))))) ; 124 (let ((caar -123)) (+ caar (with-let (unlet) (let ((val (caar '((20) 3)))) (set! caar -2) (+ val caar))))) ; -105 (caar '((30) 3)))) ; 30 + 19 49) (test (let ((a 1)) (eval '(+ a b) (sublet (curlet) (cons 'b 32)))) 33) (test (let ((a 1)) (+ (eval '(+ a b) (sublet (curlet) (cons 'b 32))) a)) 34) (test (let ((a 1)) (+ (eval '(+ a b) (sublet (curlet) (cons 'b 32) (cons 'a 12))) a)) 45) (test (let ((a 2)) (eval '(+ a 1) (sublet (curlet)))) 3) (test (let ((a 1)) (+ (eval '(+ a b) (sublet (sublet (curlet) (cons 'b 32)) (cons 'a 12))) a)) 45) (test (eval (list + 'a (eval (list - 'b) (sublet (unlet) (cons 'b 1)))) (sublet (unlet) (cons 'a 2))) 1) #| ;;; this checks each procedure call against its signature -- it could be simplified to check just one procedure (define (setup-check-sig) (define (check-sig sym sig arg args) ;; signature can be #t, values, a symbol=type desired, or a list of these. We ignore #t and values before calling check-sig. (if (#_symbol? sig) ((#_with-let (#_unlet) (symbol->value sig)) arg) ; "unlet" in pretty-print? (if (#_pair? sig) (#_call-with-exit (lambda (return) (#_for-each (lambda (checker) (if ((#_with-let (#_unlet) (symbol->value checker)) arg) (return #t))) sig) #f)) (#_format *stderr* "~S for ~S if (~S ~{~^ S~}~%" arg sig sym args)))) ;; redefine all the built-in procedures (so this code gradually clobbers rootlet as it runs) (#_for-each (lambda (sym) (let ((x (#_symbol->value sym))) (when (and (#_procedure? x) (#_signature x) (#_not (#_immutable? sym)) ; unlet etc (#_not (#_memq sym '(values setup-check-sig check-sig)))) (apply set! sym (#_list (let ((old-x x)) (lambda args (#_catch #t ; this messes with outside error handling -- it's probably also unnecessary (lambda () (let ((result (#_apply old-x args)) (sig (#_signature old-x))) ;; check result against (car signature) (unless (#_memq (#_car sig) '(#t values)) (let ((sig-result (check-sig sym (#_car sig) result args))) (if (#_not sig-result) (#_format *stderr* "(~S~{~^ ~$~}) -> ~$ (~S) but sig: ~S~%" sym args result (#_type-of result) (#_car sig))))) ;; check args against (cdr signature) (#_for-each (lambda (arg-sig arg) (unless (#_memq arg-sig '(#t values)) (let ((sig-result (check-sig sym arg-sig arg args))) (if (#_not sig-result) (#_format *stderr* "(~S~{~^ ~$~}) arg ~$ (~S) -> ~$ but sig: ~S~%" sym args arg (#_type-of arg) result arg-sig))))) (#_cdr sig) args) ;; return function result result)) (lambda (type info) #f))))))))) ;; this does not fixup any preset setter (current-output-port for example) (symbol-table))) |# (let ((e (openlet ; make it appear to be empty to the rest of s7 (inlet 'object->string (lambda args "(inlet)") 'map (lambda args ()) 'for-each (lambda args #) 'let->list (lambda args ()) 'length (lambda args 0) 'copy (lambda args (inlet)) 'open #t 'coverlet (lambda (e) (set! (e 'open) #f) e) 'openlet (lambda (e) (set! (e 'open) #t) e) 'openlet? (lambda (e) (e 'open)) ;; your secret data here 'secret 'gray-cat )))) (test (object->string e) "(inlet)") ;(test (map values e) ()) (unless pure-s7 (test (let->list e) ())) (test (length e) 0) (test (object->string (copy e)) "(inlet)") (coverlet e) (test (object->string e) "(inlet)") (test (openlet? e) #f) (openlet e) (test (openlet? e) #t)) (let () (define (lets . args) (apply sublet (rootlet) args)) (let ((e (lets '(a . 1) '(b . 2)))) (test (eval '(+ a b 3) e) 6))) ;(test (eval 'a (sublet (rootlet) '(a . 1) '(a . 2))) 'error) ; no longer an error, mainly for repl's convenience ;(test (eval 'a (varlet () '(a . 1) '(a . 2))) 'error) (test (eval 'pi (sublet (rootlet) '(pi . 1) '(a . 2))) 'error) (test (eval 'pi (varlet () '(pi . 1) '(a . 2))) 'error) (test (eval 'pi (sublet (rootlet) (cons 'pi pi))) 'error) ; changed 25-Jun-14 (test (eval 'pi (varlet () (cons 'pi pi))) 'error) (test (map (sublet (rootlet) '(asdf . 32) '(bsdf . 3)) '(bsdf asdf)) '(3 32)) (test (equal? (map (rootlet) '(abs cons car)) (list abs cons car)) #t) (test (with-let (sublet (inlet) '(a . 1)) a) 1) (test (with-let (sublet (inlet '(b . 2)) '(a . 1)) (+ a b)) 3) (test (with-let (sublet (rootlet) (inlet) '(a . 1)) a) 1) (test (with-let (sublet (rootlet) (inlet '(b . 2)) '(a . 1)) (+ a b)) 3) (test (with-let (sublet (inlet '(b . 2) '(c . 3)) '(a . 1)) (+ a b c)) 6) (let () (define (e1) (let ((e (curlet))) (with-let e 0))) (define (e2 a) (let ((e (curlet))) (with-let e a))) (define (e3) (let ((e (curlet))) (with-let e 1 . 2))) (define (e4) (let ((e (curlet))) (with-let e 0 1))) (define (e5) (let ((e (curlet))) (with-let e (+ 1 2) (+ 2 3)))) (test (e2 10) 10) (e1) (test (e1) (e2 0)) (test (e3) 'error) (e4) (test (e4) 1) (e5) (test (e5) 5)) (let () (define-constant _a_constant_ 32) (test (eval '_a_constant_ (sublet (rootlet) (cons '_a_constant_ 1))) 'error) (test (eval '_a_constant_ (sublet (rootlet) (cons '_a_constant_ 32))) 'error)) (test (let ((a 1)) (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32)))) 33) (test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32))) a)) 34) (test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (curlet) (cons 'b 32) (cons 'a 12))) a)) 45) (test (let ((a 2)) (eval-string "(+ a 1)" (sublet (curlet)))) 3) (test (let ((a 1)) (+ (eval-string "(+ a b)" (sublet (sublet (curlet) (cons 'b 32)) (cons 'a 12))) a)) 45) (test (eval-string (string-append "(+ a " (number->string (eval (list - 'b) (sublet (unlet) (cons 'b 1)))) ")") (sublet (unlet) (cons 'a 2))) 1) (test (sublet) 'error) (for-each (lambda (arg) (test (sublet arg '(a . 32)) 'error) (test (varlet arg '(a . 32)) 'error)) (list -1 #\a 1 3.14 3/4 1.0+1.0i "hi" 'hi #() #f _ht_ _undef_ _null_ _c_obj_)) (let ((e (sublet (curlet) (cons 'a 32) (cons 'b 12)))) (test (eval '(+ a b) e) 44) (test (eval '(+ a b c) (sublet e (cons 'c 3))) 47) (test (eval '(+ a b) (sublet e (cons 'b 3))) 35) (test (eval-string "(+ a b)" e) 44) (test (eval-string "(+ a b c)" (sublet e (cons 'c 3))) 47) (test (eval-string "(+ a b)" (sublet e (cons 'b 3))) 35) ) (test (with-let (sublet (rootlet) '(a . 1)) (defined? 'a)) #t) (test (defined? 'a (sublet (rootlet) '(a . 1))) #t) (test (defined? 'b (sublet (rootlet) '(a . 1))) #f) (test (defined? 'a '((a . 1))) 'error) (test (defined? 'a '((a . 1) 2)) 'error) (test (defined? 'a (sublet (rootlet))) #f) (test (symbol->value 'a (sublet (rootlet) '(a . 1))) 1) (test (symbol->value 'b (sublet (rootlet) '(a . 1))) #) (test (symbol->value 'a '((a . 1))) 'error) (test (symbol->value 'a '((a . 1) 2)) 'error) (test (eval 'a (sublet (rootlet) '(a . 1))) 1) (test (eval 'a (sublet (rootlet) '(b . 1))) 'error) (test (eval 'a '((a . 1))) 'error) (test (eval 'a '((a . 1) 2)) 'error) (test (eval-string "a" (sublet (rootlet) '(a . 1))) 1) (test (eval-string "a" (sublet (rootlet) '(b . 1))) 'error) (test (eval-string "a" '((a . 1))) 'error) (test (eval-string "a" '((a . 1) 2)) 'error) (test (with-let (sublet (rootlet) '(a . 1)) a) 1) (test (with-let (sublet (rootlet)) 1) 1) (test (with-let (sublet (rootlet) '(b . 1)) a) 'error) (test (with-let '((a . 1)) a) 'error) (test (with-let '((a . 1) 2) a) 'error) (test (let ((a 1)) (set! ((curlet) 'a) 32) a) 32) (test (with-let (inlet '+ -) (+ 2 3)) -1) ; from s7.html (for-each (lambda (arg) (test (sublet (curlet) arg) 'error) (test (varlet (curlet) arg) 'error)) (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi "hi" abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1))) (test (with-let (curlet) (let ((x 1)) x)) 1) (test (let (( x 1)) (with-let (curlet) (set! x 2)) x) 2) (let () (define (hi) (let ((e (sublet (curlet) (cons 'abs (lambda (a) (- a 1)))))) (with-let e (abs -1)))) (test (hi) -2) (test (hi) -2) (test (let ((e (sublet (curlet) (cons 'abs (lambda (a) (- a 1)))))) (with-let e (abs -1))) -2)) (test (let ((x 12)) (let ((e (curlet))) (let ((x 32)) (with-let e (* x 2))))) 24) (test (let ((e #f)) (let ((x 2) (y 3)) (set! e (curlet))) (let ((x 0) (y 0)) (with-let e (+ x y)))) 5) (test (let ((e #f)) (let () (define (func a b) (set! e (curlet)) (+ a b)) (func 1 2)) (with-let e (+ a b))) 3) (test (let ((e #f) (f #f)) (let () (define (func a b) (set! e (curlet)) (+ a b)) (set! f func) (func 1 2)) (let ((val (with-let e (+ a b)))) (f 3 4) (list val (with-let e (+ a b))))) '(3 7)) (test (with-let) 'error) (test (with-let 1) 'error) (test (with-let () 1) 'error) (test (with-let (curlet)) 'error) ; ?? perhaps this should be # but it's like (let) = error (test (outlet) 'error) (test (outlet (curlet) #f) 'error) (test (eq? (outlet (rootlet)) (rootlet)) #t) (test (set! (outlet (curlet)) #f) 'error) (test (set! (outlet (curlet)) ()) 'error) (test (set! (outlet) #f) 'error) (test (let? (set! (outlet (inlet)) (rootlet))) #t) (test (set! (outlet (inlet)) (rootlet)) (rootlet)) (test (set! (outlet (inlet 'a 1)) 32) 'error) (test (object->string (let ((a 1)) (immutable! 'a) (curlet)) :readable) "(let ((a 1)) (immutable! 'a) (curlet))") (test (object->string (let ((a 1)) (set! (setter 'a) integer?) (curlet)) :readable) "(let ((a 1)) (set! (setter 'a) #_integer?) (curlet))") (test (object->string (let ((a 1)) (set! (setter 'a) (lambda (s v) (integer? v))) (curlet)) :readable) "(let ((a 1)) (set! (setter 'a) (lambda (s v) (integer? v))) (curlet))") (test (let ((L (immutable! (inlet 'a 1 'b #(1 2 3))))) (object->string L :readable)) "(immutable! (inlet :a 1 :b (vector 1 2 3)))") (let () (test (let () (set! (outlet (curlet)) (let ((a 1) (b 2)) (set! (outlet (curlet)) (rootlet)) (curlet))) (+ a b)) 3)) ;; equivalent to (let ((a 1) (b 2)) (let () (curlet))) ;; that is, we've turned the let structure inside out (test (let () (set! (outlet (curlet)) (rootlet)) (eq? (outlet (curlet)) (rootlet))) #t) (test (let ((a 1)) (let ((b 2)) (set! (outlet (curlet)) (rootlet)) ((curlet) 'a))) #) (test (let ((a 1) (e #f)) (set! e (curlet)) (let ((b 2)) (let ((c 3)) (set! (outlet (curlet)) e) (and (equal? ((curlet) 'a) 1) (equal? ((curlet) 'b) #) (equal? ((curlet) 'c) 3) (equal? (outlet (curlet)) e))))) #t) (for-each (lambda (arg) (test (with-let arg #f) 'error) (test (outlet arg) 'error) (test (set! (outlet (curlet)) arg) 'error)) (list -1 () #\a #(1 2 3) 3.14 3/4 1.0+1.0i 'hi "hi" #(()) (list 1 2 3) '(1 . 2))) (test (with-let (sublet (sublet (rootlet)) '(a . 1)) 1) 1) (test (with-let (sublet (sublet (rootlet)) '(a . 1)) a) 1) (test (with-let (curlet) 1) 1) (test (let ((a 1)) (+ (with-let (sublet (curlet) (cons 'a 10)) a) a)) 11) (test (let ((a 1)) (+ (with-let (sublet (curlet) (cons 'a 10)) (+ a (with-let (sublet (curlet) (cons 'a 100)) a))) a)) 111) (test (let ((a 1)) (+ (with-let (sublet (curlet) (cons 'a 10)) (+ a (with-let (sublet (curlet) (cons 'b 100)) a))) a)) 21) (test (let ((a 1)) (let ((e (curlet))) (+ (with-let (sublet (curlet) (cons 'a 10)) (+ a (with-let e a))) a))) 12) (test (let ((a 1)) (let ((e (curlet))) (+ (with-let (varlet (sublet (curlet) (cons 'a 10)) (cons 'a 20)) (+ a (with-let e a))) a))) 22) ; (test (= ((inlet 'a 1 'a 2) 'a) (with-let (inlet 'a 1 'a 2) a)) #t) ; undecided... (test (= ((varlet (inlet 'a 1) 'a 2) 'a) (with-let (varlet (inlet 'a 1) 'a 2) a)) #t) (test (let ((a 1)) (+ (with-let (sublet (curlet) (cons 'a 10)) (+ (let ((b a)) (varlet (curlet) (cons 'a 20)) (+ a b)) a)) a)) 41) (test (let ((a 1)) (+ (let ((a 2)) (+ (let ((a 3)) a) a)) a)) 6) (test (let ((a 1)) (+ (let () (+ (let ((a 3)) (varlet (outlet (curlet)) '(a . 2)) a) a)) a)) 6) (test (let () (let ((a 1)) (varlet (outlet (curlet)) '(a . 2))) a) 2) (test (let ((a 1)) (let ((e (curlet))) (+ (with-let (sublet e (cons 'a 10)) (+ a (with-let e a))) a))) 'error) ; "e" is not in the curlet at the top, so it's not in the nested env (test (let ((x 3)) (varlet (curlet) (cons 'y 123)) (+ x y)) 126) #| ;; can't decide about these -- safe closures prebuild the funclet from the arglist so two of these fail (test (let () (define (hiho a) (+ a b)) (varlet (funclet hiho) (cons 'b 21)) (hiho 1)) 22) (test (let () (define hiho (let ((x 32)) (lambda (a) (+ a x b)))) (varlet (funclet hiho) (cons 'b 10) (cons 'x 100)) (hiho 1)) 111) (test (let () (define hiho (let ((x 32)) (lambda* (a) (+ a x b)))) (varlet (funclet hiho) (cons 'b 10) (cons 'x 100)) (hiho 1)) 111) (test (let () (define hiho (let () (define (hi b) (+ b 1)) (lambda (a) (hi a)))) (varlet (funclet hiho) (cons 'hi (lambda (b) (+ b 123)))) (hiho 2)) 125) |# (test (let () ; here's one way for multiple functions to share a normal scheme closure (define f1 (let ((x 23)) (lambda (a) (+ x a)))) (define f2 (with-let (outlet (funclet f1)) ; outlet is needed as of 28-Feb-16 (lambda (b) (+ b (* 2 x))))) (+ (f1 1) (f2 1))) 71) (test (varlet) 'error) (test (sublet 3) 'error) (test (varlet 3) 'error) (test (let ((e (curlet))) (let? e)) #t) (test (let ((f (lambda (x) (let? x)))) (f (curlet))) #t) (test (let ((e (varlet (rootlet) '(a . 1)))) (let? e)) #t) (test (let ((e (varlet (rootlet) '(a . 1)))) ((lambda (x) (let? x)) e)) #t) (test (let? ((lambda () (curlet)))) #t) (test (let? ((lambda (x) x) (curlet))) #t) (test (let ((e (let ((x 32)) (lambda (y) (let ((z 123)) (curlet)))))) (eval `(+ x y z) (e 1))) 156) (test (let ((e #f)) (set! e (let ((x 32)) (lambda (y) (let ((z 123)) (funclet e))))) (eval `(+ x 1) (e 1))) 33) (test (let () ((curlet) 'abs)) abs) ; was #)?? (test ((rootlet) 'abs) abs) (test (catch #t (lambda () (with-let (curlet) (error 'testing "a test") 32)) (lambda args (car args))) 'testing) (test (call-with-exit (lambda (go) (with-let (curlet) (go 1) 32))) 1) (test (let ((x 0)) (call-with-exit (lambda (go) (with-let (varlet (curlet) (cons 'x 123)) (go 1)))) x) 0) (test (let ((x 1)) (+ x (call-with-exit (lambda (go) (with-let (varlet (curlet) (cons 'x 123)) (go x)))) x)) 125) (test (let ((x 0)) (catch #t (lambda () (with-let (varlet (curlet) (cons 'x 123)) (error 'oops) x)) (lambda args x))) 0) (let ((a 1)) (test ((curlet) 'a) 1) (set! ((curlet) 'a) 32) (test ((curlet) 'a) 32)) (let () (test (equal? (curlet) (rootlet)) #f)) (test (let ((a 1)) (let ((e (curlet))) (set! (e 'a) 2)) a) 2) (let () (define (hi e) (set! (e 'a) 2)) (test (let ((a 1)) (hi (curlet)) a) 2)) (let () (define (hi) (let ((a 1)) (let ((e (curlet)) (i 'a)) (set! (e i) #\a)) a)) (hi) (hi) (test (hi) #\a)) (let ((e1 #f) (e2 #f)) (let ((a 1)) (set! e1 (curlet))) (let ((a 1)) (set! e2 (curlet))) (test (equal? e1 e2) #t) (test (eqv? e1 e2) #f)) (let ((e1 #f) (e2 #f)) (let ((a 1)) (set! e1 (curlet))) (let ((a 2)) (set! e2 (curlet))) (test (equal? e1 e2) #f)) (let ((e1 #f) (e2 #f)) (let ((a 1)) (set! e1 (curlet))) (let ((a 1) (b 2)) (set! e2 (curlet))) (test (equal? e1 e2) #f)) (let ((e1 #f) (e2 #f)) (let ((a 1) (b 2)) (set! e1 (curlet))) (let ((a 1) (b 2)) (set! e2 (curlet))) (test (equal? e1 e2) #t)) (let ((e1 #f) (e2 #f)) (let () (set! e1 (curlet))) (let ((a 1)) (set! e2 (curlet))) (test (equal? e1 e2) #f)) (test (let ((a #(1 2 3))) ((curlet) 'a 1)) 2) (test (let ((a #(1 2 3))) (let ((e (curlet))) ((curlet) 'e 'a 1))) 2) (let ((x (openlet (inlet 'let-ref-fallback (lambda args args))))) (test (x) 'error) (test (x 1) (list x 1)) (varlet x 'let-ref-fallback (lambda (s v) 32)) (test (x 1) 32) (test (cutlet x 'let-ref-fallback) 'error)) (let ((x (openlet (inlet 'let-ref-fallback (lambda args args))))) (let ((y (copy x))) (test (y 1) (list y 1)))) (let ((x (openlet (inlet 'a 1)))) (varlet x 'let-ref-fallback (lambda (s v) 32)) (test (x 'a) 1) (test (x 'b) 32)) (let ((x (openlet (inlet 'a 1)))) (test (x 'a) 1) (test (x 'b) #) (varlet x (openlet (inlet 'let-ref-fallback (lambda (s v) 32)))) (test (x 'a) 1) (test (x 'b) 32)) (let ((x (openlet (inlet 'a 1 'let-ref-fallback #)))) (test (x 'abs) #) (test (x 'a) 1)) (let ((x (openlet (inlet 'a 1 'let-ref-fallback 32)))) (test (x 'abs) 32) (test (x 'a) 1)) (test ((inlet :a 1)) 'error) (let () (define (f1) (let ((v (vector #f)) (X 0)) (do ((i 0 (+ i 1))) ((= i 1) v) (vector-set! v 0 (let-ref X 'a))))) (test (f1) 'error)) (let ((x '(a))) (let ((x '(c))) x) (let ((x '(b))) (define (transparent-memq sym var e) (let ((val (symbol->value var e))) (or (and (pair? val) (memq sym val)) (and (not (eq? e (rootlet))) (transparent-memq sym var (outlet e)))))) (let ((ce (curlet))) (test (list (transparent-memq 'a 'x ce) (transparent-memq 'b 'x ce) (transparent-memq 'c 'x ce)) '((a) (b) #f))))) (test (let-set! (rootlet) :rest #f) 'error) ; key->sym so this is not a constant (test (let-set! (rootlet) 'pi #f) 'error) (let ((a44 (subvector #i2d((1 2) (3 4)))) (bat (bignum 1/2))) (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) (let-set! a44 bat (integer->char 255))))) (test (func) 'error)) ; op_safe_c_ssa has_fx clear (let-temporarily ((*#readers* (cons (cons #\l (lambda (str) (and (string=? str "let") ; #let(...) (if (> (*s7* 'safety) 0) (immutable! (apply inlet (read))) (apply inlet (read)))))) *#readers*))) (test (eval-string "#let(:a 1)") (inlet :a 1)) ; need eval-string since this is handled at read-time (test (eval-string "#let(:a 1 :b \"asdf\")") (inlet :a 1 :b "asdf")) ; unlike hash-tables, :a and 'a are the same in lets: (test ((inlet :a 1) 'a) 1) (test ((inlet 'a 1) 'a) 1) (test (eval-string "#let(a 1 b 2)") (inlet 'b 2 'a 1)) (test (eval-string "#let(a #let(c 1))") (inlet 'a (inlet 'c 1))) (test (eval-string "#lot(:a 1)") 'error) ;attempt to apply a symbol :a to (1) in (:a 1)? because #lot is not handled by the reader (set! *#readers* (cons (cons #\l (lambda (str) (and (string=? str "lot") ; #let(...) (apply inlet (read))))) *#readers*)) (test (eval-string "#lot(:a 1)") (inlet 'a 1))) ;;; make-type ---------------- (let () (define (make-type . args) (let* ((type (gensym "make-type type")) ; built-in type and value slots have gensym'd names (value (gensym "make-type value")) (obj (openlet (sublet (rootlet) (cons type type) (cons value #))))) ;; load up any methods/slots (do ((arg args (cddr arg))) ((null? arg)) (varlet obj (cons (keyword->symbol (car arg)) (cadr arg)))) ;; return a list of '(? make ref) funcs (list (lambda (x) (and (let? x) (eq? (x type) type))) (lambda* (new-value) (let ((new-obj (copy obj))) (set! (new-obj value) new-value) new-obj)) (lambda (x) (x value))))) (define special-value (let ((type (make-type))) ((cadr type) 'special))) (test (eq? special-value special-value) #t) (test (eqv? special-value special-value) #t) (test (equal? special-value special-value) #t) (test (procedure? special-value) #f) (for-each (lambda (arg) (test (or (eq? arg special-value) (eqv? arg special-value) (equal? arg special-value)) #f)) (list "hi" -1 #\a 1 'special 3.14 3/4 1.0+1.0i #f #t '(1 . 2) # #)) (test (let ((obj ((cadr (make-type :type "hi" :value 123)) 0))) (list (obj 'type) (obj 'value))) '("hi" 123)) (test (let ((obj ((cadr (make-type :type "hi" :value 123))))) (list (obj 'type) (obj 'value))) '("hi" 123)) (test (let* ((rec-type (make-type)) (? (car rec-type)) (make (cadr rec-type)) (ref (caddr rec-type))) (let ((val-1 (make "hi"))) (let ((val-2 (make val-1))) (let ((val-3 (make val-2))) (ref (ref (ref val-3))))))) "hi") (test (let* ((rec1-type (make-type)) (?1 (car rec1-type)) (make1 (cadr rec1-type)) (ref1 (caddr rec1-type))) (let* ((rec2-type (make-type)) (?2 (car rec2-type)) (make2 (cadr rec2-type)) (ref2 (caddr rec2-type))) (let ((val-1 (make1 "hi"))) (let ((val-2 (make2 "hi"))) (let ((val-3 (make1 val-2))) (and (string=? (ref2 (ref1 val-3)) "hi") (not (equal? val-1 val-2)) (?1 val-1) (?2 val-2) (not (?2 val-3)))))))) #t) (test (let* ((rec1-type (make-type)) (make1 (cadr rec1-type)) (ref1 (caddr rec1-type))) (let* ((rec2-type (make-type)) (make2 (cadr rec2-type))) (let ((val-1 (make1 "hi"))) (let ((val-2 (make2 val-1))) (ref1 val-2))))) #) (test (make-type (make-type)) 'error) (let ((t (make-type))) (let ((t? (car t)) (make-t (cadr t)) (t-ref (caddr t))) (test (make-t 1 2) 'error) (test (t? (make-t)) #t) (test (t-ref (make-t)) #f) (test (t? 1 2) 'error) (test (t?) 'error) (test (t-ref) 'error) (test (t-ref 1 2) 'error) (for-each (lambda (arg) (test (t-ref arg) 'error)) (list #\a 'a-symbol 1.0+1.0i #t #(1 2) () 3/4 3.14 #() "hi" :hi 1 #f #t '(1 . 2))))) (begin (define rec? #f) (define make-rec #f) (define rec-a #f) (define rec-b #f) (let* ((rec-type (make-type)) (? (car rec-type)) (make (cadr rec-type)) (ref (caddr rec-type))) (set! make-rec (lambda* ((a 1) (b 2)) (make (vector a b)))) (set! rec? (lambda (obj) (? obj))) (set! rec-a (dilambda (lambda (obj) (and (rec? obj) (vector-ref (ref obj) 0))) (lambda (obj val) (if (rec? obj) (vector-set! (ref obj) 0 val))))) (set! rec-b (dilambda (lambda (obj) (and (rec? obj) (vector-ref (ref obj) 1))) (lambda (obj val) (if (rec? obj) (vector-set! (ref obj) 1 val))))))) (let ((hi (make-rec 32 '(1 2)))) (test (rec? hi) #t) (test (equal? hi hi) #t) (test (rec? 32) #f) (test (rec-a hi) 32) (test (rec-b hi) '(1 2)) (set! (rec-b hi) 123) (test (rec-b hi) 123) (let ((ho (make-rec 32 '(1 2)))) (test (eq? hi ho) #f) (test (eqv? hi ho) #f) (test (equal? hi ho) #f) (set! (rec-b ho) 123) (test (equal? hi ho) #t)) (let ((ho (make-rec 123 ()))) (test (eq? hi ho) #f) (test (eqv? hi ho) #f) (test (equal? hi ho) #f)) (test (equal? (copy hi) hi) #t) (test (fill! hi 1) 1) ;(test (object->string hi) "(inlet)") (test (length hi) 2) (test (let? (reverse hi)) 'error) (test (for-each abs hi) 'error) (test (map abs hi) 'error) (test (hi 1) 'error) (test (set! (hi 1) 2) 'error) ) (let ((rec3? (car (make-type))) (rec4? (car (make-type :value 21)))) (for-each (lambda (arg) (test (rec3? arg) #f) (test (rec4? arg) #f)) (list "hi" -1 #\a 1 'a-symbol 3.14 3/4 1.0+1.0i #f #t '(1 . 2)))) ) ;;; pfloat-vector (let () (begin (define pfloat-vector? #f) (define make-pfloat-vector #f) (let ((type (gensym)) (->float (lambda (x) (if (real? x) (* x 1.0) (error 'wrong-type-arg "pfloat-vector new value is not a real: ~A" x))))) (varlet (curlet) (cons 'length (lambda (p) ((funclet p) 'len))) (cons 'object->string (lambda args "#")) (cons 'vector? (lambda (p) #t)) (cons 'vector-length (lambda (p) ((funclet p) 'len))) (cons 'vector-dimensions (lambda (p) (list ((funclet p) 'len)))) (cons 'vector-ref (lambda (p ind) (#_vector-ref ((funclet p) 'obj) ind))) (cons 'vector-set! (lambda (p ind val) (#_vector-set! ((funclet p) 'obj) ind (->float val)))) (cons 'equal? (lambda (x y) (#_equal? ((funclet x) 'obj) ((funclet y) 'obj)))) (cons 'equivalent? (lambda (x y) (#_equivalent? ((funclet x) 'obj) ((funclet y) 'obj)))) (cons 'reverse (lambda (p) (vector->pfloat-vector (#_reverse ((funclet p) 'obj))))) (cons 'copy (lambda (p) (vector->pfloat-vector ((funclet p) 'obj)))) (cons 'sort! (lambda (p f) (vector->pfloat-vector (#_sort! ((funclet p) 'obj) f)))) ) (set! make-pfloat-vector (lambda* (len (init 0.0)) (let ((obj (make-vector len (->float init)))) (openlet (dilambda (lambda (i) (#_vector-ref obj i)) (lambda (i val) (#_vector-set! obj i (->float val)))))))) (set! pfloat-vector? (lambda (obj) (and (procedure? obj) (eq? ((funclet obj) 'type) type)))))) (define pfloat-vector (lambda args (let* ((len (length args)) (v (make-pfloat-vector len))) (do ((i 0 (+ i 1)) (arg args (cdr arg))) ((= i len) v) (set! (v i) (car arg)))))) (define (vector->pfloat-vector v) (let* ((len (length v)) (fv (make-pfloat-vector len))) (do ((i 0 (+ i 1))) ((= i len)) (set! (fv i) (v i))) fv)) (let ((v (make-pfloat-vector 3 0.0))) (test (length v) 3) (set! (v 1) 32.0) (test (v 0) 0.0) (test (v 1) 32.0) (test (eq? v v) #t) (test (eq? v (pfloat-vector 0.0 32.0 0.0)) #f) (test (equal? v (pfloat-vector 0.0 32.0 0.0)) #t) (test (equivalent? v (pfloat-vector 0.0 32.0 0.0)) #t) (test (reverse (pfloat-vector 1.0 2.0 3.0)) (pfloat-vector 3.0 2.0 1.0)) (test (copy (pfloat-vector 1.0 2.0 3.0)) (pfloat-vector 1.0 2.0 3.0)) (test (object->string v) "#") (test (let ((v (pfloat-vector 1.0 2.0 3.0))) (map v (list 2 1 0))) '(3.0 2.0 1.0)) (test (v -1) 'error) (test (v 32) 'error) (for-each (lambda (arg) (test (v arg) 'error)) (list #\a 'a-symbol 1.0+1.0i #f #t abs #(1 2) () 3/4 3.14 '(1 . 2))) (test (set! (v 0) "hi") 'error) (test (set! (v -1) "hi") 'error) (test (set! (v 32) "hi") 'error) (for-each (lambda (arg) (test (set! (v 0) arg) 'error)) (list #\a 'a-symbol 1.0+1.0i #f #t abs #(1 2) () '(1 . 2))) (test (length v) 3) ) (let ((v1 (pfloat-vector 3 1 4 8 2))) (let ((v2 (sort! v1 <)) (one 1)) (test (equal? v2 (pfloat-vector 1 2 3 4 8)) #t) (test (vector? v1) #t) (test (pfloat-vector? v1) #t) (test (vector-length v1) 5) (test (vector-ref v1 one) 2.0) (test (vector-set! v1 1 3/2) 1.5) (test (vector-ref v1 1) 1.5) (test (vector-dimensions v1) '(5)) (for-each (lambda (arg) (test (pfloat-vector? arg) #f)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))) (for-each (lambda (arg) (test (make-pfloat-vector arg) 'error)) (list -1 #\a #(1 2 3) 3.14 3/4 1.0+1.0i () #f #(()) '(1 . 2) "hi" '((a . 1)))) (for-each (lambda (arg) (test (make-pfloat-vector 3 arg) 'error)) (list #\a #(1 2 3) 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))) (for-each (lambda (arg) (test (pfloat-vector (list arg)) 'error)) (list #\a #(1 2 3) 1.0+1.0i () #f #(()) (list 1 2 3) '(1 . 2) "hi" '((a . 1)))) ))) ;;; environments as objects (define-macro* (define-class class-name inherited-classes (slots ()) (methods ())) `(let ((outer-env (outlet (curlet))) (new-methods ()) (new-slots ()) (new-type (gensym "define-class"))) (for-each (lambda (class) ;; each class is a set of nested environments, the innermost (first in the list) ;; holds the local slots which are copied each time an instance is created, ;; the next holds the class slots (global to all instances, not copied); ;; these hold the class name and other such info. The remaining environments ;; hold the methods, with the localmost method first. So in this loop, we ;; are gathering the local slots and all the methods of the inherited ;; classes, and will splice them together below as a new class. (set! new-slots (append (let->list class) new-slots)) (do ((e (outlet (outlet class)) (outlet e))) ((or (not (let? e)) (eq? e (rootlet)))) (set! new-methods (append (let->list e) new-methods)))) ,inherited-classes) (let ((remove-duplicates (lambda (lst) ; if multiple local slots with same name, take the localmost (letrec ((rem-dup (lambda (lst nlst) (cond ((null? lst) nlst) ((assq (caar lst) nlst) (rem-dup (cdr lst) nlst)) (else (rem-dup (cdr lst) (cons (car lst) nlst))))))) (reverse (rem-dup lst ())))))) (set! new-slots (remove-duplicates (append (map (lambda (slot) (if (pair? slot) (cons (car slot) (cadr slot)) (cons slot #f))) ,slots) ; the incoming new slots, #f is the default value new-slots))) ; the inherited slots (set! new-methods (remove-duplicates (append (map (lambda (method) (if (pair? method) (cons (car method) (cadr method)) (cons method #f))) ,methods) ; the incoming new methods ;; add an object->string method for this class. (list (cons 'object->string (lambda* (obj (port #f)) (format port "#<~A: ~{~A~^ ~}>" ',class-name (map (lambda (slot) (list (car slot) (cdr slot))) obj))))) (reverse! new-methods))))) ; the inherited methods (let ((new-class (openlet (apply sublet ; the local slots (sublet ; the global slots (apply sublet (rootlet) ; the methods new-methods) (cons 'class-name ',class-name) ; class-name slot (cons 'class-type new-type) ; save a unique type identifier (unneeded if class-names are unique) (cons 'inherited ,inherited-classes) (cons 'inheritors ())) ; classes that inherit from this class new-slots)))) (varlet outer-env (cons ',class-name new-class) ; define the class as class-name in the calling environment ;; define class-name? type check (cons (symbol (symbol->string ',class-name) "?") (lambda (obj) (and (let? obj) (eq? (obj 'class-type) new-type))))) (varlet outer-env ;; define the make-instance function for this class. ;; Each slot is a keyword argument to the make function. (cons (symbol "make-" (symbol->string ',class-name)) (apply lambda* (map (lambda (slot) (if (pair? slot) (list (car slot) (cdr slot)) (list slot #f))) new-slots) `((let ((new-obj (copy ,,class-name))) ,@(map (lambda (slot) `(set! (new-obj ',(car slot)) ,(car slot))) new-slots) new-obj))))) ;; save inheritance info for this class for subsequent define-method (letrec ((add-inheritor (lambda (class) (for-each add-inheritor (class 'inherited)) (if (not (memq new-class (class 'inheritors))) (set! (class 'inheritors) (cons new-class (class 'inheritors))))))) (for-each add-inheritor ,inherited-classes)) ',class-name))) (define-macro (define-generic name) `(define ,name (lambda args (apply ((car args) ',name) args)))) (define-macro (define-slot-accessor name slot) `(define ,name (dilambda (lambda (obj) (obj ',slot)) (lambda (obj val) (set! (obj ',slot) val))))) (define-macro (define-method name-and-args . body) `(let* ((outer-env (outlet (curlet))) (method-name (car ',name-and-args)) (method-args (cdr ',name-and-args)) (object (caar method-args)) (class (symbol->value (cadar method-args))) (old-method (class method-name)) (method (apply lambda* method-args ',body))) ;; define the method as a normal-looking function ;; s7test.scm has define-method-with-next-method that implements call-next-method here ;; it also has make-instance (varlet outer-env (cons method-name (apply lambda* method-args `(((,object ',method-name) ,@(map (lambda (arg) (if (pair? arg) (car arg) arg)) method-args)))))) ;; add the method to the class (varlet (outlet (outlet class)) (cons method-name method)) ;; if there are inheritors, add it to them as well, but not if they have a shadowing version (for-each (lambda (inheritor) (if (not (eq? (inheritor method-name) #)) ; defined? goes to the global env (if (eq? (inheritor method-name) old-method) (set! (inheritor method-name) method)) (varlet (outlet (outlet inheritor)) (cons method-name method)))) (class 'inheritors)) method-name)) (define (all-methods obj method) ;; for arbitrary method combinations: this returns a list of all the methods of a given name ;; in obj's class and the classes it inherits from (see example below) (let* ((base-method (obj method)) (methods (if (procedure? base-method) (list base-method) ()))) (for-each (lambda (ancestor) (let ((next-method (ancestor method))) (if (and (procedure? next-method) (not (memq next-method methods))) (set! methods (cons next-method methods))))) (obj 'inherited)) (reverse methods))) (define-macro (make-instance class . args) `(let* ((cls (if (symbol? ,class) (symbol->value ,class) ,class)) (make (symbol->value (symbol "make-" (symbol->string (cls 'class-name)))))) (apply make ',args))) (define-macro (define-method-with-next-method name-and-args . body) `(let* ((outer-env (outlet (curlet))) (method-name (car ',name-and-args)) (method-args (cdr ',name-and-args)) (object (caar method-args)) (class (symbol->value (cadar method-args))) (old-method (class method-name)) (arg-names (map (lambda (arg) (if (pair? arg) (car arg) arg)) method-args)) (next-class (and (pair? (class 'inherited)) (car (class 'inherited)))) ; or perhaps the last member of this list? (nwrap-body (if next-class `((let ((call-next-method (lambda new-args (apply (,next-class ',method-name) (or new-args ,arg-names))))) ,@',body)) ',body)) (method (apply lambda* method-args nwrap-body))) ;; define the method as a normal-looking function (varlet outer-env (cons method-name (apply lambda* method-args `(((,object ',method-name) ,@arg-names))))) ;; add the method to the class (varlet (outlet (outlet class)) (cons method-name method)) ;; if there are inheritors, add it to them as well, but not if they have a shadowing version (for-each (lambda (inheritor) (if (not (eq? (inheritor method-name) #)) ; defined? goes to the global env (if (eq? (inheritor method-name) old-method) (set! (inheritor method-name) method)) (varlet (outlet (outlet inheritor)) (cons method-name method)))) (class 'inheritors)) method-name)) (let () (let () (define-class class-1 () '((a 1) (b 2)) (list (list 'add (lambda (obj) (with-let obj (+ a b)))))) (define-slot-accessor slot-a a) (let () (test (let? (outlet (curlet))) #t) (test (class-1? class-1) #t) (test (class-1 'a) 1) (test (class-1 'b) 2) (test (class-1 'class-name) 'class-1) (test (class-1 'divide) #) (test (class-1 'inheritors) ()) (test ((class-1 'add) class-1) 3) (test (pair? (member (object->string class-1) '("#" "#"))) #t) (test (format #f "~{~A~^ ~}" class-1) "(a . 1) (b . 2)")) (let ((v (make-class-1))) (test (class-1? v) #t) (test (v 'a) 1) (test (v 'b) 2) (test (v 'class-name) 'class-1) (test (v 'inheritors) ()) (test ((v 'add) v) 3) (test (pair? (member (object->string v) '("#" "#"))) #t) (test (format #f "~{~A~^ ~}" v) "(a . 1) (b . 2)") (set! (v 'a) 32) (test ((v 'add) v) 34) (test (equal? v v) #t) (test (equal? v (make-class-1 :a 32)) #t) (test (slot-a v) 32) (set! (slot-a v) 1) (test (slot-a v) 1) (test (pair? (member (map cdr v) '((1 2) (2 1)))) #t)) (let ((v (make-class-1 :a 32)) (v1 (make-class-1)) (v2 (make-class-1 :a 32))) (test (class-1? v) #t) (test (v 'a) 32) (test (v 'b) 2) (test (v 'class-name) 'class-1) (test (v 'inheritors) ()) (test ((v 'add) v) 34) (test (pair? (member (object->string v) '("#" "#"))) #t) (test (eq? v v) #t) (test (eq? v v1) #f) (test (eqv? v v) #t) (test (eqv? v v1) #f) (test (eqv? v v2) #f) (test (equal? v v) #t) (test (equal? v v1) #f) (test (equal? v v2) #t)) (let ((v (make-class-1 32 3))) (test (class-1? v) #t) (test (v 'a) 32) (test (v 'b) 3) (test (v 'class-name) 'class-1) (test (v 'inheritors) ()) (test ((v 'add) v) 35) (test (pair? (member (object->string v) '("#" "#"))) #t)) (define-generic add) (let () (test (add class-1) 3) (test (add (make-class-1 :b 0)) 1) (test (add 2) 'error)) (define-class class-2 (list class-1) '((c 3)) (list (list 'multiply (lambda (obj) (with-let obj (* a b c)))))) (let ((v (make-class-2 :a 32))) (test (class-1? v) #f) (test (class-2? v) #t) (test (equal? v (make-class-1 :a 32)) #f) (test (equal? v (make-class-2 :a 32)) #t) (test (v 'a) 32) (test (v 'b) 2) (test (v 'c) 3) (test (v 'class-name) 'class-2) (test (v 'inheritors) ()) (test (class-1 'inheritors) (list class-2)) (test ((v 'add) v) 34) (test (pair? (member (object->string v) '("#" "#" "#"))) #t) (test ((v 'multiply) v) 192) (test (add v) 34)) (let ((v1 (make-class-1)) (v2 (make-class-1))) (test (add v1) 3) (test (add v2) 3) (varlet v2 (cons 'add (lambda (obj) (with-let obj (+ 1 a (* 2 b)))))) (test (add v1) 3) (test (add v2) 6)) (define-class class-3 (list class-2) () (list (list 'multiply (lambda (obj num) (* num ((class-2 'multiply) obj) (add obj)))))) (let ((v (make-class-3))) (test (class-1? v) #f) (test (class-2? v) #f) (test (class-3? v) #t) (test (v 'a) 1) (test (v 'b) 2) (test (v 'c) 3) (test (v 'class-name) 'class-3) (test (v 'inheritors) ()) (test (class-1 'inheritors) (list class-3 class-2)) (test (class-2 'inheritors) (list class-3)) (test ((v 'add) v) 3) (test (pair? (member (object->string v) '("#" "#" "#"))) #t) (test ((v 'multiply) v) 'error) (test ((v 'multiply) v 4) (* 4 6 3)) (test (add v) 3)) (define-method (subtract (obj class-1)) (with-let obj (- a b))) (let ((v1 (make-class-1)) (v2 (make-class-2)) (v3 (make-class-3))) (test (subtract v1) -1) (test (subtract v2) -1) (test (subtract v3) -1)) ;; class-2|3 have their own multiply so... (define-method (multiply (obj class-1)) (with-let obj (* a b 100))) (let ((v1 (make-class-1)) (v2 (make-class-2)) (v3 (make-class-3))) (test (multiply v1) 200) (test (multiply v2) 6) (test (multiply v3) 'error)) (define-method-with-next-method (add-1 (obj class-1)) (+ (obj 'a) 1)) (define-method-with-next-method (add-1 (obj class-2)) (+ 1 (call-next-method))) (define-method-with-next-method (add-1 (obj class-3)) (+ 1 (call-next-method obj))) (test (add-1 (make-class-1)) 2) (test (add-1 (make-class-2)) 3) (test (add-1 (make-class-3)) 4) (test ((make-instance class-1) 'class-name) 'class-1) (test ((make-instance 'class-1) 'class-name) 'class-1) (test ((make-instance class-2) 'class-name) 'class-2) (test ((make-instance class-1 :a 123) 'class-name) 'class-1) (test ((make-instance class-1) 'b) 2) (test ((make-instance 'class-1) 'b) 2) (test ((make-instance class-1 :b 12 :a 123) 'b) 12) (test ((make-instance 'class-3 :a "hi" :c 21) 'c) 21) )) ;;; let field writer (let () (define lt (let ((a 1)) (set! (setter 'a) (lambda (s v) (if (integer? v) v (error 'wrong-type-arg "'a value should be an integer")))) (curlet))) (test (lt 'a) 1) (set! (lt 'a) 32) (test (lt 'a) 32) (test (set! (lt 'a) pi) 'error) (define a 12) (test a 12) (set! a pi) (test a pi) (test (lt 'a) 32) (test (set! (lt 'a) pi) 'error)) ;;; -------------------------------------------------------------------------------- ;;; owlet (test (vector? (owlet)) #f) (test (let? (owlet)) #t) (test (let () (set! (owlet) 2)) 'error) (test (owlet 123) 'error) (test (let ((e (owlet))) (e 'asdf)) #) (let ((val (catch #t (lambda () (/ 1 0.0)) (lambda args args)))) (with-let (owlet) (test error-type 'division-by-zero) (test (or (equal? error-code '(/ 1 0.0)) (equal? error-code '(lambda args args))) #t) (test (list? error-data) #t) (test (string? error-file) #t) (test (integer? error-line) #t) (test ((owlet) 'error-file) error-file) )) ;;; this needs to be global (fx_tree outlet let* optimization bug, taken from array1.scm in the benchmarks) (define (_create-y_ x) (let* ((n (vector-length x)) (result (make-vector n))) (do ((i (- n 1) (- i 1))) ((< i 0) result) (vector-set! result i 0)))) (define (_test-fx_) (let loop ((repeat 2) (result ())) (if (> repeat 0) (loop (- repeat 1) (_create-y_ (make-vector 1))) result))) (_test-fx_) ;;; -------------------------------------------------------------------------------- ;;; object->let (test (object->let) 'error) (test (object->let 12 21) 'error) (test (object->let ()) (inlet :value () :type 'null?)) (test (object->let #) (inlet :value # :type 'unspecified?)) (test (object->let #) (inlet :value # :type 'undefined?)) (test (object->let else) (inlet 'value else 'type 'symbol? 'current-value else 'setter #f 'mutable? #t)) (test (object->let with-baffle) (inlet 'value with-baffle 'type 'syntax? 'documentation "(with-baffle ...) evaluates its body in a context that blocks re-entry via call/cc.")) (test (object->let #) (inlet :value # :type 'eof-object?)) (test (object->let #t) (inlet :value #t :type 'boolean?)) (test (object->let 'abc) (inlet 'value 'abc 'type 'symbol? 'current-value # 'setter #f 'mutable? #t)) (test (object->let :abc) (inlet :value :abc :type 'keyword?)) (test (object->let #\space) (inlet :value #\space :type 'char?)) (let ((_sym_ 3)) (set! (setter '_sym_) log) (test (object->let '_sym_) (inlet 'value '_sym_ 'type 'symbol? 'current-value 3 'setter log 'mutable? #t))) (test (object->let 123) (inlet :value 123 :type 'integer?)) (test (object->let 1/2) (inlet :value 1/2 :type 'rational?)) (test (object->let 1.0) (inlet :value 1.0 :type 'real?)) (test (object->let 1+i) (inlet :value 1+i :type 'complex?)) (when with-bignums (test (object->let (bignum "123")) (inlet :value (bignum "123") :type 'integer?)) (test (object->let (bignum "1/2")) (inlet :value (bignum "1/2") :type 'rational?)) (test (object->let (bignum "1.0")) (inlet :value (bignum "1.0") :type 'real?)) (test (object->let (bignum "1+i")) (inlet :value (bignum "1+i") :type 'complex?))) (test (object->let "abc") (inlet :value "abc" :type 'string? :size 3 :mutable? #t)) (test (object->let (byte-vector 1 2 3)) (inlet :value (byte-vector 1 2 3) :type 'byte-vector? :dimensions '(3) :size 3 :mutable? #t)) (test (object->let (cons 1 2)) (inlet :value (cons 1 2) :type 'pair? :size -1)) (test (object->let (c-pointer 0)) (inlet :value (c-pointer 0) :type 'c-pointer? :pointer 0 :c-type #f :info #f)) (let ((c #f)) (call/cc (lambda (f) (set! c f))) (let ((obj (object->let c))) (test (obj 'value) c) (test (obj 'type) 'continuation?) (test (obj 'name) 'f))) (let ((c #f)) (call-with-exit (lambda (f) (set! c f))) (test (object->let c) (inlet :value c :type 'goto? :active #f 'name 'f))) (call-with-exit (lambda (f) (test (object->let f) (inlet :value f :type 'goto? :active #t 'name 'f)))) (unless with-bignums (let ((r (random-state 1234))) (test (object->let r) (inlet :value r :type 'random-state? :seed 1234 :carry 1675393560)))) (test (object->let (vector 1 2 3)) (inlet :value (vector 1 2 3) :type 'vector? :size 3 :dimensions '(3) :mutable? #t)) (test (object->let (int-vector 1 2 3)) (inlet :value (int-vector 1 2 3) :type 'int-vector? :size 3 :dimensions '(3) :mutable? #t)) (test (object->let (float-vector 1 2 3)) (inlet :value (float-vector 1 2 3) :type 'float-vector? :size 3 :dimensions '(3) :mutable? #t)) (test (object->let (complex-vector 1+i 2+i 3+i)) (inlet :value (complex-vector 1+i 2+i 3+i) :type 'complex-vector? :size 3 :dimensions '(3) :mutable? #t)) (let ((v (subvector (vector 1 2 3) 1 3))) (test (object->let v) (inlet :value (vector 2 3) :type '(subvector? . vector?) :size 2 :dimensions '(2) :mutable? #t :position 1 :original-vector #(1 2 3)))) (test (object->let (make-vector '(2 3 4) #f)) (inlet :value (make-vector '(2 3 4) #f) :type 'vector? :size 24 :dimensions '(2 3 4) :mutable? #t)) (let ((iter (make-iterator '(1 2 3)))) (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence '(1 2 3) :size 3 :position '(1 2 3)))) (let ((iter (make-iterator #(1 2 3)))) (iter) (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence #(1 2 3) :size 3 :position 1))) (let ((iter (make-iterator "1234"))) (iter) (iter) (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #f :sequence "1234" :size 4 :position 2))) (let ((iter (make-iterator (int-vector 1 2)))) (iter) (iter) (iter) (test (object->let iter) (inlet :value iter :type 'iterator? :at-end #t :sequence (int-vector 1 2) :size 2 :position 2))) (let ((h (hash-table :a 1 :b 2))) (test (object->let h) (if (provided? 'debugging) (inlet :stats:0|1|2|n|max '(6 2 0 0 1) :function 'eq? :value h :type 'hash-table? :size 8 :entries 2 :mutable? #t) (inlet :value h :type 'hash-table? :size 8 :entries 2 :mutable? #t :function 'eq?)))) (let ((h (hash-table 1 1 2 2))) (test (object->let h) (if (provided? 'debugging) (inlet 'stats:0|1|2|n|max '(6 2 0 0 1) 'function '= 'value h 'type 'hash-table? 'size 8 'entries 2 'mutable? #t) (inlet :value h :type 'hash-table? :size 8 :entries 2 :mutable? #t :function '=)))) (let ((h (make-hash-table 8 string=?))) (test (object->let h) (inlet :value h :type 'hash-table? :size 8 :entries 0 :mutable? #t :function 'string=?))) (test ((object->let (make-weak-hash-table)) 'weak) #t) (let ((e (inlet 'a 1 'b 2))) (test (object->let e) (inlet :value e :type 'let? :size 2 :open #f :outlet (rootlet) :mutable? #t))) (test (object->let (rootlet)) (inlet :value (rootlet) :type 'let? :size (length (rootlet)) :open #f :outlet () :mutable? #t :alias 'rootlet)) ;(test (object->let (owlet)) (inlet :value (owlet) :type 'let? :size (length (owlet)) :open #f :outlet (rootlet) :alias 'owlet)) (let ((e (openlet (inlet 'a 1 'b 2 'object->let (lambda (p lt) (varlet lt 'a+b (+ (p 'a) (p 'b)))))))) (test (object->let e) (inlet :value e :type 'let? :size 3 :open #t :outlet (rootlet) :mutable? #t 'a+b 3))) (test (equal? (object->let (byte-vector-ref (make-byte-vector '(2 3) 1) 1)) (inlet 'value #u(1 1 1) 'type '(subvector? . byte-vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #u2d((1 1 1) (1 1 1)))) #t) ; segfault in gcc if -O2 if vector_elements used for all vector types (and the stacktrace is messed up in gdb) (test (equal? (object->let (int-vector-ref (make-int-vector '(2 3) 1) 1)) (inlet 'value #i(1 1 1) 'type '(subvector? . int-vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #i2d((1 1 1) (1 1 1)))) #t) (test (equal? (object->let (vector-ref (make-vector '(2 3) 1) 1)) (inlet 'value #(1 1 1) 'type '(subvector? . vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #2d((1 1 1) (1 1 1)))) #t) (test (equal? (object->let (float-vector-ref (make-float-vector '(2 3) 1) 1)) (inlet 'value #r(1.0 1.0 1.0) 'type '(subvector? . float-vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #r2d((1.0 1.0 1.0) (1.0 1.0 1.0)))) #t) (test (equal? (object->let (complex-vector-ref (make-complex-vector '(2 3) 1+i) 1)) (inlet 'value #c(1.0+i 1.0+i 1.0+i) 'type '(subvector? . complex-vector?) 'size 3 'dimensions '(3) 'mutable? #t 'position 3 'original-vector #c2d((1.0+i 1.0+i 1.0+i) (1.0+i 1.0+i 1.0+i)))) #t) (let () (define (fff x) (+ x 1)) (let ((e (funclet fff))) (test ((object->let e) :type) 'let?))) ; (inlet 'value e :type 'let? :size 1 :open #f :outlet (inlet 'fff fff) :function 'fff :file "s7test.scm" :line (port-line-number))))) (let ((e (openlet (inlet :abs (lambda (x) (- x 1)))))) (test (object->let e) (inlet :value e :type 'let? :size 1 :open #t :outlet (rootlet) :mutable? #t))) (when with-block (let* ((b (make-block 8)) (bl (object->let b))) (test (let? bl) #t) (test (bl 'value) b) (test (bl 'type) 'c-object?) (test (let? (bl 'class)) #t) (test ((bl 'class) 'name) "") (test (integer? (bl 'c-object-type)) #t) (test ((b 'empty) b) #f) (test (let? (bl 'c-object-let)) #t) (test (((bl 'c-object-let) 'empty) b) #f))) (when (provided? 'snd) (when (provided? 'snd-motif) (let ((cl (object->let jet-colormap))) (test (let? cl) #t) (test (cl 'value) jet-colormap) (test (cl 'type) 'c-object?) (test (cl 'class) (inlet 'name "" 'setter #f)) (test (integer? (cl 'c-object-type)) #t) (test (null? (cl 'c-object-let)) #t))) (let ((cl (object->let fourier-transform))) (test (let? cl) #t) (test (cl 'value) fourier-transform) (test (cl 'type) 'c-object?) (test (cl 'class) (inlet 'name "" 'setter #f)) (test (integer? (cl 'c-object-type)) #t) (test (null? (cl 'c-object-let)) #t))) (test (object->let *stderr*) (inlet :value *stderr* :type 'output-port? :port-type 'file :closed #f :mutable? #f :file "*stderr*")) (test (object->let *stdin*) (inlet :value *stdin* :type 'input-port? :port-type 'file :closed #f :mutable? #f :file "*stdin*" :line 0)) (with-input-from-string "1234" (lambda () (read-char) (test (object->let (current-input-port)) (inlet :value (current-input-port) :type 'input-port? :port-type 'string :closed #f :mutable? #t :size 4 :position 1 :data "1")))) (call-with-output-string (lambda (p) (display 123 p) (let ((e (object->let p))) (test (e 'type) 'output-port?) (test (e 'port-type) 'string) (test (e 'size) 128) (test (let-ref e 'size) 128) (test (e 'position) 3) (test (substring (e 'data) 0 3) "123")))) (let ((e #f)) (call-with-output-string (lambda (p) (display 123 p) (set! e p))) (test (object->let e) (inlet :value e :type 'output-port? :port-type 'string :closed #t :mutable? #t))) (when (and (zero? (*s7* 'debug)) (not (provided? 'snd))) (let () (define (ff1 x y) (+ x y)) (test (object->let ff1) (inlet 'value ff1 'type 'procedure? 'arity '(2 . 2) :mutable? #t 'file "s7test.scm" 'line (- (port-line-number) 7) 'source '(lambda (x y) (+ x y))))) (let () (define (ff2 . x) (apply + x)) (test (object->let ff2) (inlet 'value ff2 'type 'procedure? 'arity '(0 . 536870912) :mutable? #t 'file "s7test.scm" 'line (- (port-line-number) 4) 'source '(lambda x (apply + x))))) (let () (define* (ff3 x y) (+ x y)) (test (object->let ff3) (inlet 'value ff3 'type 'procedure? 'arity '(0 . 2) :mutable? #t 'file "s7test.scm" 'line (- (port-line-number) 1) 'source '(lambda* (x y) (+ x y)))))) (call-with-output-file "empty-file" (lambda (p) (format p ";;; this is a test of file/line data in object->let~%~%") (format p "(define (ff4 x)~% (+ (log x) 1))~%~%(set! (setter ff4) set-car!)~%~%"))) (when (zero? (*s7* 'debug)) (let () (load "empty-file" (curlet)) (test (object->let ff4) (inlet 'value ff4 'type 'procedure? 'arity '(1 . 1) :mutable? #t 'file "empty-file" 'line 3 '+setter+ set-car! 'source '(lambda (x) (+ (log x) 1)))))) (test (object->let abs) (inlet 'value abs 'type 'procedure? 'arity '(1 . 1) :mutable? #t '+signature+ '(real? real?) '+documentation+ "(abs x) returns the absolute value of the real number x")) (if with-block (test (object->let make-block) (inlet 'value make-block 'type 'procedure? 'arity '(1 . 1) :mutable? #t '+documentation+ "(make-block size) returns a new block of the given size"))) (test (object->let string=?) (inlet 'value string=? 'type 'procedure? 'arity '(2 . 536870912) 'mutable? #t '+signature+ (let ((lst (list 'boolean? 'string?))) (set-cdr! (cdr lst) (cdr lst)) lst) '+documentation+ "(string=? str ...) returns #t if all the string arguments are equal")) (test (object->let car) (inlet 'value car 'type 'procedure? 'arity '(1 . 1) :mutable? #t '+signature+ '(#t pair?) '+documentation+ "(car pair) returns the first element of the pair" '+setter+ set-car!)) (test (object->let quasiquote) (inlet 'value quasiquote 'type 'macro? 'arity '(1 . 1) :mutable? #t '+documentation+ "(quasiquote arg) is the same as `arg. If arg is a list, it can contain comma (\"unquote\") and comma-atsign (\"apply values\") to pre-evaluate portions of the list. unquoted expressions are evaluated and plugged into the list, apply-values evaluates the expression and splices the resultant list into the outer list. `(1 ,(+ 1 1) ,@(list 3 4)) -> (1 2 3 4).")) (let () (define-macro (1+ x) `(+ ,x 1)) (let ((e (object->let 1+))) (test (e 'value) 1+) (test (e 'type) 'macro?) (test (e 'arity) '(1 . 1)) (test (e 'source) '(macro (x) (#_list-values '+ x 1))))) (test (substring "1234" ((openlet (inlet 'value 1)) 'value) ((openlet (object->let 3)) 'value)) "23") ;(test (let? (eval-string (object->string (object->let (rootlet)) :readable))) #t) (test (let ((x '2)) (set! (setter 'x) integer?) (object->string (object->let 'x))) "(inlet 'mutable? #t 'setter integer? 'current-value 2 'value x 'type symbol?)") ;;; -------------------------------------------------------------------------------- ;;; let-temporarily (let ((aaa 1) (bbb 0) (ccc 0)) (let-temporarily ((aaa 2)) (set! bbb aaa) (set! aaa 32) (set! ccc aaa)) (test (list aaa bbb ccc) '(1 2 32))) (test (let ((aaa 0) (bbb 0)) (let-temporarily ((aaa 32)) (set! bbb aaa) (let-temporarily ((bbb 10)) (set! aaa bbb))) (list aaa bbb)) '(0 32)) (let () (define f2 (let ((x '(0 1))) (dilambda (lambda () x) (lambda (y) (set! x y))))) (let-temporarily (((f2) '(3 2))) (test (f2) '(3 2))) (test (f2) '(0 1))) (test (let ((x 3) (y 4)) (let-temporarily ((x (+ y (let-temporarily ((y 5)) (+ x y))))) (+ x y))) 16) (let () (define f3 (let ((x 'z)) (dilambda (lambda () x) (lambda (y) (set! x y))))) (let ((z 32)) (let-temporarily (((f3) 'z)) (test (f3) 'z)) (test (f3) 'z))) (let ((z 1) (x 32)) (let-temporarily ((z 'x)) (test z 'x)) (test z 1)) (let ((saved 0) (orig 1) (vars 2) (body 3)) (let ((vals (list (let-temporarily ((saved 30) (orig 31) (vars 32) (body 33)) (let ((inner (list saved orig vars body))) (set! saved 41) (set! orig 42) (set! vars 43) (set! body 44) inner)) (list saved orig vars body)))) (test vals '((30 31 32 33) (0 1 2 3))))) (let ((cons +) (curlet abs) (inlet call/cc) (saved 32) (inner-let -1)) (let-temporarily ((saved *)) (set! inner-let (cons (saved (abs inner-let) 2) 3))) (test inner-let 5) (test (eq? curlet abs) #t)) (let ((a (vector 1 2 3)) (x 1) (y 32)) (let-temporarily (((a x) y)) (test (a x) y)) (test (a x) 2)) (let ((a (inlet 'b (vector 1 2 3))) (x 32) (y 1)) (let-temporarily ((((a 'b) 1) 32)) (test (a 'b) #(1 32 3))) (test (a 'b) #(1 2 3))) (let ((x 1) (y 2)) (let-temporarily ((x 32) (y x)) (test (list x y) '(32 1))) (test (list x y) '(1 2))) (let ((a (vector 1 2 3)) (x 1) (y 32) (z 0)) (let-temporarily (((a x) y) (z (a x))) (test (list (a x) y z) '(32 32 2))) (test (list (a x) y z) '(2 32 0))) (test (let ((x 1)) (let-temporarily ((x 32)))) ()) ; was #f when let-temporarily was a macro -- not sure what it should be (test (let-temporarily . 1) 'error) (test (let-temporarily 1 1) 'error) (test (let-temporarily ((a 1) . 2) a) 'error) (test (let-temporarily (1 2) #t) 'error) (test (let-temporarily ((x . 1)) x) 'error) (test (let-temporarily ((x 1 2 3)) x) 'error) ;; (let ((x 0) (y 0)) (let-temporarily ((x 1) (x 2)) (set! y x)) (list x y)) '(0 1) ? let*-temp -> '(0 2) (test (let ((x 3)) (list (let-temporarily ((x 1)) (values x 2)))) '(1 2)) (test (let ((x #t)) (if (let-temporarily ((x #f)) x) 'error x)) #t) (test (let ((x 1)) (case (let-temporarily ((x 2)) x) ((1) 'error) ((2) x))) 1) (test (let-temporarily ((1 2)) 1) 'error) (test (let-temporarily ((*load-hook* 32)) 3) 'error) (test (apply let-temporarily (list (list 1 2)) 2) 'error) (let ((a 1)) (test (let-temporarily ((a 2)) (let-temporarily ((a 3)))) ()) (test a 1) (test (let-temporarily ((a (let-temporarily ((a 3))))) a) ()) (test a 1)) (test (let ((x 31)) (set! (setter 'x) (lambda (a b) 16)) (let-temporarily ((x 1)) x)) 16) (let () (define ourlet (let ((x 1)) (define (a-func) x) (define b-func (let ((y 1)) (lambda () (+ x y)))) (curlet))) (test (ourlet 'x) 1) (test (let-temporarily (((ourlet 'x) 2)) ((ourlet 'a-func))) 2) (test ((funclet (ourlet 'b-func)) 'y) 1) (test (let-temporarily ((((funclet (ourlet 'b-func)) 'y) 3)) ((ourlet 'b-func))) 4)) (let ((x 0)) (let ((y (call-with-exit (lambda (go) (let-temporarily ((x 1)) (go (+ x 1))))))) (test (list x y) '(0 2)))) (let ((x 0)) (let ((y (let-temporarily ((x 1)) (call-with-exit (lambda (go) (go (+ x 1))))))) (test (list x y) '(0 2)))) (let ((x 0)) (let ((y (call/cc (lambda (go) (let-temporarily ((x 1)) (go (+ x 1))))))) (test (list x y) '(0 2)))) (let ((x 0)) (let ((y (let-temporarily ((x 1)) (call/cc (lambda (go) (go (+ x 1))))))) (test (list x y) '(0 2)))) (let ((x 10) (y 10)) (catch #t (lambda () (let-temporarily ((x 1)) (set! y x) (error 'oops))) (lambda args 'error)) (test (list x y) '(10 1))) (let ((x 10) (y 10)) (catch #t (lambda () (let-temporarily ((x 1)) (set! y x) (throw 'oops))) (lambda args 'error)) (test (list x y) '(10 1))) (let ((x 10) (y 10)) (call-with-exit (lambda (go) (let-temporarily ((x 1)) (set! y x) (go 'oops)))) (test (list x y) '(10 1))) (let ((x 10) (y 10)) (call-with-exit (lambda (go) (dynamic-wind (lambda () #f) (lambda () (let-temporarily ((x 1)) (set! y x) (go 'oops))) (lambda () #f)))) (test (list x y) '(10 1))) (test (let ((x 1)) (immutable! 'x) (let-temporarily ((x 1234)) (+ x 1))) 'error) (test (let ((x 1)) (let-temporarily ((x 1234)) (immutable! 'x) (+ x 1))) 'error) (test (let ((x 1)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (let-temporarily ((x 1234)) (+ x 1)))) (immutable! 'x) (f)) 'error) (test (let () (define (g) (cadr ())) (let ((x #f) (y 0)) (let-temporarily ((x 1234) (y 1/2)) (g)))) 'error) (let () (define (func) ; fx_c_opsq_optuq_direct opt2_sym (does this mean catch lambda has no let?) (let ((x #f) (i 0)) (catch #t (lambda () (let-temporarily ((x (list (string->list i) (vector x i)))) x)) (lambda (type info) 'error)))) (func) (test (func) 'error)) (test (let ((x 0)) (let ((func (lambda () (let-temporarily ((x 1234)))))) (func) (func))) ()) (test (let ((x 0)) (let ((func (lambda () (let-temporarily ((x 1234)))))) (func) (func)) x) 0) (test (let ((x 0)) (let-temporarily ((x 1234)))) ()) (test (let ((x 0)) (let-temporarily ((x 1234))) x) 0) (test (let ((x 0) (y 1)) (let ((func (lambda () (let-temporarily ((x 1234) (y 12)))))) (func) (func))) ()) (test (let ((x 0) (y 1)) (let ((func (lambda () (let-temporarily ((x 1234) (y 12)))))) (func) (func)) (+ x y)) 1) (test (let ((x 0) (y 1)) (let-temporarily ((x 1234)))) ()) (test (let ((x 0) (y 1)) (let-temporarily ((x 1234))) (+ x y)) 1) (test (let ((x 0)) (let ((func (lambda () (let-temporarily (((*s7* 'print-length) 12)))))) (func) (func))) ()) (test (let ((x 0)) (set! (setter 'x) integer?) (let-temporarily ((x 1234)))) ()) (test (let () (define (func) (let ((x #f)) (let-temporarily ((x 1234))))) (define (hi) (func)) (hi) (hi)) ()) (test (let () (define (func) (let ((x 0)) (set! (setter 'x) (lambda (s v) (if (integer? v) v (error "setter ~A not integer" v)))) (let-temporarily ((x 1234))))) (func) (func)) ()) ; not 0! see let_temp_unwind (test (let () (define (func) (let ((x 0)) (set! (setter 'x) (lambda (s v) (if (integer? v) v (error "setter ~A not integer" v)))) (let-temporarily ((x 1234)) (+ x 1)))) (func) (func)) 1235) (test (+ 4 (let-temporarily (((*s7* 'safety) 1)) (values 1 2 3)) 5) 15) (test (+ 4 (let-temporarily (((*s7* 'safety) 1)) (c-function-with-values 1 2 3)) 5) 15) (let ((__x__ 0) (f (lambda (sym val) val))) (set! (setter '__x__) f) (test (eq? (setter '__x__) f) #t) (let-temporarily (((setter '__x__) #f)) (test (setter '__x__) #f)) (test (eq? (setter '__x__) f) #t)) ;;; need global symbol test of this also (define ___x___ 0) (let ((f (lambda (sym val) val))) (set! (setter '___x___) f) (test (eq? (setter '___x___) f) #t) (let-temporarily (((setter '___x___) #f)) (test (setter '___x___) #f)) (test (eq? (setter '___x___) f) #t)) (let () (define (flet x) x) (let-temporarily ((flet (lambda (x) (+ x 1)))) (test (flet 1) 2)) (test (flet 1) 1)) (let () (define (f x) (let-temporarily ((x (values 1 32)) (+ x 1)))) (test (catch #t (lambda () (f 2)) (lambda (type info) (apply format #f info))) "let-temporarily: variable declaration has more than one value?: (+ x 1)")) (let ((orig (*s7* 'print-length))) (define (f x) (let ((y (+ (let-temporarily (((*s7* 'print-length) 32)) (values (*s7* 'print-length) x))))) (list (*s7* 'print-length) y))) (test (f 1) (list orig 33)) (test (f 2) (list orig 34)) (test (*s7* (symbol "print-length")) orig) (let-temporarily (((*s7* (symbol "print-length")) 43)) (test (*s7* (symbol "print-length")) 43) (test (*s7* :print-length) 43)) (test (*s7* (symbol "print-length")) orig) (let ((pl 'print-length) (y 32)) (test (*s7* pl) orig) (let-temporarily (((*s7* pl) 60)) (test (*s7* 'print-length) 60)) (test (*s7* pl) orig) (let-temporarily ((y 12) ((*s7* pl) 23)) (test (*s7* pl) 23) (test y 12)) (test (*s7* 'print-length) orig) (test y 32))) (let () (define (f x) (let ((y (+ (let-temporarily ((x 32)) (values x x))))) (list x y))) (test (f 1) '(1 64)) (test (f 2) '(2 64))) (let () (define (f x) (let ((y (+ (catch #t (lambda () (let-temporarily ((x 32)) (values x x))) (lambda (type info) info))))) (list x y))) (test (f 1) '(1 64)) (test (f 2) '(2 64))) (let () (define (f x) (let ((y (+ (dynamic-wind (lambda () #f) (lambda () (let-temporarily ((x 32)) (values x x))) (lambda () #f))))) (list x y))) (test (f 1) '(1 64)) (test (f 2) '(2 64))) (when with-block (let ((obj (block 1 2 3))) (let-temporarily (((obj 1) 32)) (test obj (block 1 32 3))) (test obj (block 1 2 3)))) (test (with-output-to-string (lambda () (call-with-exit (lambda (quit) (let ((x #f) (cc #f)) (let-temporarily ((x 1)) (set! x 2) (call/cc (lambda (return) (set! cc return))) (display x) (unless (= x 2) (quit)) (set! x 3) (cc))))))) (with-output-to-string (lambda () (call-with-exit (lambda (quit) (let ((x #f) (cc #f) (returned #f)) (let-temporarily ((x 1)) (set! x 2) (call/cc (lambda (return) (set! cc return))) (display x) (when returned (quit)) (set! returned #t)) (set! x 3) (cc))))))) (let () (define dil2 (let ((val 0)) (dilambda (lambda () val) (lambda (v) (set! val (+ v 2)))))) (let-temporarily (((dil2) 3)) (test (dil2) 5)) (test (dil2) 2) ; 2! let-temp can't reset the value to 0! (define dil (let ((val 0)) (dilambda (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (t i) val))) (lambda (v) (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (set! val v))))))) (let-temporarily (((dil) 3)) (test (dil) 3)) (test (dil) 0) (define dil1 (let ((val 0)) (dilambda (lambda () (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (+ val 1)))) (lambda (v) (catch #t (lambda () (+ 1 #\a)) (lambda (t i) (set! val (+ v 2)))))))) (test (dil1) 1) ; read 0+1 (let-temporarily (((dil1) 3)) (test (dil1) 6)) ; 6 -- set val=3+2, read 5+1 (test (dil1) 4)) ; 4 -- set val=1+2 (old+2) read 3+1 (let () (define dil (let ((val 0)) (dilambda (lambda () val) (lambda (v) (set! val v))))) (test (let ((m1 0)) (list (call-with-exit (lambda (r) (let-temporarily (((dil) 21) (m1 (r 1 2 3))) 1))))) '(1 2 3)) (test (dil) 0)) (let ((x #f)) (sort! (vector 3 2) (lambda (a b) (let-temporarily ((x (list (cons x ()) (call/cc (lambda (return) (return 1)))))) (> a b)))) (test x #f)) (let ((x #f) (y 0)) (sort! (vector 3 2 1) (lambda (a b) (let-temporarily ((x (list (cons x ()) (call/cc (lambda (return) (return 1))))) (y (cons x x))) (> a b)))) (test x #f) (test y 0)) (let ((x #f)) (sort! (vector 3 2 1) (lambda (a b) (let-temporarily ((x (list (call/cc (lambda (return) (return 1))) (cons x ())))) (> a b)))) (test x #f)) ;;; -------------------------------------------------------------------------------- ;;; stacktrace (test (string? (stacktrace)) #t) (test (begin (stacktrace 0 -1 1 20100) #f) #f) ; segfault? (do ((i 0 (+ i 1))) ((= i 10)) (stacktrace (- (random 10) 50) (- (random 100) 50) (- (random 100) 50) (- (random 100) 50) (> (random 100) 50))) (test (stacktrace pi) 'error) (test (stacktrace 30 pi) 'error) (test (stacktrace 30 50 pi) 'error) (test (stacktrace 30 50 80 pi) 'error) (test (stacktrace 30 50 80 50 pi) 'error) (test (stacktrace 30 50 80 50 #f pi) 'error) (let ((str "")) (define testtrace (lambda () (set! str (stacktrace 3)))) (define (hi1 a) (testtrace)) (define (hi2 b) (string-append (hi1 b) "")) (define (hi3 c) (string-append (hi2 c) "")) (define (hi4 d) (string-append (hi3 d) "")) (define (hi5 e) (string-append (hi4 e) "")) (define (hi6 f) (string-append (hi5 f) "")) (hi6 12) (test str "hi2: (string-append (hi1 b) \"\") ; b: 12 hi3: (string-append (hi2 c) \"\") ; c: 12 hi4: (string-append (hi3 d) \"\") ; d: 12 ")) (let ((str "")) (define testtrace (lambda () (set! str (stacktrace 5)))) (define (hi1 a) (testtrace)) (define (hi2 b) (string-append (hi1 b) "")) (define (hi3 c) (string-append (hi2 c) "")) (define (hi4 d) (string-append (hi3 d) "")) (define (hi5 e) (string-append (hi4 e) "")) (define (hi6 f) (string-append (hi5 f) "")) (hi6 12) (test str "hi2: (string-append (hi1 b) \"\") ; b: 12 hi3: (string-append (hi2 c) \"\") ; c: 12 hi4: (string-append (hi3 d) \"\") ; d: 12 hi5: (string-append (hi4 e) \"\") ; e: 12 hi6: (string-append (hi5 f) \"\") ; f: 12 ")) (let ((str "")) (define testtrace (lambda () (set! str (stacktrace 5 20 40 20)))) (define (hi1 a) (testtrace)) (define (hi2 b) (string-append (hi1 b) "")) (define (hi3 c) (string-append (hi2 c) "")) (define (hi4 d) (string-append (hi3 d) "")) (define (hi5 e) (string-append (hi4 e) "")) (define (hi6 f) (string-append (hi5 f) "")) (hi6 12) (test str "hi2: (string-app... ; b: 12 hi3: (string-app... ; c: 12 hi4: (string-app... ; d: 12 hi5: (string-app... ; e: 12 hi6: (string-app... ; f: 12 ")) (let ((str "")) (define testtrace (lambda () (set! str (stacktrace 5 20 40 8)))) (define (hi1 a) (testtrace)) (define (hi2 b) (string-append (hi1 b) "")) (define (hi3 c) (string-append (hi2 c) "")) (define (hi4 d) (string-append (hi3 d) "")) (define (hi5 e) (string-append (hi4 e) "")) (define (hi6 f) (string-append (hi5 f) "")) (hi6 12) (test str "hi2: (string-app... ; b: 12 hi3: (string-app... ; c: 12 hi4: (string-app... ; d: 12 hi5: (string-app... ; e: 12 hi6: (string-app... ; f: 12 ")) (let ((str "")) (define testtrace (lambda () (set! str (stacktrace 5 20 40 8 #t)))) (define (hi1 a) (testtrace)) (define (hi2 b) (string-append (hi1 b) "")) (define (hi3 c) (string-append (hi2 c) "")) (define (hi4 d) (string-append (hi3 d) "")) (define (hi5 e) (string-append (hi4 e) "")) (define (hi6 f) (string-append (hi5 f) "")) (hi6 12) (test str "; hi2: (string-app... ; b: 12 ; hi3: (string-app... ; c: 12 ; hi4: (string-app... ; d: 12 ; hi5: (string-app... ; e: 12 ; hi6: (string-app... ; f: 12 ")) (let ((str "")) (define testtrace (lambda () (set! str (stacktrace 5 40 80 8 #t)))) (define (hi1 a) (testtrace)) (define (hi2 b) (string-append (hi1 b) "")) (define (hi3 c) (string-append (hi2 c) "")) (define (hi4 d) (string-append (hi3 d) "")) (define (hi5 e) (string-append (hi4 e) "")) (define (hi6 f) (string-append (hi5 f) "")) (hi6 12) (test (string-wi=? str "; hi2: (string-append (hi1 b) \"\") ; b: 12 ; hi3: (string-append (hi2 c) \"\") ; c: 12 ; hi4: (string-append (hi3 d) \"\") ; d: 12 ; hi5: (string-append (hi4 e) \"\") ; e: 12 ; hi6: (string-append (hi5 f) \"\") ; f: 12") #t)) (test (set! (*s7* 'max-stack-size) -1) 'error) (test (set! (*s7* 'max-stack-size) 0) 'error) (test (set! (*s7* 'max-stack-size) 32) 'error) ; this depends on INITIAL_STACK_SIZE (512) (test (set! (*s7* 'max-stack-size) #\a) 'error) (test (set! (*s7* 'max-stack-size) 3/4) 'error) (test (set! (*s7* 'max-stack-size) 123123.123) 'error) (test (> (*s7* 'max-stack-size) 8192) #t) (test (set! (*s7* 'max-heap-size) -1) 'error) (test (set! (*s7* 'max-heap-size) 0) 'error) (test (set! (*s7* 'max-heap-size) #\a) 'error) (test (set! (*s7* 'max-heap-size) 3/4) 'error) (test (set! (*s7* 'max-heap-size) 123123.123) 'error) (test (> (*s7* 'max-heap-size) (ash 1 20)) #t) (let () ; from lisp bboard (define (st n) (if (= n 0) 0 (+ 1 (st (- n 1))))) (test (st 20000) 20000)) ;;; -------------------------------------------------------------------------------- ;;; dilambda (test (let ((local 123)) (define pws-test (dilambda (lambda () local) (lambda (val) (set! local val)))) (pws-test)) 123) (test (let ((local 123)) (define pws-test (dilambda (lambda () local) (lambda (val) (set! local val)))) (pws-test 32)) 'error) (test (let ((local 123)) (define pws-test (dilambda (lambda () local) (lambda (val) (set! local val)))) (set! (pws-test 32) 123)) 'error) (let () (define-constant -dl1- (let ((x 1)) (dilambda (lambda () x) (lambda (y) (set! x y))))) (test (-dl1-) 1) (set! (-dl1-) 3) (test (-dl1-) 3) (define (f1) (set! (-dl1-) 32) (-dl1-)) (test (f1) 32)) (test (call-with-exit (lambda (return) (let ((local 123)) (define pws-test (dilambda (lambda () (return "oops")) (lambda (val) (set! local val)))) (pws-test)))) "oops") (test (call-with-exit (lambda (return) (let ((local 123)) (define pws-test (dilambda (lambda () 123) (lambda (val) (return "oops")))) (set! (pws-test) 1)))) "oops") (test (let ((local 123)) (define pws-test (dilambda (lambda () local) (lambda (val) (set! local val)))) (set! (pws-test) 321) (pws-test)) 321) (test (let ((v (vector 1 2 3))) (define vset (dilambda (lambda (loc) (vector-ref v loc)) (lambda (loc val) (vector-set! v loc val)))) (let ((lst (list vset))) (let ((val (vset 1))) (set! (vset 1) 32) (let ((val1 (vset 1))) (set! ((car lst) 1) 3) (list val val1 (vset 1)))))) (list 2 32 3)) (let ((local 123)) (define pws-test (dilambda (lambda () local) (lambda (val) (set! local val)))) (test (dilambda? pws-test) #t) (test (pws-test) 123) (set! (pws-test) 32) (test (pws-test) 32) (set! (pws-test) 0) (test (pws-test) 0) (test (set! (pws-test . 1) 1) 'error) (test (set! (pws-test 1) 1) 'error) (test (set! (pws-test 1) . 1) 'error) (test (set! (pws-test)) 'error)) (let ((local 123)) (define pws-test (dilambda (lambda (val) (+ local val)) (lambda (val new-val) (set! local new-val) (+ local val)))) (test (pws-test 1) 124) (set! (pws-test 1) 32) (test (pws-test 2) 34) (set! (pws-test 3) 0) (test (pws-test 3) 3)) (let ((ho (dilambda (lambda* ((a 1)) a) (lambda* (a (b 2)) (set! a b) a)))) (test (ho) 1) (test (ho 3) 3) (test (set! (ho) 32) 2) (test (set! (ho 3) 32) 32)) (test (dilambda) 'error) (test (dilambda abs) 'error) (test (dilambda 1 2) 'error) (test (dilambda (lambda () 1) (lambda (a) a) (lambda () 2)) 'error) (test (dilambda (lambda () 1) 2) 'error) (test (call-with-exit (lambda (return) (let ((g (dilambda return (lambda (s v) s)))) (g 0)))) 'error) (test (call-with-exit (lambda (return) (let ((g (dilambda (lambda (s) s) return))) (g 0)))) 'error) (test (+ (call-with-exit (lambda (return) (let ((g (dilambda (lambda (s) s) return))) (set! (g 1) 2))))) 'error) (test (set! (dilambda (lambda () 3) (lambda (x) x)) 32) 'error) ; dilambda (a c-function) does not have a setter ;; dilambda returns the getter, and it has a setter: (setter (dilambda (lambda () 3) (lambda (x) x))) -> # ;; but the argument to set! if a pair expects the car (as a symbol) to have a setter(?), so... (test (let ((d (dilambda (lambda () 3) (lambda (x) x)))) (define (f) d) (set! ((f)) 12)) 12) ;! maybe dilambda should have a setter... (test (set! ((dilambda (lambda () 3) (lambda (x) x))) 12) 12) (test (let ((f (lambda () 3))) (set! (setter f) (lambda (x) x)) (set! (f) 12)) 12) (test (set! ((let ((f (lambda () 3))) (set! (setter f) (lambda (x) x)) f)) 12) 12) (test (set! (let ((f (lambda () 3))) (set! (setter f) (lambda (x) x)) f) 12) 'error) ; let (syntactic) does not have a setter (for-each (lambda (arg) (test (dilambda arg (lambda () #f)) 'error) (test (dilambda (lambda () #f) arg) 'error)) (list "hi" -1 #\a 1 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2))) (for-each (lambda (arg) (test (dilambda? arg) #f)) (list -1 #\a 1 #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi "hi" #(()) abs (lambda () #f) (list (lambda () #f) (lambda (val) val)) (list 1 2 3) '(1 . 2) # # #)) (let ((pws (dilambda vector-ref vector-set!))) (let ((v (vector 1 2 3))) (test (dilambda? pws) #t) (test (dilambda? pws pws) 'error) (test (pws v 1) 2) (set! (pws v 1) 32) (test (pws v 1) 32))) (test (dilambda?) 'error) (let () (define macfun (dilambda (define-macro (_m_ a) `(+ ,a 1)) (define-macro (_m_ a b) `(- ,a 1)))) (test (macfun (+ 2 3)) 6) (test (set! (macfun (+ 2 3)) 3) 4)) (let () ; reality check... (set! (setter logbit?) (define-macro (_m_ var index on) `(if ,on (set! ,var (logior ,var (ash 1 ,index))) (set! ,var (logand ,var (lognot (ash 1 ,index))))))) (define (mingle a b) (let ((r 0)) (do ((i 0 (+ i 1))) ((= i 31) r) (set! (logbit? r (* 2 i)) (logbit? a i)) (set! (logbit? r (+ (* 2 i) 1)) (logbit? b i))))) (test (mingle 6 3) 30) (set! (setter logbit?) #f)) (let () (dilambda logbit? (define-macro (_m_ var index on) `(if ,on (set! ,var (logior ,var (ash 1 ,index))) (set! ,var (logand ,var (lognot (ash 1 ,index))))))) (define (mingle a b) (let ((r 0)) (do ((i 0 (+ i 1))) ((= i 31) r) (set! (logbit? r (* 2 i)) (logbit? a i)) (set! (logbit? r (+ (* 2 i) 1)) (logbit? b i))))) (test (mingle 6 3) 30) (set! (setter logbit?) #f)) #| (let () (define pws-args (dilambda (lambda args args) (lambda args (set-car! args 0) args))) (let ((lst (list 1 2 3))) (let ((l1 (apply pws-args lst))) (test l1 '(1 2 3)) (set-car! l1 32) (test lst '(1 2 3)) (set! (pws-args l1) 3) (test l1 '(32 2 3)) (test lst '(1 2 3)) (let () (define (pws1) (pws-args lst)) (let ((l2 (pws1))) (set! l2 (pws1)) (test lst '(1 2 3))))))) |# (test (call-with-exit (lambda (return) (dilambda? return))) #f) (test (dilambda? quasiquote) #f) (test (let ((pws (dilambda (lambda args (apply + args)) (lambda args (apply * args))))) (pws 2 3 4)) 9) (test (let ((pws (dilambda (lambda args (apply + args)) (lambda args (apply * args))))) (set! (pws 2 3 4) 5)) 120) (let ((x 0)) (let ((pws (dilambda (let ((y 1)) ((lambda () (set! x (+ x y)) (lambda () x)))) (let ((y 2)) ((lambda () (set! x (* x y)) (lambda (z) (set! x (+ x z))))))))) (test x 2) (set! (pws) 3) (test x 5))) (let ((p1 (dilambda (lambda () 1) (lambda (a) a)))) (test (dilambda? (dilambda p1 p1)) 'error)) (test ((dilambda call-with-exit call/cc) (lambda (a) (a 1))) 1) ;call/cc itself is a c_function (test (length (dilambda < >)) #f) (let () (define sf1 (let ((val 0)) (dilambda (let ((+signature+ '(integer?)) (+documentation+ "getter help")) (lambda () val)) (let ((+signature+ '(integer? integer?)) (+documentation+ "setter help")) (lambda (new-val) (if (integer? new-val) (set! val new-val) (error 'wrong-type-arg ";sf1 new value should be an integer: ~A" new-val))))))) (test (documentation sf1) "getter help") (test (documentation (setter sf1)) "setter help") (test (signature sf1) '(integer?)) (test (signature (setter sf1)) '(integer? integer?))) ;;; dilambda? (test (dilambda? (dilambda (lambda () 1) (make-hook))) 'error) (test (dilambda? (dilambda (make-hook) (setter car))) #t) ; ?? (for-each (lambda (arg) (if (dilambda? arg) (format #t ";(dilambda? ~A) -> #t?~%" arg))) (list "hi" _ht_ _undef_ _null_ :hi (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) 3.14 3/4 1.0+1.0i #\f #() (if #f #f))) (test (dilambda?) 'error) (test (dilambda? abs car) 'error) (test (dilambda? abs) #f) (test (dilambda? car) #t) (let () (define xb (dilambda (lambda args args) (lambda args args))) (define (fxb) (set! (xb 3) 2)) (fxb) (fxb)) ;;; this test needs to be outside the test macro (when (zero? (*s7* 'debug)) (test (object->string (dilambda (lambda () 1) quasiquote) :readable) "(dilambda (lambda () 1) #_quasiquote)") (test (let ((str (object->string (dilambda (lambda (x) x) logior) :readable))) (pair? (member str '("(dilambda (lambda (x) x) #_logior)" "(dilambda (lambda (x) x) logior)")))) #t) (test (let () (define-macro (mac x) `(+ ,x 1)) (object->string (dilambda (lambda () 1) mac) :readable)) "(dilambda (lambda () 1) (lambda (x) (list-values '+ x 1)))") (test (object->string (dilambda (lambda (x) x) (lambda* (x y . z) x)) :readable) "(dilambda (lambda (x) x) (lambda* (x y . z) x))") (test (object->string (dilambda (lambda (x) x) (lambda (x . y) x)) :readable) "(dilambda (lambda (x) x) (lambda (x . y) x))") (test (object->string (dilambda (lambda* (x) x) (lambda* ((x 1) :rest y) x)) :readable) "(dilambda (lambda* (x) x) (lambda* ((x 1) :rest y) x))")) ;;; -------------------------------------------------------------------------------- ;;; copy (test (copy 3) 3) (test (copy 3/4) 3/4) (test (copy "hi") "hi") (test (copy 'hi) 'hi) (test (copy (list 1 2 3)) (list 1 2 3)) (test (copy (vector 0.0)) (vector 0.0)) (let ((bv (make-byte-vector 10 2))) (test (copy bv) bv)) (let ((iv (make-int-vector 10 2))) (test (copy iv) iv)) (let ((fv (make-float-vector 10 2.5))) (test (copy fv) fv)) (test (copy #\f) #\f) (test (copy (list 1 (list 2 3))) (list 1 (list 2 3))) (test (copy (cons 1 2)) (cons 1 2)) (test (let ((x (list 1 2 3))) (eq? (copy x) x)) #f) (test (let ((x (list 1 2 3))) (equal? (copy x) x)) #t) (test (let ((x #(1 2 3))) (eq? (copy x) x)) #f) (test (let ((x #(1 2 3))) (equal? (copy x) x)) #t) (test (let ((x "hi")) (eq? (copy x) x)) #f) (test (let ((x "hi")) (equal? (copy x) x)) #t) (test (copy '(1 2 . 3)) '(1 2 . 3)) (test (copy (+)) 0) (test (copy +) +) (test (copy (#(#() #()) 1)) #()) (test (copy #f) #f) (test (copy ()) ()) (test (copy #()) #()) (test (copy #2d((1 2) (3 4))) #2d((1 2) (3 4))) (test (let ((f (lambda () 1))) ((copy f))) 1) (test (let ((f (lambda () 1))) (eq? (copy f) f)) #f) (test (let ((f (lambda* ((a 2)) (+ a 1)))) ((copy f))) 3) (test (let ((f (lambda* ((a 2)) (+ a 1)))) (eq? (copy f) f)) #f) (test (copy 1.0) 1.0) (test (copy 1.0+i) 1.0+i) (test (copy "") "") (test (copy #t) #t) (test (copy (string #\a #\null #\b)) "a\x00;b") (test (copy #) #) (test ((copy abs) -123) 123) (test (copy ''1) ''1) (test (copy '''1) '''1) (test (copy not) not) (test (copy "a\x00;b") "a\x00;b") (test (infinite? (copy (log 0.0))) #t) (test (nan? (copy 1/0)) #t) (test (copy if) if) (test (copy quote) quote) (test (let ((a 1) (b 2)) (equal? (copy (curlet)) (curlet))) #t) (test (copy (rootlet)) (rootlet)) (test (copy (funclet abs)) (rootlet)) (test (copy (funclet quasiquote)) (rootlet)) (test (eval '(+ a 1) (copy (sublet (curlet) '(a . 2)))) 3) (test (copy #) #) (test (copy _undef_) _undef_) (test (object->string (copy *s7*)) "(inlet 'let-ref-fallback s7-let-ref 'let-set-fallback s7-let-set)") (test (copy (list 1 2 (list 3 4))) '(1 2 (3 4))) (test (copy (cons 1 2)) '(1 . 2)) (test (copy '(1 2 (3 4) . 5)) '(1 2 (3 4) . 5)) (test (copy ()) ()) (let ((L '(1 (2 . 3) (4 5 . 6)))) (test L (copy L))) (test (let ((L '((1 2 (3 . 4)) ((5 . 6))))) (object->string (copy L))) "((1 2 (3 . 4)) ((5 . 6)))") (test (copy) 'error) (test (copy () () ()) 'error) (test (copy (make-hash-table) pi) 'error) (test (copy 1 3) 'error) (test (copy #() abs) 'error) (test (let ((x 0)) (copy 0 x)) 'error) (test (let () (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (copy 0 x)))) 'error) (test (let () (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (copy 0 x))) 'error) (test (let ((x 0)) (set! x (copy 0 x))) 'error) (test (let () (define (func) (let ((x 0)) (set! x (copy 0 x)))) (func)) 'error) ;;; 2 arg version of copy (test (copy (list 1 2) (vector 0 0)) #(1 2)) (test (copy (list 1 2) (vector 0)) #(1)) (test (copy (list 1 2) (vector)) #()) (test (copy (list) (vector)) #()) (test (copy (list 1 2) (vector 0 0 3 4)) #(1 2 3 4)) ; should (copy 1 2) be an error? (test (copy #2d((1 2) (3 4)) (vector 0 0 0 0 0)) #(1 2 3 4 0)) (test (copy (vector 0 0 0 0 0) #2d((1 2) (3 4))) #2d((0 0) (0 0))) (test (copy (vector 1 2 3 4 5) #2d((0 0) (0 0))) #2d((1 2) (3 4))) (test (copy "12345" (make-list 5)) '(#\1 #\2 #\3 #\4 #\5)) (test (copy (list #\0 #\1 #\2) (make-string 3)) "012") (test (copy '(0 1 2 3) (list 4 3 2 1)) '(0 1 2 3)) (test (copy #(0 1 2 3) (vector 4 3 2 1)) #(0 1 2 3)) (test (copy "12345" (make-string 5)) "12345") (test (copy "12345" (make-byte-vector 5)) #u(49 50 51 52 53)) (test (copy '(4 3 2 1) '(1 . 2)) '(4 . 2)) (test (copy (string (integer->char 255)) (vector 0)) #(#\xff)) (test (copy (vector (integer->char 255)) (string #\a)) (string (integer->char 255))) (test (copy #() "") "") (test (copy "" #()) #()) (test (copy #() (vector 1 2 3)) #(1 2 3)) (test (copy (make-float-vector 3 0.0)) (make-float-vector 3 0.0)) (test (copy (make-int-vector 3 0)) (make-int-vector 3 0)) (test (copy (make-int-vector '(2 3) 0)) (make-int-vector '(2 3) 0)) (test (eq? (copy 1) 1) #f) (test (eq? (copy 1.0) 1.0) #f) (test (eq? (copy 2/3) 2/3) #f) ;(test (eq? (copy "") "") #f) ; 23-Apr-24 these might both be nil_string (test (let ((i 1)) (eq? i (copy i))) #f) (test (let ((r 2.0)) (eq? r (copy r))) #f) (test (copy #u(101 102) (vector 1 2)) #(101 102)) (if with-block (test (copy (block 1.0) (immutable! (block 2.0))) 'error)) (test (pair? (copy *s7* (make-list (length *s7*)))) #t) (test (copy (vector 1 2 3 4 5) (vector 1 2 3) 0 5) #(1 2 3)) (test (copy (vector 1 2 3 4 5) (vector 1 2 3) 0 1) #(1 2 3)) (test (copy (vector 1 2 3 4 5) (vector 0 0 0) 0 1) #(1 0 0)) (test (copy (vector 1 2 3 4 5) (vector 0 0 0) 1 1) #(0 0 0)) (test (copy (vector 1 2 3 4 5) (vector 0 0 0) 1 2) #(2 0 0)) (test (copy (vector 1 2 3 4 5) (vector 0 0 0) 0 10) 'error) ;error: copy fourth argument, 10, is out of range (it is too large)) (test (copy (vector 1 2 3 4 5) (vector 0 0 0) 0 4) #(1 2 3)) (test (copy (vector 1 2 3) (vector 0 0 0 0 0 0) 0 4) 'error) ;error: copy fourth argument, 4, is out of range (it is too large)) (test (copy (vector 1 2 3) (vector 0 0 0 0 0 0) 0 2) #(1 2 0 0 0 0)) (test (copy (vector 1 2 3 4 5) (vector 0) 0 2) #(1)) (test (copy (vector 1 2 3 4 5) (vector 0) 0 20) 'error) ;error: copy fourth argument, 20, is out of range (it is too large)) (test (copy (vector 1 2 3 4 5) (vector 0) 0 6) 'error) ;error: copy fourth argument, 6, is out of range (it is too large)) (test (copy (vector 1 2 3 4 5) (vector 0) 0 5) #(1)) (let ((v1 (make-vector 8 'a symbol?))) (set! (v1 0) 'b) (test (equal? v1 (copy v1)) #t)) (let ((v1 (make-vector '(2 3) 'a symbol?))) (set! (v1 0 0) 'b) (test (equal? v1 (copy v1)) #t)) (let ((v1 (make-vector 3 12 integer?))) (set! (v1 0) 123) (test (equal? v1 (copy v1)) #t)) (let ((v1 (make-vector 3 12.0 float?))) (set! (v1 0) 123.0) (test (equal? v1 (copy v1)) #t)) (let ((v1 (make-vector 8 'a symbol?)) (v2 (make-vector 8 'a symbol?))) (set! (v1 0) 'b) (test (equal? v1 (copy v1 v2)) #t)) (let ((v1 (make-vector '(2 3) 'a symbol?)) (v2 (make-vector '(2 3) 'a symbol?))) (set! (v1 0 0) 'b) (test (equal? v1 (copy v1 v2)) #t)) (let ((v1 (make-vector 3 12 integer?)) (v2 (make-vector 3 12 integer?))) (set! (v1 0) 123) (test (equal? v1 (copy v1 v2)) #t)) (let ((v1 (make-vector 8 'a symbol?)) (v2 (make-vector 8 'a symbol?))) (test (equal? v1 (copy v1 v2 1 3)) #t)) (let ((v1 (make-vector '(2 3) 'a symbol?)) (v2 (make-vector '(2 3) 'a symbol?))) (test (equal? v1 (copy v1 v2 0 3)) #t)) (let ((v1 (make-vector 3 12 integer?)) (v2 (make-vector 3 12 integer?))) (set! (v1 0) 123) (set! (v1 1) 321) (test (equal? v1 (copy v1 v2 0 2)) #t)) (let ((v1 (make-vector 8 #\a char?))) (do ((i 0 (+ i 1))) ((= i 8)) (set! (v1 i) (integer->char (+ 70 i)))) (test (equal? v1 (copy v1)) #t)) (let ((<1> (list #f #f #f)) (<2> (list 1 1 1))) (set-cdr! (list-tail <1> 2) <1>) (set-cdr! (list-tail <2> 2) <2>) (test (copy (make-byte-vector 256 1) <1>) <2>)) (let ((lst (list 1 2 3))) ; segfault before source==dest check (test (copy lst lst) lst) (test (copy lst lst 1) (list 2 3 3))) (when with-block (let ((b (copy (block 1 2 3 4)))) (test b (block 1 2 3 4)) (fill! b 0 1 3) (test b (block 1 0 0 4)) (let ((b1 (block 1 1 1 1 1))) (copy b b1) (test b1 (block 1 0 0 4 1))) (let ((b2 (block 1 2 3))) (let ((b3 (copy b b2))) (test (eq? b2 b3) #t) (test b3 (block 1 0 0)))) (let ((b4 (block 5 6 7 8))) (copy b4 b 1) (test b (block 6 7 8 4)))) (let ((b (block 1 2 3 4))) (copy #r(0 3 6) b) (test b (block 0 3 6 4)) (copy #(10 11 12 13 14) b) (test b (block 10 11 12 13)) (copy '(0 2) b) (test b (block 0 2 12 13)) (copy #u(0 0 100 101) b 2) (test b (block 100 101 12 13)) (copy #r(0 1 2 3 4) b 1 3) (test b (block 1 2 12 13)) (test (copy #r(0 1 2 3 4 5 6) b 3 12) 'error)) (let ((b (block 1 2 3)) (v (float-vector 0 0 0))) (copy b v) (test v (float-vector 1 2 3)) (copy (list 3 2 1) b) (test b (block 3 2 1)))) (let ((lst (list 1 2 3))) (set! (cdr (cddr lst)) lst) (test (copy lst lst) lst) (test (copy lst (make-list 15 5)) '(1 2 3 5 5 5 5 5 5 5 5 5 5 5 5))) ; was going around twice (let ((v (vector 1 2 3))) (test (copy v v) v) (test (copy v v 1 3) #(2 3 3))) (test (copy #(1 2 3 4 5 6) (make-list 3) 0 3) '(1 2 3)) (test (copy #(1 2 3 4 5 6) (make-list 3) 0) '(1 2 3)) (test (copy #(1 2 3 4 5 6) (make-list 3) 1) '(2 3 4)) (test (copy #(1 2 3 4 5 6) (make-list 3 0) 5) '(6 0 0)) (test (copy #(1 2 3 4 5 6) (make-list 3)) '(1 2 3)) (test (copy #(1 2 3 4 5 6) (make-list 3) 1 4) '(2 3 4)) (test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 2) '(2 #f #f)) (test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 1) '(#f #f #f)) (test (copy #(1 2 3 4 5 6) (make-list 3 #f) -1 1) 'error) (test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 7) 'error) (test (copy #(1 2 3 4 5 6) (make-list 3 #f) 1 0) 'error) (test (copy #(1 2 3 4 5 6) () 1 2) ()) (test (copy #(1 2 3 4 5 6) ()) ()) (test (copy #(1 2 3 4 5 6) (make-list 6 #f) 2) '(3 4 5 6 #f #f)) (test (copy #(1 2 3 4 5 6) '(0 0 0 . 3)) '(1 2 3 . 3)) (let ((lst (list 7 8 9))) (set! (cdr (cddr lst)) lst) (copy #(1 2 3 4 5 6) lst 0 1) (test (car lst) 1) (copy #(1 2 3 4 5 6) lst 1 4) (test (car lst) 2)) (test (copy #(#\a #\b #\c) (make-string 2) 1) "bc") (test (copy '(#\a #\b #\c) (make-string 2) 1) "bc") (test (copy "abc" (make-string 2) 1) "bc") (test (copy "abc" (make-vector 2) 1) #(#\b #\c)) (test (copy "abc" (make-list 2) 1) '(#\b #\c)) (test (copy '(1 2 3) (make-list 2) 1) '(2 3)) (test (copy '(1 2 3) (make-vector 2) 1) #(2 3)) (test (copy #(1 2 3) (make-vector 2) 1) #(2 3)) (test (copy #(1 2 3) (make-list 2) 1) '(2 3)) (let ((orig "0123456789")) (let ((iv (copy (string->byte-vector orig) (make-int-vector 10)))) (test (byte-vector->string (string->byte-vector (copy iv (make-string 10)))) orig))) (test (copy "0123456789" (make-float-vector 10)) (float-vector 48 49 50 51 52 53 54 55 56 57)) (test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f)) (inlet 'd 4 'c 3 'b 2 'a 1)) (test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 0)) (inlet 'd 4 'c 3 'b 2 'a 1)) (test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 1)) (inlet 'b 2 'c 3 'd 4)) (test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy e f 1 2)) (inlet 'd 4 'b 2)) (test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'd 4))) (copy f e)) (inlet 'a 1 'b 2 'c 3 'd 4)) ;; printout is confusing (is this a reversal in this slot list, or a let-id side-effect?) (test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'a 100 'b 200 'c 300 'd 400))) ((copy e f) 'a)) 100) ; this is a bad test -- depends on order whereas let should not (test (let ((f (inlet 'a 100 'b 200 'c 300 'd 400)) (e (inlet 'a 1 'b 2 'c 3))) ((copy e f) 'a)) 1) (test (let ((e (inlet 'a 1 'b 2 'c 3)) (f (inlet 'a 100 'b 200 'c 300 'd 400))) (copy e f)) (inlet 'c 3 'b 2 'a 1 'a 100 'b 200 'c 300 'd 400)) (test (weak-hash-table? (copy (weak-hash-table))) #t) (test (object->string (copy (weak-hash-table 'a 1))) "(weak-hash-table 'a 1)") (let ((e1 (inlet 'a 1 'b 2)) (e2 (inlet 'a 3 'c 3)) (v1 (vector 1 2)) (v2 (vector 3 4)) (i1 (int-vector 5 6)) (i2 (int-vector 7 8)) (h1 (hash-table 'd 4 'e 5)) (h2 (hash-table 'f 6 'e 7)) (f1 (float-vector 9 10)) (f2 (float-vector 11 12)) (p1 (list 13 14)) (p2 (list 15 16)) (b1 (if with-block (block 17 18) (float-vector 17 18))) (b2 (if with-block (block 19 20) (float-vector 19 20))) (s1 (make-string 2 #\a)) (s2 (make-string 2 #\b))) (test (copy e1 e2) (inlet 'a 1 'b 2 'a 3 'c 3)) (test (copy e1 v2) #((a . 1) (b . 2))) (test (copy e1 i2) 'error) (test (copy e1 f2) 'error) (test (copy e1 h2) (hash-table 'a 1 'b 2 'e 7 'f 6)) (test (copy e1 p2) '((a . 1) (b . 2))) (if with-block (test (copy e1 b2) 'error)) (test (copy e1 s2) 'error) (test (copy v1 e2) 'error) (test (copy v1 v2) #(1 2)) (test (copy v1 i2) (int-vector 1 2)) (test (copy v1 f2) (float-vector 1.0 2.0)) (test (copy v1 h2) 'error) (test (copy v1 p2) '(1 2)) (if with-block (test (copy v1 b2) (block 1.000 2.000))) (test (copy v1 s2) 'error) (test (copy i1 e2) 'error) (test (copy i1 v2) #(5 6)) (test (copy i1 i2) (int-vector 5 6)) (test (copy i1 f2) (float-vector 5.0 6.0)) (test (copy i1 h2) 'error) (test (copy i1 p2) '(5 6)) (if with-block (test (copy i1 b2) (block 5.000 6.000))) (test (copy i1 s2) "\x05;\x06;") (test (copy f1 e2) 'error) (test (copy f1 v2) #(9.0 10.0)) (test (copy f1 i2) 'error) ;(int-vector 9 10)) (test (copy f1 f2) (float-vector 9.0 10.0)) (test (copy f1 h2) 'error) (test (copy f1 p2) '(9.0 10.0)) (if with-block (test (copy f1 b2) (block 9.000 10.000))) (test (copy f1 s2) 'error) (test (copy h1 e2) (inlet 'd 4 'e 5 'b 2 'a 1 'a 3 'c 3)) (test (let ((h (copy h1 v2))) (or (equal? h #((d . 4) (e . 5))) (equal? h #((e . 5) (d . 4))))) #t) (test (copy h1 i2) 'error) (test (copy h1 f2) 'error) (test (copy h1 h2) (hash-table 'a 1 'b 2 'd 4 'e 5 'f 6)) (test (let ((p (copy h1 p2))) (or (equal? p '((d . 4) (e . 5))) (equal? p '((e . 5) (d . 4))))) #t) (test (copy h1 b2) 'error) (test (copy h1 s2) 'error) (test (copy p1 e2) 'error) (test (copy p1 v2) #(13 14)) (test (copy p1 i2) (int-vector 13 14)) (test (copy p1 f2) (float-vector 13.0 14.0)) (test (copy p1 h2) 'error) (test (copy p1 p2) '(13 14)) (test (copy p1 b2) (if with-block (block 13.000 14.000) (float-vector 13.0 14.0))) (test (copy p1 s2) 'error) (test (copy b1 e2) 'error) (test (copy b1 v2) #(17.0 18.0)) (test (copy b1 i2) 'error) ;(int-vector 17 18)) (test (copy b1 f2) (float-vector 17.0 18.0)) (test (copy b1 h2) 'error) (test (copy b1 p2) '(17.0 18.0)) (test (copy b1 b2) (if with-block (block 17.000 18.000) (float-vector 17.0 18.0))) (test (copy b1 s2) 'error) (test (copy s1 e2) 'error) (test (copy s1 v2) #(#\a #\a)) (test (copy s1 i2) (int-vector 97 97)) (test (copy s1 f2) (float-vector 97.0 97.0)) (test (copy s1 h2) 'error) (test (copy s1 p2) '(#\a #\a)) (if with-block (test (copy s1 b2) 'error)) (test (copy s1 s2) "aa")) (let ((e1 (inlet 'a 1 'b 2)) (e2 (inlet 'a 3 'c 3)) (v1 (vector 1 2)) (v2 (vector 3 4)) (i1 (int-vector 5 6)) (i2 (int-vector 7 8)) (h1 (hash-table 'd 4 'e 5)) (h2 (hash-table 'f 6 'e 7)) (f1 (float-vector 9 10)) (f2 (float-vector 11 12)) (p1 (list 13 14)) (p2 (list 15 16)) (b1 (if with-block (block 17 18) (float-vector 17 18))) (b2 (if with-block (block 19 20) (float-vector 19 20))) (s1 (make-string 2 #\a)) (s2 (make-string 2 #\b))) (test (copy e1 e2 1) (inlet 'a 3 'c 3 'b 2)) (test (copy e1 v2 1) #((b . 2) 4)) (test (copy e1 i2 1) 'error) (test (copy e1 f2 1) 'error) (test (copy e1 h2 1) (hash-table 'b 2 'e 7 'f 6)) (test (copy e1 p2 1) '((b . 2) 16)) (if with-block (test (copy e1 b2 1) 'error)) (test (copy e1 s2 1) 'error) (test (copy v1 e2 1) 'error) (test (copy v1 v2 1) #(2 4)) (test (copy v1 i2 1) (int-vector 2 8)) (test (copy v1 f2 1) (float-vector 2.0 12.0)) (test (copy v1 h2 1) 'error) (test (copy v1 p2 1) '(2 16)) (if with-block (test (copy v1 b2 1) (block 2.000 20.000))) (test (copy v1 s2 1) 'error) (test (copy i1 e2 1) 'error) (test (copy i1 v2 1) #(6 4)) (test (copy i1 i2 1) (int-vector 6 8)) (test (copy i1 f2 1) (float-vector 6.0 12.0)) (test (copy i1 h2 1) 'error) (test (copy i1 p2 1) '(6 16)) (if with-block (test (copy i1 b2 1) (block 6.000 20.000))) (test (copy i1 s2 1) "\x06;b") (test (copy f1 e2 1) 'error) (test (copy f1 v2 1) #(10.0 4)) (test (copy f1 i2 1) 'error) ;(int-vector 10 8)) (test (copy f1 f2 1) (float-vector 10.0 12.0)) (test (copy f1 h2 1) 'error) (test (copy f1 p2 1) '(10.0 16)) (if with-block (test (copy f1 b2 1) (block 10.000 20.000))) (test (copy f1 s2 1) 'error) (test (let ((v (copy h1 v2 1))) (or (equal? v #((e . 5) 4)) (equal? v #((d . 4) 4)))) #t) (test (copy h1 i2 1) 'error) (test (copy h1 f2 1) 'error) (test (let ((h (copy h1 h2 1))) (or (equal? h (hash-table 'b 2 'e 5 'f 6)) (equal? h (hash-table 'e 7 'b 2 'f 6 'd 4)))) ; ?? #t) (test (let ((p (copy h1 p2 1))) (or (equal? p '((e . 5) 16)) (equal? p '((d . 4) 16)))) #t) (test (copy h1 b2 1) 'error) (test (copy h1 s2 1) 'error) (test (copy p1 e2 1) 'error) (test (copy p1 v2 1) #(14 4)) (test (copy p1 i2 1) (int-vector 14 8)) (test (copy p1 f2 1) (float-vector 14.0 12.0)) (test (copy p1 h2 1) 'error) (test (copy p1 p2 1) '(14 16)) (test (copy p1 b2 1) (if with-block (block 14.000 20.000) (float-vector 14.0 20.0))) (test (copy p1 s2 1) 'error) (test (copy b1 e2 1) 'error) (test (copy b1 v2 1) #(18.0 4)) (test (copy b1 i2 1) 'error) ;(int-vector 18 8)) (test (copy b1 f2 1) (float-vector 18.0 12.0)) (test (copy b1 h2 1) 'error) (test (copy b1 p2 1) '(18.0 16)) (test (copy b1 b2 1) (if with-block (block 18.000 20.000) (float-vector 18.0 20.0))) (test (copy b1 s2 1) 'error) (test (copy s1 e2 1) 'error) (test (copy s1 v2 1) #(#\a 4)) (test (copy s1 i2 1) (int-vector 97 8)) (test (copy s1 f2 1) (float-vector 97.0 12.0)) (test (copy s1 h2 1) 'error) (test (copy s1 p2 1) '(#\a 16)) (if with-block (test (copy s1 b2 1) 'error)) (test (copy s1 s2 1) "ab")) (for-each (lambda (x) (let ((y (copy x))) (if (not (equal? x y)) (format *stderr* ";(copy ~S) -> ~S?~%" x y)))) (list (list 1 2) (cons 1 2) #(1 2) #i(1 2) #u(1 2) #r(1 2) "12" (hash-table 'a 1) (inlet 'a 2))) #| (when full-s7test (let ((e1 (inlet 'a 1 'b 2)) (e2 (inlet 'a 3 'c 3)) (v1 (vector 1 2)) (v2 (vector 3 4)) (i1 (int-vector 5 6)) (i2 (int-vector 7 8)) (h1 (hash-table 'd 4 'e 5)) (h2 (hash-table 'f 6 'e 7)) (f1 (float-vector 9 10)) (f2 (float-vector 11 12)) (p1 (list 13 14)) (p2 (list 15 16)) (b1 (if with-block (block 17 18) (vector 17 18))) (b2 (if with-block (block 19 20) (vector 19 20))) (s1 (make-string 2 #\a)) (s2 (make-string 2 #\b))) (for-each (lambda (o1 o1name) (for-each (lambda (o2 o2name) (let ((val (catch #t (lambda () (copy o1 o2)) (lambda any 'error)))) (format *stderr* "(copy ~S ~S) -> '~S~%" o1name o2name val))) (list e2 v2 i2 f2 h2 p2 b2 s2) (list 'e2 'v2 'i2 'f2 'h2 'p2 'b2 's2))) (list e1 v1 i1 f1 h1 p1 b1 s1) (list 'e1 'v1 'i1 'f1 'h1 'p1 'b1 's1)))) |# (let () (define* (copy-1 s d start end) (let ((dend (length d)) (send (or end (length s)))) (if (not end) (set! end (length s))) (do ((i (or start 0) (+ i 1)) (j 0 (+ j 1))) ((or (= i end) (= j dend)) d) (set! (d j) (s i))))) (for-each (lambda (s1 s2) (for-each (lambda (start) (for-each (lambda (end) (for-each (lambda (d1 d2) (catch #t (lambda () (if end (copy s1 d1 (or start 0) end) (if start (copy s1 d1 start) (copy s1 d1))) (copy-1 s2 d2 start end) (if (not (equal? d1 d2)) (format *stderr* "(copy ~A ~A ~A) -> ~A ~A?~%" s1 start end d1 d2))) (lambda args 'error))) (list (vector 0 0 0) (make-int-vector 2 1) (make-float-vector 2 0.0) (string #\a #\b #\c #\d #\e) (string) (list) (vector) (if with-block (block 1.0 1.0) (float-vector 1.0 1.0)) (cons 1 2)) (list (vector 0 0 0) (make-int-vector 2 1) (make-float-vector 2 0.0) (string #\a #\b #\c #\d #\e) (string) (list) (vector) (if with-block (block 1.0 1.0) (float-vector 1.0 1.0)) (cons 1 2)))) (list #f 0 1 3))) (list #f 0 1 2))) (list (vector 1 2 3 4) (let ((v (make-int-vector 3 0))) (set! (v 0) 32) (set! (v 1) 16) (set! (v 2) 8) v) (list 1 2 3 4 5) (string #\a #\b) (string) (list) (vector) (cons 1 (cons 2 3)) (if with-block (block 1.0 2.0 3.0 4.0) (float-vector 1.0 2.0 3.0 4.0))) (list (vector 1 2 3 4) (let ((v (make-int-vector 3 0))) (set! (v 0) 32) (set! (v 1) 16) (set! (v 2) 8) v) (list 1 2 3 4 5) (string #\a #\b) (string) (list) (vector) (cons 1 (cons 2 3)) (if with-block (block 1.0 2.0 3.0 4.0) (float-vector 1.0 2.0 3.0 4.0))))) (test (copy -1 6) 'error) (for-each (lambda (arg) (test (copy arg #(1 2 3)) 'error) (test (copy #(1 2 3) arg) 'error)) (list -1 #\a 3.14 3/4 1.0+1.0i 'hi abs (lambda () #f) # # #)) (let ((ht (hash-table 'a 1))) (test (copy ht (make-vector 3 #f)) #((a . 1) #f #f)) (let ((e (inlet))) (copy ht e) (test (eval '(+ a 2) e) 3) (test (copy e #(1 2 3)) #((a . 1) 2 3)) (copy (list (cons 'b 2)) ht) (test (ht 'b) 2))) (let ((ht1 (hash-table 'a 1)) (ht2 (hash-table 123 2))) (copy ht2 ht1) (test (ht1 123) 2) (copy ht1 ht2) (test (ht2 'a) 1) (test (hash-table-entries ht2) 2) (test (let ((str (object->string ht2))) (or (string=? str "(hash-table 'a 1 123 2)") (string=? str "(hash-table 123 2 'a 1)"))) #t) (test (equal? ht1 ht2) #t)) (let ((ht1 (hash-table 'a 1)) (ht2 (make-hash-table))) (copy ht1 ht2) (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t) (test (equal? ht1 ht2) #t)) (let ((ht1 (hash-table 'a 1 'b 2 'c 3)) (ht2 (make-hash-table))) (copy ht1 ht2) (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t) (test (equal? ht1 ht2) #t)) (let ((ht1 (hash-table 'a 1 'b 2 'c 3)) (ht2 (make-hash-table))) (copy ht1 ht2 0 3) (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t) (test (equal? ht1 ht2) #t)) (let ((ht1 (hash-table 'a 1 'b 2 'c 3)) (ht2 (make-hash-table))) (copy ht1 ht2 1) ; either can be skipped here (test (= (hash-table-entries ht1) (+ (hash-table-entries ht2) 1)) #t) (test (equal? ht1 ht2) #f) (test (ht1 'a) 1) (test (ht1 'c) 3)) (let ((ht1 (hash-table 'a 1 'b 2 'c 3)) (ht2 (make-hash-table))) (copy ht1 ht2 1 2) (test (= (hash-table-entries ht1) (+ (hash-table-entries ht2) 2)) #t) (test (equal? ht1 ht2) #f) (test (ht1 'a) 1) (test (ht1 'c) 3)) (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 32) (test (equal? H (copy H)) #t)) (let ((ht1 (hash-table 'a 1)) (ht2 (hash-table "a" 2))) (copy ht1 ht2) (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #f) (test (equal? ht1 ht2) #f) (test (ht2 "a") 2) (test (ht2 'a) 1) (test (hash-table-entries ht2) 2)) (let ((ht1 (hash-table 'a 1 "a" 3)) (ht2 (hash-table "a" 2))) (copy ht1 ht2) (test (= (hash-table-entries ht1) (hash-table-entries ht2)) #t) (test (equal? ht1 ht2) #t) (test (ht2 "a") 3) (test (ht2 'a) 1) (test (hash-table-entries ht2) 2)) (when with-bignums (test (let ((x (bignum "1"))) (eq? x (copy x))) #f) (test (let ((x (bignum "1/2"))) (eq? x (copy x))) #f) (test (let ((x (bignum "1.0"))) (eq? x (copy x))) #f) (test (let ((x (bignum "1+i"))) (eq? x (copy x))) #f)) (test (let ((x 1)) (eq? x (copy x))) #f) (test (= 1 (copy 1)) #t) (test (= 1.5 (copy 1.5)) #t) (test (= 1/2 (copy 1/2)) #t) (test (= 1+i (copy 1+i)) #t) (test (let ((x "str")) (eq? x (copy x))) #f) (if (not (provided? 'gmp)) (let ((r1 (random-state 1234))) (random 1.0 r1) (let ((r2 (copy r1))) (let ((v1 (random 1.0 r1)) (v2 (random 1.0 r2))) (test (= v1 v2) #t) (let ((v3 (random 1.0 r1))) (random 1.0 r1) (random 1.0 r1) (let ((v4 (random 1.0 r2))) (test (= v3 v4) #t))))))) (if (provided? 'gmp) (let ((i (copy (bignum "1"))) (r (copy (bignum "3/4"))) (f (copy (bignum "1.5"))) (c (copy (bignum "1.0+1.0i")))) (test (= i (bignum "1")) #t) (test (= r (bignum "3/4")) #t) (test (= f (bignum "1.5")) #t) (test (= c (bignum "1.0+1.0i")) #t))) (let () (define (f1 a) (+ a 1)) (define f2 (copy f1)) (test (f1 1) (f2 1)) (define* (f3 (a 2)) (* a 2)) (define f4 (copy f3)) (test (f3 3) (f4 3)) (test (f3) (f4)) (define-macro (f5 a) `(+ ,a 1)) (define f6 (copy f5)) (test (f5 2) (f6 2))) (let () (define (engulph form) (let ((body `(let ((L ())) (do ((i 0 (+ i 1))) ((= i 10) (reverse L)) (set! L (cons ,form L)))))) (define function (apply lambda () (list (copy body :readable)))) ; an optimizable no-macro macro? (function))) (test (engulph '(+ i 1)) '(1 2 3 4 5 6 7 8 9 10))) (test (copy '((x)) (inlet 'a 1) (let ((local-func (lambda (x) x))) (local-func 0))) (inlet 'a 1 'x ())) (test (catch #t (lambda () (copy '((x)) (string #\a))) (lambda (type info) (apply format #f info))) "copy first element, (x), is a pair but should be a character") (test (copy '(+ 1 2) :readable 1 3) 'error) (let* ((Lq '((() <1>) (() <2>))) (L1 (copy Lq :readable)) (L2 (copy Lq :readable))) (set-car! (cdar L1) '<4>) (test L1 '((() <4>) (() <2>))) (test Lq '((() <1>) (() <2>))) (test L2 '((() <1>) (() <2>)))) (test (copy (let ((L (list 1))) (set-cdr! L L)) :readable) 'error) ; "tree is cyclic" (test (length (copy (let ((L (list 1))) (set-cdr! L L)))) +inf.0) (test (copy (let ((<1> (list 1 #f))) (set! (<1> 1) (let (( (list #f 3))) (set-car! <1>) )) <1>) :readable) 'error) (test (length (copy (let ((<1> (list 1 #f))) (set! (<1> 1) (let (( (list #f 3))) (set-car! <1>) )) <1>))) 2) (test (let ((x (list 1 2))) (let ((y (cons x x))) (let ((z (copy y))) (list (eq? (car y) (cdr y)) (eq? (car z) (cdr z)))))) '(#t #f)) (let () ; opt_do_copy (define (vcop-1 a b start end) (do ((i (- end 1) (- i 1))) ((< i start) b) (vector-set! b i (vector-ref a i)))) (define (vcop+1 a b start end) (do ((i start (+ i 1))) ((= i end) b) (vector-set! b i (vector-ref a i)))) (let ((a (vector 0 1 2 3 4 5 6 7 8 9)) (b (make-vector 20 10))) (test (vcop-1 a b 0 10) #(0 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10)) (fill! b 10) (test (vcop+1 a b 0 10) #(0 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10)) (fill! b 10) (test (vcop-1 a b 2 7) #(10 10 2 3 4 5 6 10 10 10 10 10 10 10 10 10 10 10 10 10)) (fill! b 10) (test (vcop+1 a b 2 7) #(10 10 2 3 4 5 6 10 10 10 10 10 10 10 10 10 10 10 10 10)) (fill! b 10) (test (vcop-1 a b 2 27) 'error) (fill! b 10) (test (vcop-1 a b -2 27) 'error)) (let ((a (vector 0 1 2 3 4 5 6 7 8 9)) (b (make-vector 10 10))) (test (vcop-1 a b 0 10) #(0 1 2 3 4 5 6 7 8 9)) (fill! b 10) (test (vcop+1 a b 0 10) #(0 1 2 3 4 5 6 7 8 9)) (fill! b 10) (test (vcop-1 a b 2 7) #(10 10 2 3 4 5 6 10 10 10)) (fill! b 10) (test (vcop+1 a b 2 7) #(10 10 2 3 4 5 6 10 10 10)) )) (when full-s7test (let () (define (fltv) (let ((v1 (make-float-vector 2048 1.0)) (v2 (make-float-vector 2048 0.0))) (copy v1 v2) (call-with-exit (lambda (quit) (do ((i 0 (+ i 1))) ((= i 2048)) (unless (= (v2 i) 1.0) (format *stderr* "flt (v2 ~D): ~S~%" i (v2 i)) (quit))))))) (fltv) (define (ivs) (for-each (lambda (maker name) (let ((v1 (maker 2048 1)) (v2 (maker 2048 0))) (copy v1 v2) (call-with-exit (lambda (quit) (do ((i 0 (+ i 1))) ((= i 2048)) (unless (= (v2 i) 1) (format *stderr* "~A (v2 ~D): ~S~%" name i (v2 i)) (quit))))))) (list make-int-vector make-byte-vector make-vector) (list "int" "byte" "normal"))) (ivs) (define (strv) (let ((v1 (make-string 2048)) (v2 (make-string 2048))) (do ((i 0 (+ i 1))) ((= i 2048)) (set! (v1 i) (integer->char (modulo i 128)))) (copy v1 v2) (call-with-exit (lambda (quit) (do ((i 0 (+ i 1))) ((= i 2048)) (unless (char=? (v1 i) (v2 i)) (format *stderr* "str (v1 ~D): ~S, (v2 ~D): ~S~%" i (v1 i) i (v2 i)) (quit))))))) (strv))) ;;; -------- (let ((c1 #f)) (call/cc (lambda (c) (test (reverse c) 'error) (test (fill! c) 'error) (test (length c) #f) (test (eq? c c) #t) ; is this the norm? (test (equal? c c) #t) (test (equal? c (copy c)) #t) (set! c1 c))) (test (continuation? c1) #t)) (let ((c1 #f)) (call-with-exit (lambda (c) (test (reverse c) 'error) (test (fill! c) 'error) (test (length c) #f) (test (eq? c c) #t) (test (equal? c c) #t) (test (equal? c (copy c)) #t) (set! c1 c))) (test (procedure? c1) #t)) ;;; length (test (length (list 1 2)) 2) (test (length "hiho") 4) (test (length (vector 1 2)) 2) (test (>= (length (make-hash-table 7)) 7) #t) (test (length ()) 0) (test (length (#(#() #()) 1)) 0) (test (length abs) #f) (when with-block (test (length (block 1.0 2.0 3.0)) 3)) (test (length (make-iterator "123")) 3) ; this is not completely correct in all cases ;;; -------------------------------------------------------------------------------- ;;; fill! (let ((str (string #\1 #\2 #\3))) (fill! str #\x) (test str "xxx")) (let ((v (vector 1 2 3))) (fill! v 0.0) (test v (vector 0.0 0.0 0.0))) (let ((lst (list 1 2 (list (list 3) 4)))) (fill! lst 100) (test lst '(100 100 100))) (let ((cn (cons 1 2))) (fill! cn 100) (test cn (cons 100 100))) (test (fill! 1 0) 'error) (test (fill! 'hi 0) 'error) (test (let ((x (cons 1 2))) (fill! x 3) x) '(3 . 3)) (test (let ((x "")) (fill! x #\c) x) "") (test (let ((x ())) (fill! x #\c) x) ()) (test (let ((x #())) (fill! x #\c) x) #()) (test (let ((x #(0 1))) (fill! x -1) (set! (x 0) -2) x) #(-2 -1)) (test (let ((x #(0 0))) (fill! x #(1)) (object->string x)) "#(#(1) #(1))") ; was "#(#1=#(1) #1#)" (test (let ((lst (list "hi" "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi"))) #t) (test (let ((lst (list "hi" "hi"))) (fill! lst "hi") (equal? lst '("hi" "hi"))) #t) (test (let ((lst (list 1 2 3 4))) (fill! lst "hi") (equal? lst '("hi" "hi" "hi" "hi"))) #t) (test (let ((lst (list 1 2 3))) (fill! lst lst) (object->string lst)) "#1=(#1# #1# #1#)") (test (let ((lst (vector 1 2 3))) (fill! lst lst) (object->string lst)) "#1=#(#1# #1# #1#)") (test (let ((lst #2d((1) (1)))) (fill! lst lst) (object->string lst)) "#1=#2d((#1#) (#1#))") (test (let ((lst '(1 2 3))) (fill! lst (cons 1 2)) (set! (car (car lst)) 3) (caadr lst)) 3) (test (let ((lst (list))) (fill! lst 0) lst) ()) (test (let ((lst (list 1))) (fill! lst 0) lst) '(0)) (test (let ((lst (list 1 2))) (fill! lst 0) lst) '(0 0)) (test (let ((lst (list 1 (list 2 3)))) (fill! lst 0) lst) '(0 0)) (test (let ((lst (cons 1 2))) (fill! lst 0) lst) '(0 . 0)) (test (let ((lst (cons 1 (cons 2 3)))) (fill! lst 0) lst) '(0 0 . 0)) (let ((lst (make-list 3))) (fill! lst lst) (test lst (lst 0)) (set! (lst 1) 32) (test ((lst 0) 1) 32)) (when with-block (let ((b (make-block 4))) (fill! b 32.0) (test b (block 32.0 32.0 32.0 32.0)))) (test (fill!) 'error) (test (fill! '"hi") 'error) (test (fill! (begin) if) if) (test (fill! (rootlet) 3) 'error) (test (fill! (rootlet) #f) 'error) ;(test (fill! (owlet) 3) 'error) ;; (owlet) copies sc->owlet (let ((a 2) (e #f)) (set! e (curlet)) (test (begin (fill! e 3) a) 3)) (test (fill! "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" #f) 'error) (let ((v (make-int-vector 3 0))) (fill! v 32) (test v (make-int-vector 3 32))) (test (fill! (byte-vector 0) 300) 'error) (test (fill! (byte-vector 0) -1) 'error) (test (fill! () 1 2) 'error) (test (fill! "" #\a) #\a) ; !? (test (fill! "" #u(65)) 'error) (test (fill! () :allow-other-keys #i(10)) 'error) (for-each (lambda (arg) (test (fill! arg 1) 'error)) (list (integer->char 65) #f 'a-symbol abs quasiquote macroexpand 1/0 (log 0) # # # (lambda (a) (+ a 1)) 3.14 3/4 1.0+1.0i #\f #t :hi (if #f #f) (lambda (a) (+ a 1)))) (for-each (lambda (arg) (let ((str (string #\a #\b))) (test (fill! str arg) 'error))) (list "hi" '(1 2 3) #() #f 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)))) (let ((ht (hash-table :a 1))) (for-each (lambda (arg) (test (fill! ht arg) arg) (test (ht :a) arg)) (list "hi" '(1 2 3) #() 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1)) #f))) (let ((str (make-string 10 #\a))) (fill! str #\b 0 2) (test str "bbaaaaaaaa") (fill! str #\c 8) (test str "bbaaaaaacc") (test (fill! str #\d -1) 'error) (test (fill! str #\d 1 0) 'error) (fill! str #\d 4 4) (test str "bbaaaaaacc")) (let ((v (vector 1 2 3 4))) (fill! v 5 2 3) (test v #(1 2 5 4)) (fill! v 6 2) (test v #(1 2 6 6))) (let ((v (float-vector 1.0 2.0 3.0))) (test (fill! v 0.0 0 4) 'error) (test (fill! v 0.0 4 4) 'error) (fill! v 0.0 1) (test v (float-vector 1.0 0.0 0.0))) (let ((v (int-vector 1 2 3))) (test (fill! v 0 0 4) 'error) (test (fill! v 0 4 4) 'error) (fill! v 0 1) (test v (int-vector 1 0 0))) (let ((p (list 0 1 2 3 4))) (fill! p 5 3) (test p (list 0 1 2 5 5)) (fill! p 6 0 3) (test p (list 6 6 6 5 5))) (let ((p (cons 1 2))) (fill! p 3 0) (test p (cons 3 3)) (set! p (cons 0 (cons 1 2))) (fill! p 4 0 1) ; "end" is ambiguous here (test p '(4 1 . 2)) (fill! p 5 1) (test p '(4 5 . 5))) (test (let ((e (let ((i 0)) (set! (setter 'i) integer?) (curlet)))) (fill! e #f) e) 'error) ;;; -------- ;; fill! ignores (can't find) the setter (except in a let), but can see typers: (let ((L (list 1 2 3))) (set! (setter 'L) (lambda (s v) (error 'oops "can't fill! ~A" s))) (fill! L 12) (test L '(12 12 12))) (let ((str "asdf")) (set! (setter 'str) (lambda (s v) (error 'oops "can't fill! ~A" s))) (fill! str #\d) (test str "dddd")) (let ((v (make-vector 3 1))) (set! (setter 'v) (lambda (s v) (error 'oops "can't fill! ~A" s))) (fill! v 2) (test v #(2 2 2))) (let ((v (make-vector 3 1/2 rational?))) (test (fill! v 2+i) 'error)) (let ((lt (inlet 'a 1))) (set! (setter 'lt) (lambda (s v) (error 'oops "can't fill! ~A" s))) (fill! lt 2) (test (equal? lt (inlet 'a 2)) #t)) (let ((lt (let ((a 2)) (set! (setter 'a) (lambda (s v) (error 'oops "can't set! ~A to ~A" s v))) (curlet)))) (test (fill! lt 2) 'error)) ; but 'a is already 2 (let ((lt (let ((a 2)) (set! (setter 'a) (lambda (s v) (error 'oops "can't set! ~A to ~A" s v))) (curlet)))) (test (fill! lt 12) 'error)) (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 1) (fill! H #f) (test H (hash-table))) (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 1) (set! (H 'a) #f) ; here the value-typer is ignored, #f is always ok (test H (hash-table))) (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 1) (test (fill! H #\a) 'error)) ;; and fill! is not as flexible as set!: (let ((v (let ((vect (vector 1 2 3))) (dilambda (lambda (index) (vector-ref vect index)) (lambda (index new-value) (if (< (abs new-value) 10) (vector-set! vect index new-value) (error 'wring-type-arg "can't set (v ~D) to ~S" index new-value))))))) (test (v 0) 1) (set! (v 1) -3) (test (v 1) -3) (test (set! (v 1) 32) 'error) (test (fill! v 3) 'error)) ; fill! first argument, v, is a function but should be a sequence ;; not ideal... ;; and copy is worse than fill!: ;; (copy '(1 2 3) *features*) ; '(1 2 3 ...)! (let ((L (list 1 2 3))) (set! (setter 'L) (lambda (s v) (error 'oops "can't set! ~A" s))) (copy '(12 12) L) (test L '(12 12 3))) (let ((str "asdf")) (set! (setter 'str) (lambda (s v) (error 'oops "can't set! ~A" s))) (copy "ddd" str) (test str "dddf")) (let ((v (make-vector 3 1))) (set! (setter 'v) (lambda (s v) (error 'oops "can't set! ~A" s))) (copy #(2 2 2) v) (test v #(2 2 2))) (let ((v (make-vector 3 1/2 rational?))) (test (copy #(2+i) v) 'error)) (let ((lt (inlet 'a 1))) (set! (setter 'lt) (lambda (s v) (error 'oops "can't set! ~A" s))) (copy (inlet 'a 2) lt) ; (inlet 'a 2 'a 1) (test (lt 'a) 2)) (let ((lt (let ((a 2)) (set! (setter 'a) (lambda (s v) (error 'oops "can't set! ~A to ~A" s v))) (curlet)))) (copy (inlet 'a 12) lt) ; (inlet 'a 12 'a 2) ! (test (lt 'a) 12)) ;; copy -> let should look for each slot setter? (let ((H (make-hash-table 8 eq? (cons symbol? integer?)))) (set! (H 'a) 1) (test (copy (hash-table 'a #\a) H) 'error)) ;; and reverse! also ignores setters: (let ((L (list 1 2 3))) (set! (setter 'L) (lambda (s v) (error 'oops "can't set! ~A" s))) (reverse! L) ; this clobbers L but we can't set! it to the value of reverse! (test L '(1))) (let ((str "asdf")) (set! (setter 'str) (lambda (s v) (error 'oops "can't set! ~A" s))) (reverse! str) (test str "fdsa")) (let ((v (vector 1 2 3))) (set! (setter 'v) (lambda (s v) (error 'oops "can't set! ~A" s))) (reverse! v) (test v #(3 2 1))) ;; and sort!, technically we're not setting the variable but messing with its value: ;; (sort! *features* (lambda (a b) (< (length (symbol->string a)) (length (symbol->string b))))) (let ((L (list 1 2 3))) (set! (setter 'L) (lambda (s v) (error 'oops "can't set! ~A" s))) (sort! L >) (test L '(3 2 1))) (let ((str "asdf")) (set! (setter 'str) (lambda (s v) (error 'oops "can't set! ~A" s))) (sort! str char>?) (test str "sfda")) (let ((v (vector 1 2 3))) (set! (setter 'v) (lambda (s v) (error 'oops "can't set! ~A" s))) (sort! v >) (test v #(3 2 1))) ;;; -------------------------------------------------------------------------------- ;; generic for-each/map (test (let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) (vector 1 2 3)) sum) 6) (test (map (lambda (n) (+ n 1)) (vector 1 2 3)) '(2 3 4)) (test (map (lambda (a b) (/ a b)) (list 1 2 3) (list 4 5 6)) '(1/4 2/5 1/2)) (when with-block (let ((b (block 1.0 2.0 3.0))) (test (map (lambda (x) (floor x)) b) '(1 2 3)) (let ((sum 0)) (for-each (lambda (x) (set! sum (+ sum (floor x)))) b) (test sum 6)))) ;; try some applicable stuff (test (let ((lst (list 1 2 3))) (set! (lst 1) 32) (list (lst 0) (lst 1))) (list 1 32)) (test (let ((hash (make-hash-table))) (set! (hash 'hi) 32) (hash 'hi)) 32) (test (let ((str (string #\1 #\2 #\3))) (set! (str 1) #\a) (str 1)) #\a) (test (let ((v (vector 1 2 3))) (set! (v 1) 0) (v 1)) 0) (let () (define (hiho a) (*function* (curlet))) (test (or (equal? (hiho 1) 'hiho) (equal? (car (hiho 1)) 'hiho)) #t)) (let () (define-macro (hiho a) (let ((p (*function* (curlet)))) (if (pair? p) (car p) p))) (test (equal? (hiho 1) hiho) #t)) ;; somewhat amusing... (let ((x (vector 0))) (set! (x 0) x) (test (fill! (x 0) 3) 3) (test (fill! (x 0) 3) 'error)) ; error: fill! argument 1, 3, is an integer but should be a sequence ;;; gc (for-each (lambda (arg) (test (gc arg) 'error)) (list "hi" '(1 2 3) #() 'a-symbol abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i 1 () "" :hi (if #f #f) (lambda (a) (+ a 1)))) (test (gc #f #t) 'error) (if with-block (test (fill! (immutable! (block 0)) 1.0) 'error)) ;;; -------------------------------------------------------------------------------- ;;; tail recursion tests (define (command-line) (let ((lst ())) (with-input-from-file "/proc/self/cmdline" (lambda () (do ((c (read-char) (read-char)) (s "")) ((eof-object? c) (reverse lst)) (if (char=? c #\null) (begin (set! lst (cons s lst)) (set! s "")) (set! s (string-append s (string c))))))))) (if (provided? 'linux) (define _max_stack_tc_ (if (member "s7test.scm" (command-line)) 13 20)) (define _max_stack_tc_ 20)) (let ((max-stack 0)) (define (tc-1 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (< b c) (tc-1 b c)))) (tc-1 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-1 max: ~D~%" max-stack))) ; 18 here and below in repl.scm, 13 in t101-3 (let ((max-stack 0)) (define (tc-1 a c) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (< a c) (tc-2 (+ a 1) c))) (define (tc-2 a c) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (< a c) (tc-1 (+ a 1) c))) (tc-1 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-1-1 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-2 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (= b c) #f (tc-2 b c)))) (tc-2 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-2 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-2 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (< b c) (tc-2 b c) #f))) (tc-2 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-2-1 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-3 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (cond ((= b c) #f) ((< b c) (tc-3 b c))))) (tc-3 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-3 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-4 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (cond ((= b c) #f) (else (tc-4 b c))))) (tc-4 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-4 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-5 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (case b ((32) #f) (else (tc-5 b c))))) (tc-5 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-5 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-6 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (case b ((17) #f) ((0 1 2 3 4 5 6 7 8) (tc-6 b c)) ((9 10 11 12 13 14 15 16) (tc-6 b c))))) (tc-6 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-6 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-7 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (or (>= b c) (tc-7 b c)))) (tc-7 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-7 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-8 a c) (let ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (and (< b c) (tc-8 b c)))) (tc-8 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-8 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-9 a c) (let tc-9a ((b a)) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (< b c) (tc-9a (+ b 1))))) (tc-9 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-9 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-10 a c) (let* ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (and (< b c) (tc-10 b c)))) (tc-10 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-10 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-11 a c) (letrec ((b (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (and (< b c) (tc-11 b c)))) (tc-11 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-11 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-12 a c) (if (< a c) (begin (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (tc-12 (+ a 1) c)))) (tc-12 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-12 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-13 a c) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (cond ((= a c) #f) ((< a c) (if (> a c) (display "oops")) (tc-13 (+ a 1) c)))) (tc-13 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-13 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-14 a) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (cond ((>= a 32) #f) ((values (+ a 1) 32) => tc-14))) (tc-14 0) (if (> max-stack _max_stack_tc_) (format #t "tc-14 max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-15 a c) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (or (>= a c) (apply tc-15 (list (+ a 1) c)))) (tc-15 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-15 max: ~D~%" max-stack))) (let ((max-stack 0) (e #f)) (set! e (curlet)) (define (tc-17 a c) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (or (and (>= a c) a) (eval `(tc-17 (+ ,a 1) ,c) e))) (let ((val (tc-17 0 32))) (test (and (= val 32) (< max-stack 28)) #t))) (when full-s7test (let ((max-stack 0)) (define (tc-19 a c) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (call/cc (lambda (r) (if (>= a c) (r a)) (tc-19 (+ a 1) c)))) (let ((val (tc-19 0 16))) (test (and (= val 16) (< max-stack 8)) #t)))) (let ((max-stack 0)) (define (tc-21 a) (if (< a 32) (do ((i (- a 1) (+ i 1))) ((= i a) (tc-21 (+ a 1))) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-)))) a)) (let ((val (tc-21 0))) (if (> max-stack _max_stack_tc_) (format #t "tc-21 max: ~D~%" max-stack)) (if (not (= val 32)) (format #t "tc-21 returned: ~A~%" val)))) (let ((max-stack 0)) (define (tc-env a c) (with-let (sublet (curlet) (cons 'b (+ a 1))) ; this confuses the optimizer -- it thinks max-stack is not defined? (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (< b c) (tc-env b c)))) (tc-env 0 32) (if (> max-stack _max_stack_tc_) (format #t "tc-env max: ~D~%" max-stack))) (let ((max-stack 0)) (define (tc-env-1 a) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (> a 0) (with-let (curlet) (tc-env-1 (- a 1))))) (tc-env-1 32) (if (> max-stack _max_stack_tc_) (format #t "tc-env-1 max: ~D~%" max-stack))) ;;; make sure for-each and map aren't messed up (let ((max-stack 0)) (for-each (lambda (a) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (not (= a 1)) (error 'wrong-type-arg ";for-each arg is ~A" a))) (make-list 100 1)) (test (<= max-stack 21) #t)) ; 10 is not snd-test (and below) (let ((max-stack 0)) (map (lambda (a) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (if (not (= a 1)) (error 'wrong-type-arg ";map arg is ~A" a))) (make-list 100 1)) (test (<= max-stack 21) #t)) (let ((max-stack 0) (e #f)) (set! e (curlet)) (define (tc-17 a c) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (or (and (>= a c) a) (eval-string (format #f "(tc-17 (+ ~A 1) ~A)" a c) e))) (let ((val (tc-17 0 32))) (test (and (= val 32) (< max-stack 28)) #t))) ;;; the next 2 are not tail-recursive ;;; OP_DEACTIVATE_GOTO in call-with-exit ;;; OP_DYNAMIC_WIND in the dynamic-wind case (let ((max-stack 0)) (define (tc-16 a c) (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-))) (call-with-exit (lambda (r) (if (>= a c) (r a)) (tc-16 (+ a 1) c)))) (let ((val (tc-16 0 32))) (test (and (= val 32) (> max-stack 28)) #t))) (let ((max-stack 0)) (define (tc-18 a c) (dynamic-wind (lambda () (if (> (-s7-stack-top-) max-stack) (set! max-stack (-s7-stack-top-)))) (lambda () (or (and (>= a c) a) (tc-18 (+ a 1) c))) (lambda () #f))) (let ((val (tc-18 0 32))) (test (and (= val 32) (> max-stack 28)) #t))) (test (let ((f #f)) (let tr ((i 10)) (if (= i 3) (set! f (lambda () i))) (if (> i 0) (tr (- i 1)))) (f)) 3) (test (let ((f ())) (let tr ((i 4)) (set! f (cons i f)) (if (> i 0) (tr (- i 1)))) f) '(0 1 2 3 4)) ;;; -------- miscellaneous amusements (test ((number->string -1) 0) #\-) (test ((reverse '(1 2)) 0) 2) (test ((append begin) list) list) (test ((begin object->string) car) "car") (test ((and abs) -1) 1) (test (((values begin) object->string) car) "car") (test (((values (begin begin)) object->string) car) "car") (test ((((values append) begin) object->string) car) "car") (test ((((((values and) or) append) begin) object->string) car) "car") (test (((((((values values) and) or) append) begin) object->string) car) "car") (test ((values (lambda hi #()))) #()) (test (((((lambda () (lambda () (lambda () (lambda () 1)))))))) 1) (test ((object->string #f) (ceiling 3/4)) #\f) (test (procedure? ((((((lambda* ((x (lambda () x))) x))))))) #t) (test (procedure? ((((((letrec ((x (lambda () x))) x))))))) #t) (test (procedure? ((((((letrec ((x (lambda () y)) (y (lambda () x))) x))))))) #t) (test (procedure? ((((((let x () x))))))) #t) (test (procedure? (((let () (define (x) x) x)))) #t) (test (procedure? ((((((lambda (x) (set! x (lambda () x))) (lambda () x))))))) #t) (test (procedure? ````,,,,((((let x () x))))) #t) (test ((do ((i 0 (+ i 1))) ((= i 1) (lambda () 3)))) 3) (num-test ((list .(log 0)) 1) 0) (num-test (((cons .(log 0)) 0) 1) 0.0) (test (+ (+) (*)) 1) (test (modulo (lcm) (gcd)) 1) (test (max (+) (*)) 1) (test (min (gcd) (lcm)) 0) (test (symbol->value (gensym) (rootlet)) #) (test (string-ref (*s7* 'version) (*)) #\7) (test (string>=? (string-append) (string)) #t) (test (substring (string-append) (+)) "") (test (ash (*) (+)) 1) (test (> (*) (+)) #t) (test ((or #f list)) ()) (test ((or #f lcm)) 1) (test ((or begin symbol?)) ()) (test ((or begin make-polar)) ()) (test ((and #t begin)) ()) (test (begin) ()) (test ((or #f lcm) 2 3) 6) (test ((or and) #f #t) #f) (test ((and or) #f #t) #t) (test (or (or) (and)) #t) (test ((car '((1 2) (3 4))) 0) 1) (test ((or apply) lcm) 1) (test (- ((or *))) -1) (test ((car (list lcm))) 1) (test ((or (cond (lcm)))) 1) (test ((cond (asin floor *))) 1) (test (logior (#(1 #\a (3)) 0) (truncate 1.5)) 1) (test (real? (*)) #t) (test (- (lcm)) -1) (test (* (*)) 1) (test (+ (+) (+ (+)) (+ (+ (+)))) 0) (test (+(*(+))(*)(+(+)(+)(*))) 2) (num-test (+(-(*).(+1))(*(+).(-1))(*(+).(-10))(*(-(+)0)1.)(-(+)(*).01)(*(-(+)).01)(-(+)(*)1.0)(-(*(+))1.0)(*(-(+))1.0)(-(+(*)1).0))-2.01) (num-test (+(-(*).(+1.0))(*(+).(-1.0))(-(+)1.(*)0.)(-(*(+)0.)1.)(-(+(*)1.)0.)(+(-(*)0.)1.))1.0) ;; float comparison so can't use direct '=' here (test (nan? (asinh (cos (real-part (log 0.0))))) #t) (num-test(cos(sin(log(tan(*))))) 0.90951841537482) (num-test (asinh (- 9223372036854775807)) -44.361419555836) (num-test (imag-part (asin -9223372036854775808)) 44.361419555836) (num-test (apply * (map (lambda (r) (sin (* pi (/ r 130)))) (list 1 67 69 73 81 97))) (/ 1.0 64)) (num-test (max 0(+)(-(*))1) 1) (test ((call-with-exit object->string) 0) #\#) ; # (test ((begin begin) 1) 1) (test ((values begin) 1) 1) (test ((provide or) 3/4) 'error) (test (string? cond) #f) (test (list? or) #f) (test (pair? define) #f) (test (number? lambda*) #f) (test ((*s7* 'version) (rationalize 0)) #\s) (test (cond (((values '(1 2) '(3 4)) 0 0))) 'error) (test (cond (((#2d((1 2) (3 4)) 0) 0) 32)) 32) (test (cond ((apply < '(1 2)))) #t) (test (dynamic-wind lcm gcd *) 0) ; was 'error but Peter Bex tells me this is normal (test (case 0 ((> 0 1) 32)) 32) (test (char-downcase (char-downcase #\newline)) #\newline) (test (and (and) (and (and)) (and (and (and (or))))) #f) (test ((values begin #\a 1)) 1) (test ((values and 1 3)) 3) (test ((((lambda () begin)) (values begin 1))) 1) (test (+ (((lambda* () values)) 1 2 3)) 6) (test ((values ('((1 2) (3 4)) 1) (abs -1))) 4) (test ((apply lambda () '(() ()))) ()) (test ((lambda* ((symbol "#(1 #\\a (3))")) #t)) #t) (test (apply if ('((1 2) (3 4)) 1)) 4) (test (((lambda #\newline gcd))) 'error) (test (symbol? (let () (define (hi) (+ 1 2)))) #f) (test (symbol? (begin (define (x y) y) (x (define (x y) y)))) #f) (test (symbol? (do () ((define (x) 1) (define (y) 2)))) #f) (test (cond (0 (define (x) 3) (x))) 3) (test (let ((x (lambda () 3))) (if (define (x) 4) (x) 0)) 4) (test (and (define (x) 4) (+ (x) 1)) 5) (test (do ((x (lambda () 3) (lambda () 4))) ((= (x) 4) (define (x) 5) (x))) 5) (test (begin (if (define (x) 3) (define (x) 4) (define (x) 5)) (x)) 4) (test (let ((1,1 3) (1'1 4) (1|1 5) (1#1 6) (1\1 7) (1?1 8)) (+ 1,1 1'1 1|1 1#1 1\1 1?1)) 33) (test (let ((,a 3)) ,a) 'error) (test (let ((@a 3)) @a) 3) (test (let (("a" 3)) "a") 'error) (test (let ((`a 3)) `a) 'error) (test (let (('a 3)) 'a) 'error) (test (let ((a`!@#$%^&*~.,<>?/'{}[]\|+=_-a 3)) a`!@#$%^&*~.,<>?/'{}[]\|+=_-a) 3) (test (set! ((quote (1 2)) 0) #t) #t) (test (set! (((lambda () (list 1 2))) 0) 2) 2) (test (let ((x (list 1 2))) (set! (((lambda () x)) 0) 3) x) '(3 2)) (test (let ((x (list 1 2))) (set! (((vector x) 0) 1) 32) x) '(1 32)) (test (let ((x (list 1 2))) (set! ((((lambda () (vector x))) 0) 0) 3) x) '(3 2)) (test (let ((x (list 1 2))) (set! ((((lambda () (list x))) 0) 0) 3) x) '(3 2)) (test (let ((x (list 1 2))) (set! ((set! x (list 4 3)) 0) 32) x) '(32 3)) (test (let ((x (list 1 2))) (list-set! (set! x (list 4 3)) 0 32) x) '(32 3)) (test (let ((x (list 1 2))) (set! ((list-set! x 0 (list 4 3)) 0) 32) x) '((32 3) 2)) (test (let ((x (list 1 2))) (list-set! (list-set! x 0 (list 4 3)) 0 32) x) '((32 3) 2)) (test (set! (('((0 2) (3 4)) 0) 0) 0) 0) (test (set! ((map abs '(1 2)) 1) 0) 0) (test (let () (set! ((define x #(1 2)) 0) 12) x) #(12 2)) (test (let ((x (list 1 2))) (set! ((call-with-exit (lambda (k) (k x))) 0) 12) x) '(12 2)) (test (let ((x #2d((1 2) (3 4)))) (set! (((values x) 0) 1) 12) x) #2d((1 12) (3 4))) (test (let ((x 0)) (set! ((dilambda (lambda () x) (lambda (y) (set! x y)))) 12) x) 12) (test (let ((x 0) (str "hiho")) (string-set! (let () (set! x 32) str) 0 #\x) (list x str)) '(32 "xiho")) (test (let ((x "hi") (y "ho")) (set! ((set! x y) 0) #\x) (list x y)) '("xo" "xo")) (test (let ((x "hi") (y "ho")) (set! x y) (set! (y 0) #\x) (list x y)) '("xo" "xo")) ; Guile gets the same result (test (let ((x (lambda (a) (a z 1) z))) (x define)) 1) ; ! (test (let ((x (lambda (a) (a z (lambda (b) (+ b 1))) (z 2)))) (x define)) 3) (test (let ((x (lambda (a b c) (apply a (list b c))))) (x let () 3)) 3) (test (let ((x (lambda (a b c) (apply a (list b c))))) (x let '((y 2)) '(+ y 1))) 3) (let () (test ((values let '((x 1))) '(+ x 1)) 2)) ; ! (let () (test ((values begin '(define x 32)) '(+ x 1)) 33)) (let () (test (((values lambda '(x) '(+ x 1))) 32) 33)) (let () (test (let ((arg '(x)) (body '(+ x 1))) (((values lambda arg body)) 32)) 33)) (let () (test (let ((arg '(x)) (body '(+ x 1))) ((apply lambda arg (list body)) 32)) 33)) (let () (test (let ((x 12)) ((apply lambda '(x) (list (list '+ 1 x 'x))) 3)) 16)) (let () (test (let* ((x 3) (arg '(x)) (body `((+ ,x x 1)))) ((apply lambda arg body) 12)) 16)) (let () (define (bcase start end func) (let ((body ())) (do ((i start (+ i 1))) ((= i end)) (set! body (cons `((,i) ,(func i)) body))) (lambda (i) (apply case i body)))) (test ((bcase 0 3 abs) 1) 1)) (when full-s7test (define (__let_f1__ a b) (list a b)) (define-expansion (read__let_f1__) `(list ,__let_f1__)) (define (call__let_f1__) (read__let_f1__)) (call__let_f1__) (gc) (gc) (__let_f1__ 1 2) (define* (__let__f2__ a) (+ a 1)) (define-expansion (read__let__f2__) `(,__let__f2__ 3)) (define (call__let__f2__) (read__let__f2__)) (call__let__f2__) (gc) (gc) (__let__f2__ 3) (__let_f1__ 1 2) (define __let__f3__-iter (make-iterator "123")) (define-expansion (read__let__f3__) `(iterate ,__let__f3__-iter)) (define (__let__f3__) (read__let__f3__)) (define (call__let__f3__) (read__let__f3__)) (call__let__f3__) (gc) (gc) (__let__f2__ 3) (__let_f1__ 1 2) (__let__f3__) (let ((d (block 0 1 2)) ; safe-list = sc->args gc problem (iterator will be a free cell) -- limit below needs to be higher in this context (m (immutable! (inlet 'a 3 'b 2)))) (define (func) (with-input-from-string (object->string (car (list (round (+)) (make-iterator (make-vector '(2 3) #f)) m d (make-list 256 1) +inf.0))) read-line)) (define (gunc) (func)) (do ((i 0 (+ i 1))) ((= i 100)) (when (zero? (modulo i 100000)) (*s7* 'version) (display ".")) (gunc)))) ;;; ------ CLisms ------------------------------------------------------------------------ (let () ;; ********************************************************************** ;; ;; Copyright (C) 2002 Heinrich Taube (taube@uiuc.edu) ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License ;; as published by the Free Software Foundation; either version 2 ;; of the License, or (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; ********************************************************************** ;; $Name: $ ;; $Revision: 1.6 $ ;; $Date: 2005/11/17 13:29:37 $ ;; ;; Implementation of the CLTL2 loop macro. The following ;; non Rev 5 definitions need to be in effect before the file ;; is loaded: ;; ;; (define-macro (name . args) ...) ;; (error string) ;; (gensym string) ;; ; (define-macro (when test . forms) ; `(if ,test (begin ,@forms))) (define-macro (loop . args) (let () (define-macro (push val sym) `(begin (set! ,sym (cons ,val ,sym)) ,sym)) (define-macro (pop sym) (let ((v (gensym "v"))) `(let ((,v (car ,sym))) (set! ,sym (cdr ,sym)) ,v))) ;; this next one is a no-op but i need it as a marker for my cltl2 ;; translator. (define-macro (function sym) sym) ;; getters and setters for the loop-clause "struct" (define (loop-operator c) (vector-ref c 0)) (define (loop-operator-set! c x) (vector-set! c 0 x)) (define (loop-bindings c) (vector-ref c 1)) (define (loop-bindings-set! c x) (vector-set! c 1 x)) (define (loop-collectors c) (vector-ref c 2)) (define (loop-collectors-set! c x) (vector-set! c 2 x)) (define (loop-initially c) (vector-ref c 3)) (define (loop-initially-set! c x) (vector-set! c 3 x)) (define (loop-end-tests c) (vector-ref c 4)) (define (loop-end-tests-set! c x) (vector-set! c 4 x)) (define (loop-looping c) (vector-ref c 5)) (define (loop-looping-set! c x) (vector-set! c 5 x)) (define (loop-stepping c) (vector-ref c 6)) (define (loop-stepping-set! c x) (vector-set! c 6 x)) (define (loop-finally c) (vector-ref c 7)) (define (loop-finally-set! c x) (vector-set! c 7 x)) (define (loop-returning c) (vector-ref c 8)) (define (loop-returning-set! c x) (vector-set! c 8 x)) (define (make-loop-clause . args) (let ((v (vector #f () () () () () () () ()))) (if (null? args) v (do ((a args (cddr a))) ((null? a) v) (case (car a) ((operator) (loop-operator-set! v (cadr a))) ((bindings) (loop-bindings-set! v (cadr a))) ((collectors) (loop-collectors-set! v (cadr a))) ((initially) (loop-initially-set! v (cadr a))) ((end-tests) (loop-end-tests-set! v (cadr a))) ((looping) (loop-looping-set! v (cadr a))) ((stepping) (loop-stepping-set! v (cadr a))) ((finally) (loop-finally-set! v (cadr a))) ((returning) (loop-returning-set! v (cadr a)))))))) (define (gather-clauses caller clauses) ;; nconc all clausal expressions into one structure (let ((gather-clause (lambda (clauses accessor) ;; append data from clauses (do ((l ())) ((null? clauses) l) (set! l (append l (accessor (car clauses)))) (set! clauses (cdr clauses)))))) (make-loop-clause 'operator caller 'bindings (gather-clause clauses (function loop-bindings)) 'collectors (gather-clause clauses (function loop-collectors)) 'initially (gather-clause clauses (function loop-initially)) 'end-tests (gather-clause clauses (function loop-end-tests)) 'looping (gather-clause clauses (function loop-looping)) 'stepping (gather-clause clauses (function loop-stepping)) 'finally (gather-clause clauses (function loop-finally)) 'returning (gather-clause clauses (function loop-returning))))) (define (loop-op? x ops) (assoc x ops)) (define (loop-variable? x) (symbol? x)) (define (make-binding var val) (list var val)) (define (loop-error ops forms . args) ;; all error messages include error context. (let ((loop-context (lambda (lst ops) ;; return tail of expr up to next op in cdr of tail (do ((h lst) (l ())) ((or (null? lst) ;; ignore op if in front. (and (not (eq? h lst)) (loop-op? (car lst) ops))) (reverse l)) (set! l (cons (car lst) l)) (set! lst (cdr lst)))))) (let ((forms (loop-context forms ops))) (newline) (display "LOOP ERROR: ") (do ((tail args (cdr tail))) ((null? tail) #f) (display (car tail))) (newline) (display "clause context: ") (if (null? forms) (display "()") (do ((tail forms (cdr tail))) ((null? tail) #f) (if (eq? tail forms) (display "'")) (display (car tail)) (display (if (null? (cdr tail)) "'" " ")))) (newline) (error 'syntax-error "illegal loop syntax")))) (define (parse-for forms clauses ops) ;; forms is (FOR ...) (let ((op (loop-op? (car forms) ops))) (if (null? (cdr forms)) (loop-error ops forms "Variable expected but source code ran out." ) (let ((var (cadr forms))) (if (loop-variable? var) (if (null? (cddr forms)) (loop-error ops forms "'for' clause expected but source code ran out.") ;; find the iteration path in the op (let ((path (assoc (caddr forms) (cdddr op)))) ;; path is ( ) (if (not path) (loop-error ops forms "'" (caddr forms) "'" " is not valid with 'for'.") ( (cadr path) forms clauses ops)))) (loop-error ops forms "Found '" (cadr forms) "' where a variable expected.")))))) (define (parse-numerical-for forms clauses ops) ;; forms is (FOR ...) ;; where is guaranteed to be one of: FROM TO BELOW ABOVE DOWNTO ;; (bil) clauses (let ((var (cadr forms)) (tail (cddr forms)) (bind ()) (from #f) (head #f) (last #f) (stop #f) (step #f) (test #f) (incr #f)) (do ((next #f)) ((or (null? tail) (loop-op? (car tail) ops))) (set! next (pop tail)) (if (null? tail) (loop-error ops forms "Expected expression but source code ran out.")) (case next ((from downfrom) (if head (loop-error ops forms "Found '" next "' when '" head "' in effect.")) (set! head next) (set! from (pop tail))) ((below) (if last (loop-error ops forms "Found '" next "' when '" last "' in effect.")) (set! stop (pop tail)) (set! last next)) ((to) (if last (loop-error ops forms "Found '" next "' when '" last "' in effect.")) (set! stop (pop tail) ) (set! last next)) ((above ) (if last (loop-error ops forms "Found '" next "' when '" last "' in effect.")) (set! stop (pop tail)) (set! last next)) ((downto ) (if last (loop-error ops forms "Found '" next "' when '" last "' in effect.")) (set! stop (pop tail)) (set! last next)) ((by) (if step (loop-error ops forms "Found duplicate 'by'.")) (set! step (pop tail))) (else (loop-error ops forms "'" next "' is not valid with 'for'.")))) (if (not head) (set! head 'from)) (if (or (eq? head 'downfrom) (eq? last 'downto) (eq? last 'above)) (begin (set! incr '-) (if (eq? last 'above) (set! test '<=) (set! test '<))) ; allow to for downto (begin (set! incr '+) (if (eq? last 'below) (set! test '>=) (set! test '>)))) ;; add binding for initial value (push (make-binding var (or from 0)) bind) ;; add binding for non-constant stepping values. (if (not step) (set! step 1) (if (not (number? step)) (let ((var (gensym "v"))) (push (make-binding var step) bind) (set! step var)))) (set! step `(set! ,var (,incr ,var ,step))) (if stop (let ((end (gensym "v"))) (push (make-binding end stop) bind) (set! stop (list test var end)))) (values (make-loop-clause 'operator 'for 'bindings (reverse bind) 'stepping (list step) 'end-tests (if (not stop) () (list stop))) tail))) (define (parse-repeat forms clauses ops) ;; forms is (REPEAT
...) (if (null? (cdr forms)) (loop-error ops forms "'repeat' clause expected but source code ran out." ) (call-with-values (lambda () (parse-numerical-for (list 'for (gensym "v") 'below (cadr forms)) clauses ops)) (lambda (clause ignore) ignore (values clause (cddr forms)))))) (define (parse-sequence-iteration forms clauses ops) ;; tail is (FOR ...) ;; is guaranteed to be one of: IN ON ACROSS ;; (bil) clauses (let ((head forms) (var (cadr forms)) (seq (gensym "v")) (tail (cddr forms)) (bind ()) (data #f) (init ()) (loop ()) (incr #f) (stop ()) (step ()) (type #f)) (do ((next #f)) ((or (null? tail) (loop-op? (car tail) ops))) (set! next (pop tail)) (when (null? tail) (loop-error ops head "Expression expected but source code ran out." )) (case next ((in on across) (if type (loop-error ops head "Extraneous '" next "' when '" type "' in effect.")) (set! type next) (set! data (pop tail))) ((by ) (if incr (loop-error ops head "Duplicate 'by'." ) (if (eq? type 'across) (loop-error ops head "'by' is invalid with 'across'." ) (set! incr (pop tail))))) (else (loop-error ops head "'" next "' is not valid with 'for'.")))) ; add bindings for stepping var and source (push (make-binding var #f) bind) (push (make-binding seq data) bind) (if (eq? type 'across) (let ((pos (gensym "v")) (mx (gensym "v"))) (push (make-binding pos 0) bind) (push (make-binding mx #f) bind) (push `(set! ,mx (vector-length ,seq)) init) (push `(set! ,pos (+ 1 ,pos)) step) (push `(set! ,var (vector-ref ,seq ,pos)) loop) (push `(>= ,pos ,mx) stop)) (begin (if incr (if (and (list? incr) (eq? (car incr) 'quote)) (push `(set! ,seq (,(cadr incr) ,seq)) step) (push `(set! ,seq (,incr ,seq)) step)) (push `(set! ,seq (cdr ,seq)) step)) (push (if (eq? type 'in) `(set! ,var (car ,seq)) `(set! ,var ,seq)) loop) (push `(null? ,seq) stop))) (values (make-loop-clause 'operator 'for 'bindings (reverse bind) 'end-tests stop 'initially init 'looping loop 'stepping step) tail))) (define (parse-general-iteration forms clauses ops) ;; forms is (FOR = ...) ;; (bil) clauses (let ((head forms) (var (cadr forms)) (tail (cddr forms)) (init #f) (type #f) (loop #f) (step #f)) (do ((next #f)) ((or (null? tail) (loop-op? (car tail) ops))) (set! next (pop tail)) (if (null? tail) (loop-error ops head "Expression expected but source code ran out.")) (case next ((= ) (if type (loop-error ops head "Duplicate '='.")) (set! loop `(set! ,var ,(pop tail))) (set! type next)) ((then ) (if init (loop-error ops head "Duplicate 'then'.")) (set! init loop) (set! loop #f) (set! step `(set! ,var ,(pop tail))) (set! type next)) (else (loop-error ops head "'" next "' is not valid with 'for'.")))) (values (make-loop-clause 'operator 'for 'bindings (list (make-binding var #f)) 'initially (if init (list init) ()) 'looping (if loop (list loop) ()) 'stepping (if step (list step) ())) tail))) (define (parse-with forms clauses ops) ;; forms is (WITH = ...) ;; (bil) clauses (let ((head forms) (tail (cdr forms)) (var #f) (expr #f) (and? #f) (bind ()) (init ())) (do ((need #t) (next #f)) ((or (null? tail) (loop-op? (car tail) ops))) (set! next (pop tail)) (cond ((and (loop-variable? next) need) (if var (loop-error ops head "Found '" next "' where 'and' expected.")) (if expr (loop-error ops head "Found '" next "' where 'and' expected.")) (set! var next) (set! expr #f) (set! and? #f) (set! need #f)) ((eq? next 'and) (if and? (loop-error ops head "Duplicate 'and'.") (if var (if expr (begin (push (make-binding var #f) bind) (push `(set! ,var ,expr) init)) (push (make-binding var #f) bind)) (loop-error ops head "Extraneous 'and'."))) (set! var #f) (set! expr #f) (set! and? #t) (set! need #t)) ((eq? next '=) (if expr (loop-error ops head "Found '=' where 'and' expected.") (set! expr (pop tail)))) (else (if need (loop-error ops head "Found '" next "' where variable expected.") (loop-error ops head "Found '" next "' where '=' or 'and' expected."))))) (if and? (loop-error ops head "Extraneous 'and'.") (if var (if expr (begin (push (make-binding var #f) bind) (push `(set! ,var ,expr) init)) (push (make-binding var #f) bind)))) (values (make-loop-clause 'operator 'with 'bindings (reverse bind) 'initially (reverse init)) tail))) (define (parse-do forms clauses ops) ;; (bil) clauses (let ((head forms) (oper (pop forms)) (body ())) (do () ((or (null? forms) (loop-op? (car forms) ops)) (if (null? body) (loop-error ops head "Missing '" oper "' expression.") (set! body (reverse body)))) (push (car forms) body) (set! forms (cdr forms))) (values (make-loop-clause 'operator oper 'looping body) forms))) (define (parse-finally forms clauses ops) ;; (bil) clauses (let ((oper (pop forms)) (expr #f)) (if (null? forms) (loop-error ops forms "Missing '" oper "' expression.")) (set! expr (pop forms)) (values (make-loop-clause 'operator oper 'finally (list expr)) forms))) (define (parse-initially forms clauses ops) ;; (bil) clauses (let ((oper (pop forms)) (expr #f)) (if (null? forms) (loop-error ops forms "Missing '" oper "' expression.")) (set! expr (pop forms)) (values (make-loop-clause 'operator oper 'initially (list expr)) forms))) (define (lookup-collector var clauses) ;; collector is list: ( ) ;; returns the clause where the collect variable VAR is ;; actually bound or nil if var hasn't already been bound ;; if var is nil only the single system allocated collecter ;; is possibly returned. (let ((checkthem (lambda (var lis) (do ((a #f)) ((or (null? lis) a) a) (if (eq? var (car (car lis))) ;collector-var (set! a (car lis))) (set! lis (cdr lis)))))) (do ((c #f)) ((or (null? clauses) c) c) (set! c (checkthem var (loop-collectors (car clauses)))) (set! clauses (cdr clauses))))) (define (compatible-accumulation? typ1 typ2) (let ((l1 '(collect append nconc)) (l2 '(never always)) (l3 '(minimize maximize))) (or (eq? typ1 typ2) (and (member typ1 l1) (member typ2 l1)) (and (member typ1 l2) (member typ2 l2)) (and (member typ1 l3) (member typ2 l3))))) (define (parse-accumulation forms clauses ops) ;; forms is ( form ...) ;; where is collect append nconc (let ((save forms) (oper (pop forms)) (make-collector (lambda (var type acc head) (list var type acc head))) ;; removed because noop ;;(collector-var (lambda (col) (car col))) (collector-type (lambda (col) (cadr col))) (collector-acc (lambda (col) (caddr col))) (collector-head (lambda (col) (cadddr col))) (expr #f) (coll #f) (new? #f) (into #f) (loop ()) (bind ()) (init ()) (tests ()) (return ())) (if (null? forms) (loop-error ops forms "Missing '" oper "' expression.")) (set! expr (pop forms)) (if (not (null? forms)) (if (eq? (car forms) 'into) (begin (if (null? (cdr forms)) (loop-error ops save "Missing 'into' variable.")) (if (loop-variable? (cadr forms)) (begin (set! into (cadr forms)) (set! forms (cddr forms))) (loop-error ops save "Found '" (car forms) "' where 'into' variable expected."))))) ;; search for a clause that already binds either the user specified ;; accumulator (into) or a system allocated one if no into. ;; system collectors ;; o only one allowed, all accumuations must be compatible ;; o returns value ;; value collector: (nil <#:acc>) ;; list collector: (nil <#:tail> <#:head>) ;; into collectors ;; o any number allowed ;; o returns nothing. ;; value collector: ( ) ;; list collector: ( <#:tail> <#:head>) (set! coll (lookup-collector into clauses)) (if (not coll) (set! new? #t) ;; accumulator already established by earlier clause ;; check to make sure clauses are compatible. (if (not (compatible-accumulation? oper (collector-type coll))) (loop-error ops save "'" (collector-type coll) "' and '" oper "' are incompatible accumulators."))) (case oper ((sum count) (let ((acc #f)) (if new? (begin (set! acc (or into (gensym "v"))) (push (make-binding acc 0) bind) ;; coll= (nil <#:acc>) or ( ) (set! coll (make-collector into oper acc #f)) ;; only add a return value if new collector isnt into (if (not into) (push acc return))) (set! acc (collector-acc coll))) (if (eq? oper 'sum) (push `(set! ,acc (+ ,acc ,expr)) loop) (push `(if ,expr (set! ,acc (+ ,acc 1))) loop)))) ((minimize maximize) (let ((var (gensym "v")) (opr (if (eq? oper 'minimize) '< '>)) (acc #f)) (if new? (begin (set! acc (or into (gensym "v"))) (push (make-binding acc #f) bind) ;; coll= (nil <#:acc>) or ( ) (set! coll (make-collector into oper acc #f)) ;; only add a return value if new collector isnt into (if (not into) (push `(or ,acc 0) return))) (set! acc (collector-acc coll))) (push (make-binding var #f) bind) (push `(begin (set! ,var ,expr) (if (or (not ,acc) (,opr ,var ,acc)) (set! ,acc ,var))) loop))) ((append collect nconc) ;; for list accumulation a pointer to the tail of the list ;; is updated and the head of the list is returned. any ;; into variable is set to the head inside the loop. (let ((head #f) (tail #f)) (if (not new?) (begin (set! tail (collector-acc coll)) (set! head (collector-head coll))) (begin (if into (push (make-binding into '(list)) bind)) (set! tail (gensym "v")) ;; allocate a pointer to the head of list (set! head (gensym "v")) (push (make-binding head '(list #f)) bind) (push (make-binding tail #f) bind) ;; initialize tail to head (push `(set! ,tail ,head) init) (set! coll (make-collector into oper tail head)) ;; only add a return value if new collector isnt into (if (not into) (push `(cdr ,head) return)))) ;; add loop accumulation forms (if (eq? oper 'append) (begin (push `(set-cdr! ,tail (append ,expr (list))) loop) (push `(set! ,tail (last-pair ,tail)) loop)) (if (eq? oper 'collect) (begin (push `(set-cdr! ,tail (list ,expr)) loop) (push `(set! ,tail (cdr ,tail)) loop)) (begin (push `(set-cdr! ,tail ,expr) loop) (push `(set! ,tail (last-pair ,tail)) loop)))) ;; update user into variable inside the main loop ;; regardless of whether its a new collector or not (if into (push `(set! ,into (cdr ,head)) loop))))) (values (make-loop-clause 'operator oper 'bindings (reverse bind) 'initially (reverse init) 'looping (reverse loop) 'returning (reverse return) 'collectors (if new? (list coll) ()) 'end-tests (reverse tests)) forms))) ;(define (loop-stop expr) ; `(%done% ,expr)) (define (loop-return expr) `(return ,expr)) (define (parse-while-until forms clauses ops) ;; (bil) clauses (let ((head forms) (oper (pop forms)) (test #f) (stop '(go #t))) ; :done (if (null? forms) (loop-error ops head "Missing '" oper "' expression.")) (case oper ((until ) (set! test (pop forms))) ((while ) (set! test `(not ,(pop forms))))) ;; calls the DONE continuation. (values (make-loop-clause 'operator oper 'looping (list `(if ,test ,stop))) forms))) (define (parse-thereis forms clauses ops) ;; (bil) clauses (let ((oper (car forms)) (expr #f) (bool #f) (func #f)) (if (null? (cdr forms)) (loop-error ops forms "Missing '" (car forms) "' expression." )) (set! expr (cadr forms)) ;; fourth element of operator definition must be ;; a function that returns the stop expression. (set! func (cadddr (loop-op? oper ops) )) (case oper ((thereis ) ;; return true as soon as expr is true or false at end (set! bool #f)) ((always ) ;; return false as soon as expr is false, or true at end (set! expr `(not ,expr)) (set! bool #t)) ((never ) ;; return false as soon as expr is true, or true at end (set! bool #t))) (set! forms (cddr forms)) ;; this calls the RETURN continuation (values (make-loop-clause 'operator 'thereis 'looping (list `(if ,expr ,(func (not bool)))) 'returning (list bool)) forms))) (define (parse-return forms clauses ops) ;; (bil) clauses (let ((oper (car forms)) (expr #f) (func #f)) (if (null? (cdr forms)) (loop-error ops forms "Missing '" (car forms) "' expression.")) (set! expr (cadr forms)) (set! forms (cddr forms)) ;; fourth element of operator definition must be ;; a function that returns the stop expression. (set! func (cadddr (loop-op? oper ops) )) ;; this calls the RETURN continuation (values (make-loop-clause 'operator 'return 'looping `(,(func expr))) forms))) (define (legal-in-conditional? x ops) ;; FIXED (member (loop-operator...)) (let ((op (loop-op? x ops))) (if (and op (not (null? (cddr op))) (eq? (caddr op) 'task) (not (member (car op) '(thereis never always)))) op #f))) (define (parse-then-else-dependents forms clauses ops) (let ((previous forms) (stop? #f) (parsed ())) (do ((op #f) (clause #f) (remains #f)) ((or (null? forms) stop?)) (set! op (legal-in-conditional? (car forms) ops)) (if (not op) (loop-error ops previous "'" (car forms) "' is not conditional operator.")) ;(multiple-value-setq ; (clause remains) ; ( (cadr op) forms (append clauses parsed) ops)) (call-with-values (lambda () ( (cadr op) forms (append clauses parsed) ops)) (lambda (a b) (set! clause a) (set! remains b))) ;(format #t "~%after call clause=~s forms=~S" clause forms) (set! parsed (append parsed (list clause))) (set! previous forms) (set! forms remains) (if (not (null? forms)) (if (eq? (car forms) 'and) (begin (set! forms (cdr forms)) (if (null? forms) (loop-error ops previous "Missing 'and' clause."))) (if (eq? (car forms) 'else) (set! stop? #t) (if (loop-op? (car forms) ops) (set! stop? #t)))))) (values parsed forms))) (define (parse-conditional forms clauses ops) (let ((ops (cons '(else ) ops)) (save forms) (oper (car forms)) (loop (list)) ; avoid () because of acl bug (expr (list)) (then (list)) (else (list))) (if (null? (cdr forms)) (loop-error ops save "Missing '" oper "' expression.")) (set! forms (cdr forms)) (set! expr (pop forms)) (if (null? forms) (loop-error ops forms "Missing conditional clause.")) (if (eq? oper 'unless) (set! expr (list 'not expr))) (call-with-values (lambda () (parse-then-else-dependents forms clauses ops)) (lambda (a b) (set! then a) (set! forms b))) ;; combine dependant clauses if more than one (if (not (null? (cdr then))) (set! then (gather-clauses (list) then)) (set! then (car then))) (loop-operator-set! then 'if) ;; this (if ...) is hacked so that it is a newly ;; allocated list. otherwise acl and clisp have a ;; nasty structure sharing problem. (set! loop (list 'if expr (append `(begin ,@(loop-looping then)) (list)) #f)) (if (and (not (null? forms)) (eq? (car forms) 'else)) (begin (set! forms (cdr forms)) (when (null? forms) (loop-error ops save "Missing 'else' clause.")) (call-with-values (lambda () (parse-then-else-dependents forms (append clauses (list then)) ops)) (lambda (a b) (set! else a) (set! forms b))) (if (not (null? (cdr else))) (set! else (gather-clauses () else)) (set! else (car else))) (set-car! (cdddr loop) `(begin ,@(loop-looping else))) ;; flush loop forms so we dont gather actions. (loop-looping-set! then ()) (loop-looping-set! else ()) (set! then (gather-clauses 'if (list then else))))) (loop-looping-set! then (list loop)) (values then forms))) (define (parse-clauses forms cond? ops) (if (or (null? forms) (not (symbol? (car forms)))) (list (make-loop-clause 'operator 'do 'looping forms)) (let ((op-type? (lambda (op type) (and (not (null? (cddr op))) (eq? (caddr op) type))))) (let ((previous forms) (clauses ())) (do ((op #f) (clause #f) (remains ()) (body ()) ) ((null? forms)) (if (and cond? (eq? (car forms) 'and)) (pop forms)) (set! op (loop-op? (car forms) ops)) (if (not op) (loop-error ops previous "Found '" (car forms) "' where operator expected.")) ;(multiple-value-setq (clause remains) ; ((cadr op) forms clauses ops)) (call-with-values (lambda () ( (cadr op) forms clauses ops)) (lambda (a b) (set! clause a) (set! remains b))) (if (op-type? op 'task) (set! body op) (if (op-type? op 'iter) (if (not (null? body)) (loop-error ops previous "'" (car op) "' clause cannot follow '" (car body) "'.")))) (set! previous forms) (set! forms remains) (set! clauses (append clauses (list clause)))) clauses)))) (define (parse-iteration caller forms ops) (gather-clauses caller (parse-clauses forms () ops))) ;; ;; loop implementation ;; (define *loop-operators* ;; each clause is ( . ) (list (list 'with (function parse-with) #f) (list 'initially (function parse-initially) #f) (list 'repeat (function parse-repeat) 'iter) (list 'for (function parse-for) 'iter (list 'from (function parse-numerical-for)) (list 'downfrom (function parse-numerical-for)) (list 'below (function parse-numerical-for)) (list 'to (function parse-numerical-for)) (list 'above (function parse-numerical-for)) (list 'downto (function parse-numerical-for)) (list 'in (function parse-sequence-iteration)) (list 'on (function parse-sequence-iteration)) (list 'across (function parse-sequence-iteration)) (list '= (function parse-general-iteration))) (list 'as (function parse-for) 'iter) (list 'do (function parse-do) 'task) (list 'collect (function parse-accumulation) 'task) (list 'append (function parse-accumulation) 'task) (list 'nconc (function parse-accumulation) 'task) (list 'sum (function parse-accumulation) 'task) (list 'count (function parse-accumulation) 'task) (list 'minimize (function parse-accumulation) 'task) (list 'maximize (function parse-accumulation) 'task) (list 'thereis (function parse-thereis) 'task (function loop-return)) (list 'always (function parse-thereis) 'task (function loop-return)) (list 'never (function parse-thereis) 'task (function loop-return)) (list 'return (function parse-return) 'task (function loop-return)) (list 'while (function parse-while-until) #f ) (list 'until (function parse-while-until) #f ) (list 'when (function parse-conditional) 'task) (list 'unless (function parse-conditional) 'task) (list 'if (function parse-conditional) 'task) (list 'finally (function parse-finally) #f))) ;; ;; loop expansions for scheme and cltl2 ;; (define (scheme-loop forms) (let ((name (gensym "v")) (parsed (parse-iteration 'loop forms *loop-operators*)) (end-test ()) (done '(go #t)) ; :done (return #f)) ;(write (list :parsed-> parsed)) ;; cltl2's loop needs a way to stop iteration from with the run ;; block (the done form) and/or immediately return a value ;; (the return form). scheme doesnt have a block return or a ;; go/tagbody mechanism these conditions are implemented using ;; continuations. The forms that done and return expand to are ;; not hardwired into the code because this utility is also used ;; by CM's 'process' macro. Instead, the done and return forms ;; are returned by functions assocated with the relevant operator ;; data. For example, the function that returns the return form ;; is stored as the fourth element in the return operator data. ;; and the done function is stored in the while and until op data. ;; the cadddr of the RETURN operator is a function that ;; provides the form for immediately returning a value ;; from the iteration. (let ((returnfn (cadddr (assoc 'return *loop-operators*)))) (set! return (returnfn (if (null? (loop-returning parsed)) #f (car (loop-returning parsed)))))) ;; combine any end-tests into a single IF expression ;; that calls the (done) continuation if true. multiple ;; tests are OR'ed togther (set! end-test (let ((ends (loop-end-tests parsed))) (if (null? ends) () (list `(if ,(if (null? (cdr ends)) (car ends) (cons 'or ends)) ;; calls the done continuation ,done #f))))) `(let (,@ (loop-bindings parsed)) ,@(loop-initially parsed) (call-with-exit (lambda (return) ; <- (return) returns from this lambda (call-with-exit (lambda (go) ; <- (go #t) returns from this lambda ;; a named let provides the actual looping mechanism. ;; the various tests and actions may exit via the ;; (done) or (return) continuations. (let ,name () ,@end-test ,@(loop-looping parsed) ,@(loop-stepping parsed) (,name)))) ;; this is the lexical point for (go #t) continuation. ,@(loop-finally parsed) ;; invoke the RETURN continuation with loop value or #f ,return))))) (scheme-loop args))) ;; ;; loop tests. ;; (test (loop for i below 10 collect i) '(0 1 2 3 4 5 6 7 8 9)) (test (loop for i to 10 sum i) 55) (test (loop for i downto -10 count (even? i)) 6) (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) by cddr collect x) '(0 2 4 6 8)) (test (loop for x on '(0 1 2 3) by cddr collect x) '((0 1 2 3) (2 3))) (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) thereis (= x 4)) #t) (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) never (= x 4)) #f) (test (loop for x in '(0 1 2 3 4 5 6 7 8 9) never (= x 40)) #t) (test (loop for x in '(0 2 3 4 5 6 7 8 9) always (< x 40)) #t) (test (loop repeat 10 with x = 0 collect x do (set! x (+ x 1))) '(0 1 2 3 4 5 6 7 8 9)) (test (loop repeat 10 for x = #t then (not x) collect x) '(#t #f #t #f #t #f #t #f #t #f)) (test (loop repeat 10 count #t) 10) (test (loop repeat 10 count #f) 0) (test (loop for i to 10 collect i collect (* 2 i)) '(0 0 1 2 2 4 3 6 4 8 5 10 6 12 7 14 8 16 9 18 10 20)) (test (loop for i from -10 to 10 by 2 nconc (list i (- i))) '(-10 10 -8 8 -6 6 -4 4 -2 2 0 0 2 -2 4 -4 6 -6 8 -8 10 -10)) (test (loop for i from -10 downto 10 by -1 collect i) ()) (test (loop for i downfrom 10 downto -10 by 2 collect i) '(10 8 6 4 2 0 -2 -4 -6 -8 -10)) (test (loop for i from 10 to -10 by 1 collect i) ()) (test (loop for i to 10 for j downfrom 10 collect i collect j) '(0 10 1 9 2 8 3 7 4 6 5 5 6 4 7 3 8 2 9 1 10 0)) (test (loop for i below 0 collect i into foo finally (return foo)) ()) (test (loop for i below 0 sum i into foo finally (return foo)) 0) (test (loop for i below 0 maximize i into foo finally (return foo)) #f) (test (loop with a and b = 'x and c = 2 repeat 10 for x = 1 then 'fred collect (list x a b c)) '((1 #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2) (fred #f x 2))) (test (loop for i across #(0 1 2 3) append (list i (expt 2 i))) '(0 1 1 2 2 4 3 8)) (test (loop with a = 0 and b = -1 while (< a 10) sum a into foo do (set! a (+ a 1)) finally (return (list foo b))) '(45 -1)) (test (loop for i from 0 until (> i 9) collect i) '(0 1 2 3 4 5 6 7 8 9)) (test (loop for i from 0 while (< i 9) when (even? i) collect i) '(0 2 4 6 8)) (test (loop with l = (list 0) for s in spec for k = s then (+ k s) do (push k l) finally (return l)) 'error) (test (loop with l = (list (encode-interval 'p 1)) for s in spec for k = (interval s) then (transpose k (interval s)) do (push k l) finally (return l)) 'error) ;; end loop ;; more macros from Rick's stuff (define-macro (dolist spec . body) ;; spec = (var list . return) (let ((v (gensym))) `(do ((,v ,(cadr spec) (cdr ,v)) (,(car spec) #f)) ((null? ,v) ,@(cddr spec)) (set! ,(car spec) (car ,v)) ,@body))) (test (let ((sum 0)) (dolist (v (list 1 2 3) sum) (set! sum (+ sum v)))) 6) (define-macro (dotimes spec . body) ;; spec = (var end . return) (let ((e (gensym)) (n (car spec))) `(do ((,e ,(cadr spec)) (,n 0 (+ ,n 1))) ((>= ,n ,e) ,@(cddr spec)) ,@body))) (test (let ((sum 0)) (dotimes (i 3 sum) (set! sum (+ sum i)))) 3) (define-macro (do* spec end . body) `(let* (,@(map (lambda (var) (list (car var) (cadr var))) spec)) (do () ,end ,@body ,@(map (lambda (var) (if (pair? (cddr var)) `(set! ,(car var) ,(caddr var)) (values))) spec)))) (define (1+ x) (+ x 1)) (test (let ((sum 0)) (do* ((i 0 (+ i 1)) (j i (+ i 1))) ((= i 3) sum) (set! sum (+ sum j)))) 5) (test (do* ((a 1 (+ a 1)) (b a)) ((> a 9) b)) 1) (test (let ((a 0)) (do* ((a 1 (+ a 1)) (b a)) ((> a 9) a)) a) 0) (test (do* ((i 0 (1+ i))) ((>= i 10) i)) 10) (test (do* ((i 0 (1+ j)) (j 0 (1+ i))) ((>= i 10) (+ i j))) 23) (test (let ((x ())) (do* ((i 0 (1+ i))) ((>= i 10) x) (set! x (cons i x)))) '(9 8 7 6 5 4 3 2 1 0)) (test (call-with-exit (lambda (return) (do* ((i 0 (1+ i))) () (when (> i 10) (return i))))) 11) (test (do* ((i 0 (+ i 10))) ((> i -1) i) (error 'bad)) 0) (test (do* ((i 0 (1+ i)) (x ())) ((>= i 10) x) (set! x (cons 'a x))) '(a a a a a a a a a a)) (test (let ((i 0)) (do* () ((>= i 10) i) (set! i (+ i 1)))) 10) (test (do* ((i 0 (1+ i))) ((> i 10) (values))) #) (test (+ 1 (do* ((i 0 (1+ i))) ((> i 10) (values i (1+ i))))) 24) (test (do* ((i 0 (1+ i))) ((> i 10) (set! i (+ i 1)) (set! i (+ i 1)) i)) 13) (test (do* ((i 0 (1+ i))) ((> i 10))) #t) (test (map (lambda (f) (f)) (let ((x ())) (do* ((i 0 (+ i 1))) ((= i 5) x) (set! x (cons (lambda () i) x))))) '(5 5 5 5 5)) (test (do* ((lst (list 0 1 2 3 4 5 6 7 8 9) (cdr lst)) (elm (car lst) (and (pair? lst) (car lst))) (n 0 (+ n (or elm 0)))) ((null? lst) n)) 45) (test (do* ((lst (list 0 1 2 3 4 5 6 7 8 9) (cdr lst)) (elm (car lst) (and (pair? lst) (car lst))) (n 0)) ((null? lst) n) (set! n (+ n elm))) 45) (test (let ((vec (vector 0 1 2 3 4 5 6 7 8 9))) (and (do* ((n #f) (i 0 (+ i 1)) (j (- 9 i) (- 9 i))) ((>= i j)) (set! n (vec i)) (set! (vec i) (vec j)) (set! (vec j) n)) (equal? vec #(9 8 7 6 5 4 3 2 1 0)))) #t) (define-macro (fluid-let xexe . body) ;; taken with changes from Teach Yourself Scheme (let ((xx (map car xexe)) (ee (map cadr xexe)) (old-xx (map (lambda (ig) (gensym)) xexe))) `(let ,(map (lambda (old-x x) `(,old-x ,x)) old-xx xx) (dynamic-wind (lambda () #f) (lambda () ,@(map (lambda (x e) `(set! ,x ,e)) xx ee) (let () ,@body)) (lambda () ,@(map (lambda (x old-x) `(set! ,x ,old-x)) xx old-xx)))))) (test (let ((x 32) (y 0)) (define (gx) x) (fluid-let ((x 12)) (set! y (gx))) (list x y)) '(32 12)) (test (let ((x "hi") (y 0) (z '(1 2 3))) (define (gx) (+ x z)) (fluid-let ((x 32) (z (+ 123 (car z)))) (set! y (gx))) (list x y z)) '("hi" 156 (1 2 3))) (test (let ((x 32) (y 0)) (define (gx) x) (call-with-exit (lambda (return) (fluid-let ((x 12)) (set! y (gx)) (return)))) (list x y)) '(32 12)) (test (let ((x 32) (y 0)) (define (gx) x) (let ((x 100)) (fluid-let ((x 12)) (set! y (gx)))) (list x y)) '(32 32)) ;; oops! fluid-let doesn't actually work ;; to make this work, use symbol->dynamic-value. See also let-temporarily in stuff.scm. (test (let ((x 32) (y 0)) (define (gx) (symbol->dynamic-value 'x)) (let ((x 100)) (let ((x 12)) ; no need for fluid-let anymore (set! y (gx)))) (list x y)) '(32 12)) (test (let ((y 0)) (define (gx) (symbol->dynamic-value 'x)) (let ((x 100)) (let ((x 12)) (set! y (gx)) (set! x 123)) (list x y))) '(100 12)) ;; in CL: (defvar x 32) (let ((y 0)) (defun gx () x) (let ((x 12)) (setf y (gx))) (list x y)) -> '(32 12) ;; (let ((y 0)) (defun gx () x) (let ((x 100)) (let ((x 12)) (setf y (gx)))) (list x y)) -> '(32 12) ;; (let ((y 0)) (defun gx () x) (let ((x 100)) (let ((x 12)) (setf y (gx)) (setf x 123)) (list x y))) -> '(100 12) ! ;; (the defvar makes x dynamic) ;; define** treats args before :optional as required args (define-macro (define** declarations . forms) (let ((name (car declarations)) (args (cdr declarations))) (define (position thing lst count) (if (or (null? lst) (not (pair? (cdr lst)))) #f (if (eq? thing (car lst)) count (position thing (cdr lst) (+ count 1))))) (define (no-opt old-args new-args) (if (null? old-args) (reverse new-args) (no-opt (cdr old-args) (if (eq? (car old-args) :optional) new-args (cons (car old-args) new-args))))) (let ((required-args (position :optional args 0))) (if required-args `(define* (,name . func-args) (if (< (length func-args) ,required-args) (error 'syntax-error "~A requires ~D argument~A: ~A" ',name ,required-args (if (> ,required-args 1) "s" "") func-args) (apply (lambda* ,(no-opt args ()) ,@forms) func-args))) `(define* ,declarations ,@forms))))) (let () (define** (f1 a :optional b) (+ a (or b 1))) (test (f1 1) 2) (test (f1 1 2) 3) (test (f1) 'error)) ;; Rick's with-optkeys (define-macro (with-optkeys spec . body) ( (lambda (user rawspec body) ;(define (string->keyword str) (symbol->keyword (string->symbol str))) (define (key-parse-clause info mode args argn user) ;; return a cond clause that parses one keyword. info for each ;; var is: ( ) (let* ((got (car info)) (var (cadr info)) (key (string->keyword (symbol->string var)))) `((eq? (car ,args) ,key ) (if ,got (error 'syntax-error "duplicate keyword: ~S" , key)) (set! ,var (if (null? (cdr ,args)) (error 'syntax-error "missing value for keyword: ~S" , user) (cadr ,args))) (set! ,got #t) ; mark that we have a value for this param (set! ,mode #t) ; mark that we are now parsing keywords (set! ,argn (+ ,argn 1)) (set! ,args (cddr ,args))))) (define (pos-parse-clause info mode args argn I) ;; return a cond clause that parses one positional. info for ;; each var is: ( ) (let ((got (car info)) (var (cadr info))) `((= ,argn ,I) (set! ,var (car ,args)) (set! ,got #t) ; mark that we have a value for this param (set! ,argn (+ ,argn 1)) (set! ,args (cdr ,args))))) (let* ((otherkeys? (member '&allow-other-keys rawspec)) ;; remove &allow-other-keys from spec (spec (if otherkeys? (reverse (cdr (reverse rawspec))) rawspec)) (data (map (lambda (v) ;; for each optkey variable v return a list ;; ( ) where the ;; variable indicates that has been ;; set, is the optkey variable itself ;; and is its default value (if (pair? v) (cons (gensym (symbol->string (car v))) v) (list (gensym (symbol->string v)) v #f))) spec)) (args (gensym "args")) ; holds arg data as its parsed (argn (gensym "argn")) (SIZE (length data)) (mode (gensym "keyp")) ; true if parsing keywords ;; keyc are cond clauses that parse valid keyword (keyc (map (lambda (d) (key-parse-clause d mode args argn user)) data)) (posc (let lup ((tail data) (I 0)) (if (null? tail) (list) (cons (pos-parse-clause (car tail) mode args argn I) (lup (cdr tail) (+ I 1)))))) (bindings (map cdr data)) ; optkey variable bindings ) (if otherkeys? (set! bindings (cons '(&allow-other-keys (list)) bindings))) `(let* ,bindings ; bind all the optkey variables with default values ;; bind status and parsing vars (let ,(append (map (lambda (i) (list (car i) #f)) data) `((,args ,user) (,argn 0) (,mode #f))) ;; iterate arglist and set opt/key values (do () ((null? ,args) #f) (cond ;; add valid keyword clauses first ,@ keyc ;; a keyword in (car args) is now either added to ;; &allow-other-keys or an error , (if otherkeys? `((keyword? (car ,args)) (if (not (pair? (cdr ,args))) (error 'syntax-error "missing value for keyword ~S" (car ,args))) (set! &allow-other-keys (append &allow-other-keys (list (car ,args) (cadr ,args)))) (set! ,mode #t) ; parsing keys now... (set! ,args (cddr ,args)) ) `((keyword? (car ,args)) ;(and ,mode (keyword? (car ,args))) (error 'syntax-error "invalid keyword: ~S" (car ,args)) ) ) ;; positional clauses illegal if keywords have happened (,mode (error 'syntax-error "positional after keywords: ~S" (car ,args))) ;; too many value specified ((not (< ,argn ,SIZE)) (error 'wrong-number-of-args "too many args: ~S" , args)) ;; add the valid positional clauses ,@ posc )) ,@ body)) )) (car spec) (cdr spec) body )) (test (let ((args '(1 2 3))) (with-optkeys (args a b c) (list a b c))) '(1 2 3)) (test (let ((args '(1 2 3 4))) (with-optkeys (args a b c) (list a b c))) 'error) (test (let ((args '(1 2))) (with-optkeys (args a b (c 33)) (list a b c))) '(1 2 33)) (test (let ((args ())) (with-optkeys (args a b (c 33)) (list a b c))) '(#f #f 33)) (test (let ((args '(:b 22))) (with-optkeys (args a b (c 33)) (list a b c))) '(#f 22 33)) (test (let ((args '(-1 :z 22))) (with-optkeys (args a b (c 33)) (list a b c))) 'error) (test (let ((args '(:b 99 :z 22))) (with-optkeys (args a b (c 33)) (list a b c))) 'error) (test (let ((args '(:z 22))) (with-optkeys (args a b (c 33) &allow-other-keys) (list a b c &allow-other-keys))) '(#f #f 33 (:z 22))) (test (let ((args '(:id "0" :inst "flute" :name "Flute"))) (with-optkeys (args id inst &allow-other-keys) (list id inst &allow-other-keys))) '("0" "flute" (:name "Flute"))) (test (let ((args '(:inst "flute" :id "0" :name "Flute"))) (with-optkeys (args id inst &allow-other-keys) (list id inst &allow-other-keys))) '("0" "flute" (:name "Flute"))) (test (let ((args '(:id "0" :name "Flute" :inst "flute"))) (with-optkeys (args id inst &allow-other-keys) (list id inst &allow-other-keys))) '("0" "flute" (:name "Flute"))) (test (let ((args '(:name "Flute" :inst "flute" :id "0"))) (with-optkeys (args id inst &allow-other-keys) (list id inst &allow-other-keys))) '("0" "flute" (:name "Flute"))) (let () ;; some common lispisms ;; where names are the same, but functions are different (abs for example), ;; I'll prepend "cl-" to the CL version; otherwise we end up redefining ;; map and member, for example, which can only cause confusion. ;; ;; also I'm omitting the test-if-not and test-not args which strike me as ridiculous. ;; If CLtL2 says something is deprecated, it's not included. ;; Series and generators are ignored. ;; ;; ... later ... I've run out of gas. ;(define-macro (progn . body) `(let () ,@body)) (define (null obj) (or (not obj) (null? obj))) (define t #t) (define nil ()) (define eq eq?) (define eql eqv?) (define equal equal?) (define (equalp x y) (or (equal x y) (and (char? x) (char? y) (char-ci=? x y)) (and (number? x) (number? y) (= x y)) (and (string? x) (string? y) (string-ci=? x y)))) (define (identity x) x) (define (complement fn) (lambda args (not (apply fn args)))) ;; -------- numbers (define (conjugate z) (complex (real-part z) (- (imag-part z)))) (define zerop zero?) (define oddp odd?) (define evenp even?) (define plusp positive?) (define minusp negative?) (define realpart real-part) (define imagpart imag-part) (define* (float x ignore) (* 1.0 x)) (define rational rationalize) (define mod modulo) (define rem remainder) (define (logtest i1 i2) (not (zero? (logand i1 i2)))) (define (logbitp index integer) (logbit? integer index)) ;(logtest (expt 2 index) integer)) (define (lognand n1 n2) (lognot (logand n1 n2))) (define (lognor n1 n2) (lognot (logior n1 n2))) (define (logandc1 n1 n2) (logand (lognot n1) n2)) (define (logandc2 n1 n2) (logand n1 (lognot n2))) (define (logorc1 n1 n2) (logior (lognot n1) n2)) (define (logorc2 n1 n2) (logior n1 (logior n2))) (define (logeqv . ints) (lognot (apply logxor ints))) ;; from slib (define (logcount n) (define bitwise-bit-count (letrec ((logcnt (lambda (n tot) (if (zero? n) tot (logcnt (quotient n 16) (+ (vector-ref #(0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4) (modulo n 16)) tot)))))) (lambda (n) (cond ((negative? n) (lognot (logcnt (lognot n) 0))) ((positive? n) (logcnt n 0)) (else 0))))) (cond ((negative? n) (bitwise-bit-count (lognot n))) (else (bitwise-bit-count n)))) (define-constant boole-clr 0) (define-constant boole-set 1) (define-constant boole-1 2) (define-constant boole-2 3) (define-constant boole-c1 4) (define-constant boole-c2 5) (define-constant boole-and 6) (define-constant boole-ior 7) (define-constant boole-xor 8) (define-constant boole-eqv 9) (define-constant boole-nand 10) (define-constant boole-nor 11) (define-constant boole-andc1 12) (define-constant boole-andc2 13) (define-constant boole-orc1 14) (define-constant boole-orc2 15) (define (boole op int1 int2) (cond ((= op boole-clr) 0) ((= op boole-set) -1) ;; all ones -- "always 1" is misleading ((= op boole-1) int1) ((= op boole-2) int2) ((= op boole-c1) (lognot int1)) ((= op boole-c2) (lognot int2)) ((= op boole-and) (logand int1 int2)) ((= op boole-ior) (logior int1 int2)) ((= op boole-xor) (logxor int1 int2)) ((= op boole-eqv) (logeqv int1 int2)) ((= op boole-nand) (lognot (logand int1 int2))) ((= op boole-nor) (lognot (logior int1 int2))) ((= op boole-andc1) (logand (lognot int1) int2)) ((= op boole-andc2) (logand int1 (lognot int2))) ((= op boole-orc1) (logior (lognot int1) int2)) ((= op boole-orc2) (logior int1 (lognot int2))))) ;; from Rick (define (byte siz pos) ;; cache size, position and mask. (list siz pos (ash (- (ash 1 siz) 1) pos))) (define byte-size car) (define byte-position cadr) (define byte-mask caddr) (define (ldb bytespec integer) (ash (logand integer (byte-mask bytespec)) (- (byte-position bytespec)))) (define (dpb integer bytespec into) (logior (ash (logand integer (- (ash 1 (byte-size bytespec)) 1)) (byte-position bytespec)) (logand into (lognot (byte-mask bytespec))))) (define (ldb-test byte int) (not (zero? (ldb byte int)))) (define (mask-field byte int) (logand int (dpb -1 byte 0))) (define (deposit-field byte spec int) (logior (logand byte (byte-mask spec)) (logand int (lognot (byte-mask spec))))) (define (scale-float x k) (* x (expt 2.0 k))) ;; from clisp -- can't see any point to most of these (define-constant double-float-epsilon 1.1102230246251568e-16) (define-constant double-float-negative-epsilon 5.551115123125784e-17) (define-constant least-negative-double-float -2.2250738585072014e-308) (define-constant least-negative-long-float -5.676615526003731344e-646456994) (define-constant least-negative-normalized-double-float -2.2250738585072014e-308) (define-constant least-negative-normalized-long-float -5.676615526003731344e-646456994) (define-constant least-negative-normalized-short-float -1.1755e-38) (define-constant least-negative-normalized-single-float -1.1754944e-38) (define-constant least-negative-short-float -1.1755e-38) (define-constant least-negative-single-float -1.1754944e-38) (define-constant least-positive-double-float 2.2250738585072014e-308) (define-constant least-positive-long-float 5.676615526003731344e-646456994) (define-constant least-positive-normalized-double-float 2.2250738585072014e-308) (define-constant least-positive-normalized-long-float 5.676615526003731344e-646456994) (define-constant least-positive-normalized-short-float 1.1755e-38) (define-constant least-positive-normalized-single-float 1.1754944e-38) (define-constant least-positive-short-float 1.1755e-38) (define-constant least-positive-single-float 1.1754944e-38) (define-constant long-float-epsilon 5.4210108624275221706e-20) (define-constant long-float-negative-epsilon 2.7105054312137610853e-20) (define-constant most-negative-double-float -1.7976931348623157e308) ;; most-negative-fixnum (define-constant most-negative-long-float -8.8080652584198167656e646456992) (define-constant most-negative-short-float -3.4028e38) (define-constant most-negative-single-float -3.4028235e38) (define-constant most-positive-double-float 1.7976931348623157e308) ;; most-positive-fixnum (define-constant most-positive-long-float 8.8080652584198167656e646456992) (define-constant most-positive-short-float 3.4028e38) (define-constant most-positive-single-float 3.4028235e38) (define-constant short-float-epsilon 7.6295e-6) (define-constant short-float-negative-epsilon 3.81476e-6) (define-constant single-float-epsilon 5.960465e-8) (define-constant single-float-negative-epsilon 2.9802326e-8) (define (lisp-implementation-type) "s7") (define lisp-implementation-version (lambda () (*s7* 'version))) (define (software-type) "s7") (define software-version (lambda () (*s7* 'version))) (define (machine-version) (if (and (defined? 'file-exists?) (file-exists? "/proc/cpuinfo")) (call-with-input-file "/proc/cpuinfo" (lambda (cpufile) (do ((line (read-line cpufile) (read-line cpufile))) ((or (eof-object? line) (string=? (substring line 0 10) "model name")) (if (string? line) (string-trim " " (substring line (+ 1 (position #\: line)))) "unknown"))))) "unknown")) ;; = < <= > >= are the same, also min max + - * / lcm gcd exp expt log sqrt ;; sin cos tan acos asin atan pi sinh cosh tanh asinh acosh atanh ;; numerator denominator logior logxor logand ash integer-length random ;; slightly different: floor ceiling truncate round and the ff cases thereof ;; abs of complex -> magnitude (define (cl-abs x) (if (not (zero? (imag-part x))) (magnitude x) (abs x))) ;; these actually return multiple values (define* (cl-floor x (divisor 1)) (floor (/ x divisor))) (define* (cl-ceiling x (divisor 1)) (ceiling (/ x divisor))) (define* (cl-truncate x (divisor 1)) (truncate (/ x divisor))) (define* (cl-round x (divisor 1)) (round (/ x divisor))) (define* (ffloor x divisor) (* 1.0 (cl-floor x divisor))) (define* (fceling x divisor) (* 1.0 (cl-ceiling x divisor))) (define* (ftruncate x divisor) (* 1.0 (cl-truncate x divisor))) (define* (fround x divisor) (* 1.0 (cl-round x divisor))) (define (/= . args) (if (null? (cdr args)) #t (if (member (car args) (cdr args)) #f (apply /= (cdr args))))) (define (1- x) (- x 1)) (define (isqrt x) (floor (sqrt x))) (define phase angle) (define* (cl-complex rl (im 0.0)) (#_complex rl im)) (define (signum x) (if (zerop x) x (/ x (abs x)))) (define (cis x) (exp (cl-complex 0.0 x))) ;; -------- characters (define char-code-limit 256) (define alpha-char-p char-alphabetic?) (define upper-case-p char-upper-case?) (define lower-case-p char-lower-case?) (define* (digit-char-p c (radix 10)) (string->number (string c) radix)) (define (alphanumericp c) (or (char-alphabetic? c) (char-numeric? c))) (define* (char= . args) (or (< (length args) 2) (apply char=? args))) (define* (char< . args) (or (< (length args) 2) (apply char . args) (or (< (length args) 2) (apply char>? args))) (define* (char>= . args) (or (< (length args) 2) (apply char>=? args))) (define* (char-equal . args) (or (< (length args) 2) (apply char-ci=? args))) (define* (char-lessp . args) (or (< (length args) 2) (apply char-ci? args))) (define* (char-not-lessp . args) (or (< (length args) 2) (apply char-ci>=? args))) (define* (char-not-greaterp . args) (or (< (length args) 2) (apply char-ci<=? args))) (define (char/= . args) (if (null? (cdr args)) #t (if (member (car args) (cdr args)) #f (apply char/= (cdr args))))) (define (char-not-equal . args) (if (null? (cdr args)) #t (if (or (member (char-upcase (car args)) (cdr args)) (member (char-downcase (car args)) (cdr args))) #f (apply char-not-equal (cdr args))))) (define char-code char->integer) (define code-char integer->char) (define (character c) (if (char? c) c (if (integer? c) (integer->char c) (if (string? c) (c 0) (if (symbol? c) ((symbol->string c) 0)))))) ;; char-upcase and char-downcase are ok (define char-int char->integer) (define int-char integer->char) (define* (digit-char w (radix 10)) (let ((str (number->string w radix))) (and str (= (length str) 1) (str 0)))) (define (both-case-p c) "unimplemented") (define (standard-char-p c) "unimplemented") (define (char-name c) "unimplemented") (define (name-char s) "unimplemented") ;; -------- (define terpri newline) ;; -------- types (define vectorp vector?) (define simple-vector-p vector?) (define symbolp symbol?) (define (atom obj) (not (pair? obj))) (define consp pair?) (define (listp obj) (or (null? obj) (pair? obj))) (define numberp number?) (define integerp integer?) (define rationalp rational?) (define (floatp l) (and (number? l) (not (rational? l)) (zero? (imag-part l)))) ; clisp (define (complexp l) (and (complex? l) (not (real? l)))) (define realp real?) (define characterp char?) (define stringp string?) (define simple-string-p string?) (define arrayp vector?) (define simple-bit-vector-p vector?) (define keywordp keyword?) (define functionp procedure?) (define symbol-value symbol->value) (define symbol-function symbol->value) (define fdefinition symbol->value) (define boundp defined?) (define fboundp defined?) (define (funcall fn . arguments) (apply fn arguments)) (define-constant call-arguments-limit 65536) ;; -------- (define progn begin) (define-macro (prog1 first . body) (let ((result (gensym))) `(let ((,result ,first)) ,@body ,result))) (define-macro (prog2 first second . body) `(prog1 (progn ,first ,second) ,@body)) (define-macro (the type form) form) ; see function the in stuff.scm (define-macro (defvar var . args) `(define ,var (or ,(and (not (null? args)) (car args)) #f))) (define-macro* (incf sym (inc 1)) `(set! ,sym (+ ,sym ,inc))) (define-macro* (decf sym (dec 1)) `(set! ,sym (- ,sym ,dec))) ;; the simple version seems to work ok, but just for lafs: (define incf-b (let ((arg (gensym)) (inc (gensym)) (name (gensym))) (apply define-bacro* `((,name ,arg (,inc 1)) `(set! ,,arg (+ ,,arg ,,inc)))))) (define-macro (push val sym) `(setf ,sym (cons ,val ,sym))) (define-macro (pop sym) (let ((v (gensym))) `(let ((,v (car ,sym))) (setf ,sym (cdr ,sym)) ,v))) (define-macro* (pushnew val sym (test equal?) (key identity)) (let ((g (gensym)) (k (if (procedure? key) key identity))) ; can be explicit nil! `(let ((,g ,val)) (if (null? (cl-member (,k ,g) ,sym ,test ,k)) (push ,g ,sym)) ,sym))) (define-macro (declare . args) #f) (define-macro (set a b) `(set! ,(symbol->value a) ,b)) (define-expansion (setf . pairs) (if (not (even? (length pairs))) (error 'syntax-error "setf has odd number of args")) `(let () ,@(let ((var #f)) (map (lambda (p) (if var (let ((val (if (pair? var) (if (member (car var) '(aref svref elt char schar)) (list 'set! (cdr var) p) (if (eq? (car var) 'car) (list 'set-car! (cadr var) p) (if (eq? (car var) 'cdr) (list 'set-cdr! (cadr var) p) (if (eq? (car var) 'nth) (list 'set! (list (caddr var) (cadr var)) p) (list 'set! var p) )))) (list 'set! var p)))) (set! var #f) val) (begin (set! var p) ()))) pairs)))) (define-expansion (setq . pairs) (if (not (even? (length pairs))) (error 'syntax-error "setq has odd number of args")) `(let () ,@(let ((var #f)) (map (lambda (p) (if var (let ((val (list 'set! var p))) (set! var #f) val) (begin (set! var p) ()))) pairs)))) (define-macro (psetq . pairs) (let ((vals ()) (vars ())) (do ((var-val pairs (cddr var-val))) ((null? var-val)) (let ((interval (gensym))) (set! vals (cons (list interval (cadr var-val)) vals)) (set! vars (cons (list 'set! (car var-val) interval) vars)))) `(let ,(reverse vals) ,@vars))) (define (mapcar func . lists) ;; not scheme's map because lists can be different lengths ;; and args can be any sequence type (all mixed together) (define (mapcar-seqs func seqs) (if (null? seqs) () (cons (func (car seqs)) (mapcar-seqs func (cdr seqs))))) (define (mapcar-1 index lens func seqs) (if (member index lens) () (cons (apply func (mapcar-seqs (lambda (obj) (obj index)) seqs)) (mapcar-1 (+ index 1) lens func seqs)))) (let ((lens (map length lists))) (mapcar-1 0 lens func lists))) ;; (define (mapcar func . lists) ;; not scheme's map because lists can be different lengths ;; (if (member () lists) () (cons (apply func (map car lists)) (apply mapcar func (map cdr lists))))) (define (maplist function . lists) (if (member () lists) () (cons (apply function lists) (apply maplist function (map cdr lists))))) (define (mapc function . lists) (define (mapc-1 function . lists) (if (not (member () lists)) (begin (apply function (map car lists)) (apply mapc-1 function (map cdr lists))))) (apply mapc-1 function lists) (car lists)) (define (mapl function . lists) (define (mapl-1 function . lists) (if (not (member () lists)) (begin (apply function lists) (apply mapl-1 function (map cdr lists))))) (apply mapl-1 function lists) (car lists)) (define (mapcon function . lists) (apply nconc (apply maplist function lists))) (define (mapcan function . lists) (apply nconc (apply mapcar function lists))) (define* (map-into result-sequence function . sequences) (if (or (null? result-sequence) (null? sequences)) result-sequence (let* ((vals (apply mapcar function sequences)) (len (min (length vals) (length result-sequence)))) (do ((i 0 (+ i 1))) ((= i len)) (set! (result-sequence i) (vals i))) result-sequence))) (define input-stream-p input-port?) (define output-stream-p output-port?) ;; -------- vectors ;; vector is ok (define svref vector-ref) (define aref vector-ref) (define array-dimensions vector-dimensions) (define array-total-size vector-length) (define (array-dimension array num) (list-ref (vector-dimensions array) num)) (define-constant array-dimension-limit 16777215) (define-constant array-rank-limit 4096) (define-constant array-total-size-limit 16777215) (define* (make-array dimensions element-type initial-element initial-contents adjustable fill-pointer displaced-to displaced-index-offset) (if (eq? element-type 'character) (or (and initial-contents (string-copy initial-contents)) (cl-make-string dimensions initial-element)) (make-vector (or dimensions 1) initial-element))) (define (array-in-bounds-p array . subscripts) (define (in-bounds dims subs) (or (null? subs) (null? dims) (and (< (car subs) (car dims)) (in-bounds (cdr dims) (cdr subs))))) (in-bounds (vector-dimensions array) subscripts)) (define (row-major-index array . subscripts) (apply + (maplist (lambda (x y) (* (car x) (apply * (cdr y)))) subscripts (vector-dimensions array)))) ;; -------- lists ;; in CL (cdr ()) is nil (define (first l) (if (not (null? l)) (list-ref l 0) ())) (define (second l) (if (> (length l) 1) (list-ref l 1) ())) (define (third l) (if (> (length l) 2) (list-ref l 2) ())) (define (fourth l) (if (> (length l) 3) (list-ref l 3) ())) (define (fifth l) (if (> (length l) 4) (list-ref l 4) ())) (define (sixth l) (if (> (length l) 5) (list-ref l 5) ())) (define (seventh l) (if (> (length l) 6) (list-ref l 6) ())) (define (eighth l) (if (> (length l) 7) (list-ref l 7) ())) (define (ninth l) (if (> (length l) 8) (list-ref l 8) ())) (define (tenth l) (if (> (length l) 9) (list-ref l 9) ())) (define (nth n l) (if (< n (length l)) (list-ref l n) ())) (define (endp val) (if (null? val) #t (if (pair? val) #f (error 'wrong-type-arg "bad arg to endp")))) (define rest cdr) (define list-length length) (define* (cl-make-list size (initial-element ())) (make-list size initial-element)) (define (copy-list lis) (if (not (pair? lis)) lis (cons (car lis) (copy-list (cdr lis))))) (define (rplaca x y) (set-car! x y) x) (define (rplacd x y) (set-cdr! x y) x) (define (copy-tree lis) (if (pair? lis) (copy lis :readable) lis)) (define* (butlast lis (n 1)) (let ((len (length lis))) (if (<= len n) () (let ((result ())) (do ((i 0 (+ i 1)) (lst lis (cdr lst))) ((= i (- len n)) (reverse result)) (set! result (cons (car lst) result))))))) (define* (last lst (n 1)) (let ((len (length lst))) (do ((i 0 (+ i 1)) (l lst (cdr l))) ((or (null? l) (>= i (- len n))) l)))) (define (nthcdr n lst) (do ((i n (- i 1)) (result lst (cdr result))) ((or (null? result) (zero? i)) result))) (define* (tree-equal a b (test eql)) (define (teq a b) (if (not (pair? a)) (and (not (pair? b)) (test a b)) (and (pair? b) (teq (car a) (car b)) (teq (cdr a) (cdr b))))) (teq a b)) (define (acons key datum alist) (cons (cons key datum) alist)) (define (list* obj1 . objs) (define (list-1 obj) (if (null? (cdr obj)) (car obj) (cons (car obj) (list-1 (cdr obj))))) (if (null? objs) obj1 (cons obj1 (list-1 objs)))) (define* (assoc-if predicate alist (key car)) (if (null? alist) () (if (and (not (null? (car alist))) (predicate (key (car alist)))) (car alist) (assoc-if predicate (cdr alist) key)))) (define* (assoc-if-not predicate alist (key car)) (assoc-if (lambda (obj) (not (predicate obj))) alist key)) (define* (cl-assoc item alist (test eql) (key car)) (assoc-if (lambda (obj) (test item obj)) alist key)) (define* (rassoc-if predicate alist (key cdr)) (if (null? alist) () (if (and (pair? (car alist)) (predicate (key (car alist)))) (car alist) (rassoc-if predicate (cdr alist) key)))) (define* (rassoc-if-not predicate alist (key cdr)) (rassoc-if (lambda (obj) (not (predicate obj))) alist key)) (define* (rassoc item alist (test eql) (key cdr)) (rassoc-if (lambda (obj) (test item obj)) alist key)) (define (copy-alist alist) (if (null? alist) () (cons (if (pair? (car alist)) (cons (caar alist) (cdar alist)) (car alist)) (copy-alist (cdr alist))))) (define (revappend x y) (append (reverse x) y)) (define* (pairlis keys data alist) (if (not (= (length keys) (length data))) (error 'syntax-error "pairlis keys and data lists should have the same length")) (let ((lst (or alist ()))) (if (null? keys) lst (do ((key keys (cdr key)) (datum data (cdr datum))) ((null? key) lst) (set! lst (cons (cons (car key) (car datum)) lst)))))) (define* (sublis alist tree (test eql) (key car)) (let ((val (cl-assoc tree alist test key))) (if (not (null? val)) (cdr val) (if (not (pair? tree)) tree (cons (sublis alist (car tree) test key) (sublis alist (cdr tree) test key)))))) (define* (nsublis alist tree (test eql) (key car)) ; sacla (define (sub subtree) (let ((ac (cl-assoc subtree alist test key))) (if (not (null? ac)) (cdr ac) (if (not (pair? subtree)) subtree (let () (set-car! subtree (sub (car subtree))) (set-cdr! subtree (sub (cdr subtree))) subtree))))) (sub tree)) (let () (define* (subst-if new test tree (key identity)) (if (test (key tree)) new (if (not (pair? tree)) tree (cons (subst-if new test (car tree) key) (subst-if new test (cdr tree) key))))) (define* (subst-if-not new test tree (key identity)) (subst-if new (lambda (obj) (not (test obj))) tree key)) (define* (subst new old tree (test eql) (key identity)) (subst-if new (lambda (obj) (test old obj)) tree key)) (define* (nsubst-if new predicate tree (key identity)) ; sacla (define (sub subtree) (if (predicate (key subtree)) new (if (not (pair? subtree)) subtree (let () (set-car! subtree (sub (car subtree))) (set-cdr! subtree (sub (cdr subtree))) subtree)))) (sub tree)) (define* (nsubst-if-not new predicate tree (key identity)) (nsubst-if new (lambda (obj) (not (predicate obj))) tree key)) (define* (nsubst new old tree (test eql) (key identity)) (nsubst-if new (lambda (obj) (test old obj)) tree key)) (test-t (let ((tree '(old (old) ((old))))) (equal (subst 'new 'old tree) '(new (new) ((new)))))) (test-t (eq (subst 'new 'old 'old) 'new)) (test-t (eq (subst 'new 'old 'not-old) 'not-old)) (test-t (equal (subst 'new '(b) '(a ((b))) :test equal) '(a (new)))) (test-t (equal (subst 'x 3 '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (equal (subst 'x "D" '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")) :test equalp :key (lambda (y) (and (listp y) (fourth y)))) '("a" ("a" "b") ("a" "b" "c") x))) (test-t (equal (subst-if 'new (lambda (x) (eq x 'old)) '(old old)) '(new new))) (test-t (equal (subst-if 'x (lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (let ((tree '(old (old) ((old))))) (equal (subst-if 'new (lambda (x) (eq x 'old)) tree) '(new (new) ((new)))))) (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'old) 'new)) (test-t (eq (subst-if 'new (lambda (x) (eq x 'old)) 'not-old) 'not-old)) (test-t (equal (subst-if 'new (lambda (x) (equal x '(b))) '(a ((b)))) '(a (new)))) (test-t (equal (subst-if 'x (lambda (x) (eql x 3)) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (equal (subst-if 'x (lambda (x) (equalp x "D")) '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")) :key (lambda (y) (and (listp y) (fourth y)))) '("a" ("a" "b") ("a" "b" "c") x))) (test-t (equal (subst-if-not 'new (lambda (x) (not (eq x 'old))) '(old old)) '(new new))) (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new)) (test-t (equal (subst-if-not 'x (lambda (x) (not (eql x 3))) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (let ((tree '(old (old) ((old))))) (equal (subst-if-not 'new (lambda (x) (not (eq x 'old))) tree) '(new (new) ((new)))))) (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new)) (test-t (eq (subst-if-not 'new (lambda (x) (not (eq x 'old))) 'not-old) 'not-old)) (test-t (equal (subst-if-not 'new (lambda (x) (not (equal x '(b)))) '(a ((b)))) '(a (new)))) (test-t (equal (subst-if-not 'x (lambda (x) (not (eql x 3))) '(1 (1 2) (1 2 3) (1 2 3 4)) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (equal (subst-if-not 'x (lambda (x) (not (equalp x "D"))) '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d")) :key (lambda (y) (and (listp y) (fourth y)))) '("a" ("a" "b") ("a" "b" "c") x))) (test-t (let ((tree '(old (old) ((old))))) (equal (nsubst 'new 'old (copy-tree tree)) '(new (new) ((new)))))) (test-t (let* ((tree (copy-tree '(old (old) ((old))))) (new-tree (nsubst 'new 'old tree))) (and (eq tree new-tree) (equal tree '(new (new) ((new))))))) (test-t (eq (nsubst 'new 'old 'old) 'new)) (test-t (eq (nsubst 'new 'old 'not-old) 'not-old)) (test-t (equal (nsubst 'new '(b) (copy-tree '(a ((b)))) :test equal) '(a (new)))) (test-t (equal (nsubst 'x 3 (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4))) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (equal (nsubst 'x "D" (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))) :test equalp :key (lambda (y) (and (listp y) (fourth y)))) '("a" ("a" "b") ("a" "b" "c") x))) (test-t (equal (nsubst-if 'new (lambda (x) (eq x 'old)) (list 'old 'old)) '(new new))) (test-t (let* ((x (copy-tree '(old (old) ((old)) (old) old))) (y (nsubst-if 'new (lambda (x) (eq x 'old)) x))) (and (eq x y) (equal x '(new (new) ((new)) (new) new))))) (test-t (equal (nsubst-if 'x (lambda (x) (eql x 3)) (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4))) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (let ((tree '(old (old) ((old))))) (equal (nsubst-if 'new (lambda (x) (eq x 'old)) (copy-tree tree)) '(new (new) ((new)))))) (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'old) 'new)) (test-t (eq (nsubst-if 'new (lambda (x) (eq x 'old)) 'not-old) 'not-old)) (test-t (equal (nsubst-if 'new (lambda (x) (equal x '(b))) (copy-tree '(a ((b))))) '(a (new)))) (test-t (equal (nsubst-if 'x (lambda (x) (eql x 3)) (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4))) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (equal (nsubst-if 'x (lambda (x) (equalp x "D")) (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))) :key (lambda (y) (and (listp y) (fourth y)))) '("a" ("a" "b") ("a" "b" "c") x))) (test-t (equal (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) (list 'old 'old)) '(new new))) (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'old) 'new)) (test-t (let* ((x (copy-tree '(old (old) ((old)) (old) old))) (y (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) x))) (and (eq x y) (equal x '(new (new) ((new)) (new) new))))) (test-t (equal (nsubst-if-not 'x (lambda (x) (not (eql x 3))) (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4))) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (let ((tree '(old (old) ((old))))) (equal (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) (copy-tree tree)) '(new (new) ((new)))))) (test-t (eq (nsubst-if-not 'new (lambda (x) (not (eq x 'old))) 'not-old) 'not-old)) (test-t (equal (nsubst-if-not 'new (lambda (x) (not (equal x '(b)))) (copy-tree '(a ((b))))) '(a (new)))) (test-t (equal (nsubst-if-not 'x (lambda (x) (not (eql x 3))) (copy-tree '(1 (1 2) (1 2 3) (1 2 3 4))) :key (lambda (y) (and (listp y) (third y)))) '(1 (1 2) x x))) (test-t (equal (nsubst-if-not 'x (lambda (x) (not (equalp x "D"))) (copy-tree '("a" ("a" "b") ("a" "b" "c") ("a" "b" "c" "d"))) :key (lambda (y) (and (listp y) (fourth y)))) '("a" ("a" "b") ("a" "b" "c") x))) ) (define (ldiff lst object) ; sacla (if (not (eqv? lst object)) (let* ((result (list (car lst))) (splice result)) (call-with-exit (lambda (return) (do ((l (cdr lst) (cdr l))) ((not (pair? l)) (if (eql l object) (set-cdr! splice ())) result) (if (eqv? l object) (return result) (set! splice (cdr (rplacd splice (list (car l)))))))))) ())) (define* (member-if predicate list (key identity)) (if (null? list) () (if (predicate (key (car list))) list (member-if predicate (cdr list) key)))) (define* (member-if-not predicate list (key identity)) (member-if (lambda (obj) (not (predicate obj))) list key)) (define* (cl-member item list (test eql) (key identity)) (if (null? list) () (if (test item (key (car list))) list (cl-member item (cdr list) test key)))) (define* (adjoin item list (test eql) (key identity)) (if (not (null? (cl-member (key item) list test key))) list (cons item list))) (define (tailp sublist list) (or (eq? sublist list) (and (not (null? list)) (tailp sublist (cdr list))))) (define* (nbutlast list (n 1)) ; sacla (if (null? list) () (let ((length (do ((p (cdr list) (cdr p)) (i 1 (+ i 1))) ((not (pair? p)) i)))) (if (> length n) (do ((1st (cdr list) (cdr 1st)) (2nd list 1st) (count (- length n 1) (- count 1))) ((zero? count) (set-cdr! 2nd ()) list)) ())))) (define (nconc . lists) ; sacla sort of (let ((ls (let () (define (strip-nulls lst) (if (null? lst) () (if (null? (car lst)) (strip-nulls (cdr lst)) lst))) (strip-nulls lists)))) (if (null? ls) () (let* ((top (car ls)) (splice top)) (do ((here (cdr ls) (cdr here))) ((null? here) top) (set-cdr! (last splice) (car here)) (if (not (null? (car here))) (set! splice (car here)))))))) (define (nreconc x y) (nconc (nreverse x) y)) ;; -------- sequences (define-macro (with-iterator it . body) `(let ((,(car it) (let ((f (make-iterator ,(cadr it))) (+iterator+ #t)) (lambda () (let ((val (f))) (and val (values #t (car val) (cdr val)))))))) ,@body)) (define hash-table-p hash-table?) (define* (gethash k h (d ())) (or (hash-table-ref k h) d)) (define maphash map) (define clrhash fill!) (define hash-table-count hash-table-entries) (let () (define* (count-if predicate sequence from-end (start 0) end (key identity)) (let* ((counts 0) (len (length sequence)) (nd (or (and (number? end) end) len))) ; up to but not including end (if (< nd start) (error 'out-of-range "count-if :start ~A is greater than ~A ~A" start (if end ":end" "length") nd)) (if (not from-end) (do ((i start (+ i 1))) ((= i nd)) (if (predicate (key (sequence i))) (set! counts (+ counts 1)))) (do ((i (- nd 1) (- i 1))) ((< i start)) (if (predicate (key (sequence i))) (set! counts (+ counts 1))))) counts)) (define* (count-if-not predicate sequence from-end (start 0) end (key identity)) (count-if (lambda (obj) (not (predicate obj))) sequence from-end start end key)) (define* (count item sequence from-end (test eql) (start 0) end (key identity)) (count-if (lambda (arg) (test item arg)) sequence from-end start end key)) (test-t (eql (count-if-not oddp '((1) (2) (3) (4)) :key car) 2)) (test-t (eql (count-if upper-case-p "The Crying of Lot 49" :start 4) 2)) ;(test-t (eql (count #\a (concatenate 'list "how many A's are there in here?")) 2)) (test-t (eql (count-if alpha-char-p "-a-b-c-0-1-2-3-4-") 3)) (test-t (eql (count-if alphanumericp "-a-b-c-0-1-2-3-4-") 8)) (test-t (eql (count nil (list t nil t nil t nil)) 3)) (test-t (eql (count nil (vector t nil t nil t nil)) 3)) (test-t (zerop (count 9 '(0 1 2 3 4)))) (test-t (zerop (count 'a '(0 1 2 3 4)))) (test-t (eql (count 0 '(0 0 0 0 0) :start 1) 4)) (test-t (eql (count 0 '(0 0 0 0 0) :start 1 :end nil) 4)) (test-t (eql (count 0 '(0 0 0 0 0) :start 2) 3)) (test-t (zerop (count 0 '(0 0 0 0) :start 0 :end 0))) (test-t (zerop (count 0 '(0 0 0 0) :start 2 :end 2))) (test-t (zerop (count 0 '(0 0 0 0) :start 4 :end 4))) (test-t (eql (count 0 '(0 0 0 0) :start 2 :end 3) 1)) (test-t (eql (count #\a "abcABC" :test equalp) 2)) (test-t (eql (count #\a "abcABC" :test char-equal) 2)) (test-t (eql (count '(a) '((x) (y) (z) (a) (b) (c)) :test equalp) 1)) (test-t (eql (count 'a '((x) (y) (z) (a) (b) (c)) :key car :test eq) 1)) (test-t (eql (count nil '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr :test eq) 3)) (test-t (let ((lst nil)) (and (eql (count 'a '(a b c d) :test (lambda (a b) (setq lst (cons b lst)) (eq a b))) 1) (equal lst '(d c b a))))) (test-t (let ((lst nil)) (and (eql (count 'a '(a b c d) :test (lambda (a b) (setq lst (cons b lst)) (eq a b)) :from-end t) 1) (equal lst '(a b c d))))) (test-t (zerop (count 9 #(0 1 2 3 4)))) (test-t (zerop (count 'a #(0 1 2 3 4)))) (test-t (eql (count 0 #(0 0 0 0 0) :start 1) 4)) (test-t (eql (count 0 #(0 0 0 0 0) :start 1 :end nil) 4)) (test-t (eql (count 0 #(0 0 0 0 0) :start 2) 3)) (test-t (zerop (count 0 #(0 0 0 0) :start 0 :end 0))) (test-t (zerop (count 0 #(0 0 0 0) :start 2 :end 2))) (test-t (zerop (count 0 #(0 0 0 0) :start 4 :end 4))) (test-t (eql (count 0 #(0 0 0 0) :start 2 :end 3) 1)) (test-t (eql (count '(a) #((x) (y) (z) (a) (b) (c)) :test equalp) 1)) (test-t (eql (count 'a #((x) (y) (z) (a) (b) (c)) :key car :test eq) 1)) (test-t (eql (count nil #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr :test eq) 3)) (test-t (let ((list nil)) (and (eql (count 'a #(a b c d) :test (lambda (a b) (setq list (cons b list)) (eq a b))) 1) (equal list '(d c b a))))) (test-t (let ((list nil)) (and (eql (count 'a #(a b c d) :test (lambda (a b) (setq list (cons b list)) (eq a b)) :from-end t) 1) (equal list '(a b c d))))) (test-t (eql (count-if null (list t nil t nil t nil)) 3)) (test-t (zerop (count-if (lambda (x) (eql x 9)) #(0 1 2 3 4)))) (test-t (zerop (count-if (lambda (a) (eq 'x a)) #(0 1 2 3 4)))) (test-t (eql (count-if zerop '(0 0 0 0 0) :start 1) 4)) (test-t (eql (count-if zerop '(0 0 0 0 0) :start 1 :end nil) 4)) (test-t (eql (count-if zerop '(0 0 0 0 0) :start 2) 3)) (test-t (zerop (count-if zerop '(0 0 0 0) :start 0 :end 0))) (test-t (zerop (count-if zerop '(0 0 0 0) :start 2 :end 2))) (test-t (zerop (count-if zerop '(0 0 0 0) :start 4 :end 4))) (test-t (eql (count-if zerop '(0 0 0 0) :start 2 :end 3) 1)) (test-t (eql (count-if (lambda (x) (equalp #\a x)) "abcABC") 2)) (test-t (eql (count-if (lambda (x) (char-equal #\a x)) "abcABC") 2)) (test-t (eql (count-if (lambda (x) (equal x '(a))) '((x) (y) (z) (a) (b) (c))) 1)) (test-t (eql (count-if (lambda (x) (eq x 'a)) '((x) (y) (z) (a) (b) (c)) :key car) 1)) (test-t (eql (count-if null '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3)) (test-t (let ((list nil)) (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a)) '(a b c d)) 1) (equal list '(d c b a))))) (test-t (let ((list nil)) (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a)) '(a b c d) :from-end t) 1) (equal list '(a b c d))))) (test-t (eql (count-if null (vector t nil t nil t nil)) 3)) (test-t (eql (count-if zerop #(0 0 0 0 0) :start 1) 4)) (test-t (eql (count-if zerop #(0 0 0 0 0) :start 1 :end nil) 4)) (test-t (eql (count-if zerop #(0 0 0 0 0) :start 2) 3)) (test-t (zerop (count-if zerop #(0 0 0 0) :start 0 :end 0))) (test-t (zerop (count-if zerop #(0 0 0 0) :start 2 :end 2))) (test-t (zerop (count-if zerop #(0 0 0 0) :start 4 :end 4))) (test-t (eql (count-if zerop #(0 0 0 0) :start 2 :end 3) 1)) (test-t (eql (count-if (lambda (x) (equal x '(a))) #((x) (y) (z) (a) (b) (c))) 1)) (test-t (eql (count-if (lambda (x) (eq x 'a)) #((x) (y) (z) (a) (b) (c)) :key car) 1)) (test-t (eql (count-if null #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3)) (test-t (let ((list nil)) (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a)) #(a b c d)) 1) (equal list '(d c b a))))) (test-t (let ((list nil)) (and (eql (count-if (lambda (x) (setq list (cons x list)) (eq x 'a)) #(a b c d) :from-end t) 1) (equal list '(a b c d))))) (test-t (eql (count-if-not (complement null) (list t nil t nil t nil)) 3)) (test-t (zerop (count-if-not (lambda (x) (not (eql x 9))) #(0 1 2 3 4)))) (test-t (zerop (count-if-not (lambda (a) (not (eq 'x a))) #(0 1 2 3 4)))) (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 1) 4)) (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 1 :end nil) 4)) (test-t (eql (count-if-not (complement zerop) '(0 0 0 0 0) :start 2) 3)) (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 0 :end 0))) (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 2 :end 2))) (test-t (zerop (count-if-not (complement zerop) '(0 0 0 0) :start 4 :end 4))) (test-t (eql (count-if-not (complement zerop) '(0 0 0 0) :start 2 :end 3) 1)) (test-t (eql (count-if-not (lambda (x) (not (equalp #\a x))) "abcABC") 2)) (test-t (eql (count-if-not (lambda (x) (not (char-equal #\a x))) "abcABC") 2)) (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) '((x) (y) (z) (a) (b) (c))) 1)) (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) '((x) (y) (z) (a) (b) (c)) :key car) 1)) (test-t (eql (count-if-not (complement null) '((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3)) (test-t (let ((list nil)) (and (eql (count-if-not (lambda (x) (setq list (cons x list)) (not (eq x 'a))) '(a b c d)) 1) (equal list '(d c b a))))) (test-t (let ((list nil)) (and (eql (count-if-not (lambda (x) (setq list (cons x list)) (not (eq x 'a))) '(a b c d) :from-end t) 1) (equal list '(a b c d))))) (test-t (eql (count-if-not (complement null) (vector t nil t nil t nil)) 3)) (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 1) 4)) (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 1 :end nil) 4)) (test-t (eql (count-if-not (complement zerop) #(0 0 0 0 0) :start 2) 3)) (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 0 :end 0))) (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 2 :end 2))) (test-t (zerop (count-if-not (complement zerop) #(0 0 0 0) :start 4 :end 4))) (test-t (eql (count-if-not (complement zerop) #(0 0 0 0) :start 2 :end 3) 1)) (test-t (eql (count-if-not (lambda (x) (not (equal x '(a)))) #((x) (y) (z) (a) (b) (c))) 1)) (test-t (eql (count-if-not (lambda (x) (not (eq x 'a))) #((x) (y) (z) (a) (b) (c)) :key car) 1)) (test-t (eql (count-if-not (complement null) #((x . x) (y) (z . z) (a) (b . b) (c)) :key cdr) 3)) (test-t (let ((list nil)) (and (eql (count-if-not (lambda (x) (setq list (cons x list)) (not (eq x 'a))) #(a b c d)) 1) (equal list '(d c b a))))) (test-t (let ((list nil)) (and (eql (count-if-not (lambda (x) (setq list (cons x list)) (not (eq x 'a))) #(a b c d) :from-end t) 1) (equal list '(a b c d))))) (test (count-if zero? '(0 1 2 0)) 2) (test (count-if-not zero? '(0 1 2 0 3)) 3) (test (count-if zero? #(0 1 2 0)) 2) (test (count-if zero? '((0 1) (1 0) (2 3) (0 1)) :key car) 2) (test (count-if zero? '(0 1 2 0) :from-end #t) 2) (test (count-if zero? '(0 1 2 0) :start 1) 1) (test (count-if zero? '(0 1 2 0) :start 1 :end 3) 0) (test (count-if zero? '(0 1 2 0) :end 3) 1) (test (count-if zero? '(0 1 2 0) :end 4) 2) (test (count-if zero? '(0 1 2 0) :end 4 :from-end #t) 2) (test-t (eql (count #\a "how many A's are there in here?") 2)) ) (define* (find-if predicate sequence from-end (start 0) end (key identity)) (let* ((len (length sequence)) (nd (or (and (number? end) end) len))) ; up to but not including end (if (< nd start) (error 'out-of-range "~A :start ~A is greater than ~A ~A" (*function* (curlet)) start (if end ":end" "length") nd)) (call-with-exit (lambda (return) (if (not from-end) (do ((i start (+ i 1))) ((= i nd) #f) (if (predicate (key (sequence i))) (return (sequence i)))) (do ((i (- nd 1) (- i 1))) ((< i start) #f) (if (predicate (key (sequence i))) (return (sequence i))))))))) (define* (find item sequence from-end (test eql) (start 0) end (key identity)) (find-if (lambda (arg) (test item arg)) sequence from-end start end key)) (let () (define* (find-if-not predicate sequence from-end (start 0) end (key identity)) (find-if (lambda (obj) (not (predicate obj))) sequence from-end start end key)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c)) 'a)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c)) 'b)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c)) 'c)) (test-t (null (find-if-not (lambda (arg) (not (eq arg 'x))) '(a b c)))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1))) (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :start 2))) (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :start 3))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0 :from-end t))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1 :from-end t))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2 :from-end t))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3 :from-end t))) (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end nil) 'a)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end nil) 'b)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end nil) 'c)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 1) 'a)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 2) 'b)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 3) 'c)) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 0))) (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 1))) (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 2))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c))))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key car) '(a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key car) '(b))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key car) '(c))) (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key car))) (test-t (let ((list '((a) (b) (c)))) (and (eq (find-if-not (lambda (x) (not (eq x 'a))) list :key car) (car list)) (eq (find-if-not (lambda (x) (not (eq x 'b))) list :key car) (cadr list)) (eq (find-if-not (lambda (x) (not (eq x 'c))) list :key car) (caddr list)) (null (find-if-not (lambda (x) (not (eq x 'z))) list :key car))))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(b))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(c))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c))) (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c)) 'a)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c)) 'b)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c)) 'c)) (test-t (null (find-if-not (lambda (arg) (not (eq arg 'x))) #(a b c)))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1))) (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :start 2))) (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :start 3))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0 :from-end t))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1 :from-end t))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2 :from-end t))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3 :from-end t))) (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end nil) 'a)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end nil) 'b)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end nil) 'c)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 1) 'a)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 2) 'b)) (test-t (eq (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 3) 'c)) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 0))) (test-t (null (find-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 1))) (test-t (null (find-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 2))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c))))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key car) '(a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key car) '(b))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key car) '(c))) (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key car))) (test-t (let ((vect #((a) (b) (c)))) (and (eq (find-if-not (lambda (x) (not (eq x 'a))) vect :key car) (aref vect 0)) (eq (find-if-not (lambda (x) (not (eq x 'b))) vect :key car) (aref vect 1)) (eq (find-if-not (lambda (x) (not (eq x 'c))) vect :key car) (aref vect 2)) (null (find-if-not (lambda (x) (not (eq x 'z))) vect :key car))))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(b))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(c))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c))) (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (find-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a))) (test-t (equal (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a))) (test-t (null (find-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) ) (let () (define* (position-if predicate sequence from-end (start 0) end (key identity)) (let* ((len (length sequence)) (nd (or (and (number? end) end) len))) ; up to but not including end (if (< nd start) (error 'out-of-range "~A :start ~A is greater than ~A ~A" (*function* (curlet)) start (if end ":end" "length") nd)) (call-with-exit (lambda (return) (if (not from-end) (do ((i start (+ i 1))) ((= i nd) #f) (if (predicate (key (sequence i))) (return i))) (do ((i (- nd 1) (- i 1))) ((< i start) #f) (if (predicate (key (sequence i))) (return i)))))))) (define* (position-if-not predicate sequence from-end (start 0) end (key identity)) (position-if (lambda (obj) (not (predicate obj))) sequence from-end start end key)) (define* (position item sequence from-end (test eql) (start 0) end (key identity)) (position-if (lambda (arg) (test item arg)) sequence from-end start end key)) (test-t (eql (position #\a "baobab" :from-end t) 4)) (test-t (eql (position-if oddp '((1) (2) (3) (4)) :start 1 :key car) 2)) (test-t (null (position 595 ()))) (test-t (eql (position-if-not integerp '(1 2 3 4 5.0)) 4)) (test-t (eql (position 'a '(a b c)) 0)) (test-t (eql (position 'b '(a b c)) 1)) (test-t (eql (position 'c '(a b c)) 2)) (test-t (null (position 'x '(a b c)))) (test-t (null (position 'a '(a b c) :start 1))) (test-t (null (position 'b '(a b c) :start 2))) (test-t (null (position 'c '(a b c) :start 3))) (test-t (null (position 'a '(a b c) :start 0 :end 0))) (test-t (null (position 'a '(a b c) :start 0 :end 0 :from-end t))) (test-t (null (position 'a '(a b c) :start 1 :end 1))) (test-t (null (position 'a '(a b c) :start 1 :end 1 :from-end t))) (test-t (null (position 'a '(a b c) :start 2 :end 2))) (test-t (null (position 'a '(a b c) :start 2 :end 2 :from-end t))) (test-t (null (position 'a '(a b c) :start 3 :end 3))) (test-t (null (position 'a '(a b c) :start 3 :end 3 :from-end t))) (test-t (eql (position 'a '(a b c) :end nil) '0)) (test-t (eql (position 'b '(a b c) :end nil) '1)) (test-t (eql (position 'c '(a b c) :end nil) '2)) (test-t (eql (position 'a '(a b c) :end 1) '0)) (test-t (eql (position 'b '(a b c) :end 2) '1)) (test-t (eql (position 'c '(a b c) :end 3) '2)) (test-t (null (position 'a '(a b c) :end 0))) (test-t (null (position 'b '(a b c) :end 1))) (test-t (null (position 'c '(a b c) :end 2))) (test-t (null (position 'a '((a) (b) (c))))) (test-t (eql (position 'a '((a) (b) (c)) :key car) 0)) (test-t (eql (position 'b '((a) (b) (c)) :key car) 1)) (test-t (eql (position 'c '((a) (b) (c)) :key car) 2)) (test-t (null (position 'z '((a) (b) (c)) :key car))) (test-t (null (position '(a) '((a) (b) (c))))) (test-t (eql (position '(a) '((a) (b) (c)) :test equal) 0)) (test-t (null (position '("a") '(("a") ("b") ("c"))))) (test-t (eql (position 3 '(0 1 2 3 4 5)) 3)) (test-t (eql (position 3 '(0 1 2 3 4 5) :test <) 4)) (test-t (eql (position 3 '(0 1 2 3 4 5) :test >) 0)) (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key car) 0)) (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3)) (test-t (eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key car) 1)) (test-t (eql (position 'b '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4)) (test-t (eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key car) 2)) (test-t (eql (position 'c '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5)) (test-t (null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (position 'z '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6)) (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6)) (test-t (eql (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3)) (test-t (null (position 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (eql (position 'a #(a b c)) 0)) (test-t (eql (position 'b #(a b c)) 1)) (test-t (eql (position 'c #(a b c)) 2)) (test-t (null (position 'x #(a b c)))) (test-t (null (position 'a #(a b c) :start 1))) (test-t (null (position 'b #(a b c) :start 2))) (test-t (null (position 'c #(a b c) :start 3))) (test-t (null (position 'a #(a b c) :start 0 :end 0))) (test-t (null (position 'a #(a b c) :start 0 :end 0 :from-end t))) (test-t (null (position 'a #(a b c) :start 1 :end 1))) (test-t (null (position 'a #(a b c) :start 1 :end 1 :from-end t))) (test-t (null (position 'a #(a b c) :start 2 :end 2))) (test-t (null (position 'a #(a b c) :start 2 :end 2 :from-end t))) (test-t (null (position 'a #(a b c) :start 3 :end 3))) (test-t (null (position 'a #(a b c) :start 3 :end 3 :from-end t))) (test-t (eql (position 'a #(a b c) :end nil) 0)) (test-t (eql (position 'b #(a b c) :end nil) 1)) (test-t (eql (position 'c #(a b c) :end nil) 2)) (test-t (eql (position 'a #(a b c) :end 1) 0)) (test-t (eql (position 'b #(a b c) :end 2) 1)) (test-t (eql (position 'c #(a b c) :end 3) 2)) (test-t (null (position 'a #(a b c) :end 0))) (test-t (null (position 'b #(a b c) :end 1))) (test-t (null (position 'c #(a b c) :end 2))) (test-t (null (position 'a #((a) (b) (c))))) (test-t (eql (position 'a #((a) (b) (c)) :key car) 0)) (test-t (eql (position 'b #((a) (b) (c)) :key car) 1)) (test-t (eql (position 'c #((a) (b) (c)) :key car) 2)) (test-t (null (position 'z #((a) (b) (c)) :key car))) (test-t (null (position '(a) #((a) (b) (c))))) (test-t (eql (position '(a) #((a) (b) (c)) :test equal) 0)) (test-t (null (position '("a") #(("a") ("b") ("c"))))) (test-t (eql (position 3 #(0 1 2 3 4 5)) 3)) (test-t (eql (position 3 #(0 1 2 3 4 5) :test <) 4)) (test-t (eql (position 3 #(0 1 2 3 4 5) :test >) 0)) (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key car) 0)) (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3)) (test-t (eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key car) 1)) (test-t (eql (position 'b #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4)) (test-t (eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key car) 2)) (test-t (eql (position 'c #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5)) (test-t (null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (position 'z #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6)) (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6)) (test-t (eql (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3)) (test-t (null (position 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (null (position #\z "abcABC"))) (test-t (eql (position #\a "abcABC") 0)) (test-t (eql (position #\A "abcABC") 3)) (test-t (eql (position #\A "abcABC" :test char-equal) 0)) (test-t (eql (position #\A "abcABC" :test char-equal :from-end t) 3)) (test-t (eql (position #\a "abcABC" :test char-equal :from-end t) 3)) (test-t (eql (position #\a "abcABC" :test char-equal :from-end t :end 4) 3)) (test-t (eql (position #\a "abcABC" :test char-equal :from-end t :end 3) 0)) (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c)) 0)) (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c)) 1)) (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c)) 2)) (test-t (null (position-if (lambda (arg) (eq arg 'x)) '(a b c)))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1))) (test-t (null (position-if (lambda (x) (eq x 'b)) '(a b c) :start 2))) (test-t (null (position-if (lambda (x) (eq x 'c)) '(a b c) :start 3))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0 :from-end t))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1 :from-end t))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2 :from-end t))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3))) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3 :from-end t))) (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c) :end nil) 0)) (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c) :end nil) 1)) (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c) :end nil) 2)) (test-t (eql (position-if (lambda (x) (eq x 'a)) '(a b c) :end 1) 0)) (test-t (eql (position-if (lambda (x) (eq x 'b)) '(a b c) :end 2) 1)) (test-t (eql (position-if (lambda (x) (eq x 'c)) '(a b c) :end 3) 2)) (test-t (null (position-if (lambda (x) (eq x 'a)) '(a b c) :end 0))) (test-t (null (position-if (lambda (x) (eq x 'b)) '(a b c) :end 1))) (test-t (null (position-if (lambda (x) (eq x 'c)) '(a b c) :end 2))) (test-t (null (position-if (lambda (x) (eq x 'a)) '((a) (b) (c))))) (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c)) :key car) 0)) (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c)) :key car) 1)) (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c)) :key car) 2)) (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c)) :key car))) (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 0)) (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3)) (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 1)) (test-t (eql (position-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4)) (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car) 2)) (test-t (eql (position-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5)) (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (position-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6)) (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6)) (test-t (eql (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3)) (test-t (null (position-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c)) 0)) (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c)) 1)) (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c)) 2)) (test-t (null (position-if (lambda (arg) (eq arg 'x)) #(a b c)))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1))) (test-t (null (position-if (lambda (x) (eq x 'b)) #(a b c) :start 2))) (test-t (null (position-if (lambda (x) (eq x 'c)) #(a b c) :start 3))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0 :from-end t))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1 :from-end t))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2 :from-end t))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3))) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3 :from-end t))) (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c) :end nil) 0)) (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c) :end nil) 1)) (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c) :end nil) 2)) (test-t (eql (position-if (lambda (x) (eq x 'a)) #(a b c) :end 1) 0)) (test-t (eql (position-if (lambda (x) (eq x 'b)) #(a b c) :end 2) 1)) (test-t (eql (position-if (lambda (x) (eq x 'c)) #(a b c) :end 3) 2)) (test-t (null (position-if (lambda (x) (eq x 'a)) #(a b c) :end 0))) (test-t (null (position-if (lambda (x) (eq x 'b)) #(a b c) :end 1))) (test-t (null (position-if (lambda (x) (eq x 'c)) #(a b c) :end 2))) (test-t (null (position-if (lambda (x) (eq x 'a)) #((a) (b) (c))))) (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c)) :key car) 0)) (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c)) :key car) 1)) (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c)) :key car) 2)) (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c)) :key car))) (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 0)) (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3)) (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 1)) (test-t (eql (position-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4)) (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car) 2)) (test-t (eql (position-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5)) (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (position-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6)) (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6)) (test-t (eql (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3)) (test-t (null (position-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c)) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c)) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c)) 2)) (test-t (null (position-if-not (lambda (arg) (not (eq arg 'x))) '(a b c)))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1))) (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :start 2))) (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :start 3))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 0 :end 0 :from-end t))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 1 :end 1 :from-end t))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 2 :end 2 :from-end t))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :start 3 :end 3 :from-end t))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end nil) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end nil) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end nil) 2)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 1) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 2) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 3) 2)) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '(a b c) :end 0))) (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) '(a b c) :end 1))) (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) '(a b c) :end 2))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c))))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c)) :key car) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c)) :key car) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c)) :key car) 2)) (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c)) :key car))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car) 2)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5)) (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3)) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c)) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c)) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c)) 2)) (test-t (null (position-if-not (lambda (arg) (not (eq arg 'x))) #(a b c)))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1))) (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :start 2))) (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :start 3))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 0 :end 0 :from-end t))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 1 :end 1 :from-end t))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 2 :end 2 :from-end t))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :start 3 :end 3 :from-end t))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end nil) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end nil) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end nil) 2)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 1) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 2) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 3) 2)) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #(a b c) :end 0))) (test-t (null (position-if-not (lambda (x) (not (eq x 'b))) #(a b c) :end 1))) (test-t (null (position-if-not (lambda (x) (not (eq x 'c))) #(a b c) :end 2))) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c))))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c)) :key car) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c)) :key car) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c)) :key car) 2)) (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c)) :key car))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 0)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 3)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 1)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'b))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 4)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car) 2)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'c))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) 5)) (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (position-if-not (lambda (x) (not (eq x 'z))) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) 6)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) 6)) (test-t (eql (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) 3)) (test-t (null (position-if-not (lambda (x) (not (eq x 'a))) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) ) ;; -------- strings (define char string-ref) (define schar string-ref) (define* (cl-make-string size (initial-element #\null)) (make-string size initial-element)) (define (cl-string x) (if (string? x) x (if (char? x) (string x) (if (symbol? x) (symbol->string x) (error 'wrong-type-arg "string ~A?" x))))) (define* (string= str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2)))) (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (string=? str1 str2) (string=? (subseq str1 start1 nd1) (subseq str2 start2 nd2))))) (define* (string-equal str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2)))) (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (string-ci=? str1 str2) (string-ci=? (subseq str1 start1 nd1) (subseq str2 start2 nd2))))) (define (string-prefixes-equal str1 str2 start1 nd1 start2 nd2) (do ((i start1 (+ i 1)) (j start2 (+ j 1))) ((or (= i nd1) (= j nd2) (not (char=? (str1 i) (str2 j)))) i))) (define (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2) (do ((i start1 (+ i 1)) (j start2 (+ j 1))) ((or (= i nd1) (= j nd2) (not (char-ci=? (str1 i) (str2 j)))) i))) (define* (string< str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2))) (val (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (string str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2))) (val (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (string>? str1 str2) (string>? (subseq str1 start1 nd1) (subseq str2 start2 nd2))))) (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2)))) (define* (string-greaterp str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2))) (val (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (string-ci>? str1 str2) (string-ci>? (subseq str1 start1 nd1) (subseq str2 start2 nd2))))) (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2)))) (define* (string>= str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2))) (val (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (string>=? str1 str2) (string>=? (subseq str1 start1 nd1) (subseq str2 start2 nd2))))) (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2)))) (define* (string-not-lessp str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2))) (val (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (string-ci>=? str1 str2) (string-ci>=? (subseq str1 start1 nd1) (subseq str2 start2 nd2))))) (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2)))) (define* (string/= str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2))) (val (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (not (string=? str1 str2)) (not (string=? (subseq str1 start1 nd1) (subseq str2 start2 nd2)))))) (and val (string-prefixes-equal str1 str2 start1 nd1 start2 nd2)))) (define* (string-not-equal str-1 str-2 (start1 0) end1 (start2 0) end2) (let* ((str1 (cl-string str-1)) (str2 (cl-string str-2)) (nd1 (if (number? end1) end1 (length str1))) (nd2 (if (number? end2) end2 (length str2))) (val (if (and (not end1) (not end2) (= start1 0) (= start2 0)) (not (string-ci=? str1 str2)) (not (string-ci=? (subseq str1 start1 nd1) (subseq str2 start2 nd2)))))) (and val (string-prefixes-equal-ci str1 str2 start1 nd1 start2 nd2)))) (define (string-left-trim bag str-1) (let ((str (cl-string str-1))) (if (string? bag) (set! bag (string->list bag))) (let ((len (length str))) (do ((i 0 (+ i 1))) ((or (= i len) (not (member (str i) bag))) (if (= i 0) str (subseq str i))))))) (define (string-right-trim bag str-1) (let ((str (cl-string str-1))) (if (string? bag) (set! bag (string->list bag))) (let ((len (length str))) (do ((i (- len 1) (- i 1))) ((or (< i 0) (not (member (str i) bag))) (if (= i (- len 1)) str (subseq str 0 (+ i 1)))))))) (define (string-trim bag str) (string-right-trim bag (string-left-trim bag str))) (define* (nstring-upcase str (start 0) end) (let ((nd (if (number? end) end (length str)))) (do ((i start (+ i 1))) ((= i nd) str) (set! (str i) (char-upcase (str i)))))) (define* (cl-string-upcase str-1 (start 0) end) (let ((str (cl-string str-1))) (nstring-upcase (copy str) start end))) (define* (nstring-downcase str (start 0) end) (let ((nd (if (number? end) end (length str)))) (do ((i start (+ i 1))) ((= i nd) str) (set! (str i) (char-downcase (str i)))))) (define* (cl-string-downcase str-1 (start 0) end) (let ((str (cl-string str-1))) (nstring-downcase (copy str) start end))) (define* (nstring-capitalize str-1 (start 0) end) (define (alpha? c) (or (char-alphabetic? c) (char-numeric? c))) (let ((str (cl-string str-1))) (let ((nd (if (number? end) end (length str)))) (do ((i start (+ i 1))) ((= i nd) str) (if (alpha? (str i)) (if (or (= i 0) (not (alpha? (str (- i 1))))) (set! (str i) (char-upcase (str i))) (set! (str i) (char-downcase (str i))))))))) (define* (string-capitalize str-1 (start 0) end) (let ((str (cl-string str-1))) (nstring-capitalize (copy str) start end))) (let () (define* (union list1 list2 (test eql) (key identity)) (let ((new-list (copy list1))) (do ((obj list2 (cdr obj))) ((null? obj) new-list) (set! new-list (adjoin (car obj) new-list test key))))) (define nunion union) ; this is not required to be destructive (define* (intersection list1 list2 (test eql) (key identity)) (let ((new-list ())) (do ((obj list1 (cdr obj))) ((null? obj) new-list) (if (not (null? (cl-member (key (car obj)) list2 test key))) (set! new-list (adjoin (car obj) new-list test key)))))) (define nintersection intersection) (define* (set-difference list1 list2 (test eql) (key identity)) (let ((new-list ())) (do ((obj list1 (cdr obj))) ((null? obj) new-list) (if (null? (cl-member (key (car obj)) list2 test key)) (set! new-list (adjoin (car obj) new-list test key)))))) (define nset-difference set-difference) (define* (set-exclusive-or list1 list2 (test eql) (key identity)) (let ((new-list ())) (do ((obj list1 (cdr obj))) ((null? obj)) (if (null? (cl-member (key (car obj)) list2 test key)) (set! new-list (adjoin (car obj) new-list test key)))) (do ((obj list2 (cdr obj))) ((null? obj) new-list) (if (null? (cl-member (key (car obj)) list1 test key)) (set! new-list (adjoin (car obj) new-list test key)))))) (define nset-exclusive-or set-exclusive-or) (define* (subsetp list1 list2 (test eql) (key identity)) (call-with-exit (lambda (return) (do ((obj list1 (cdr obj))) ((null? obj) #t) (if (null? (cl-member (key (car obj)) list2 test key)) (return nil)))))) (test-t (subsetp '(1 2 3) '(1 2 3))) (test-t (subsetp '(1 2 3) '(3 2 1))) (test-t (subsetp '(1 2 3) '(2 1 3))) (test-t (null (subsetp '(1 2 3 4) '(2 1 3)))) (test-t (subsetp '(1) '(2 1 3))) (test-t (subsetp '(1 2) '(1 2 3 4 5 6 7 8))) (test-t (subsetp '(1 2 3 4 5) '(8 7 6 5 4 3 2 1))) (test-t (null (subsetp '("car" "ship" "airplane" "submarine") '("car" "ship" "horse" "airplane" "submarine" "camel")))) (test-t (subsetp '("car" "ship" "airplane" "submarine") '("car" "ship" "horse" "airplane" "submarine" "camel") :test equal)) (test-t (subsetp '("CAR" "SHIP" "AIRPLANE" "SUBMARINE") '("car" "ship" "horse" "airplane" "submarine" "camel") :test equalp)) (test-t (subsetp '(("car") ("ship") ("airplane") ("submarine")) '(("car") ("ship") ("horse") ("airplane") ("submarine") ("camel")) :test string= :key car)) (test-t (null (union () ()))) (test-t (null (nunion () ()))) (test-t (null (set-difference (union '(1 2 3) '(2 3 4)) '(1 2 3 4)))) (test-t (null (set-difference (nunion (list 1 2 3) (list 2 3 4)) '(1 2 3 4)))) (test-t (null (set-difference (union '(1 2 3) '(1 2 3)) '(1 2 3)))) (test-t (null (set-difference (nunion (list 1 2 3) (list 1 2 3)) '(1 2 3)))) (test-t (null (set-difference (union '(1) '(3 2 1)) '(1 2 3)))) (test-t (null (set-difference (nunion (list 1) (list 3 2 1)) '(1 2 3)))) (test-t (null (set-difference (union '(1 2 3) ()) '(1 2 3)))) (test-t (null (set-difference (nunion (list 1 2 3) ()) '(1 2 3)))) (test-t (null (set-difference (union () '(1 2 3)) '(1 2 3)))) (test-t (null (set-difference (nunion () (list 1 2 3)) '(1 2 3)))) (test-t (null (set-difference (union '(1 2 3) '(2)) '(1 2 3)))) (test-t (null (set-difference (nunion (list 1 2 3) (list 2)) '(1 2 3)))) (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d")) (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D"))) (test-t (null (set-exclusive-or (intersection list1 list2) '(c b 4 1 1)))) (test-t (null (set-exclusive-or (intersection list1 list2 :test equal) '("B" c b 4 1 1) :test equal))) (test-t (null (set-exclusive-or (intersection list1 list2 :test equalp) '("d" "C" "B" "A" c b 4 1 1) :test equalp)))) (test-t (null (intersection '(0 1 2) ()))) (test-t (null (intersection () ()))) (test-t (null (intersection () '(0 1 2)))) (test-t (equal (intersection '(0) '(0)) '(0))) (test-t (equal (intersection '(0 1 2 3) '(2)) '(2))) (test-t (cl-member 0 (intersection '(0 0 0 0 0) '(0 1 2 3 4 5)))) (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0)) '(4 3 2 1 0)))) (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(0 1 2 3 4)) '(0 1 2 3 4)))) (test-t (null (set-exclusive-or (intersection '(0 1 2 3 4) '(4 3 2 1 0)) '(0 1 2 3 4)))) (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h")) (list2 (list "a" "B" "c" "D" "E" "F" "g" "h"))) (null (set-exclusive-or (intersection list1 list2 :test char= :key (lambda (x) (char x 0))) '("B" "F" "h") :test char= :key (lambda (x) (char x 0)))))) (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h")) (list2 (list "a" "B" "c" "D" "E" "F" "g" "h"))) (null (set-exclusive-or (intersection list1 list2 :test char-equal :key (lambda (x) (char x 0))) '("A" "B" "C" "d" "e" "F" "G" "h") :test char-equal :key (lambda (x) (char x 0)))))) (test-t (let ((list1 (list "A" "B" "C" "d")) (list2 (list "D" "E" "F" "g" "h"))) (null (set-exclusive-or (intersection list1 list2 :test char-equal :key (lambda (x) (char x 0))) '("d") :test char-equal :key (lambda (x) (char x 0)))))) (let ((list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d")) (list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D"))) (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2) '(c b 4 1 1)))) (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2 :test equal) '("B" c b 4 1 1) :test equal))) (test-t (null (set-exclusive-or (nintersection (copy-list list1) list2 :test equalp) '("d" "C" "B" "A" c b 4 1 1) :test equalp)))) (test-t (null (nintersection (list 0 1 2) ()))) (test-t (null (nintersection () ()))) (test-t (null (nintersection () '(0 1 2)))) (test-t (equal (nintersection (list 0) '(0)) '(0))) (test-t (equal (nintersection (list 0 1 2 3) '(2)) '(2))) (test-t (cl-member 0 (nintersection (list 0 0 0 0 0) '(0 1 2 3 4 5)))) (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0)) '(4 3 2 1 0)))) (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(0 1 2 3 4)) '(0 1 2 3 4)))) (test-t (null (set-exclusive-or (nintersection (list 0 1 2 3 4) '(4 3 2 1 0)) '(0 1 2 3 4)))) (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h")) (list2 (list "a" "B" "c" "D" "E" "F" "g" "h"))) (null (set-exclusive-or (nintersection list1 list2 :test char= :key (lambda (x) (char x 0))) '("B" "F" "h") :test char= :key (lambda (x) (char x 0)))))) (test-t (let ((list1 (list "A" "B" "C" "d" "e" "F" "G" "h")) (list2 (list "a" "B" "c" "D" "E" "F" "g" "h"))) (null (set-exclusive-or (nintersection list1 list2 :test char-equal :key (lambda (x) (char x 0))) '("A" "B" "C" "d" "e" "F" "G" "h") :test char-equal :key (lambda (x) (char x 0)))))) (test-t (let ((list1 (list "A" "B" "C" "d")) (list2 (list "D" "E" "F" "g" "h"))) (null (set-exclusive-or (nintersection list1 list2 :test char-equal :key (lambda (x) (char x 0))) '("d") :test char-equal :key (lambda (x) (char x 0)))))) (test-t (null (set-difference (set-difference '(1 2 3 4 5 6 7 8 9) '(2 4 6 8)) '(1 3 5 7 9)))) (test-t (null (nset-difference (set-difference (list 1 2 3 4 5 6 7 8 9) '(2 4 6 8)) '(1 3 5 7 9)))) (test-t (null (set-difference () ()))) (test-t (null (set-difference () () :test equal :key 'identity))) (test-t (null (nset-difference () ()))) (test-t (null (set-difference () '(1 2 3)))) (test-t (null (set-difference () '(1 2 3) :test equal :key 'identity))) (test-t (null (nset-difference () '(1 2 3)))) (test-t (null (set-difference '(1 2 3 4) '(4 3 2 1)))) (test-t (null (nset-difference (list 1 2 3 4) '(4 3 2 1)))) (test-t (null (set-difference '(1 2 3 4) '(2 4 3 1)))) (test-t (null (nset-difference (list 1 2 3 4) '(2 4 3 1)))) (test-t (null (set-difference '(1 2 3 4) '(1 3 4 2)))) (test-t (null (nset-difference (list 1 2 3 4) '(1 3 4 2)))) (test-t (null (set-difference '(1 2 3 4) '(1 3 2 4)))) (test-t (null (nset-difference (list 1 2 3 4) '(1 3 2 4)))) (test-t (eq (set-difference (set-difference '(1 2 3) ()) '(1 2 3)) ())) (test-t (eq (nset-difference (nset-difference (list 1 2 3) ()) '(1 2 3)) ())) (test-t (eq (set-difference (set-difference '(1 2 3) '(1)) '(2 3)) ())) (test-t (eq (nset-difference (nset-difference (list 1 2 3) '(1)) '(2 3)) ())) (test-t (eq (set-difference (set-difference '(1 2 3) '(1 2)) '(3)) ())) (test-t (eq (nset-difference (nset-difference (list 1 2 3) '(1 2)) '(3)) ())) (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '(2 3 4)) '(1 4)))) (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(2 3 4)) '(1 4)))) (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) '(1 3)) '(2)))) (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) '(1 3)) '(2)))) (test-t (null (set-exclusive-or () ()))) (test-t (null (nset-exclusive-or () ()))) (test-t (null (set-exclusive-or '(1 2 3) '(3 2 1)))) (test-t (null (nset-exclusive-or (list 1 2 3) '(3 2 1)))) (test-t (null (set-exclusive-or '(1 2 3) '(2 3 1)))) (test-t (null (nset-exclusive-or (list 1 2 3) '(2 3 1)))) (test-t (null (set-exclusive-or '(1 2 3) '(1 3 2)))) (test-t (null (nset-exclusive-or (list 1 2 3) '(1 3 2)))) (test-t (null (set-exclusive-or (set-exclusive-or '(1 2 3) ()) '(3 2 1)))) (test-t (null (nset-exclusive-or (nset-exclusive-or (list 1 2 3) ()) '(3 2 1)))) (test-t (null (set-exclusive-or (set-exclusive-or () '(1 2 3)) '(2 1 3)))) (test-t (null (nset-exclusive-or (nset-exclusive-or () '(1 2 3)) '(2 1 3)))) (test-t (null (set-exclusive-or '("car" "ship" "airplane" "submarine") '("car" "ship" "airplane" "submarine") :test equal))) (test-t (null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine")) '("car" "ship" "airplane" "submarine") :test equal))) (test-t (null (set-exclusive-or '("car" "ship" "airplane" "submarine") '("CAR" "SHIP" "AIRPLANE" "SUBMARINE") :test equalp))) (test-t (null (nset-exclusive-or (copy-list '("car" "ship" "airplane" "submarine")) '("CAR" "SHIP" "AIRPLANE" "SUBMARINE") :test equalp))) (test-t (null (set-exclusive-or '(("car") ("ship") ("airplane") ("submarine")) '(("car") ("ship") ("airplane") ("submarine")) :test string= :key car))) (test-t (null (nset-exclusive-or (copy-tree '(("car") ("ship") ("airplane") ("submarine"))) '(("car") ("ship") ("airplane") ("submarine")) :test string= :key car))) ) (let () (define* (nsubstitute-if new-item test sequence from-end (start 0) end count (key identity)) (if (and (number? count) (not (positive? count))) sequence (let* ((len (length sequence)) (nd (or (and (number? end) end) len))) ; up to but not including end (if (< nd start) (error 'out-of-range "~A :start ~A is greater than ~A ~A" (*function* (curlet)) start (if end ":end" "length") nd)) (let ((cur-count 0)) (if (not (number? count)) (set! count len)) (if (not from-end) (do ((i start (+ i 1))) ((or (= cur-count count) (= i nd)) sequence) (if (test (key (sequence i))) (begin (set! cur-count (+ cur-count 1)) (set! (sequence i) new-item)))) (do ((i (- nd 1) (- i 1))) ((or (= cur-count count) (< i start)) sequence) (if (test (key (sequence i))) (begin (set! cur-count (+ cur-count 1)) (set! (sequence i) new-item))))))))) (define* (nsubstitute-if-not new-item test sequence from-end (start 0) end count (key identity)) (nsubstitute-if new-item (lambda (obj) (not (test obj))) sequence from-end start end count key)) (define* (nsubstitute new-item old-item sequence from-end (test eql) (start 0) end count (key identity)) (nsubstitute-if new-item (lambda (arg) (test old-item arg)) sequence from-end start end count key)) (define* (substitute-if new-item test sequence from-end (start 0) end count (key identity)) (nsubstitute-if new-item test (copy sequence) from-end start end count key)) (define* (substitute-if-not new-item test sequence from-end (start 0) end count (key identity)) (substitute-if new-item (lambda (obj) (not (test obj))) (copy sequence) from-end start end count key)) (define* (substitute new-item old-item sequence from-end (test eql) (start 0) end count (key identity)) (nsubstitute new-item old-item (copy sequence) from-end test start end count key)) (test-t (equal (substitute #\. #\space "0 2 4 6") "0.2.4.6")) (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5)) '(1 2 9 1 3 9 5))) (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 9 1 3 4 5))) (test-t (equal (substitute 9 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5))) (test-t (equal (substitute 9 3 '(1 2 4 1 3 4 5) :test >) '(9 9 4 9 3 4 5))) (test-t (equal (substitute-if 0 evenp '((1) (2) (3) (4)) :start 2 :key car) '((1) (2) (3) 0))) (test-t (equal (substitute-if 9 oddp '(1 2 4 1 3 4 5)) '(9 2 4 9 9 4 9))) (test-t (equal (substitute-if 9 evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 9 5))) (test-t (let ((some-things (list 'a 'car 'b 'cdr 'c))) (and (equal (nsubstitute-if "function was here" fboundp some-things :count 1 :from-end t) '(a car b "function was here" c)) (equal some-things '(a car b "function was here" c))))) (test-t (let ((alpha-tester (copy "ab "))) (and (equal (nsubstitute-if-not #\z alpha-char-p alpha-tester) "abz") (equal alpha-tester "abz")))) (test-t (equal (substitute 'a 'x '(x y z)) '(a y z))) (test-t (equal (substitute 'b 'y '(x y z)) '(x b z))) (test-t (equal (substitute 'c 'z '(x y z)) '(x y c))) (test-t (equal (substitute 'a 'p '(x y z)) '(x y z))) (test-t (equal (substitute 'a 'x ()) ())) (test-t (equal (substitute #\x #\b '(#\a #\b #\c #\d #\e) :test char<) '(#\a #\b #\x #\x #\x))) (test-t (equal (substitute '(a) 'x '((x) (y) (z)) :key car) '((a) (y) (z)))) (test-t (equal (substitute 'c 'b '(a b a b a b a b)) '(a c a c a c a c))) (test-t (equal (substitute 'a 'b '(b b b)) '(a a a))) (define axbx-etc '(a x b x c x d x e x f)) (test-t (equal (substitute 'z 'x axbx-etc) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count nil) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 0) axbx-etc)) (test-t (equal (substitute 'z 'x axbx-etc :count -100) axbx-etc)) (test-t (equal (substitute 'z 'x axbx-etc :count 1) '(a z b x c x d x e x f))) (test-t (equal (substitute 'z 'x axbx-etc :count 2) '(a z b z c x d x e x f))) (test-t (equal (substitute 'z 'x axbx-etc :count 3) '(a z b z c z d x e x f))) (test-t (equal (substitute 'z 'x axbx-etc :count 4) '(a z b z c z d z e x f))) (test-t (equal (substitute 'z 'x axbx-etc :count 5) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 6) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 7) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count nil :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 0 :from-end t) axbx-etc)) (test-t (equal (substitute 'z 'x axbx-etc :count -100 :from-end t) axbx-etc)) (test-t (equal (substitute 'z 'x axbx-etc :count 1 :from-end t) '(a x b x c x d x e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 2 :from-end t) '(a x b x c x d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 3 :from-end t) '(a x b x c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 4 :from-end t) '(a x b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 5 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 6 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :count 7 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :start 2 :count 1) '(a x b z c x d x e x f))) (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end nil :count 1) '(a x b z c x d x e x f))) (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end 6 :count 100) '(a x b z c z d x e x f))) (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end 11 :count 100) '(a x b z c z d z e z f))) (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end 8 :count 10) '(a x b z c z d z e x f))) (test-t (equal (substitute 'z 'x axbx-etc :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f))) (test-t (equal (substitute #\z #\c '(#\a #\b #\c #\d #\e #\f) :test char<) '(#\a #\b #\c #\z #\z #\z))) (test-t (equal (substitute "peace" "war" '("war" "War" "WAr" "WAR") :test string-equal) '("peace" "peace" "peace" "peace"))) (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :test string=) '("war" "War" "WAr" "peace"))) (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) '("peace" "peace" "peace" "peace"))) (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :start 1 :end 2 :test string= :key cl-string-upcase) '("war" "peace" "WAr" "WAR"))) (test-t (equal (substitute "peace" "WAR" '("war" "War" "WAr" "WAR") :start 1 :end nil :test string= :key cl-string-upcase) '("war" "peace" "peace" "peace"))) (test-t (equal (substitute "peace" "war" '("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) '("war" "War" "WAr" "WAR"))) (test-t (equalp (substitute 'a 'x #(x y z)) #(a y z))) (test-t (equalp (substitute 'b 'y #(x y z)) #(x b z))) (test-t (equalp (substitute 'c 'z #(x y z)) #(x y c))) (test-t (equalp (substitute 'a 'p #(x y z)) #(x y z))) (test-t (equalp (substitute 'a 'x #()) #())) (test-t (equalp (substitute #\x #\b #(#\a #\b #\c #\d #\e) :test char<) #(#\a #\b #\x #\x #\x))) (test-t (equalp (substitute '(a) 'x #((x) (y) (z)) :key car) #((a) (y) (z)))) (test-t (equalp (substitute 'c 'b #(a b a b a b a b)) #(a c a c a c a c))) (test-t (equalp (substitute 'a 'b #(b b b)) #(a a a))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f)) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f))) (test-t (equalp (substitute 'z 'x #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f))) (test-t (equalp (substitute #\z #\c #(#\a #\b #\c #\d #\e #\f) :test char<) #(#\a #\b #\c #\z #\z #\z))) (test-t (equalp (substitute "peace" "war" #("love" "hate" "war" "peace") :test equal) #("love" "hate" "peace" "peace"))) (test-t (equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR") :test string-equal) #("peace" "peace" "peace" "peace"))) (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :test string=) #("war" "War" "WAr" "peace"))) (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) #("peace" "peace" "peace" "peace"))) (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :start 1 :end 2 :test string= :key cl-string-upcase) #("war" "peace" "WAr" "WAR"))) (test-t (equalp (substitute "peace" "WAR" #("war" "War" "WAr" "WAR") :start 1 :end nil :test string= :key cl-string-upcase) #("war" "peace" "peace" "peace"))) (test-t (equalp (substitute "peace" "war" #("war" "War" "WAr" "WAR") :test string= :key cl-string-upcase) #("war" "War" "WAr" "WAR"))) (test-t (string= (substitute #\A #\a "abcabc") "AbcAbc")) (test-t (string= (substitute #\A #\a "") "")) (test-t (string= (substitute #\A #\a "xyz") "xyz")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA")) (test-t (string= (substitute #\x #\5 "0123456789" :test char<) "012345xxxx")) (test-t (string= (substitute #\x #\5 "0123456789" :test char>) "xxxxx56789")) (test-t (string= (substitute #\x #\D "abcdefg" :key char-upcase :test char>) "xxxdefg")) (test-t (string= (substitute #\x #\D "abcdefg" :start 1 :end 2 :key char-upcase :test char>) "axcdefg")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 2) "AAaaaaaaaa")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count -1) "aaaaaaaaaa")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 0) "aaaaaaaaaa")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count nil) "AAAAAAAAAA")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 100) "AAAAAAAAAA")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 9) "AAAAAAAAAa")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa")) (test-t (string= (substitute #\A #\a "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa")) (test-t (string= (substitute #\x #\A "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa")) (test-t (string= (substitute #\X #\A "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa")) (test-t (string= (substitute #\X #\D "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :test char< :count 3) "abcdeXXXij")) (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'x)) '(x y z)) '(a y z))) (test-t (equal (substitute-if 'b (lambda (arg) (eq arg 'y)) '(x y z)) '(x b z))) (test-t (equal (substitute-if 'c (lambda (arg) (eq arg 'z)) '(x y z)) '(x y c))) (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'p)) '(x y z)) '(x y z))) (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'x)) ()) ())) (test-t (equal (substitute-if #\x (lambda (arg) (char< #\b arg)) '(#\a #\b #\c #\d #\e)) '(#\a #\b #\x #\x #\x))) (test-t (equal (substitute-if '(a) (lambda (arg) (eq arg 'x)) '((x) (y) (z)) :key car) '((a) (y) (z)))) (test-t (equal (substitute-if 'c (lambda (arg) (eq arg 'b)) '(a b a b a b a b)) '(a c a c a c a c))) (test-t (equal (substitute-if 'a (lambda (arg) (eq arg 'b)) '(b b b)) '(a a a))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count nil) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 0) axbx-etc)) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count -100) axbx-etc)) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 1) '(a z b x c x d x e x f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 2) '(a z b z c x d x e x f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 3) '(a z b z c z d x e x f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 4) '(a z b z c z d z e x f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 5) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 6) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 7) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count nil :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 0 :from-end t) axbx-etc)) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count -100 :from-end t) axbx-etc)) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 1 :from-end t) '(a x b x c x d x e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 2 :from-end t) '(a x b x c x d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 3 :from-end t) '(a x b x c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 4 :from-end t) '(a x b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 5 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 6 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :count 7 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :count 1) '(a x b z c x d x e x f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end nil :count 1) '(a x b z c x d x e x f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end 6 :count 100) '(a x b z c z d x e x f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end 11 :count 100) '(a x b z c z d z e z f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end 8 :count 10) '(a x b z c z d z e x f))) (test-t (equal (substitute-if 'z (lambda (arg) (eq arg 'x)) axbx-etc :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f))) (test-t (equal (substitute-if #\z (lambda (arg) (char< #\c arg)) '(#\a #\b #\c #\d #\e #\f)) '(#\a #\b #\c #\z #\z #\z))) (test-t (equal (substitute-if "peace" (lambda (arg) (equal "war" arg)) '("love" "hate" "war" "peace")) '("love" "hate" "peace" "peace"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string-equal "war" arg)) '("war" "War" "WAr" "WAR")) '("peace" "peace" "peace" "peace"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :key cl-string-upcase) '("peace" "peace" "peace" "peace"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "war" arg)) '("war" "War" "WAr" "WAR") :key string-upcase) '("war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'x)) #(x y z)) #(a y z))) (test-t (equalp (substitute-if 'b (lambda (arg) (eq arg 'y)) #(x y z)) #(x b z))) (test-t (equalp (substitute-if 'c (lambda (arg) (eq arg 'z)) #(x y z)) #(x y c))) (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'p)) #(x y z)) #(x y z))) (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'x)) #()) #())) (test-t (equalp (substitute-if #\x (lambda (arg) (char< #\b arg)) #(#\a #\b #\c #\d #\e)) #(#\a #\b #\x #\x #\x))) (test-t (equalp (substitute-if '(a) (lambda (arg) (eq arg 'x)) #((x) (y) (z)) :key car) #((a) (y) (z)))) (test-t (equalp (substitute-if 'c (lambda (arg) (eq arg 'b)) #(a b a b a b a b)) #(a c a c a c a c))) (test-t (equalp (substitute-if 'a (lambda (arg) (eq arg 'b)) #(b b b)) #(a a a))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f)) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f))) (test-t (equalp (substitute-if 'z (lambda (arg) (eq arg 'x)) #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f))) (test-t (equalp (substitute-if #\z (lambda (arg) (char< #\c arg)) #(#\a #\b #\c #\d #\e #\f)) #(#\a #\b #\c #\z #\z #\z))) (test-t (equalp (substitute-if "peace" (lambda (arg) (equal "war" arg)) #("love" "hate" "war" "peace")) #("love" "hate" "peace" "peace"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string-equal "war" arg)) #("war" "War" "WAr" "WAR")) #("peace" "peace" "peace" "peace"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :key string-upcase) #("peace" "peace" "peace" "peace"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "war" arg)) #("war" "War" "WAr" "WAR") :key string-upcase) #("war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if "peace" (lambda (arg) (string= "WAR" arg)) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "abcabc") "AbcAbc")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "") "")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "xyz") "xyz")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA")) (test-t (string= (substitute-if #\x (lambda (arg) (char< #\5 arg)) "0123456789") "012345xxxx")) (test-t (string= (substitute-if #\x (lambda (arg) (char> #\5 arg)) "0123456789") "xxxxx56789")) (test-t (string= (substitute-if #\x (lambda (arg) (char> #\D arg)) "abcdefg" :key char-upcase) "xxxdefg")) (test-t (string= (substitute-if #\x (lambda (arg) (char> #\D arg)) "abcdefg" :start 1 :end 2 :key char-upcase) "axcdefg")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 2) "AAaaaaaaaa")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count -1) "aaaaaaaaaa")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 0) "aaaaaaaaaa")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count nil) "AAAAAAAAAA")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 100) "AAAAAAAAAA")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 9) "AAAAAAAAAa")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa")) (test-t (string= (substitute-if #\A (lambda (arg) (eql #\a arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa")) (test-t (string= (substitute-if #\x (lambda (arg) (eql #\A arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa")) (test-t (string= (substitute-if #\X (lambda (arg) (eql #\A arg)) "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa")) (test-t (string= (substitute-if #\X (lambda (arg) (char< #\D arg)) "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :count 3) "abcdeXXXij")) (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) '(x y z)) '(a y z))) (test-t (equal (substitute-if-not 'b (lambda (arg) (not (eq arg 'y))) '(x y z)) '(x b z))) (test-t (equal (substitute-if-not 'c (lambda (arg) (not (eq arg 'z))) '(x y z)) '(x y c))) (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'p))) '(x y z)) '(x y z))) (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) ()) ())) (test-t (equal (substitute-if-not #\x (lambda (arg) (not (char< #\b arg))) '(#\a #\b #\c #\d #\e)) '(#\a #\b #\x #\x #\x))) (test-t (equal (substitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) '((x) (y) (z)) :key car) '((a) (y) (z)))) (test-t (equal (substitute-if-not 'c (lambda (arg) (not (eq arg 'b))) '(a b a b a b a b)) '(a c a c a c a c))) (test-t (equal (substitute-if-not 'a (lambda (arg) (not (eq arg 'b))) '(b b b)) '(a a a))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count nil) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 0) axbx-etc)) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count -100) axbx-etc)) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 1) '(a z b x c x d x e x f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 2) '(a z b z c x d x e x f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 3) '(a z b z c z d x e x f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 4) '(a z b z c z d z e x f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 5) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 6) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 7) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count nil :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 0 :from-end t) axbx-etc)) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count -100 :from-end t) axbx-etc)) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 1 :from-end t) '(a x b x c x d x e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 2 :from-end t) '(a x b x c x d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 3 :from-end t) '(a x b x c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 4 :from-end t) '(a x b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 5 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 6 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :count 7 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :count 1) '(a x b z c x d x e x f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end nil :count 1) '(a x b z c x d x e x f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end 6 :count 100) '(a x b z c z d x e x f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end 11 :count 100) '(a x b z c z d z e z f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end 8 :count 10) '(a x b z c z d z e x f))) (test-t (equal (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) axbx-etc :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f))) (test-t (equal (substitute-if-not #\z (lambda (arg) (not (char< #\c arg))) '(#\a #\b #\c #\d #\e #\f)) '(#\a #\b #\c #\z #\z #\z))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (equal "war" arg))) '("love" "hate" "war" "peace")) '("love" "hate" "peace" "peace"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string-equal "war" arg))) '("war" "War" "WAr" "WAR")) '("peace" "peace" "peace" "peace"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :key string-upcase) '("peace" "peace" "peace" "peace"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "war" arg))) '("war" "War" "WAr" "WAR") :key string-upcase) '("war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) #(x y z)) #(a y z))) (test-t (equalp (substitute-if-not 'b (lambda (arg) (not (eq arg 'y))) #(x y z)) #(x b z))) (test-t (equalp (substitute-if-not 'c (lambda (arg) (not (eq arg 'z))) #(x y z)) #(x y c))) (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'p))) #(x y z)) #(x y z))) (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'x))) #()) #())) (test-t (equalp (substitute-if-not #\x (lambda (arg) (not (char< #\b arg))) #(#\a #\b #\c #\d #\e)) #(#\a #\b #\x #\x #\x))) (test-t (equalp (substitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) #((x) (y) (z)) :key car) #((a) (y) (z)))) (test-t (equalp (substitute-if-not 'c (lambda (arg) (not (eq arg 'b))) #(a b a b a b a b)) #(a c a c a c a c))) (test-t (equalp (substitute-if-not 'a (lambda (arg) (not (eq arg 'b))) #(b b b)) #(a a a))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f)) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count nil) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 0) #(a x b x c x d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count -100) #(a x b x c x d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 1) #(a z b x c x d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 2) #(a z b z c x d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 3) #(a z b z c z d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 4) #(a z b z c z d z e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 5) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 6) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 7) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count nil :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 0 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count -100 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 1 :from-end t) #(a x b x c x d x e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 2 :from-end t) #(a x b x c x d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 3 :from-end t) #(a x b x c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 4 :from-end t) #(a x b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 5 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 6 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :count 7 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :count 1) #(a x b z c x d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end nil :count 1) #(a x b z c x d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 6 :count 100) #(a x b z c z d x e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 11 :count 100) #(a x b z c z d z e z f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 8 :count 10) #(a x b z c z d z e x f))) (test-t (equalp (substitute-if-not 'z (lambda (arg) (not (eq arg 'x))) #(a x b x c x d x e x f) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f))) (test-t (equalp (substitute-if-not #\z (lambda (arg) (not (char< #\c arg))) #(#\a #\b #\c #\d #\e #\f)) #(#\a #\b #\c #\z #\z #\z))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (equal "war" arg))) #("love" "hate" "war" "peace")) #("love" "hate" "peace" "peace"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string-equal "war" arg))) #("war" "War" "WAr" "WAR")) #("peace" "peace" "peace" "peace"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :key string-upcase) #("peace" "peace" "peace" "peace"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR") :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "war" arg))) #("war" "War" "WAr" "WAR") :key string-upcase) #("war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 0 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count -2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count nil :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 6 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 7 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (substitute-if-not "peace" (lambda (arg) (not (string= "WAR" arg))) #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR") :start 1 :end 7 :count 100 :from-end t :key string-upcase) #("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "abcabc") "AbcAbc")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "") "")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "xyz") "xyz")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 5 :end nil) "aaaaaAAAAA")) (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char< #\5 arg))) "0123456789") "012345xxxx")) (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\5 arg))) "0123456789") "xxxxx56789")) (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\D arg))) "abcdefg" :key char-upcase) "xxxdefg")) (test-t (string= (substitute-if-not #\x (lambda (arg) (not (char> #\D arg))) "abcdefg" :start 1 :end 2 :key char-upcase) "axcdefg")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 2) "AAaaaaaaaa")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count -1) "aaaaaaaaaa")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 0) "aaaaaaaaaa")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count nil) "AAAAAAAAAA")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 100) "AAAAAAAAAA")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 9) "AAAAAAAAAa")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :count 9 :from-end t) "aAAAAAAAAA")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 2 :end 8 :count 3) "aaAAAaaaaa")) (test-t (string= (substitute-if-not #\A (lambda (arg) (not (eql #\a arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa")) (test-t (string= (substitute-if-not #\x (lambda (arg) (not (eql #\A arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa")) (test-t (string= (substitute-if-not #\X (lambda (arg) (not (eql #\A arg))) "aaaaaaaaaa" :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa")) (test-t (string= (substitute-if-not #\X (lambda (arg) (not (char< #\D arg))) "abcdefghij" :start 2 :end 8 :from-end t :key char-upcase :count 3) "abcdeXXXij")) (test-t (equal (nsubstitute 'a 'x (copy '(x y z))) '(a y z))) (test-t (equal (nsubstitute 'b 'y (copy '(x y z))) '(x b z))) (test-t (equal (nsubstitute 'c 'z (copy '(x y z))) '(x y c))) (test-t (equal (nsubstitute 'a 'p (copy '(x y z))) '(x y z))) (test-t (equal (nsubstitute 'a 'x (copy ())) ())) (test-t (equal (nsubstitute #\x #\b (copy '(#\a #\b #\c #\d #\e)) :test char<) '(#\a #\b #\x #\x #\x))) (test-t (equal (nsubstitute '(a) 'x (copy '((x) (y) (z))) :key car) '((a) (y) (z)))) (test-t (equal (nsubstitute 'c 'b (copy '(a b a b a b a b))) '(a c a c a c a c))) (test-t (equal (nsubstitute 'a 'b (copy '(b b b))) '(a a a))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc)) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count nil) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 0) axbx-etc)) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count -100) axbx-etc)) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 1) '(a z b x c x d x e x f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 2) '(a z b z c x d x e x f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 3) '(a z b z c z d x e x f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 4) '(a z b z c z d z e x f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 5) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 6) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 7) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count nil :from-end t) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 0 :from-end t) axbx-etc)) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count -100 :from-end t) axbx-etc)) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 1 :from-end t) '(a x b x c x d x e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 2 :from-end t) '(a x b x c x d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 3 :from-end t) '(a x b x c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 4 :from-end t) '(a x b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 5 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 6 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :count 7 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :count 1) '(a x b z c x d x e x f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end nil :count 1) '(a x b z c x d x e x f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end 6 :count 100) '(a x b z c z d x e x f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end 11 :count 100) '(a x b z c z d z e z f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end 8 :count 10) '(a x b z c z d z e x f))) (test-t (equal (nsubstitute 'z 'x (copy axbx-etc) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f))) (test-t (equal (nsubstitute #\z #\c (copy '(#\a #\b #\c #\d #\e #\f)) :test char<) '(#\a #\b #\c #\z #\z #\z))) (test-t (equal (nsubstitute "peace" "war" (copy '("love" "hate" "war" "peace")) :test equal) '("love" "hate" "peace" "peace"))) (test-t (equal (nsubstitute "peace" "war" (copy '("war" "War" "WAr" "WAR")) :test string-equal) '("peace" "peace" "peace" "peace"))) (test-t (equal (nsubstitute "peace" "WAR" (copy '("war" "War" "WAr" "WAR")) :test string=) '("war" "War" "WAr" "peace"))) (test-t (equal (nsubstitute "peace" "WAR" (copy '("war" "War" "WAr" "WAR")) :test string= :key string-upcase) '("peace" "peace" "peace" "peace"))) (test-t (equal (nsubstitute "peace" "WAR" (copy '("war" "War" "WAr" "WAR")) :start 1 :end 2 :test string= :key string-upcase) '("war" "peace" "WAr" "WAR"))) (test-t (equalp (nsubstitute 'a 'x (copy #(x y z))) #(a y z))) (test-t (equalp (nsubstitute 'b 'y (copy #(x y z))) #(x b z))) (test-t (equalp (nsubstitute 'c 'z (copy #(x y z))) #(x y c))) (test-t (equalp (nsubstitute 'a 'p (copy #(x y z))) #(x y z))) (test-t (equalp (nsubstitute 'a 'x (copy #())) #())) (test-t (equalp (nsubstitute #\x #\b (copy #(#\a #\b #\c #\d #\e)) :test char<) #(#\a #\b #\x #\x #\x))) (test-t (equalp (nsubstitute '(a) 'x (copy #((x) (y) (z))) :key car) #((a) (y) (z)))) (test-t (equalp (nsubstitute 'c 'b (copy #(a b a b a b a b))) #(a c a c a c a c))) (test-t (equalp (nsubstitute 'a 'b (copy #(b b b))) #(a a a))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f))) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count nil) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 0) #(a x b x c x d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count -100) #(a x b x c x d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 1) #(a z b x c x d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 2) #(a z b z c x d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 3) #(a z b z c z d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 4) #(a z b z c z d z e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 5) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 6) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 7) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count nil :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 0 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count -100 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 1 :from-end t) #(a x b x c x d x e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 2 :from-end t) #(a x b x c x d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 3 :from-end t) #(a x b x c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 4 :from-end t) #(a x b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 5 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 6 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :count 7 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :count 1) #(a x b z c x d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end nil :count 1) #(a x b z c x d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end 6 :count 100) #(a x b z c z d x e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end 11 :count 100) #(a x b z c z d z e z f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end 8 :count 10) #(a x b z c z d z e x f))) (test-t (equalp (nsubstitute 'z 'x (copy #(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f))) (test-t (equalp (nsubstitute #\z #\c (copy #(#\a #\b #\c #\d #\e #\f)) :test char<) #(#\a #\b #\c #\z #\z #\z))) (test-t (equalp (nsubstitute "peace" "war" (copy #("love" "hate" "war" "peace")) :test equal) #("love" "hate" "peace" "peace"))) (test-t (equalp (nsubstitute "peace" "war" (copy #("war" "War" "WAr" "WAR")) :test string-equal) #("peace" "peace" "peace" "peace"))) (test-t (equalp (nsubstitute "peace" "WAR" (copy #("war" "War" "WAr" "WAR")) :test string=) #("war" "War" "WAr" "peace"))) (test-t (equalp (nsubstitute "peace" "WAR" (copy #("war" "War" "WAr" "WAR")) :test string= :key string-upcase) #("peace" "peace" "peace" "peace"))) (test-t (equalp (nsubstitute "peace" "WAR" (copy #("war" "War" "WAr" "WAR")) :start 1 :end 2 :test string= :key string-upcase) #("war" "peace" "WAr" "WAR"))) (test-t (equalp (nsubstitute "peace" "WAR" (copy #("war" "War" "WAr" "WAR")) :start 1 :end nil :test string= :key cl-string-upcase) #("war" "peace" "peace" "peace"))) (test-t (string= (nsubstitute #\A #\a (copy "abcabc")) "AbcAbc")) (test-t (string= (nsubstitute #\A #\a (copy "")) "")) (test-t (string= (nsubstitute #\A #\a (copy "xyz")) "xyz")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :start 5 :end nil) "aaaaaAAAAA")) (test-t (string= (nsubstitute #\x #\5 (copy "0123456789") :test char<) "012345xxxx")) (test-t (string= (nsubstitute #\x #\5 (copy "0123456789") :test char>) "xxxxx56789")) (test-t (string= (nsubstitute #\x #\D (copy "abcdefg") :key char-upcase :test char>) "xxxdefg")) (test-t (string= (nsubstitute #\x #\D (copy "abcdefg") :start 1 :end 2 :key char-upcase :test char>) "axcdefg")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 2) "AAaaaaaaaa")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count -1) "aaaaaaaaaa")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 0) "aaaaaaaaaa")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count nil) "AAAAAAAAAA")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 100) "AAAAAAAAAA")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 9) "AAAAAAAAAa")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :count 9 :from-end t) "aAAAAAAAAA")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :start 2 :end 8 :count 3) "aaAAAaaaaa")) (test-t (string= (nsubstitute #\A #\a (copy "aaaaaaaaaa") :start 2 :end 8 :from-end t :count 3) "aaaaaAAAaa")) (test-t (string= (nsubstitute #\x #\A (copy "aaaaaaaaaa") :start 2 :end 8 :from-end t :count 3) "aaaaaaaaaa")) (test-t (string= (nsubstitute #\X #\A (copy "aaaaaaaaaa") :start 2 :end 8 :from-end t :key char-upcase :count 3) "aaaaaXXXaa")) (test-t (string= (nsubstitute #\X #\D (copy "abcdefghij") :start 2 :end 8 :from-end t :key char-upcase :test char< :count 3) "abcdeXXXij")) (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy '(x y z))) '(a y z))) (test-t (equal (nsubstitute-if 'b (lambda (arg) (eq arg 'y)) (copy '(x y z))) '(x b z))) (test-t (equal (nsubstitute-if 'c (lambda (arg) (eq arg 'z)) (copy '(x y z))) '(x y c))) (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'p)) (copy '(x y z))) '(x y z))) (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy ())) ())) (test-t (equal (nsubstitute-if #\x (lambda (arg) (char< #\b arg)) (copy '(#\a #\b #\c #\d #\e))) '(#\a #\b #\x #\x #\x))) (test-t (equal (nsubstitute-if '(a) (lambda (arg) (eq arg 'x)) (copy '((x) (y) (z))) :key car) '((a) (y) (z)))) (test-t (equal (nsubstitute-if 'c (lambda (arg) (eq arg 'b)) (copy '(a b a b a b a b))) '(a c a c a c a c))) (test-t (equal (nsubstitute-if 'a (lambda (arg) (eq arg 'b)) (copy '(b b b))) '(a a a))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc)) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count nil) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 0) axbx-etc)) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count -100) axbx-etc)) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 1) '(a z b x c x d x e x f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 2) '(a z b z c x d x e x f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 3) '(a z b z c z d x e x f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 4) '(a z b z c z d z e x f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 5) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 6) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 7) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count nil :from-end t) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 0 :from-end t) axbx-etc)) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count -100 :from-end t) axbx-etc)) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 1 :from-end t) '(a x b x c x d x e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 2 :from-end t) '(a x b x c x d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 3 :from-end t) '(a x b x c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 4 :from-end t) '(a x b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 5 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 6 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :count 7 :from-end t) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :count 1) '(a x b z c x d x e x f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end nil :count 1) '(a x b z c x d x e x f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end 6 :count 100) '(a x b z c z d x e x f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end 11 :count 100) '(a x b z c z d z e z f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end 8 :count 10) '(a x b z c z d z e x f))) (test-t (equal (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy axbx-etc) :start 2 :end 8 :count 2 :from-end t) '(a x b x c z d z e x f))) (test-t (equal (nsubstitute-if #\z (lambda (arg) (char< #\c arg)) (copy '(#\a #\b #\c #\d #\e #\f))) '(#\a #\b #\c #\z #\z #\z))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (equal "war" arg)) (copy '("love" "hate" "war" "peace"))) '("love" "hate" "peace" "peace"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string-equal "war" arg)) (copy '("war" "War" "WAr" "WAR"))) '("peace" "peace" "peace" "peace"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR")) :key string-upcase) '("peace" "peace" "peace" "peace"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR")) :start 1 :end 2 :key string-upcase) '("war" "peace" "WAr" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR")) :start 1 :end nil :key string-upcase) '("war" "peace" "peace" "peace"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "war" arg)) (copy '("war" "War" "WAr" "WAR")) :key string-upcase) '("war" "War" "WAr" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 1 :key string-upcase) '("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :key string-upcase) '("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 0 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count -2 :from-end t :key string-upcase) '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count nil :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 6 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 7 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equal (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy '("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 100 :from-end t :key string-upcase) '("war" "peace" "peace" "peace" "peace" "peace" "peace" "WAR"))) (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy #(x y z))) #(a y z))) (test-t (equalp (nsubstitute-if 'b (lambda (arg) (eq arg 'y)) (copy #(x y z))) #(x b z))) (test-t (equalp (nsubstitute-if 'c (lambda (arg) (eq arg 'z)) (copy #(x y z))) #(x y c))) (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'p)) (copy #(x y z))) #(x y z))) (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'x)) (copy #())) #())) (test-t (equalp (nsubstitute-if #\x (lambda (arg) (char< #\b arg)) (copy #(#\a #\b #\c #\d #\e))) #(#\a #\b #\x #\x #\x))) (test-t (equalp (nsubstitute-if '(a) (lambda (arg) (eq arg 'x)) (copy #((x) (y) (z))) :key car) #((a) (y) (z)))) (test-t (equalp (nsubstitute-if 'c (lambda (arg) (eq arg 'b)) (copy #(a b a b a b a b))) #(a c a c a c a c))) (test-t (equalp (nsubstitute-if 'a (lambda (arg) (eq arg 'b)) (copy #(b b b))) #(a a a))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f))) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count nil) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 0) #(a x b x c x d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count -100) #(a x b x c x d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 1) #(a z b x c x d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 2) #(a z b z c x d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 3) #(a z b z c z d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 4) #(a z b z c z d z e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 5) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 6) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 7) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count nil :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 0 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count -100 :from-end t) #(a x b x c x d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 1 :from-end t) #(a x b x c x d x e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 2 :from-end t) #(a x b x c x d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 3 :from-end t) #(a x b x c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 4 :from-end t) #(a x b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 5 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 6 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :count 7 :from-end t) #(a z b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :count 1) #(a x b z c x d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end nil :count 1) #(a x b z c x d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end 6 :count 100) #(a x b z c z d x e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end 11 :count 100) #(a x b z c z d z e z f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end 8 :count 10) #(a x b z c z d z e x f))) (test-t (equalp (nsubstitute-if 'z (lambda (arg) (eq arg 'x)) (copy #(a x b x c x d x e x f)) :start 2 :end 8 :count 2 :from-end t) #(a x b x c z d z e x f))) (test-t (equalp (nsubstitute-if #\z (lambda (arg) (char< #\c arg)) (copy #(#\a #\b #\c #\d #\e #\f))) #(#\a #\b #\c #\z #\z #\z))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (equal "war" arg)) (copy #("love" "hate" "war" "peace"))) #("love" "hate" "peace" "peace"))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string-equal "war" arg)) (copy #("war" "War" "WAr" "WAR"))) #("peace" "peace" "peace" "peace"))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR")) :key string-upcase) #("peace" "peace" "peace" "peace"))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR")) :start 1 :end 2 :key string-upcase) #("war" "peace" "WAr" "WAR"))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR")) :start 1 :end nil :key string-upcase) #("war" "peace" "peace" "peace"))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "war" arg)) (copy #("war" "War" "WAr" "WAR")) :key string-upcase) #("war" "War" "WAr" "WAR"))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 1 :key string-upcase) #("war" "peace" "WAr" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :key string-upcase) #("war" "peace" "peace" "WAR" "war" "War" "WAr" "WAR"))) (test-t (equalp (nsubstitute-if "peace" (lambda (arg) (string= "WAR" arg)) (copy #("war" "War" "WAr" "WAR" "war" "War" "WAr" "WAR")) :start 1 :end 7 :count 2 :from-end t :key string-upcase) #("war" "War" "WAr" "WAR" "war" "peace" "peace" "WAR"))) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "abcabc")) "AbcAbc")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "")) "")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "xyz")) "xyz")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :start 5 :end nil) "aaaaaAAAAA")) (test-t (string= (nsubstitute-if #\x (lambda (arg) (char< #\5 arg)) (copy "0123456789")) "012345xxxx")) (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\5 arg)) (copy "0123456789")) "xxxxx56789")) (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\D arg)) (copy "abcdefg") :key char-upcase) "xxxdefg")) (test-t (string= (nsubstitute-if #\x (lambda (arg) (char> #\D arg)) (copy "abcdefg") :start 1 :end 2 :key char-upcase) "axcdefg")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 2) "AAaaaaaaaa")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count -1) "aaaaaaaaaa")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 0) "aaaaaaaaaa")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count nil) "AAAAAAAAAA")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 100) "AAAAAAAAAA")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 9) "AAAAAAAAAa")) (test-t (string= (nsubstitute-if #\A (lambda (arg) (eql #\a arg)) (copy "aaaaaaaaaa") :count 9 :from-end t) "aAAAAAAAAA")) (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'x))) (copy '(x y z))) '(a y z))) (test-t (equal (nsubstitute-if-not 'b (lambda (arg) (not (eq arg 'y))) (copy '(x y z))) '(x b z))) (test-t (equal (nsubstitute-if-not 'c (lambda (arg) (not (eq arg 'z))) (copy '(x y z))) '(x y c))) (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'p))) (copy '(x y z))) '(x y z))) (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'x))) (copy ())) ())) (test-t (equal (nsubstitute-if-not #\x (lambda (arg) (not (char< #\b arg))) (copy '(#\a #\b #\c #\d #\e))) '(#\a #\b #\x #\x #\x))) (test-t (equal (nsubstitute-if-not '(a) (lambda (arg) (not (eq arg 'x))) (copy '((x) (y) (z))) :key car) '((a) (y) (z)))) (test-t (equal (nsubstitute-if-not 'c (lambda (arg) (not (eq arg 'b))) (copy '(a b a b a b a b))) '(a c a c a c a c))) (test-t (equal (nsubstitute-if-not 'a (lambda (arg) (not (eq arg 'b))) (copy '(b b b))) '(a a a))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc)) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count nil) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 0) axbx-etc)) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count -100) axbx-etc)) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 1) '(a z b x c x d x e x f))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 2) '(a z b z c x d x e x f))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 3) '(a z b z c z d x e x f))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 4) '(a z b z c z d z e x f))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 5) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 6) '(a z b z c z d z e z f))) (test-t (equal (nsubstitute-if-not 'z (lambda (arg) (not (eq arg 'x))) (copy axbx-etc) :count 7) '(a z b z c z d z e z f))) ) (let () (define* (reduce function sequence from-end (start 0) end initial-value (key identity)) (let* ((slen (length sequence)) (nd (or (and (number? end) end) slen)) (len (min slen (- nd start)))) (if (< nd start) (error 'out-of-range "~A :start ~A is greater than ~A ~A" (*function* (curlet)) start (if end ":end" "length") nd)) (if (not (positive? len)) (or initial-value (function)) (if (and (= len 1) (not initial-value)) (sequence start) (if (and (not from-end) (not (null? from-end))) (let* ((first-arg (or initial-value (key (sequence start)))) (second-arg (if initial-value (key (sequence start)) (key (sequence (+ start 1))))) (val (function first-arg second-arg))) (do ((i (if initial-value (+ start 1) (+ start 2)) (+ i 1))) ((= i nd) val) (set! val (function val (key (sequence i)))))) (let* ((second-arg (or initial-value (key (sequence (- nd 1))))) (first-arg (if initial-value (key (sequence (- nd 1))) (key (sequence (- nd 2))))) (val (function first-arg second-arg))) (do ((i (if initial-value (- nd 2) (- nd 3)) (- i 1))) ((< i start) val) (set! val (function (key (sequence i)) val))))))))) (test-t (eql (reduce * '(1 2 3 4 5)) 120)) (test-t (equal (reduce append '((1) (2)) :initial-value '(i n i t)) '(i n i t 1 2))) (test-t (equal (reduce append '((1) (2)) :from-end t :initial-value '(i n i t)) '(1 2 i n i t))) (test-t (eql (reduce - '(1 2 3 4)) -8)) (test-t (eql (reduce - '(1 2 3 4) :from-end t) -2)) (test-t (eql (reduce + ()) 0)) (test-t (eql (reduce + '(3)) 3)) (test-t (eq (reduce + '(foo)) 'foo)) (test-t (equal (reduce list '(1 2 3 4)) '(((1 2) 3) 4))) (test-t (equal (reduce list '(1 2 3 4) :from-end t) '(1 (2 (3 4))))) (test-t (equal (reduce list '(1 2 3 4) :initial-value 'foo) '((((foo 1) 2) 3) 4))) (test-t (equal (reduce list '(1 2 3 4) :from-end t :initial-value 'foo) '(1 (2 (3 (4 foo)))))) (test-t (equal (reduce list '(0 1 2 3)) '(((0 1) 2) 3))) (test-t (equal (reduce list '(0 1 2 3) :start 1) '((1 2) 3))) (test-t (equal (reduce list '(0 1 2 3) :start 1 :end nil) '((1 2) 3))) (test-t (equal (reduce list '(0 1 2 3) :start 2) '(2 3))) (test-t (eq (reduce list '(0 1 2 3) :start 0 :end 0) ())) (test-t (eq (reduce list '(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value) 'initial-value)) (test-t (eq (reduce list '(0 1 2 3) :start 2 :end 2) ())) (test-t (eq (reduce list '(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value) 'initial-value)) (test-t (eq (reduce list '(0 1 2 3) :start 4 :end 4) ())) (test-t (eq (reduce list '(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value) 'initial-value)) (test-t (eql (reduce list '(0 1 2 3) :start 2 :end 3) 2)) (test-t (equal (reduce list '(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value) '(initial-value 2))) (test-t (eql (reduce + '(0 1 2 3 4 5 6 7 8 9)) 45)) (test-t (eql (reduce - '(0 1 2 3 4 5 6 7 8 9)) -45)) (test-t (eql (reduce - '(0 1 2 3 4 5 6 7 8 9) :from-end t) -5)) (test-t (equal (reduce list '(0 1 2 3) :initial-value 'initial-value) '((((initial-value 0) 1) 2) 3))) (test-t (equal (reduce list '(0 1 2 3) :from-end t) '(0 (1 (2 3))))) (test-t (equal (reduce list '((1) (2) (3) (4)) :key car) '(((1 2) 3) 4))) ;(test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end nil) '(((1 2) 3) 4))) (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :initial-value 0) '((((0 1) 2) 3) 4))) (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end t) '(1 (2 (3 4))))) (test-t (equal (reduce list '((1) (2) (3) (4)) :key car :from-end t :initial-value 5) '(1 (2 (3 (4 5)))))) (test-t (equal (reduce list #(0 1 2 3)) '(((0 1) 2) 3))) (test-t (equal (reduce list #(0 1 2 3) :start 1) '((1 2) 3))) (test-t (equal (reduce list #(0 1 2 3) :start 1 :end nil) '((1 2) 3))) (test-t (equal (reduce list #(0 1 2 3) :start 2) '(2 3))) (test-t (eq (reduce list #(0 1 2 3) :start 0 :end 0) ())) (test-t (eq (reduce list #(0 1 2 3) :start 0 :end 0 :initial-value 'initial-value) 'initial-value)) (test-t (eq (reduce list #(0 1 2 3) :start 2 :end 2) ())) (test-t (eq (reduce list #(0 1 2 3) :start 2 :end 2 :initial-value 'initial-value) 'initial-value)) (test-t (eq (reduce list #(0 1 2 3) :start 4 :end 4) ())) (test-t (eq (reduce list #(0 1 2 3) :start 4 :end 4 :initial-value 'initial-value) 'initial-value)) (test-t (eql (reduce list #(0 1 2 3) :start 2 :end 3) 2)) (test-t (equal (reduce list #(0 1 2 3) :start 2 :end 3 :initial-value 'initial-value) '(initial-value 2))) (test-t (eql (reduce + #(0 1 2 3 4 5 6 7 8 9)) 45)) (test-t (eql (reduce - #(0 1 2 3 4 5 6 7 8 9)) -45)) (test-t (eql (reduce - #(0 1 2 3 4 5 6 7 8 9) :from-end t) -5)) (test-t (equal (reduce list #(0 1 2 3) :initial-value 'initial-value) '((((initial-value 0) 1) 2) 3))) (test-t (equal (reduce list #(0 1 2 3) :from-end t) '(0 (1 (2 3))))) (test-t (equal (reduce list #((1) (2) (3) (4)) :key car) '(((1 2) 3) 4))) ;(test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end nil) '(((1 2) 3) 4))) (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :initial-value 0) '((((0 1) 2) 3) 4))) (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end t) '(1 (2 (3 4))))) (test-t (equal (reduce list #((1) (2) (3) (4)) :key car :from-end t :initial-value 5) '(1 (2 (3 (4 5)))))) ) (define (nreverse sequence) (let ((len (length sequence))) (do ((i 0 (+ i 1)) (j (- len 1) (- j 1))) ((>= i j) sequence) (let ((tmp (sequence i))) (set! (sequence i) (sequence j)) (set! (sequence j) tmp))))) (define (cl-reverse sequence) (nreverse (copy sequence))) (define (elt sequence index) (sequence index)) ;; length is ok (define* (some predicate . sequences) (call-with-exit (lambda (return) (apply for-each (lambda args (let ((val (apply predicate args))) (if val (return val)))) sequences) #f))) (define* (notany predicate . sequences) (not (apply some predicate sequences))) (define* (every predicate . sequences) (call-with-exit (lambda (return) (apply for-each (lambda args (if (not (apply predicate args)) (return #f))) sequences) #t))) (define* (notevery predicate . sequences) (not (apply every predicate sequences))) (define* (cl-fill sequence item (start 0) end) ; actually "fill" doesn't collide, but it's confusing (let ((nd (or (and (not (null? end)) end) (length sequence)))) (fill! sequence item start nd) sequence)) ;; many of the sequence functions return a different length sequence, but ;; for user-defined sequence types, we can't use the 'type kludge (or ;; at least it's ugly), so we need either (make obj size initial-value) ;; where obj is a representative of the desired type, or another ;; arg to copy giving the new object's size. For now, I'll cobble up ;; something explicit. ;; ;; perhaps the extended type could give its type symbol as well as the make function? (define (make obj size) (cond ((vector? obj) (make-vector size)) ((list? obj) (make-list size)) ((string? obj) (make-string size)) ((hash-table? obj) (make-hash-table size)))) ; does this make any sense? (define* (make-sequence type size initial-element) (case type ((vector bit-vector simple-vector) (make-vector size initial-element)) ((hash-table) (make-hash-table size)) ((string) (cl-make-string size (or initial-element #\null))) ; not #f! ((list) (cl-make-list size initial-element)) (else ()))) (define (cl-map type func . lists) (let* ((vals (apply mapcar func lists)) (len (length vals))) (let ((obj (make-sequence (or type 'list) len))) (if (> (length obj) 0) (do ((i 0 (+ i 1))) ((= i len)) (set! (obj i) (vals i)))) obj))) (define* (subseq sequence start end) (let* ((len (length sequence)) (nd (or (and (number? end) end) len)) (size (- nd start)) (obj (make sequence size))) (do ((i start (+ i 1)) (j 0 (+ j 1))) ((= i nd) obj) (set! (obj j) (sequence i))))) (define (concatenate type . sequences) (let* ((len (apply + (map length sequences))) (new-obj (make-sequence type len)) (ctr 0)) (for-each (lambda (sequence) (for-each (lambda (obj) (set! (new-obj ctr) obj) (set! ctr (+ ctr 1))) sequence)) sequences) new-obj)) ;; :(concatenate 'list "hiho" #(1 2)) -> (#\h #\i #\h #\o 1 2) (define* (replace seq1 seq2 (start1 0) end1 (start2 0) end2) (let* ((len1 (length seq1)) (len2 (length seq2)) (nd1 (or (and (number? end1) end1) len1)) (nd2 (or (and (number? end2) end2) len2))) (if (and (eq? seq1 seq2) (> start1 start2)) (let ((offset (- start1 start2))) (do ((i (- nd1 1) (- i 1))) ((< i start1) seq1) (set! (seq1 i) (seq1 (- i offset))))) (do ((i start1 (+ i 1)) (j start2 (+ j 1))) ((or (= i nd1) (= j nd2)) seq1) (set! (seq1 i) (seq2 j)))))) (let () (define* (remove-if predicate sequence from-end (start 0) end count (key identity)) (let* ((len (length sequence)) (nd (or (and (number? end) end) len)) (num (if (number? count) count len)) (changed 0)) (if (not (positive? num)) sequence (let ((result ())) (if (null from-end) (do ((i 0 (+ i 1))) ((= i len)) (if (or (< i start) (>= i nd) (>= changed num) (not (predicate (key (sequence i))))) (set! result (cons (sequence i) result)) (set! changed (+ changed 1)))) (do ((i (- len 1) (- i 1))) ((< i 0)) (if (or (< i start) (>= i nd) (>= changed num) (not (predicate (key (sequence i))))) (set! result (cons (sequence i) result)) (set! changed (+ changed 1))))) (let* ((len (length result)) (obj (make sequence len)) (vals (if (null from-end) (reverse result) result))) (do ((i 0 (+ i 1))) ((= i len)) (set! (obj i) (vals i))) obj))))) (define* (remove-if-not predicate sequence from-end (start 0) end count (key identity)) (remove-if (lambda (obj) (not (predicate obj))) sequence from-end start end count key)) (define* (remove item sequence from-end (test eql) (start 0) end count (key identity)) (remove-if (lambda (arg) (test item arg)) sequence from-end start end count key)) (define-macro* (delete-if predicate sequence from-end (start 0) end count (key identity)) `(let ((obj (remove-if ,predicate ,sequence ,from-end ,start ,end ,count ,key))) (if (symbol? ',sequence) (set! ,sequence obj)) obj)) (define-macro* (delete-if-not predicate sequence from-end (start 0) end count (key identity)) `(let ((obj (remove-if-not ,predicate ,sequence ,from-end ,start ,end ,count ,key))) (if (symbol? ',sequence) (set! ,sequence obj)) obj)) (define-macro* (delete item sequence from-end (test eql) (start 0) end count (key identity)) `(let ((obj (remove ,item ,sequence ,from-end ,test ,start ,end ,count ,key))) (if (symbol? ',sequence) (set! ,sequence obj)) obj)) (define* (remove-duplicates sequence from-end (test eql) (start 0) end (key identity)) (let* ((result ()) (start-seq (+ start 1)) (len (length sequence)) (nd (if (number? end) end len))) (do ((i start (+ i 1))) ((= i nd)) (let* ((orig-obj (sequence i)) (obj (key orig-obj))) (if (null from-end) (begin (if (not (find obj sequence :start start-seq :end nd :test test :key key)) (set! result (cons orig-obj result))) (set! start-seq (+ start-seq 1))) (if (not (find obj result :test test :key key)) (set! result (cons orig-obj result)))))) (let* ((res (reverse result)) (new-len (+ (length result) start (- len nd))) (new-seq (make sequence new-len))) (let ((n 0)) (do ((i 0 (+ i 1))) ((= i len) new-seq) (if (or (< i start) (>= i nd)) (begin (set! (new-seq n) (sequence i)) (set! n (+ n 1))) (if (not (null? res)) (begin (set! (new-seq n) (car res)) (set! res (cdr res)) (set! n (+ n 1)))))))))) (define-macro* (delete-duplicates sequence from-end (test eql) (start 0) end (key identity)) `(let ((obj (remove-duplicates ,sequence ,from-end ,test ,start ,end ,key))) (if (symbol? ,sequence) (set! ,sequence obj)) obj)) (test-t (equal (remove 4 '(1 3 4 5 9)) '(1 3 5 9))) (test-t (equal (remove 4 '(1 2 4 1 3 4 5)) '(1 2 1 3 5))) (test-t (equal (remove 4 '(1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5))) (test-t (equal (remove 4 '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5))) (test-t (equal (remove 3 '(1 2 4 1 3 4 5) :test >) '(4 3 4 5))) (test-t (let* ((lst '(list of four elements)) (lst2 (copy lst)) (lst3 (delete 'four lst))) (and (equal lst3 '(list of elements)) (not (equal lst lst2))))) (test-t (equal (remove-if oddp '(1 2 4 1 3 4 5)) '(2 4 4))) (test-t (equal (remove-if evenp '(1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5))) (test-t (equal (remove-if-not evenp '(1 2 3 4 5 6 7 8 9) :count 2 :from-end t) '(1 2 3 4 5 6 8))) (test-t (equal (delete 4 (list 1 2 4 1 3 4 5)) '(1 2 1 3 5))) (test-t (equal (delete 4 (list 1 2 4 1 3 4 5) :count 1) '(1 2 1 3 4 5))) (test-t (equal (delete 4 (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5))) (test-t (equal (delete 3 (list 1 2 4 1 3 4 5) :test >) '(4 3 4 5))) (test-t (equal (delete-if oddp (list 1 2 4 1 3 4 5)) '(2 4 4))) (test-t (equal (delete-if evenp (list 1 2 4 1 3 4 5) :count 1 :from-end t) '(1 2 4 1 3 5))) (test-t (equal (delete-if evenp (list 1 2 3 4 5 6)) '(1 3 5))) (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove 3 list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4))))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c))) (test-t (equal (remove 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c))) (test-t (equal (remove 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b))) (test-t (equal (remove 'a (list 'a 'a 'a)) ())) (test-t (equal (remove 'z (list 'a 'b 'c)) '(a b c))) (test-t (equal (remove 'a ()) ())) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c))) (test-t (equal (remove 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c))) (test-t (equal (remove 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c)))) (test-t (equal (remove 'a (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c)))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) ())) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) '(("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) '(("Love") ("LOve") ("LOVe")))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) '(("Love") ("LOve")))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE")))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE")))) (test-t (equal (remove "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove 3 vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4))))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))) (test-t (equalp (remove 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))) (test-t (equalp (remove 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))) (test-t (equalp (remove 'a (vector 'a 'a 'a)) #())) (test-t (equalp (remove 'z (vector 'a 'b 'c)) #(a b c))) (test-t (equalp (remove 'a #()) #())) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c))) (test-t (equalp (remove 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c))) (test-t (equalp (remove 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c)))) (test-t (equalp (remove 'a (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c)))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) #())) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) #(("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) #(("Love") ("LOve") ("LOVe")))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) #(("Love") ("LOve")))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE")))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE")))) (test-t (equalp (remove "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (string= (remove #\a (copy "")) "")) (test-t (string= (remove #\a (copy "xyz")) "xyz")) (test-t (string= (remove #\a (copy "ABCABC")) "ABCABC")) (test-t (string= (remove #\a (copy "ABCABC") :key char-downcase) "BCBC")) (test-t (string= (remove #\a (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (let* ((str0 (copy "abc")) (str (remove #\a str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc")))) (test-t (string= (remove #\a (copy "abcabc") :count 0) "abcabc")) (test-t (string= (remove #\a (copy "abcabc")) "bcbc")) (test-t (string= (remove #\b (copy "abcabc")) "acac")) (test-t (string= (remove #\c (copy "abcabc")) "abab")) (test-t (string= (remove #\a (copy "abcabc") :count 0) "abcabc")) (test-t (string= (remove #\a (copy "abcabc") :count 1) "bcabc")) (test-t (string= (remove #\a (copy "abcabc") :count 2) "bcbc")) (test-t (string= (remove #\a (copy "abcabc") :count 2 :from-end t) "bcbc")) (test-t (string= (remove #\a (copy "abcabc") :count 3) "bcbc")) (test-t (string= (remove #\a (copy "abcabc") :count 3 :from-end t) "bcbc")) (test-t (string= (remove #\a (copy "abcabc") :count 4) "bcbc")) (test-t (string= (remove #\a (copy "abcabc") :count 4 :from-end t) "bcbc")) (test-t (string= (remove #\a (copy "abcabc") :count -1) "abcabc")) (test-t (string= (remove #\a (copy "abcabc") :count -10) "abcabc")) (test-t (string= (remove #\a (copy "abcabc") :count -100) "abcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1) "abcbcbcbc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc")) (test-t (string= (remove #\a (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc")) (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove-if (lambda (arg) (eql arg 3)) list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4))))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)) '(b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c)) '(a c a c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c)) '(a b a b))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) ())) (test-t (equal (remove-if (lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) ()) ())) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c)))) (test-t (equal (remove-if (lambda (arg) (eql arg 'a)) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c)))) (test-t (equal (remove-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ())) (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe")))) (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve")))) (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE")))) (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE")))) (test-t (equal (remove-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove-if (lambda (arg) (eql arg 3)) vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4))))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'b)) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'c)) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'a 'a)) #())) (test-t (equalp (remove-if (lambda (arg) (eql arg 'z)) (vector 'a 'b 'c)) #(a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) #()) #())) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c)))) (test-t (equalp (remove-if (lambda (arg) (eql arg 'a)) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c)))) (test-t (equalp (remove-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #())) (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe")))) (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve")))) (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE")))) (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE")))) (test-t (equalp (remove-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc")) "bcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "")) "")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "xyz")) "xyz")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "ABCABC") :key char-downcase) "BCBC")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1) "bcabc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -10) "abcabc")) (test-t (let* ((str0 (copy "abc")) (str (remove-if (lambda (arg) (string-equal arg #\a)) str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc")))) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc")) "bcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\b)) (copy "abcabc")) "acac")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\c)) (copy "abcabc")) "abab")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 2) "bcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 2 :from-end t) "bcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 3) "bcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 3 :from-end t) "bcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 4) "bcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 4 :from-end t) "bcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -1) "abcabc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -100) "abcabc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabcabcabc") :start 1) "abcbcbcbc")) (test-t (string= (remove-if (lambda (arg) (string-equal arg #\a)) (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc")) (test-t (string= (remove-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc")) (test-t (let* ((list0 (list 0 1 2 3 4)) (list (remove-if-not (lambda (arg) (not (eql arg 3))) list0))) (and (not (eq list0 list)) (equal list0 '(0 1 2 3 4)) (equal list '(0 1 2 4))))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c)) '(b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'b))) (list 'a 'b 'c 'a 'b 'c)) '(a c a c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'c))) (list 'a 'b 'c 'a 'b 'c)) '(a b a b))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'a 'a)) ())) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'z))) (list 'a 'b 'c)) '(a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) ()) ())) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c)))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg 'a))) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c)))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ())) (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE")))) (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe")))) (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve")))) (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE")))) (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE")))) (test-t (equal (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (let* ((vector0 (vector 0 1 2 3 4)) (vector (remove-if-not (lambda (arg) (not (eql arg 3))) vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(0 1 2 3 4)) (equalp vector #(0 1 2 4))))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'b))) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'c))) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'a 'a)) #())) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'z))) (vector 'a 'b 'c)) #(a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) #()) #())) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c)))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c)))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #())) (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe")))) (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve")))) (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE")))) (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE")))) (test-t (equalp (remove-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc")) "bcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "")) "")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "xyz")) "xyz")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "ABCABC") :key char-downcase) "BCBC")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1) "bcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -10) "abcabc")) (test-t (let* ((str0 (copy "abc")) (str (remove-if-not (lambda (arg) (not (string-equal arg #\a))) str0))) (and (not (eq str0 str)) (string= str0 "abc") (string= str "bc")))) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc")) "bcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\b))) (copy "abcabc")) "acac")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\c))) (copy "abcabc")) "abab")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 2) "bcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 2 :from-end t) "bcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 3) "bcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 3 :from-end t) "bcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 4) "bcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 4 :from-end t) "bcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -1) "abcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -100) "abcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabcabcabc") :start 1) "abcbcbcbc")) (test-t (string= (remove-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc")) (test-t (string= (remove-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc")) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c)) '(b c b c))) (test-t (equal (delete 'b (list 'a 'b 'c 'a 'b 'c)) '(a c a c))) (test-t (equal (delete 'c (list 'a 'b 'c 'a 'b 'c)) '(a b a b))) (test-t (equal (delete 'a (list 'a 'a 'a)) ())) (test-t (equal (delete 'z (list 'a 'b 'c)) '(a b c))) (test-t (equal (delete 'a ()) ())) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c))) (test-t (equal (delete 'a (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c))) (test-t (equal (delete 'a (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c)))) (test-t (equal (delete 'a (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c)))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) ())) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) '(("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) '(("Love") ("LOve") ("LOVe")))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) '(("Love") ("LOve")))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE")))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE")))) (test-t (equal (delete "love" (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))) (test-t (equalp (delete 'b (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))) (test-t (equalp (delete 'c (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))) (test-t (equalp (delete 'a (vector 'a 'a 'a)) #())) (test-t (equalp (delete 'z (vector 'a 'b 'c)) #(a b c))) (test-t (equalp (delete 'a #()) #())) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c))) (test-t (equalp (delete 'a (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c))) (test-t (equalp (delete 'a (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c)))) (test-t (equalp (delete 'a (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c)))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal) #())) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1) #(("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t) #(("Love") ("LOve") ("LOVe")))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 2 :from-end t) #(("Love") ("LOve")))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE")))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE")))) (test-t (equalp (delete "love" (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :test string-equal :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (string= (delete #\a (copy "abcabc")) "bcbc")) (test-t (string= (delete #\a (copy "")) "")) (test-t (string= (delete #\a (copy "xyz")) "xyz")) (test-t (string= (delete #\a (copy "ABCABC")) "ABCABC")) (test-t (string= (delete #\a (copy "ABCABC") :key char-downcase) "BCBC")) (test-t (string= (delete #\a (copy "abcabc") :count 1) "bcabc")) (test-t (string= (delete #\a (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (delete #\a (copy "abcabc") :count 0) "abcabc")) (test-t (string= (delete #\a (copy "abcabc") :count -10) "abcabc")) (test-t (string= (delete #\a (copy "abcabc") :count 0) "abcabc")) (test-t (string= (delete #\b (copy "abcabc")) "acac")) (test-t (string= (delete #\c (copy "abcabc")) "abab")) (test-t (string= (delete #\a (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (delete #\a (copy "abcabc") :count 2) "bcbc")) (test-t (string= (delete #\a (copy "abcabc") :count 2 :from-end t) "bcbc")) (test-t (string= (delete #\a (copy "abcabc") :count 3) "bcbc")) (test-t (string= (delete #\a (copy "abcabc") :count 3 :from-end t) "bcbc")) (test-t (string= (delete #\a (copy "abcabc") :count 4) "bcbc")) (test-t (string= (delete #\a (copy "abcabc") :count 4 :from-end t) "bcbc")) (test-t (string= (delete #\a (copy "abcabc") :count -1) "abcabc")) (test-t (string= (delete #\a (copy "abcabc") :count -100) "abcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1) "abcbcbcbc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc")) (test-t (string= (delete #\a (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc")) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c)) '(b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'b)) (list 'a 'b 'c 'a 'b 'c)) '(a c a c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'c)) (list 'a 'b 'c 'a 'b 'c)) '(a b a b))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'a 'a)) ())) (test-t (equal (delete-if (lambda (arg) (eql arg 'z)) (list 'a 'b 'c)) '(a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) ()) ())) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c)))) (test-t (equal (delete-if (lambda (arg) (eql arg 'a)) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c)))) (test-t (equal (delete-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete-if (lambda (arg) (eql arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ())) (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe")))) (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve")))) (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE")))) (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE")))) (test-t (equal (delete-if (lambda (arg) (string-equal arg "love")) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'b)) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'c)) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'a 'a)) #())) (test-t (equalp (delete-if (lambda (arg) (eql arg 'z)) (vector 'a 'b 'c)) #(a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) #()) #())) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c)))) (test-t (equalp (delete-if (lambda (arg) (eql arg 'a)) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c)))) (test-t (equalp (delete-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete-if (lambda (arg) (eql arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #())) (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe")))) (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve")))) (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE")))) (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE")))) (test-t (equalp (delete-if (lambda (arg) (string-equal arg "love")) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc")) "bcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "")) "")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "xyz")) "xyz")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "ABCABC") :key char-downcase) "BCBC")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1) "bcabc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -10) "abcabc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\b)) (copy "abcabc")) "acac")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\c)) (copy "abcabc")) "abab")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 0) "abcabc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 2) "bcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 2 :from-end t) "bcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 3) "bcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 3 :from-end t) "bcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 4) "bcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count 4 :from-end t) "bcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -1) "abcabc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabc") :count -100) "abcabc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabcabcabc") :start 1) "abcbcbcbc")) (test-t (string= (delete-if (lambda (arg) (string-equal arg #\a)) (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc")) (test-t (string= (delete-if (lambda (arg) (eql arg #\a)) (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc")) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c)) '(b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'b))) (list 'a 'b 'c 'a 'b 'c)) '(a c a c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'c))) (list 'a 'b 'c 'a 'b 'c)) '(a b a b))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'a 'a)) ())) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'z))) (list 'a 'b 'c)) '(a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) ()) ())) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 0) '(a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1) '(b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) '(a b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2) '(b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) '(b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3) '(b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) '(b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4) '(b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) '(b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -1) '(a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -10) '(a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c) :count -100) '(a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) '(a b c b c b c b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) '(a b c b c a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) '(a b c b c b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) '(a b c b c b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) '(a b c b c b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) '(a b c b c a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) '(a b c a b c b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) '(a b c a b c a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) '(a b c a b c a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) '(a b c a b c a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) '(a b c a b c a b c a b c))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list '(a) '(b) '(c) '(a) '(b) '(c)) :key car) '((b) (c) (b) (c)))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg 'a))) (list '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) '((a . b) (b . c) (a . b) (b . c)))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete-if-not (lambda (arg) (not (eql arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) '(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) ())) (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) '(("LOve") ("LOVe") ("LOVE")))) (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) '(("Love") ("LOve") ("LOVe")))) (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) '(("Love") ("LOve")))) (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) '(("Love") ("LOVe") ("LOVE")))) (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) '(("Love") ("LOve") ("LOVE")))) (test-t (equal (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (list '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) '(("Love") ("LOVE")))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c)) #(b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'b))) (vector 'a 'b 'c 'a 'b 'c)) #(a c a c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'c))) (vector 'a 'b 'c 'a 'b 'c)) #(a b a b))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'a 'a)) #())) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'z))) (vector 'a 'b 'c)) #(a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) #()) #())) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 0) #(a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1) #(b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 1 :from-end t) #(a b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2) #(b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 2 :from-end t) #(b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3) #(b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 3 :from-end t) #(b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4) #(b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count 4 :from-end t) #(b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -1) #(a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -10) #(a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c) :count -100) #(a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1) #(a b c b c b c b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :count 2) #(a b c b c b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end nil :count 2) #(a b c b c b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8) #(a b c b c b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1) #(a b c b c a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 1 :from-end t) #(a b c a b c b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count 0 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 8 :count -100 :from-end t) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 1 :end 1) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 2 :end 2) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector 'a 'b 'c 'a 'b 'c 'a 'b 'c 'a 'b 'c) :start 12 :end 12) #(a b c a b c a b c a b c))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a) '(b) '(c) '(a) '(b) '(c)) :key car) #((b) (c) (b) (c)))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg 'a))) (vector '(a . b) '(b . c) '(c . a) '(a . b) '(b . c) '(c . a)) :key cdr) #((a . b) (b . c) (a . b) (b . c)))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete-if-not (lambda (arg) (not (eql arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count -10) #(("Love") ("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car) #())) (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1) #(("LOve") ("LOVe") ("LOVE")))) (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t) #(("Love") ("LOve") ("LOVe")))) (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 2 :from-end t) #(("Love") ("LOve")))) (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :start 1 :end 3) #(("Love") ("LOVe") ("LOVE")))) (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 1 :from-end t :start 1 :end 3) #(("Love") ("LOve") ("LOVE")))) (test-t (equalp (delete-if-not (lambda (arg) (not (string-equal arg "love"))) (vector '("Love") '("LOve") '("LOVe") '("LOVE")) :key car :count 10 :from-end t :start 1 :end 3) #(("Love") ("LOVE")))) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc")) "bcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "")) "")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "xyz")) "xyz")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "ABCABC") :key char-downcase) "BCBC")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1) "bcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -10) "abcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\b))) (copy "abcabc")) "acac")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\c))) (copy "abcabc")) "abab")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 0) "abcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 1 :from-end t) "abcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 2) "bcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 2 :from-end t) "bcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 3) "bcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 3 :from-end t) "bcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 4) "bcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count 4 :from-end t) "bcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -1) "abcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabc") :count -100) "abcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabcabcabc") :start 1) "abcbcbcbc")) (test-t (string= (delete-if-not (lambda (arg) (not (string-equal arg #\a))) (copy "abcabcabcabc") :start 1 :count 1) "abcbcabcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :count 2) "abcbcbcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end nil :count 2) "abcbcbcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8) "abcbcbcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 1) "abcbcabcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 1 :from-end t) "abcabcbcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count 0 :from-end t) "abcabcabcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 8 :count -100 :from-end t) "abcabcabcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 1 :end 1) "abcabcabcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 2 :end 2) "abcabcabcabc")) (test-t (string= (delete-if-not (lambda (arg) (not (eql arg #\a))) (copy "abcabcabcabc") :start 12 :end 12) "abcabcabcabc")) (test-t (equal (remove-duplicates "aBcDAbCd" :test char-equal :from-end t) "aBcD")) (test-t (equal (remove-duplicates '(a b c b d d e)) '(a c b d e))) (test-t (equal (remove-duplicates '(a b c b d d e) :from-end t) '(a b c d e))) (test-t (let* ((list0 (list 0 1 2 3 4 5 6)) (list (delete-duplicates list0 :key oddp :start 1 :end 6))) (equal list '(0 4 5 6)))) (test-t (let* ((list0 (list 2 1 0 1 0 1 2)) (list (remove-duplicates list0))) (and (not (eq list0 list)) (equal list0 '(2 1 0 1 0 1 2)) (equal list '(0 1 2))))) (test-t (let* ((vector0 (vector 2 1 0 1 0 1 2)) (vector (remove-duplicates vector0))) (and (not (eq vector0 vector)) (equalp vector0 #(2 1 0 1 0 1 2)) (equalp vector #(0 1 2))))) (test-t (equal (remove-duplicates (list 0 1 2 2 3 3 3)) '(0 1 2 3))) (test-t (equal (remove-duplicates (list 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) '(0 1 2))) (test-t (equal (remove-duplicates (list 'a 'a 'b 'c 'c)) '(a b c))) (test-t (equal (remove-duplicates (list 0 1 2)) '(0 1 2))) (test-t (equal (remove-duplicates (list 2 0 2 1 1 1 0 0 0 1 2)) '(0 1 2))) (test-t (equal (remove-duplicates (list)) ())) (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr) '((a . 0) (b . 1) (c . 2)))) (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr :test (lambda (a b) (and (oddp a) (oddp b)))) '((x . 0) (z . 2) (a . 0) (b . 1) (c . 2)))) (test-t (equal (remove-duplicates (list '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr :test (lambda (a b) (and (evenp a) (evenp b)))) '((y . 1) (b . 1) (c . 2)))) (test-t (equal (remove-duplicates (list 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9) '(0 1 2 0 1 2 0 1 2))) (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11))) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)))) (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :key car) '((0 . 9) (1 . 10) (2 . 11)))) (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2)))) (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :key car) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 9) '(1 . 10) '(2 . 11)))) (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5)))) (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end nil :key car) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 9) '(1 . 10) '(2 . 11)))) (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end 9 :key car) '((0 . 0) (1 . 1) (2 . 2) (0 . 6) (1 . 7) (2 . 8) (0 . 9) (1 . 10) (2 . 11)))) (test-t (equal (remove-duplicates (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 6) '(1 . 7) '(2 . 8) '(0 . 9) '(1 . 10) '(2 . 11)) :start 3 :end 9 :key car :from-end t) (list '(0 . 0) '(1 . 1) '(2 . 2) '(0 . 3) '(1 . 4) '(2 . 5) '(0 . 9) '(1 . 10) '(2 . 11)))) (test-t (equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key length) (list "Tuesday" "Wednesday" "Saturday" "Sunday"))) (test-t (equal (remove-duplicates (list "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key (lambda (arg) (char arg 0)) :test char=) (list "Monday" "Wednesday" "Thursday" "Friday" "Sunday"))) (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key char-upcase) '(#\A #\B #\C))) (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :key char-upcase :from-end t) '(#\a #\b #\c))) (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char=) (list #\a #\b #\c #\A #\B #\C))) (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char-equal) (list #\A #\B #\C))) (test-t (equal (remove-duplicates (list #\a #\b #\c #\A #\B #\C) :test char-equal :from-end t) (list #\a #\b #\c))) (test-t (equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alpha-char-p) (list #\C #\9))) (test-t (equal (remove-duplicates (list #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alphanumericp) (list #\9))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11))) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car) (list '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9 :test char-equal) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end 9 :test char-equal :from-end t) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\a . 9) '(#\B . 10) '(#\c . 11)))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :end nil) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :start 3 :from-end t) (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8)))) (test-t (equal (remove-duplicates (list '(#\A . 0) '(#\b . 1) '(#\C . 2) '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)) :key car :end 9) (list '(#\a . 3) '(#\B . 4) '(#\c . 5) '(#\A . 6) '(#\b . 7) '(#\C . 8) '(#\a . 9) '(#\B . 10) '(#\c . 11)))) (test-t (equalp (remove-duplicates (vector 0 1 2 2 3 3 3)) #(0 1 2 3))) (test-t (equalp (remove-duplicates (vector 0 0 0 2 0 1 1 2 2 2 1 1 1 1 2)) #(0 1 2))) (test-t (equalp (remove-duplicates (vector 'a 'a 'b 'c 'c)) #(a b c))) (test-t (equalp (remove-duplicates (vector 0 1 2)) #(0 1 2))) (test-t (equalp (remove-duplicates (vector 2 0 2 1 1 1 0 0 0 1 2)) #(0 1 2))) (test-t (equalp (remove-duplicates (vector)) #())) (test-t (equalp (remove-duplicates (vector '(x . 0) '(y . 1) '(z . 2) '(a . 0) '(b . 1) '(c . 2)) :key cdr) #((a . 0) (b . 1) (c . 2)))) (test-t (equalp (remove-duplicates (vector 0 1 2 0 1 2 0 1 2 0 1 2) :start 3 :end 9) #(0 1 2 0 1 2 0 1 2))) (test-t (equalp (remove-duplicates (vector "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday") :key length) (vector "Tuesday" "Wednesday" "Saturday" "Sunday"))) (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key char-upcase) #(#\A #\B #\C))) (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :key char-upcase :from-end t) #(#\a #\b #\c))) (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char=) (vector #\a #\b #\c #\A #\B #\C))) (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char-equal) (vector #\A #\B #\C))) (test-t (equalp (remove-duplicates (vector #\a #\b #\c #\A #\B #\C) :test char-equal :from-end t) (vector #\a #\b #\c))) (test-t (equalp (remove-duplicates (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alpha-char-p) (vector #\C #\9))) (test-t (equalp (remove-duplicates (vector #\a #\1 #\b #\1 #\2 #\c #\0 #\A #\0 #\B #\C #\9) :key alphanumericp) (vector #\9))) (test-t (string= (remove-duplicates (copy "")) "")) (test-t (string= (remove-duplicates (copy "abc")) "abc")) (test-t (string= (remove-duplicates (copy "abcabc")) "abc")) (test-t (string= (remove-duplicates (copy "cbaabc")) "abc")) (test-t (string= (remove-duplicates (copy "cbaabc") :from-end t) "cba")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA")) "abcCBA")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :from-end t) "cbaABC")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :key char-downcase) "CBA")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :key char-downcase :from-end t) "cba")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3) "cbaabcCBA")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :from-end t) "cbaabcABC")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9) "cbaabcABCCBA")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :key char-upcase) "cbaABCCBA")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :key char-upcase :from-end t) "cbaabcCBA")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :test char-equal :from-end t) "cbaabcCBA")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :key upper-case-p :test eq) "cbacCCBA")) (test-t (string= (remove-duplicates (copy "cbaabcABCCBA") :start 3 :end 9 :key upper-case-p :test eq :from-end t) "cbaaACBA")) ) (let () (define* (merge result-type seq1 seq2 predicate (key identity)) (let* ((len1 (length seq1)) (len2 (length seq2)) (size (+ len1 len2)) (obj (make-sequence result-type size)) (i 0) (j 0)) (do ((n 0 (+ n 1))) ((or (= i len1) (= j len2)) (if (< i len1) (do ((k i (+ k 1))) ((= k len1) obj) (set! (obj n) (seq1 k)) (set! n (+ n 1))) (if (< j len2) (do ((k j (+ k 1))) ((= k len2) obj) (set! (obj n) (seq2 k)) (set! n (+ n 1))) obj))) (if (null (predicate (key (seq1 i)) (key (seq2 j)))) (begin (set! (obj n) (seq2 j)) (set! j (+ j 1))) (begin (set! (obj n) (seq1 i)) (set! i (+ i 1))))))) (test-t (let ((test1 (list 1 3 4 6 7)) (test2 (list 2 5 8))) (equal (merge 'list test1 test2 <) '(1 2 3 4 5 6 7 8)))) (test-t (let ((test1 (vector '(red . 1) '(blue . 4))) (test2 (vector '(yellow . 2) '(green . 7)))) (equalp (merge 'vector test1 test2 < :key cdr) #((red . 1) (yellow . 2) (blue . 4) (green . 7))))) (test-t (equal (merge 'list (list 1 3 5 7 9) (list 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9))) (test-t (equal (merge 'list (list 0 1 2) nil <) '(0 1 2))) (test-t (equal (merge 'list nil (list 0 1 2) <) '(0 1 2))) (test-t (equal (merge 'list nil nil <) nil)) (test-t (equal (merge 'list (list '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))) (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))) (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))) (test-t (equal (merge 'list (list 3 1 9 5 7) (list 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7))) (test-t (equal (merge 'list (vector 1 3 5 7 9) (list 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9))) (test-t (equal (merge 'list (vector 0 1 2) nil <) '(0 1 2))) (test-t (equal (merge 'list #() (list 0 1 2) <) '(0 1 2))) (test-t (equal (merge 'list #() #() <) nil)) (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))) (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))) (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))) (test-t (equal (merge 'list (vector 3 1 9 5 7) (list 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7))) (test-t (equal (merge 'list (list 1 3 5 7 9) (vector 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9))) (test-t (equal (merge 'list (list 0 1 2) #() <) '(0 1 2))) (test-t (equal (merge 'list nil (vector 0 1 2) <) '(0 1 2))) (test-t (equal (merge 'list nil #() <) nil)) (test-t (equal (merge 'list (list '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))) (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))) (test-t (equal (merge 'list (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))) (test-t (equal (merge 'list (list 3 1 9 5 7) (vector 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7))) (test-t (equal (merge 'list (vector 1 3 5 7 9) (vector 0 2 4 6 8) <) '(0 1 2 3 4 5 6 7 8 9))) (test-t (equal (merge 'list (vector 0 1 2) #() <) '(0 1 2))) (test-t (equal (merge 'list #() (vector 0 1 2) <) '(0 1 2))) (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))) (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))) (test-t (equal (merge 'list (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) '((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))) (test-t (equal (merge 'list (vector 3 1 9 5 7) (vector 8 6 0 2 4) <) '(3 1 8 6 0 2 4 9 5 7))) (test-t (equalp (merge 'vector (list 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9))) (test-t (equalp (merge 'vector (list 0 1 2) nil <) #(0 1 2))) (test-t (equalp (merge 'vector nil (list 0 1 2) <) #(0 1 2))) (test-t (equalp (merge 'vector nil nil <) #())) (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))) (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))) (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))) (test-t (equalp (merge 'vector (list 3 1 9 5 7) (list 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7))) (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (list 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9))) (test-t (equalp (merge 'vector (vector 0 1 2) nil <) #(0 1 2))) (test-t (equalp (merge 'vector #() (list 0 1 2) <) #(0 1 2))) (test-t (equalp (merge 'vector #() #() <) #())) (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))) (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))) (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (list '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))) (test-t (equalp (merge 'vector (vector 3 1 9 5 7) (list 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7))) (test-t (equalp (merge 'vector (list 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9))) (test-t (equalp (merge 'vector (list 0 1 2) #() <) #(0 1 2))) (test-t (equalp (merge 'vector nil (vector 0 1 2) <) #(0 1 2))) (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))) (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))) (test-t (equalp (merge 'vector (list '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))) (test-t (equalp (merge 'vector (list 3 1 9 5 7) (vector 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7))) (test-t (equalp (merge 'vector (vector 1 3 5 7 9) (vector 0 2 4 6 8) <) #(0 1 2 3 4 5 6 7 8 9))) (test-t (equalp (merge 'vector (vector 0 1 2) #() <) #(0 1 2))) (test-t (equalp (merge 'vector #() (vector 0 1 2) <) #(0 1 2))) (test-t (equalp (merge 'vector #() #() <) #())) (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 2) (3 1) (3 2)))) (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2)))) (test-t (equalp (merge 'vector (vector '(1 1) '(2 1) '(2 1 1) '(3 1)) (vector '(1 2) '(2 2) '(3 2) '(3 2 2)) <= :key car) #((1 1) (1 2) (2 1) (2 1 1) (2 2) (3 1) (3 2) (3 2 2)))) (test-t (equalp (merge 'vector (vector 3 1 9 5 7) (vector 8 6 0 2 4) <) #(3 1 8 6 0 2 4 9 5 7))) (test-t (string= (merge 'string (list #\a #\c #\e) (list #\b #\d #\f) char<) "abcdef")) (test-t (string= (merge 'string (list #\a #\b #\c) (list #\d #\e #\f) char<) "abcdef")) (test-t (string= (merge 'string (list #\a #\b #\c) () char<) "abc")) (test-t (string= (merge 'string () (list #\a #\b #\c) char<) "abc")) (test-t (string= (merge 'string (list #\a #\b #\c) (copy "") char<) "abc")) (test-t (string= (merge 'string (list #\a #\b #\z) #(#\c #\x #\y) char<) "abcxyz")) ) (let () (define* (search seq1 seq2 from-end (test eql) (key identity) (start1 0) (start2 0) end1 end2) (let* ((len1 (length seq1)) (len2 (length seq2)) (nd1 (or (and (number? end1) end1) len1)) (nd2 (or (and (number? end2) end2) len2))) (set! len1 (min len1 (- nd1 start1))) (set! len2 (min len2 (- nd2 start2))) (if (or (= len2 0) (> len1 len2)) () (call-with-exit (lambda (return) (if (or (not from-end) (null? from-end)) (do ((i start2 (+ i 1))) ((> i (- nd2 len1)) ()) (do ((j start1 (+ j 1)) (k i (+ k 1))) ((or (= j nd1) (not (test (key (seq1 j)) (key (seq2 k))))) (if (= j nd1) (return i))))) (do ((i (- nd2 len1) (- i 1))) ((< i start2) ()) (do ((j start1 (+ j 1)) (k i (+ k 1))) ((or (= j nd1) (not (test (key (seq1 j)) (key (seq2 k))))) (if (= j nd1) (return i))))))))))) (define* (mismatch seq1 seq2 from-end (test eql) (key identity) (start1 0) (start2 0) end1 end2) (let* ((nd1 (or (and (number? end1) end1) (length seq1))) (nd2 (or (and (number? end2) end2) (length seq2)))) (if (not from-end) (do ((i start1 (+ i 1)) (j start2 (+ j 1))) ((or (= i nd1) (= j nd2) (not (test (key (seq1 i)) (key (seq2 j))))) (if (and (= i nd1) (= j nd2)) () i))) (do ((i (- nd1 1) (- i 1)) (j (- nd2 1) (- j 1))) ((or (< i start1) (< j start2) (not (test (key (seq1 i)) (key (seq2 j))))) (if (and (< i start1) (< j start2)) () (+ i 1))))))) (test-t (eql (search "dog" "it's a dog's life") 7)) (test-t (eql (search '(0 1) '(2 4 6 1 3 5) :key oddp) 2)) (test-t (null (search '(a b c) '(x y z)))) (test-t (eql (search () '(x y z)) 0)) (test-t (eql (search '(a) '(a)) 0)) (test-t (eql (search '(a b c) '(a b c x y z)) 0)) (test-t (eql (search '(a b c) '(x a b c y z)) 1)) (test-t (eql (search '(a b c) '(x y a b c z)) 2)) (test-t (eql (search '(a b c) '(x y z a b c)) 3)) (test-t (eql (search '(a b c) '(a b c a b c) :start2 1) 3)) (test-t (eql (search '(a b c) '(a b c a b c) :start2 1 :end2 nil) 3)) (test-t (eql (search '(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1)) (test-t (eql (search '(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1)) (test-t (null (search '(a b c) '(a b c a b c) :start2 0 :end2 0))) (test-t (null (search '(a b c) '(a b c a b c) :start2 1 :end2 1))) (test-t (null (search '(a b c) '(a b c a b c) :start2 2 :end2 2))) (test-t (null (search '(a b c) '(a b c a b c) :start2 3 :end2 3))) (test-t (null (search '(a b c) '(a b c a b c) :start2 4 :end2 4))) (test-t (null (search '(a b c) '(a b c a b c) :start2 5 :end2 5))) (test-t (null (search '(a b c) '(a b c a b c) :start2 6 :end2 6))) (test-t (eql (search '(a b c) '(a b c a b c)) 0)) (test-t (eql (search '(a b c) '(a b c a b c) :from-end t) 3)) (test-t (eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6) 3)) (test-t (eql (search '(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3)) (test-t (eql (search '(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0)) (test-t (eql (search '(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3)) (test-t (null (search '(#\a #\b #\c) '(#\A #\B #\C)))) (test-t (eql (search '(#\a #\b #\c) '(#\A #\B #\C) :test char-equal) 0)) (test-t (eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z)) 0)) (test-t (eql (search '(#\a #\b) '(#\a #\b #\x #\y #\z) :test char<) 1)) (test-t (null (search '((a) (b)) '((x) (y) (z) (a) (b) (c))))) (test-t (eql (search '((a) (b)) '((x) (y) (z) (a) (b) (c)) :key car) 3)) (test-t (eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0)) (test-t (eql (search '((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6)) (test-t (eql (search '((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0)) (test-t (eql (search '((a a) (b b)) '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6)) (test-t (eql (search '(("a" a) ("b" b)) '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z") ("A" 0) ("B" 1) ("C" 2)) :start1 1 :end1 2 :start2 3 :end2 nil :key car :test string-equal :from-end t) 7)) (test-t (null (search #(a b c) '(x y z)))) (test-t (eql (search #() '(x y z)) 0)) (test-t (eql (search #(a) '(a)) 0)) (test-t (eql (search #(a b c) '(a b c x y z)) 0)) (test-t (eql (search #(a b c) '(x a b c y z)) 1)) (test-t (eql (search #(a b c) '(x y a b c z)) 2)) (test-t (eql (search #(a b c) '(x y z a b c)) 3)) (test-t (eql (search #(a b c) '(a b c a b c) :start2 1) 3)) (test-t (eql (search #(a b c) '(a b c a b c) :start2 1 :end2 nil) 3)) (test-t (eql (search #(a b c) '(a b c a b c) :start1 1 :start2 1 :end2 nil) 1)) (test-t (eql (search #(a b c) '(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1)) (test-t (null (search #(a b c) '(a b c a b c) :start2 0 :end2 0))) (test-t (null (search #(a b c) '(a b c a b c) :start2 1 :end2 1))) (test-t (null (search #(a b c) '(a b c a b c) :start2 2 :end2 2))) (test-t (null (search #(a b c) '(a b c a b c) :start2 3 :end2 3))) (test-t (null (search #(a b c) '(a b c a b c) :start2 4 :end2 4))) (test-t (null (search #(a b c) '(a b c a b c) :start2 5 :end2 5))) (test-t (null (search #(a b c) '(a b c a b c) :start2 6 :end2 6))) (test-t (eql (search #(a b c) '(a b c a b c)) 0)) (test-t (eql (search #(a b c) '(a b c a b c) :from-end t) 3)) (test-t (eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6) 3)) (test-t (eql (search #(a b c) '(a b c a b c) :start2 3 :end2 6 :from-end t) 3)) (test-t (eql (search #(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0)) (test-t (eql (search #(a b c) '(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3)) (test-t (null (search #(#\a #\b #\c) '(#\A #\B #\C)))) (test-t (eql (search #(#\a #\b #\c) '(#\A #\B #\C) :test char-equal) 0)) (test-t (eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z)) 0)) (test-t (eql (search #(#\a #\b) '(#\a #\b #\x #\y #\z) :test char<) 1)) (test-t (null (search #((a) (b)) '((x) (y) (z) (a) (b) (c))))) (test-t (eql (search #((a) (b)) '((x) (y) (z) (a) (b) (c)) :key car) 3)) (test-t (eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0)) (test-t (eql (search #((a) (b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6)) (test-t (eql (search #((a a) (b b)) '((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0)) (test-t (eql (search #((a a) (b b)) '((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6)) (test-t (eql (search #(("a" a) ("b" b)) '(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z") ("A" 0) ("B" 1) ("C" 2)) :start1 1 :end1 2 :start2 3 :end2 nil :key car :test string-equal :from-end t) 7)) (test-t (null (search '(a b c) #(x y z)))) (test-t (eql (search () #(x y z)) 0)) (test-t (eql (search '(a) #(a)) 0)) (test-t (eql (search '(a b c) #(a b c x y z)) 0)) (test-t (eql (search '(a b c) #(x a b c y z)) 1)) (test-t (eql (search '(a b c) #(x y a b c z)) 2)) (test-t (eql (search '(a b c) #(x y z a b c)) 3)) (test-t (eql (search '(a b c) #(a b c a b c) :start2 1) 3)) (test-t (eql (search '(a b c) #(a b c a b c) :start2 1 :end2 nil) 3)) (test-t (eql (search '(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1)) (test-t (eql (search '(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1)) (test-t (null (search '(a b c) #(a b c a b c) :start2 0 :end2 0))) (test-t (null (search '(a b c) #(a b c a b c) :start2 1 :end2 1))) (test-t (null (search '(a b c) #(a b c a b c) :start2 2 :end2 2))) (test-t (null (search '(a b c) #(a b c a b c) :start2 3 :end2 3))) (test-t (null (search '(a b c) #(a b c a b c) :start2 4 :end2 4))) (test-t (null (search '(a b c) #(a b c a b c) :start2 5 :end2 5))) (test-t (null (search '(a b c) #(a b c a b c) :start2 6 :end2 6))) (test-t (eql (search '(a b c) #(a b c a b c)) 0)) (test-t (eql (search '(a b c) #(a b c a b c) :from-end t) 3)) (test-t (eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6) 3)) (test-t (eql (search '(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3)) (test-t (eql (search '(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0)) (test-t (eql (search '(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3)) (test-t (null (search '(#\a #\b #\c) #(#\A #\B #\C)))) (test-t (eql (search '(#\a #\b #\c) #(#\A #\B #\C) :test char-equal) 0)) (test-t (eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z)) 0)) (test-t (eql (search '(#\a #\b) #(#\a #\b #\x #\y #\z) :test char<) 1)) (test-t (null (search '((a) (b)) #((x) (y) (z) (a) (b) (c))))) (test-t (eql (search '((a) (b)) #((x) (y) (z) (a) (b) (c)) :key car) 3)) (test-t (eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0)) (test-t (eql (search '((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6)) (test-t (eql (search '((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0)) (test-t (eql (search '((a a) (b b)) #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6)) (test-t (eql (search '(("a" a) ("b" b)) #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z") ("A" 0) ("B" 1) ("C" 2)) :start1 1 :end1 2 :start2 3 :end2 nil :key car :test string-equal :from-end t) 7)) (test-t (null (search #(a b c) #(x y z)))) (test-t (eql (search #() #(x y z)) 0)) (test-t (eql (search #(a) #(a)) 0)) (test-t (eql (search #(a b c) #(a b c x y z)) 0)) (test-t (eql (search #(a b c) #(x a b c y z)) 1)) (test-t (eql (search #(a b c) #(x y a b c z)) 2)) (test-t (eql (search #(a b c) #(x y z a b c)) 3)) (test-t (eql (search #(a b c) #(a b c a b c) :start2 1) 3)) (test-t (eql (search #(a b c) #(a b c a b c) :start2 1 :end2 nil) 3)) (test-t (eql (search #(a b c) #(a b c a b c) :start1 1 :start2 1 :end2 nil) 1)) (test-t (eql (search #(a b c) #(a b c a b c) :start1 1 :end1 nil :start2 1 :end2 nil) 1)) (test-t (null (search #(a b c) #(a b c a b c) :start2 0 :end2 0))) (test-t (null (search #(a b c) #(a b c a b c) :start2 1 :end2 1))) (test-t (null (search #(a b c) #(a b c a b c) :start2 2 :end2 2))) (test-t (null (search #(a b c) #(a b c a b c) :start2 3 :end2 3))) (test-t (null (search #(a b c) #(a b c a b c) :start2 4 :end2 4))) (test-t (null (search #(a b c) #(a b c a b c) :start2 5 :end2 5))) (test-t (null (search #(a b c) #(a b c a b c) :start2 6 :end2 6))) (test-t (eql (search #(a b c) #(a b c a b c)) 0)) (test-t (eql (search #(a b c) #(a b c a b c) :from-end t) 3)) (test-t (eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6) 3)) (test-t (eql (search #(a b c) #(a b c a b c) :start2 3 :end2 6 :from-end t) 3)) (test-t (eql (search #(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6) 0)) (test-t (eql (search #(a b c) #(a b c a b c) :start1 0 :end1 2 :start2 0 :end2 6 :from-end t) 3)) (test-t (null (search #(#\a #\b #\c) #(#\A #\B #\C)))) (test-t (eql (search #(#\a #\b #\c) #(#\A #\B #\C) :test char-equal) 0)) (test-t (eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z)) 0)) (test-t (eql (search #(#\a #\b) #(#\a #\b #\x #\y #\z) :test char<) 1)) (test-t (null (search #((a) (b)) #((x) (y) (z) (a) (b) (c))))) (test-t (eql (search #((a) (b)) #((x) (y) (z) (a) (b) (c)) :key car) 3)) (test-t (eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0)) (test-t (eql (search #((a) (b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car :from-end t) 6)) (test-t (eql (search #((a a) (b b)) #((a) (b) (c) (x) (y) (z) (a) (b) (c)) :key car) 0)) (test-t (eql (search #((a a) (b b)) #((a nil) (b t) (c nil) (x) (y) (z) (a 0) (b 1) (c 2)) :key car :from-end t) 6)) (test-t (eql (search #(("a" a) ("b" b)) #(("a" nil) ("b" t) ("c" nil) ("x") ("y") ("z") ("A" 0) ("B" 1) ("C" 2)) :start1 1 :end1 2 :start2 3 :end2 nil :key car :test string-equal :from-end t) 7)) (test-t (null (search "peace" "LOVE&PEACE"))) (test-t (eql (search "peace" "LOVE&PEACE" :test char-equal) 5)) (test-t (null (search "PeAcE" "LoVe&pEaCe"))) (test-t (eql (search "PeAcE" "LoVe&pEaCe" :key char-upcase) 5)) (test-t (eql (search "abc" "abc xyz abc" :from-end t) 8)) (test-t (eql (search "abc" "abc xyz abc xyz abc xyz abc" :start2 8 :end2 19) 8)) (test-t (eql (search "abc" "abc xyz abc xyz abc xyz abc" :from-end t :start2 8 :end2 19) 16)) (test-t (eql (mismatch "abcd" "ABCDE" :test char-equal) 4)) (test-t (eql (mismatch '(3 2 1 1 2 3) '(1 2 3) :from-end t) 3)) (test-t (null (mismatch '(1 2 3 4 5 6) '(3 4 5 6 7) :start1 2 :end2 4))) (test-t (null (mismatch () ()))) (test-t (eql (mismatch '(a b c) '(x y z)) 0)) (test-t (eql (mismatch () '(x y z)) 0)) (test-t (eql (mismatch '(x y z) ()) 0)) (test-t (null (mismatch '(a) '(a)))) (test-t (eql (mismatch '(a b c x y z) '(a b c)) 3)) (test-t (null (mismatch '(a b c) '(a b c)))) (test-t (eql (mismatch '(a b c d e f) '(a b c)) 3)) (test-t (eql (mismatch '(a b c) '(a b c d e f)) 3)) (test-t (eql (mismatch '(a b c) '(a b x)) 2)) (test-t (eql (mismatch '(a b c) '(a x c)) 1)) (test-t (eql (mismatch '(a b c) '(x b c)) 0)) (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3) 6)) (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6)) (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4)) (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3)) (test-t (null (mismatch '(x y z) () :start1 0 :end1 0))) (test-t (null (mismatch '(x y z) () :start1 1 :end1 1))) (test-t (null (mismatch '(x y z) () :start1 2 :end1 2))) (test-t (null (mismatch '(x y z) () :start1 3 :end1 3))) (test-t (null (mismatch '(x y z) () :start1 0 :end1 0 :start2 0 :end2 0))) (test-t (null (mismatch '(x y z) () :start1 1 :end1 1 :start2 1 :end2 1))) (test-t (null (mismatch '(x y z) () :start1 2 :end1 2 :start2 2 :end2 2))) (test-t (null (mismatch '(x y z) () :start1 3 :end1 3 :start2 3 :end2 3))) (test-t (null (mismatch '(x y z) () :start1 0 :end1 0 :start2 3 :end2 3))) (test-t (null (mismatch '(x y z) () :start1 1 :end1 1 :start2 2 :end2 2))) (test-t (null (mismatch '(x y z) () :start1 2 :end1 2 :start2 1 :end2 1))) (test-t (null (mismatch '(x y z) () :start1 3 :end1 3 :start2 0 :end2 0))) (test-t (eql (mismatch '(x y z) '(a b c) :start1 0 :end1 0) 0)) (test-t (eql (mismatch '(x y z) '(a b c) :start1 1 :end1 1) 1)) (test-t (eql (mismatch '(x y z) '(a b c) :start1 2 :end1 2) 2)) (test-t (eql (mismatch '(x y z) '(a b c) :start1 3 :end1 3) 3)) (test-t (eql (mismatch '(x y z) '(x y z) :start1 0 :end1 1) 1)) (test-t (eql (mismatch '(x y z) '(x y z) :start1 0 :end1 2) 2)) (test-t (eql (mismatch '(x y z) '(x y z Z) :start1 0 :end1 3) 3)) (test-t (null (mismatch '(x y z) '(x y z) :start1 0 :end1 3))) (test-t (eql (mismatch '(a b c x y z) '(x y z a b c)) 0)) (test-t (eql (mismatch '(a b c x y z) '(x y z a b c) :start1 3) 6)) (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9)) (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6)) (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3) 9)) (test-t (eql (mismatch '(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3) 6)) (test-t (eql (mismatch '(a b c) '(a b c x y z)) 3)) (test-t (eql (mismatch '(a b c) '(x a b c y z)) 0)) (test-t (eql (mismatch '(a b c) '(x a b c y z) :start2 1) 3)) (test-t (eql (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 nil) 3)) (test-t (null (mismatch '(a b c) '(x a b c y z) :start2 1 :end2 4))) (test-t (eql (mismatch '(a b c d e) '(c d)) 0)) (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2) 4)) (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :end1 3) 3)) (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :start2 1) 2)) (test-t (eql (mismatch '(a b c d e) '(c d) :start1 3 :start2 1) 4)) (test-t (eql (mismatch '(a b c d e) '(c d) :start1 2 :end2 1) 3)) (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2))) (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3))) (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4))) (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1)) (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2)) (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3)) (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4))) (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1)) (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2)) (test-t (eql (mismatch '(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3)) (test-t (null (mismatch '(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1))) (test-t (null (mismatch '(a b c) '(a b c) :from-end t))) (test-t (eql (mismatch '(a b c d) '(a b c) :from-end t) 4)) (test-t (eql (mismatch '(a b c) '(c) :from-end t) 2)) (test-t (eql (mismatch '(a b c) '(z a b c) :from-end t) 0)) (test-t (eql (mismatch '(a b c) '(x y z a b c) :from-end t) 0)) (test-t (eql (mismatch '(x y z a b c) '(a b c) :from-end t) 3)) (test-t (eql (mismatch '(x y z a b c) '(a b c) :end1 3 :from-end t) 3)) (test-t (eql (mismatch '(x y z a b c) '(a b c) :end1 5 :from-end t) 5)) (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3)) (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3)) (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4)) (test-t (eql (mismatch '(x y z a b c x y z) '(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2)) (test-t (eql (mismatch '((a) (b) (c)) '((a) (b) (c))) 0)) (test-t (null (mismatch '((a) (b) (c)) '((a) (b) (c)) :key car))) (test-t (null (mismatch '((a) (b) (c)) '((a) (b) (c)) :test equal))) (test-t (eql (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0)) (test-t (null (mismatch '(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test equalp))) (test-t (eql (mismatch '((a) (b) (c) (d)) '((a) (b) (c)) :key car) 3)) (test-t (eql (mismatch '((a) (b) (c)) '((a) (b) (c) (d)) :key car) 3)) (test-t (eql (mismatch '(#\a #\b #\c) '(#\A #\B #\C)) 0)) (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase))) (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-downcase))) (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2))) (test-t (null (mismatch '(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 2 :start2 2))) (test-t (eql (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f))) 0)) (test-t (eql (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr) 0)) (test-t (null (mismatch '((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal))) (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal) 3)) (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4)) (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1)) (test-t (null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4))) (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5)) (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2)) (test-t (null (mismatch #() ()))) (test-t (eql (mismatch #(a b c) '(x y z)) 0)) (test-t (eql (mismatch #() '(x y z)) 0)) (test-t (eql (mismatch #(x y z) ()) 0)) (test-t (null (mismatch #(a) '(a)))) (test-t (eql (mismatch #(a b c x y z) '(a b c)) 3)) (test-t (null (mismatch #(a b c) '(a b c)))) (test-t (eql (mismatch #(a b c d e f) '(a b c)) 3)) (test-t (eql (mismatch #(a b c) '(a b c d e f)) 3)) (test-t (eql (mismatch #(a b c) '(a b x)) 2)) (test-t (eql (mismatch #(a b c) '(a x c)) 1)) (test-t (eql (mismatch #(a b c) '(x b c)) 0)) (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3) 6)) (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 nil) 6)) (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 4) 4)) (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 3 :end1 3) 3)) (test-t (null (mismatch #(x y z) () :start1 0 :end1 0))) (test-t (null (mismatch #(x y z) () :start1 1 :end1 1))) (test-t (null (mismatch #(x y z) () :start1 2 :end1 2))) (test-t (null (mismatch #(x y z) () :start1 3 :end1 3))) (test-t (eql (mismatch #(x y z) '(a b c) :start1 0 :end1 0) 0)) (test-t (eql (mismatch #(x y z) '(a b c) :start1 1 :end1 1) 1)) (test-t (eql (mismatch #(x y z) '(a b c) :start1 2 :end1 2) 2)) (test-t (eql (mismatch #(x y z) '(a b c) :start1 3 :end1 3) 3)) (test-t (eql (mismatch #(x y z) '(x y z) :start1 0 :end1 1) 1)) (test-t (eql (mismatch #(x y z) '(x y z) :start1 0 :end1 2) 2)) (test-t (eql (mismatch #(x y z) '(x y z Z) :start1 0 :end1 3) 3)) (test-t (null (mismatch #(x y z) '(x y z) :start1 0 :end1 3))) (test-t (eql (mismatch #(a b c x y z) '(x y z a b c)) 0)) (test-t (eql (mismatch #(a b c x y z) '(x y z a b c) :start1 3) 6)) (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 3) 9)) (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6) 6)) (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 6 :start2 3) 9)) (test-t (eql (mismatch #(a b c x y z a b c) '(x y z a b c x y z) :start1 0 :start2 3) 6)) (test-t (eql (mismatch #(a b c) '(a b c x y z)) 3)) (test-t (eql (mismatch #(a b c) '(x a b c y z)) 0)) (test-t (eql (mismatch #(a b c) '(x a b c y z) :start2 1) 3)) (test-t (eql (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 nil) 3)) (test-t (null (mismatch #(a b c) '(x a b c y z) :start2 1 :end2 4))) (test-t (eql (mismatch #(a b c d e) '(c d)) 0)) (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2) 4)) (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :end1 3) 3)) (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :start2 1) 2)) (test-t (eql (mismatch #(a b c d e) '(c d) :start1 3 :start2 1) 4)) (test-t (eql (mismatch #(a b c d e) '(c d) :start1 2 :end2 1) 3)) (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1 :end2 2))) (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1 :end2 3))) (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1 :end2 4))) (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1)) (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2)) (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3)) (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 nil :start2 1 :end2 4))) (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 1 :start2 1) 1)) (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 2 :start2 1) 2)) (test-t (eql (mismatch #(a b c d) '(a b c d) :start1 1 :end1 3 :start2 1) 3)) (test-t (null (mismatch #(a b c d) '(a b c d) :start1 1 :end1 4 :start2 1))) (test-t (null (mismatch #(a b c) '(a b c) :from-end t))) (test-t (eql (mismatch #(a b c d) '(a b c) :from-end t) 4)) (test-t (eql (mismatch #(a b c) '(c) :from-end t) 2)) (test-t (eql (mismatch #(a b c) '(z a b c) :from-end t) 0)) (test-t (eql (mismatch #(a b c) '(x y z a b c) :from-end t) 0)) (test-t (eql (mismatch #(x y z a b c) '(a b c) :from-end t) 3)) (test-t (eql (mismatch #(x y z a b c) '(a b c) :end1 3 :from-end t) 3)) (test-t (eql (mismatch #(x y z a b c) '(a b c) :end1 5 :from-end t) 5)) (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :end1 6 :from-end t) 3)) (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 6 :from-end t) 3)) (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4)) (test-t (eql (mismatch #(x y z a b c x y z) '(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2)) (test-t (eql (mismatch #((a) (b) (c)) '((a) (b) (c))) 0)) (test-t (null (mismatch #((a) (b) (c)) '((a) (b) (c)) :key car))) (test-t (null (mismatch #((a) (b) (c)) '((a) (b) (c)) :test equal))) (test-t (eql (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c))) 0)) (test-t (null (mismatch #(#(a) #(b) #(c)) '(#(a) #(b) #(c)) :test equalp))) (test-t (eql (mismatch #((a) (b) (c) (d)) '((a) (b) (c)) :key car) 3)) (test-t (eql (mismatch #((a) (b) (c)) '((a) (b) (c) (d)) :key car) 3)) (test-t (eql (mismatch #(#\a #\b #\c) '(#\A #\B #\C)) 0)) (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase))) (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-downcase))) (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2))) (test-t (null (mismatch #(#\a #\b #\c) '(#\A #\B #\C) :key char-upcase :start1 2 :start2 2))) (test-t (eql (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f))) 0)) (test-t (eql (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr) 0)) (test-t (null (mismatch #((a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal))) (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal) 3)) (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4)) (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1)) (test-t (null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4))) (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5)) (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) '((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2)) (test-t (null (mismatch () #()))) (test-t (eql (mismatch '(a b c) #(x y z)) 0)) (test-t (eql (mismatch () #(x y z)) 0)) (test-t (eql (mismatch '(x y z) #()) 0)) (test-t (null (mismatch '(a) #(a)))) (test-t (eql (mismatch '(a b c x y z) #(a b c)) 3)) (test-t (null (mismatch '(a b c) #(a b c)))) (test-t (eql (mismatch '(a b c d e f) #(a b c)) 3)) (test-t (eql (mismatch '(a b c) #(a b c d e f)) 3)) (test-t (eql (mismatch '(a b c) #(a b x)) 2)) (test-t (eql (mismatch '(a b c) #(a x c)) 1)) (test-t (eql (mismatch '(a b c) #(x b c)) 0)) (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3) 6)) (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6)) (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4)) (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3)) (test-t (null (mismatch '(x y z) #() :start1 0 :end1 0))) (test-t (null (mismatch '(x y z) #() :start1 1 :end1 1))) (test-t (null (mismatch '(x y z) #() :start1 2 :end1 2))) (test-t (null (mismatch '(x y z) #() :start1 3 :end1 3))) (test-t (eql (mismatch '(x y z) #(a b c) :start1 0 :end1 0) 0)) (test-t (eql (mismatch '(x y z) #(a b c) :start1 1 :end1 1) 1)) (test-t (eql (mismatch '(x y z) #(a b c) :start1 2 :end1 2) 2)) (test-t (eql (mismatch '(x y z) #(a b c) :start1 3 :end1 3) 3)) (test-t (eql (mismatch '(x y z) #(x y z) :start1 0 :end1 1) 1)) (test-t (eql (mismatch '(x y z) #(x y z) :start1 0 :end1 2) 2)) (test-t (eql (mismatch '(x y z) #(x y z Z) :start1 0 :end1 3) 3)) (test-t (null (mismatch '(x y z) #(x y z) :start1 0 :end1 3))) (test-t (eql (mismatch '(a b c x y z) #(x y z a b c)) 0)) (test-t (eql (mismatch '(a b c x y z) #(x y z a b c) :start1 3) 6)) (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9)) (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6)) (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3) 9)) (test-t (eql (mismatch '(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3) 6)) (test-t (eql (mismatch '(a b c) #(a b c x y z)) 3)) (test-t (eql (mismatch '(a b c) #(x a b c y z)) 0)) (test-t (eql (mismatch '(a b c) #(x a b c y z) :start2 1) 3)) (test-t (eql (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 nil) 3)) (test-t (null (mismatch '(a b c) #(x a b c y z) :start2 1 :end2 4))) (test-t (eql (mismatch '(a b c d e) #(c d)) 0)) (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2) 4)) (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :end1 3) 3)) (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :start2 1) 2)) (test-t (eql (mismatch '(a b c d e) #(c d) :start1 3 :start2 1) 4)) (test-t (eql (mismatch '(a b c d e) #(c d) :start1 2 :end2 1) 3)) (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2))) (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3))) (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4))) (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1)) (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2)) (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3)) (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4))) (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1)) (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2)) (test-t (eql (mismatch '(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3)) (test-t (null (mismatch '(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1))) (test-t (null (mismatch '(a b c) #(a b c) :from-end t))) (test-t (eql (mismatch '(a b c d) #(a b c) :from-end t) 4)) (test-t (eql (mismatch '(a b c) #(c) :from-end t) 2)) (test-t (eql (mismatch '(a b c) #(z a b c) :from-end t) 0)) (test-t (eql (mismatch '(a b c) #(x y z a b c) :from-end t) 0)) (test-t (eql (mismatch '(x y z a b c) #(a b c) :from-end t) 3)) (test-t (eql (mismatch '(x y z a b c) #(a b c) :end1 3 :from-end t) 3)) (test-t (eql (mismatch '(x y z a b c) #(a b c) :end1 5 :from-end t) 5)) (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3)) (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3)) (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4)) (test-t (eql (mismatch '(x y z a b c x y z) #(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2)) (test-t (eql (mismatch '((a) (b) (c)) #((a) (b) (c))) 0)) (test-t (null (mismatch '((a) (b) (c)) #((a) (b) (c)) :key car))) (test-t (null (mismatch '((a) (b) (c)) #((a) (b) (c)) :test equal))) (test-t (eql (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0)) (test-t (null (mismatch '(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test equalp))) (test-t (eql (mismatch '((a) (b) (c) (d)) #((a) (b) (c)) :key car) 3)) (test-t (eql (mismatch '((a) (b) (c)) #((a) (b) (c) (d)) :key car) 3)) (test-t (eql (mismatch '(#\a #\b #\c) #(#\A #\B #\C)) 0)) (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase))) (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-downcase))) (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2))) (test-t (null (mismatch '(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 2 :start2 2))) (test-t (eql (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f))) 0)) (test-t (eql (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr) 0)) (test-t (null (mismatch '((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal))) (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal) 3)) (test-t (eql (mismatch '((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4)) (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1)) (test-t (null (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4))) (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5)) (test-t (eql (mismatch '((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2)) (test-t (null (mismatch #() #()))) (test-t (eql (mismatch #(a b c) #(x y z)) 0)) (test-t (eql (mismatch #() #(x y z)) 0)) (test-t (eql (mismatch #(x y z) #()) 0)) (test-t (null (mismatch #(a) #(a)))) (test-t (eql (mismatch #(a b c x y z) #(a b c)) 3)) (test-t (null (mismatch #(a b c) #(a b c)))) (test-t (eql (mismatch #(a b c d e f) #(a b c)) 3)) (test-t (eql (mismatch #(a b c) #(a b c d e f)) 3)) (test-t (eql (mismatch #(a b c) #(a b x)) 2)) (test-t (eql (mismatch #(a b c) #(a x c)) 1)) (test-t (eql (mismatch #(a b c) #(x b c)) 0)) (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3) 6)) (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 nil) 6)) (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 4) 4)) (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 3 :end1 3) 3)) (test-t (null (mismatch #(x y z) #() :start1 0 :end1 0))) (test-t (null (mismatch #(x y z) #() :start1 1 :end1 1))) (test-t (null (mismatch #(x y z) #() :start1 2 :end1 2))) (test-t (null (mismatch #(x y z) #() :start1 3 :end1 3))) (test-t (eql (mismatch #(x y z) #(a b c) :start1 0 :end1 0) 0)) (test-t (eql (mismatch #(x y z) #(a b c) :start1 1 :end1 1) 1)) (test-t (eql (mismatch #(x y z) #(a b c) :start1 2 :end1 2) 2)) (test-t (eql (mismatch #(x y z) #(a b c) :start1 3 :end1 3) 3)) (test-t (eql (mismatch #(x y z) #(x y z) :start1 0 :end1 1) 1)) (test-t (eql (mismatch #(x y z) #(x y z) :start1 0 :end1 2) 2)) (test-t (eql (mismatch #(x y z) #(x y z Z) :start1 0 :end1 3) 3)) (test-t (null (mismatch #(x y z) #(x y z) :start1 0 :end1 3))) (test-t (eql (mismatch #(a b c x y z) #(x y z a b c)) 0)) (test-t (eql (mismatch #(a b c x y z) #(x y z a b c) :start1 3) 6)) (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 3) 9)) (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6) 6)) (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 6 :start2 3) 9)) (test-t (eql (mismatch #(a b c x y z a b c) #(x y z a b c x y z) :start1 0 :start2 3) 6)) (test-t (eql (mismatch #(a b c) #(a b c x y z)) 3)) (test-t (eql (mismatch #(a b c) #(x a b c y z)) 0)) (test-t (eql (mismatch #(a b c) #(x a b c y z) :start2 1) 3)) (test-t (eql (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 nil) 3)) (test-t (null (mismatch #(a b c) #(x a b c y z) :start2 1 :end2 4))) (test-t (eql (mismatch #(a b c d e) #(c d)) 0)) (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2) 4)) (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :end1 3) 3)) (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :start2 1) 2)) (test-t (eql (mismatch #(a b c d e) #(c d) :start1 3 :start2 1) 4)) (test-t (eql (mismatch #(a b c d e) #(c d) :start1 2 :end2 1) 3)) (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1 :end2 2))) (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1 :end2 3))) (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1 :end2 4))) (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 1) 1)) (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 2) 2)) (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 3) 3)) (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 nil :start2 1 :end2 4))) (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 1 :start2 1) 1)) (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 2 :start2 1) 2)) (test-t (eql (mismatch #(a b c d) #(a b c d) :start1 1 :end1 3 :start2 1) 3)) (test-t (null (mismatch #(a b c d) #(a b c d) :start1 1 :end1 4 :start2 1))) (test-t (null (mismatch #(a b c) #(a b c) :from-end t))) (test-t (eql (mismatch #(a b c d) #(a b c) :from-end t) 4)) (test-t (eql (mismatch #(a b c) #(c) :from-end t) 2)) (test-t (eql (mismatch #(a b c) #(z a b c) :from-end t) 0)) (test-t (eql (mismatch #(a b c) #(x y z a b c) :from-end t) 0)) (test-t (eql (mismatch #(x y z a b c) #(a b c) :from-end t) 3)) (test-t (eql (mismatch #(x y z a b c) #(a b c) :end1 3 :from-end t) 3)) (test-t (eql (mismatch #(x y z a b c) #(a b c) :end1 5 :from-end t) 5)) (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :end1 6 :from-end t) 3)) (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 6 :from-end t) 3)) (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :from-end t :start1 2 :end1 5 :start2 1 :end2 2 ) 4)) (test-t (eql (mismatch #(x y z a b c x y z) #(a b c) :start1 2 :end1 5 :start2 1 :end2 2 ) 2)) (test-t (eql (mismatch #((a) (b) (c)) #((a) (b) (c))) 0)) (test-t (null (mismatch #((a) (b) (c)) #((a) (b) (c)) :key car))) (test-t (null (mismatch #((a) (b) (c)) #((a) (b) (c)) :test equal))) (test-t (eql (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c))) 0)) (test-t (null (mismatch #(#(a) #(b) #(c)) #(#(a) #(b) #(c)) :test equalp))) (test-t (eql (mismatch #((a) (b) (c) (d)) #((a) (b) (c)) :key car) 3)) (test-t (eql (mismatch #((a) (b) (c)) #((a) (b) (c) (d)) :key car) 3)) (test-t (eql (mismatch #(#\a #\b #\c) #(#\A #\B #\C)) 0)) (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase))) (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-downcase))) (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 1 :end1 2 :start2 1 :end2 2))) (test-t (null (mismatch #(#\a #\b #\c) #(#\A #\B #\C) :key char-upcase :start1 2 :start2 2))) (test-t (eql (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f))) 0)) (test-t (eql (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr) 0)) (test-t (null (mismatch #((a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal))) (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal) 3)) (test-t (eql (mismatch #((a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 4)) (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t) 1)) (test-t (null (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1 :end1 4))) (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :start1 1) 5)) (test-t (eql (mismatch #((a a a) (a b c) (b c d) (d e f) (e f g)) #((b b c) (c c d) (e e f)) :key cdr :test equal :from-end t :end1 3 :start2 1 :end2 2) 2)) (test-t (eql (mismatch "abc" "xyz") 0)) (test-t (null (mismatch "" ""))) (test-t (null (mismatch "a" "a"))) (test-t (null (mismatch "abc" "abc"))) (test-t (null (mismatch "abc" "ABC" :key char-downcase))) (test-t (null (mismatch "abc" "ABC" :test char-equal))) (test-t (eql (mismatch "abcde" "abc") 3)) (test-t (eql (mismatch "abc" "abcde") 3)) (test-t (eql (mismatch "abc" "abxyz") 2)) (test-t (eql (mismatch "abcde" "abx") 2)) (test-t (null (mismatch "abc" "abc" :from-end t))) (test-t (eql (mismatch "abcxyz" "xyzxyz" :from-end t) 3)) (test-t (eql (mismatch "abcxyz" "xyz" :from-end t) 3)) (test-t (eql (mismatch "xyz" "abcxyz" :from-end t) 0)) (test-t (eql (mismatch "ayz" "abcxyz" :from-end t) 1)) (test-t (null (mismatch "abc" "xyz" :test char<))) (test-t (eql (mismatch "abc" "xyz" :test char>) 0)) (test-t (eql (mismatch "abcxyz" "abcdefg") 3)) (test-t (eql (mismatch "1xyz" "22xyz" :from-end t) 1)) ) ;; -------- defstruct (define-macro (defstruct struct-name . fields) (let* ((name (if (list? struct-name) (car struct-name) struct-name)) (sname (if (string? name) name (symbol->string name))) (fsname (if (list? struct-name) (let ((cname (assoc :conc-name (cdr struct-name)))) (if cname (symbol->string (cadr cname)) sname)) sname)) (make-name (if (list? struct-name) (let ((cname (assoc :constructor (cdr struct-name)))) (if cname (cadr cname) (symbol "make-" sname))) (symbol "make-" sname))) (copy-name (if (list? struct-name) (let ((cname (assoc :copier (cdr struct-name)))) (if cname (cadr cname) (symbol "copy-" sname))) (symbol "copy-" sname))) (field-names (map (lambda (n) (symbol->string (if (list? n) (car n) n))) fields)) (field-types (map (lambda (field) (if (list? field) (apply (lambda* (val type read-only) type) (cdr field)) #f)) fields)) (field-read-onlys (map (lambda (field) (if (list? field) (apply (lambda* (val type read-only) read-only) (cdr field)) #f)) fields))) `(begin (define ,(symbol sname "?") (lambda (obj) (and (vector? obj) (eq? (obj 0) ',(string->symbol sname))))) (define* (,make-name ,@(map (lambda (n) (if (and (list? n) (>= (length n) 2)) (list (car n) (cadr n)) (list n #f))) fields)) (vector ',(string->symbol sname) ,@(map string->symbol field-names))) (define ,copy-name copy) ,@(map (let ((ctr 1)) (lambda (n type read-only) (let ((val (if read-only `(define ,(symbol fsname "-" n) (lambda (arg) (arg ,ctr))) `(define ,(symbol fsname "-" n) (dilambda (lambda (arg) (arg ,ctr)) (lambda (arg val) (set! (arg ,ctr) val))))))) (set! ctr (+ 1 ctr)) val))) field-names field-types field-read-onlys)))) ;; not yet implemented: :print-function :include :named :type :initial-offset ;; also the explicit constructor business (define-macro (enum . args) ; (enum zero one two) `(begin ,@(let ((names ())) (do ((arg args (cdr arg)) (i 0 (+ i 1))) ((null? arg) names) (set! names (cons `(define ,(car arg) ,i) names)))))) (define-macro (let*-values vals . body) (let ((args ()) (exprs ())) (for-each (lambda (arg+expr) (set! args (cons (car arg+expr) args)) (set! exprs (cons (cadr arg+expr) exprs))) vals) (let ((form `((lambda ,(car args) ,@body) ,(car exprs)))) (if (not (null? (cdr args))) (for-each (lambda (arg expr) (set! form `((lambda ,arg ,form) ,expr))) (cdr args) (cdr exprs))) form))) (let () ;; this is the nbody computer shootout benchmark taken from mzscheme (define +days-per-year+ 365.24) (define +solar-mass+ (* 4 pi pi)) (defstruct body x y z vx vy vz mass) (define *sun* (make-body 0.0 0.0 0.0 0.0 0.0 0.0 +solar-mass+)) (define *jupiter* (make-body 4.84143144246472090 -1.16032004402742839 -1.03622044471123109e-1 (* 1.66007664274403694e-3 +days-per-year+) (* 7.69901118419740425e-3 +days-per-year+) (* -6.90460016972063023e-5 +days-per-year+) (* 9.54791938424326609e-4 +solar-mass+))) (define *saturn* (make-body 8.34336671824457987 4.12479856412430479 -4.03523417114321381e-1 (* -2.76742510726862411e-3 +days-per-year+) (* 4.99852801234917238e-3 +days-per-year+) (* 2.30417297573763929e-5 +days-per-year+) (* 2.85885980666130812e-4 +solar-mass+))) (define *uranus* (make-body 1.28943695621391310e1 -1.51111514016986312e1 -2.23307578892655734e-1 (* 2.96460137564761618e-03 +days-per-year+) (* 2.37847173959480950e-03 +days-per-year+) (* -2.96589568540237556e-05 +days-per-year+) (* 4.36624404335156298e-05 +solar-mass+))) (define *neptune* (make-body 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 (* 2.68067772490389322e-03 +days-per-year+) (* 1.62824170038242295e-03 +days-per-year+) (* -9.51592254519715870e-05 +days-per-year+) (* 5.15138902046611451e-05 +solar-mass+))) (define (offset-momentum system) (let loop-i ((i system) (px 0.0) (py 0.0) (pz 0.0)) (if (null? i) (begin (set! (body-vx (car system)) (/ (- px) +solar-mass+)) (set! (body-vy (car system)) (/ (- py) +solar-mass+)) (set! (body-vz (car system)) (/ (- pz) +solar-mass+))) (loop-i (cdr i) (+ px (* (body-vx (car i)) (body-mass (car i)))) (+ py (* (body-vy (car i)) (body-mass (car i)))) (+ pz (* (body-vz (car i)) (body-mass (car i)))))))) (define (energy system) (let loop-o ((o system) (e 0.0)) (if (null? o) e (let ((e (+ e (* 0.5 (body-mass (car o)) (+ (* (body-vx (car o)) (body-vx (car o))) (* (body-vy (car o)) (body-vy (car o))) (* (body-vz (car o)) (body-vz (car o)))))))) (let loop-i ((i (cdr o)) (e e)) (if (null? i) (loop-o (cdr o) e) (let* ((dx (- (body-x (car o)) (body-x (car i)))) (dy (- (body-y (car o)) (body-y (car i)))) (dz (- (body-z (car o)) (body-z (car i)))) (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz))))) (let ((e (- e (/ (* (body-mass (car o)) (body-mass (car i))) distance)))) (loop-i (cdr i) e))))))))) (define (advance system dt) (let loop-o ((o system)) (unless (null? o) (let loop-i ((i (cdr o))) (unless (null? i) (let* ((o1 (car o)) (i1 (car i)) (dx (- (body-x o1) (body-x i1))) (dy (- (body-y o1) (body-y i1))) (dz (- (body-z o1) (body-z i1))) (distance (sqrt (+ (* dx dx) (* dy dy) (* dz dz)))) (mag (/ dt (* distance distance distance))) (dxmag (* dx mag)) (dymag (* dy mag)) (dzmag (* dz mag)) (om (body-mass o1)) (im (body-mass i1))) (set! (body-vx o1) (- (body-vx o1) (* dxmag im))) (set! (body-vy o1) (- (body-vy o1) (* dymag im))) (set! (body-vz o1) (- (body-vz o1) (* dzmag im))) (set! (body-vx i1) (+ (body-vx i1) (* dxmag om))) (set! (body-vy i1) (+ (body-vy i1) (* dymag om))) (set! (body-vz i1) (+ (body-vz i1) (* dzmag om))) (loop-i (cdr i))))) (loop-o (cdr o)))) (let loop-o ((o system)) (unless (null? o) (let ((o1 (car o))) (set! (body-x o1) (+ (body-x o1) (* dt (body-vx o1)))) (set! (body-y o1) (+ (body-y o1) (* dt (body-vy o1)))) (set! (body-z o1) (+ (body-z o1) (* dt (body-vz o1)))) (loop-o (cdr o)))))) ;; (define (nbody-test) (let ((n 10) ;(n 1000) ; (command-line #:args (n) (string->number n))) (system (list *sun* *jupiter* *saturn* *uranus* *neptune*))) (offset-momentum system) (let ((initial (energy system))) (do ((i 1 (+ i 1))) ((< n i)) (advance system 0.01)) (let ((final (energy system))) (test (< (abs (- initial -0.16907516382852)) 1e-5) #t) (test (< (abs (- final -0.1690730217)) 1e-4) #t) )))) ;;; ---------------- ;;; some of these tests are taken (with modifications) from sacla which has ;;; the following copyright notice: ;;; ;; Copyright (C) 2002-2004, Yuji Minejima ;; ALL RIGHTS RESERVED. ;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions ;; are met: ;; ;; * Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; * Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in ;; the documentation and/or other materials provided with the ;; distribution. ;; ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (test-t (equal 'a 'a)) (test-t (not (equal 'a 'b))) (test-t (equal 'abc 'abc)) (test-t (equal 1 1)) (test-t (equal 2 2)) (test-t (equal 0.1 0.1)) (test-t (equal 1/3 1/3)) (test-t (not (equal 0 1))) (test-t (not (equal 1 1.0))) (test-t (not (equal 1/3 1/4))) (test-t (equal #\a #\a)) (test-t (equal #\b #\b)) (test-t (not (equal #\b #\B))) (test-t (not (equal #\C #\c))) (test-t (equal '(0) '(0))) (test-t (equal '(0 #\a) '(0 #\a))) (test-t (equal '(0 #\a x) '(0 #\a x))) (test-t (equal '(0 #\a x (0)) '(0 #\a x (0)))) (test-t (eql (identity 101) 101)) (test-t (eq (identity 'x) 'x)) ;; chars (test-t (char= #\d #\d)) (test-t (not (char= #\A #\a))) (test-t (not (char= #\d #\x))) (test-t (not (char= #\d #\D))) (test-t (not (char/= #\d #\d))) (test-t (char/= #\d #\x)) (test-t (char/= #\d #\D)) (test-t (char= #\d #\d #\d #\d)) (test-t (not (char/= #\d #\d #\d #\d))) (test-t (not (char= #\d #\d #\x #\d))) (test-t (not (char/= #\d #\d #\x #\d))) (test-t (not (char= #\d #\y #\x #\c))) (test-t (char/= #\d #\y #\x #\c)) (test-t (not (char= #\d #\c #\d))) (test-t (not (char/= #\d #\c #\d))) (test-t (char< #\d #\x)) (test-t (char<= #\d #\x)) (test-t (not (char< #\d #\d))) (test-t (char<= #\d #\d)) (test-t (char< #\a #\e #\y #\z)) (test-t (char<= #\a #\e #\y #\z)) (test-t (not (char< #\a #\e #\e #\y))) (test-t (char<= #\a #\e #\e #\y)) (test-t (char> #\e #\d)) (test-t (char>= #\e #\d)) (test-t (char> #\d #\c #\b #\a)) (test-t (char>= #\d #\c #\b #\a)) (test-t (not (char> #\d #\d #\c #\a))) (test-t (char>= #\d #\d #\c #\a)) (test-t (not (char> #\e #\d #\b #\c #\a))) (test-t (not (char>= #\e #\d #\b #\c #\a))) (test-t (char-equal #\A #\a)) (test-t (char= #\a)) (test-t (char= #\a #\a)) (test-t (char= #\a #\a #\a)) (test-t (char= #\a #\a #\a #\a)) (test-t (char= #\a #\a #\a #\a #\a)) (test-t (char= #\a #\a #\a #\a #\a #\a)) (test-t (let ((c #\z)) (and (eq c c) (char= c c)))) (test-t (not (char= #\Z #\z))) (test-t (not (char= #\z #\z #\z #\a))) (test-t (not (char= #\a #\z #\z #\z #\a))) (test-t (not (char= #\z #\i #\z #\z))) (test-t (not (char= #\z #\z #\Z #\z))) (test-t (char/= #\a)) (test-t (char/= #\a #\b)) (test-t (char/= #\a #\b #\c)) (test-t (char/= #\a #\b #\c #\d)) (test-t (char/= #\a #\b #\c #\d #\e)) (test-t (char/= #\a #\b #\c #\d #\e #\f)) (test-t (let ((c #\z)) (and (eq c c) (not (char/= c c))))) (test-t (char/= #\Z #\z)) (test-t (not (char/= #\z #\z #\z #\a))) (test-t (not (char= #\a #\z #\z #\z #\a))) (test-t (not (char= #\z #\i #\z #\z))) (test-t (not (char= #\z #\z #\Z #\z))) (test-t (not (char/= #\a #\a #\b #\c))) (test-t (not (char/= #\a #\b #\a #\c))) (test-t (not (char/= #\a #\b #\c #\a))) (test-t (char< #\a)) (test-t (char< #\a #\z)) (test-t (char< #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)) (test-t (not (char< #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))) (test-t (char< #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)) (test-t (not (char< #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))) (test-t (char< #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) (test-t (not (char< #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))) (test-t (or (char< #\9 #\A) (char< #\Z #\0))) (test-t (or (char< #\9 #\a) (char< #\z #\0))) (test-t (not (char< #\a #\a #\b #\c))) (test-t (not (char< #\a #\b #\a #\c))) (test-t (not (char< #\a #\b #\c #\a))) (test-t (not (char< #\9 #\0))) (test-t (char> #\a)) (test-t (not (char> #\a #\z))) (test-t (char> #\z #\a)) (test-t (not (char> #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))) (test-t (char> #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)) (test-t (not (char> #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))) (test-t (char> #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)) (test-t (not (char> #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) (test-t (char> #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)) (test-t (or (char> #\A #\9) (char> #\0 #\Z))) (test-t (or (char> #\a #\9) (char> #\0 #\z))) (test-t (not (char> #\a #\a #\b #\c))) (test-t (not (char> #\a #\b #\a #\c))) (test-t (not (char> #\a #\b #\c #\a))) (test-t (char> #\9 #\0)) (test-t (char<= #\a)) (test-t (char<= #\a #\z)) (test-t (char<= #\a #\a)) (test-t (char<= #\Z #\Z)) (test-t (char<= #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)) (test-t (char<= #\a #\a #\b #\b #\c #\c #\d #\d #\e #\e #\f #\f #\g #\g #\h #\h #\i #\i #\j #\j #\k #\k #\l #\l #\m #\m #\n #\n #\o #\o #\p #\p #\q #\q #\r #\r #\s #\s #\t #\t #\u #\u #\v #\v #\w #\w #\x #\x #\y #\y #\z #\z)) (test-t (not (char<= #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))) (test-t (char<= #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)) (test-t (char<= #\A #\B #\B #\C #\D #\E #\E #\F #\G #\H #\I #\I #\J #\K #\L #\M #\N #\N #\O #\P #\Q #\R #\S #\T #\T #\U #\V #\W #\X #\Y #\Z)) (test-t (not (char<= #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))) (test-t (char<= #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) (test-t (char<= #\0 #\1 #\2 #\2 #\3 #\3 #\3 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\9)) (test-t (not (char<= #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))) (test-t (or (char<= #\9 #\A) (char<= #\Z #\0))) (test-t (or (char<= #\9 #\a) (char<= #\z #\0))) (test-t (char<= #\a #\a #\b #\c)) (test-t (not (char<= #\a #\b #\a #\c))) (test-t (not (char<= #\a #\b #\c #\a))) (test-t (not (char<= #\9 #\0))) (test-t (char>= #\a)) (test-t (not (char>= #\a #\z))) (test-t (char>= #\z #\a)) (test-t (char>= #\a #\a)) (test-t (char>= #\Z #\Z)) (test-t (not (char>= #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))) (test-t (char>= #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)) (test-t (char>= #\z #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n #\m #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a #\a)) (test-t (not (char>= #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))) (test-t (char>= #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)) (test-t (char>= #\Z #\Y #\X #\W #\V #\U #\U #\T #\T #\S #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\H #\G #\G #\F #\F #\E #\D #\C #\B #\A)) (test-t (not (char>= #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) (test-t (char>= #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)) (test-t (char>= #\9 #\8 #\8 #\8 #\7 #\6 #\5 #\4 #\3 #\3 #\3 #\2 #\1 #\0)) (test-t (or (char>= #\A #\9) (char>= #\0 #\Z))) (test-t (or (char>= #\a #\9) (char>= #\0 #\z))) (test-t (char>= #\c #\b #\a #\a)) (test-t (not (char>= #\c #\b #\a #\a #\b #\c))) (test-t (not (char>= #\c #\b #\a #\c))) (test-t (not (char>= #\c #\b #\c #\a))) (test-t (char>= #\9 #\0)) (test-t (not (char>= #\0 #\9))) (test-t (char-equal #\a)) (test-t (char-equal #\a #\a)) (test-t (char-equal #\a #\a #\a)) (test-t (char-equal #\a #\a #\a #\a)) (test-t (char-equal #\a #\a #\a #\a #\a)) (test-t (char-equal #\a #\a #\a #\a #\a #\a)) (test-t (char-equal #\a #\A)) (test-t (char-equal #\a #\A #\a)) (test-t (char-equal #\a #\a #\A #\a)) (test-t (char-equal #\a #\a #\a #\A #\a)) (test-t (char-equal #\a #\a #\a #\a #\A #\a)) (test-t (let ((c #\z)) (and (eq c c) (char-equal c c)))) (test-t (char-equal #\Z #\z)) (test-t (not (char-equal #\z #\z #\z #\a))) (test-t (not (char-equal #\a #\z #\z #\z #\a))) (test-t (not (char-equal #\z #\i #\z #\z))) (test-t (char-equal #\z #\z #\Z #\z)) (test-t (char-equal #\a #\A #\a #\A #\a #\A #\a #\A #\a #\A)) (test-t (char-not-equal #\a)) (test-t (char-not-equal #\a #\b)) (test-t (char-not-equal #\a #\b #\c)) (test-t (char-not-equal #\a #\b #\c #\d)) (test-t (char-not-equal #\a #\b #\c #\d #\e)) (test-t (char-not-equal #\a #\b #\c #\d #\e #\f)) (test-t (let ((c #\z)) (and (eq c c) (not (char-not-equal c c))))) (test-t (not (char-not-equal #\Z #\z))) (test-t (not (char-not-equal #\z #\z #\z #\a))) (test-t (not (char= #\a #\z #\z #\z #\a))) (test-t (not (char= #\z #\i #\z #\z))) (test-t (not (char= #\z #\z #\Z #\z))) (test-t (not (char-not-equal #\a #\a #\b #\c))) (test-t (not (char-not-equal #\a #\b #\a #\c))) (test-t (not (char-not-equal #\a #\b #\c #\a))) (test-t (not (char-not-equal #\a #\A #\a #\A))) (test-t (char-lessp #\a)) (test-t (char-lessp #\a #\z)) (test-t (char-lessp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)) (test-t (not (char-lessp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))) (test-t (char-lessp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)) (test-t (not (char-lessp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))) (test-t (char-lessp #\a #\B #\c #\D #\e #\F #\g #\H #\i #\J #\k #\L #\m #\N #\o #\P #\q #\R #\s #\T #\u #\V #\w #\X #\y #\Z)) (test-t (char-lessp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) (test-t (not (char-lessp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))) (test-t (or (char-lessp #\9 #\A) (char-lessp #\Z #\0))) (test-t (or (char-lessp #\9 #\a) (char-lessp #\z #\0))) (test-t (not (char-lessp #\a #\a #\b #\c))) (test-t (not (char-lessp #\a #\b #\a #\c))) (test-t (not (char-lessp #\a #\b #\c #\a))) (test-t (not (char-lessp #\9 #\0))) (test-t (and (char-lessp #\a #\Z) (char-lessp #\A #\z))) (test-t (char-greaterp #\a)) (test-t (not (char-greaterp #\a #\z))) (test-t (char-greaterp #\z #\a)) (test-t (not (char-greaterp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))) (test-t (char-greaterp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)) (test-t (not (char-greaterp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))) (test-t (char-greaterp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)) (test-t (char-greaterp #\z #\Y #\x #\W #\v #\U #\t #\S #\r #\Q #\p #\O #\n #\M #\l #\K #\j #\I #\h #\G #\f #\E #\d #\C #\b #\A)) (test-t (not (char-greaterp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) (test-t (char-greaterp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)) (test-t (or (char-greaterp #\A #\9) (char-greaterp #\0 #\Z))) (test-t (or (char-greaterp #\a #\9) (char-greaterp #\0 #\z))) (test-t (not (char-greaterp #\a #\a #\b #\c))) (test-t (not (char-greaterp #\a #\b #\a #\c))) (test-t (not (char-greaterp #\a #\b #\c #\a))) (test-t (char-greaterp #\9 #\0)) (test-t (and (char-greaterp #\z #\A) (char-greaterp #\Z #\a))) (test-t (char-not-greaterp #\a)) (test-t (char-not-greaterp #\a #\z)) (test-t (char-not-greaterp #\a #\a)) (test-t (char-not-greaterp #\Z #\Z)) (test-t (char-not-greaterp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)) (test-t (char-not-greaterp #\a #\a #\b #\b #\c #\c #\d #\d #\e #\e #\f #\f #\g #\g #\h #\h #\i #\i #\j #\j #\k #\k #\l #\l #\m #\m #\n #\n #\o #\o #\p #\p #\q #\q #\r #\r #\s #\s #\t #\t #\u #\u #\v #\v #\w #\w #\x #\x #\y #\y #\z #\z)) (test-t (char-not-greaterp #\a #\A #\b #\B #\c #\C #\d #\D #\e #\E #\f #\F #\g #\G #\h #\H #\i #\I #\j #\J #\k #\K #\l #\L #\m #\M #\n #\N #\o #\O #\p #\P #\q #\Q #\r #\R #\s #\S #\t #\T #\u #\U #\v #\V #\w #\W #\x #\X #\y #\Y #\z #\z)) (test-t (not (char-not-greaterp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a))) (test-t (char-not-greaterp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)) (test-t (char-not-greaterp #\A #\B #\B #\C #\D #\E #\E #\F #\G #\H #\I #\I #\J #\K #\L #\M #\N #\N #\O #\P #\Q #\R #\S #\T #\T #\U #\V #\W #\X #\Y #\Z)) (test-t (not (char-not-greaterp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A))) (test-t (char-not-greaterp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) (test-t (char-not-greaterp #\0 #\1 #\2 #\2 #\3 #\3 #\3 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\9)) (test-t (not (char-not-greaterp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0))) (test-t (or (char-not-greaterp #\9 #\A) (char-not-greaterp #\Z #\0))) (test-t (or (char-not-greaterp #\9 #\a) (char-not-greaterp #\z #\0))) (test-t (char-not-greaterp #\a #\a #\b #\c)) (test-t (not (char-not-greaterp #\a #\b #\a #\c))) (test-t (not (char-not-greaterp #\a #\b #\c #\a))) (test-t (not (char-not-greaterp #\9 #\0))) (test-t (and (char-not-greaterp #\A #\z) (char-not-greaterp #\a #\Z))) (test-t (char-not-lessp #\a)) (test-t (not (char-not-lessp #\a #\z))) (test-t (char-not-lessp #\z #\a)) (test-t (char-not-lessp #\a #\a)) (test-t (char-not-lessp #\Z #\Z)) (test-t (not (char-not-lessp #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))) (test-t (char-not-lessp #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a)) (test-t (char-not-lessp #\z #\z #\y #\x #\w #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n #\m #\m #\l #\k #\j #\i #\h #\g #\f #\e #\d #\c #\b #\a #\a)) (test-t (not (char-not-lessp #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\m #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))) (test-t (char-not-lessp #\Z #\Y #\X #\W #\V #\U #\T #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\G #\F #\E #\D #\C #\B #\A)) (test-t (char-not-lessp #\Z #\Y #\X #\W #\V #\U #\U #\T #\T #\S #\S #\R #\Q #\P #\O #\N #\M #\L #\K #\J #\I #\H #\H #\G #\G #\F #\F #\E #\D #\C #\B #\A)) (test-t (char-not-lessp #\z #\Z #\y #\x #\w #\V #\v #\u #\t #\s #\r #\q #\p #\o #\n #\n #\m #\M #\l #\k #\K #\j #\i #\h #\g #\f #\e #\d #\c #\b #\A #\a)) (test-t (not (char-not-lessp #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) (test-t (char-not-lessp #\9 #\8 #\7 #\6 #\5 #\4 #\3 #\2 #\1 #\0)) (test-t (char-not-lessp #\9 #\8 #\8 #\8 #\7 #\6 #\5 #\4 #\3 #\3 #\3 #\2 #\1 #\0)) (test-t (or (char-not-lessp #\A #\9) (char-not-lessp #\0 #\Z))) (test-t (or (char-not-lessp #\a #\9) (char-not-lessp #\0 #\z))) (test-t (char-not-lessp #\c #\b #\a #\a)) (test-t (not (char-not-lessp #\c #\b #\a #\a #\b #\c))) (test-t (not (char-not-lessp #\c #\b #\a #\c))) (test-t (not (char-not-lessp #\c #\b #\c #\a))) (test-t (char-not-lessp #\9 #\0)) (test-t (not (char-not-lessp #\0 #\9))) (test-t (and (char-not-lessp #\z #\A) (char-not-lessp #\Z #\a))) (test-t (char= (character #\a) #\a)) (test-t (char= (character #\b) #\b)) ; (test-t (char= (character #\Space) #\Space)) (test-t (char= (character "a") #\a)) (test-t (char= (character "X") #\X)) (test-t (char= (character "z") #\z)) (test-t (char= (character 'a) #\a)) ; (test-t (char= (character '\a) #\a)) (test-t (alpha-char-p #\a)) (test-t (every alpha-char-p '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))) (test-t (every alpha-char-p '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))) (test-t (notany alpha-char-p '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) ; (test-t (not (alpha-char-p #\Newline))) (test-t (alphanumericp #\Z)) (test-t (alphanumericp #\9)) (test-t (every alphanumericp '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))) (test-t (every alphanumericp '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))) (test-t (every alphanumericp '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))) ; (test-t (not (alphanumericp #\Newline))) (test-t (not (alphanumericp #\#))) (test-t (char= (digit-char 0) #\0)) ; (test-t (char= (digit-char 10 11) #\A)) (test-t (null (digit-char 10 10))) (test-t (char= (digit-char 7) #\7)) (test-t (null (digit-char 12))) ; (test-t (char= (digit-char 12 16) #\C)) (test-t (null (digit-char 6 2))) (test-t (char= (digit-char 1 2) #\1)) ; (test-t (char= (digit-char 35 36) #\Z)) (test-t (= (digit-char-p #\0) 0)) (test-t (= (digit-char-p #\5) 5)) (test-t (not (digit-char-p #\5 2))) (test-t (not (digit-char-p #\A))) (test-t (not (digit-char-p #\a))) ; (test-t (= (digit-char-p #\A 11) 10)) (test-t (= (digit-char-p #\a 11) 10)) ; (test-t (standard-char-p #\a)) ; (test-t (standard-char-p #\z)) ; (test-t (standard-char-p #\Newline)) ; (test-t (every standard-char-p " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'abcdefghijklmnopqrstuvwxyz{|}~")) (test-t (char= (char-upcase #\a) #\A)) (test-t (char= (char-upcase #\A) #\A)) (test-t (char= (char-upcase #\-) #\-)) (test-t (char= (char-downcase #\A) #\a)) (test-t (char= (char-downcase #\a) #\a)) (test-t (char= (char-downcase #\-) #\-)) (test-t (not (upper-case-p #\a))) (test-t (upper-case-p #\A)) (test-t (not (upper-case-p #\-))) (test-t (not (lower-case-p #\A))) (test-t (lower-case-p #\a)) (test-t (not (lower-case-p #\-))) ; (test-t (char= #\Space (name-char (char-name #\Space)))) ; (test-t (char= #\Newline (name-char (char-name #\Newline)))) (test-t (simple-string-p "")) (test-t (simple-string-p "abc")) (test-t (not (simple-string-p 'not-a-string))) (test-t (char= (char "abc" 0) #\a)) (test-t (char= (char "abc" 1) #\b)) (test-t (char= (char "abc" 2) #\c)) (test-t (char= (schar "abc" 0) #\a)) (test-t (char= (schar "abc" 1) #\b)) (test-t (char= (schar "abc" 2) #\c)) (test-t (string= (cl-string "") "")) (test-t (string= (cl-string "abc") "abc")) (test-t (string= (cl-string "a") "a")) (test-t (string= (cl-string 'abc) "abc")) (test-t (string= (cl-string 'a) "a")) (test-t (string= (cl-string #\a) "a")) (test-t (string= (cl-string-upcase "abcde") "ABCDE")) (test-t (string= (cl-string-upcase "Dr. Livingston, I presume?") "DR. LIVINGSTON, I PRESUME?")) (test-t (string= (cl-string-upcase "Dr. Livingston, I presume?" :start 6 :end 10) "Dr. LiVINGston, I presume?")) (test-t (string= (cl-string-upcase 'Kludgy-HASH-Search) "KLUDGY-HASH-SEARCH")) (test-t (string= (cl-string-upcase "abcde" :start 2 :end nil) "abCDE")) (test-t (string= (cl-string-downcase "Dr. Livingston, I presume?") "dr. livingston, i presume?")) (test-t (string= (cl-string-downcase 'Kludgy-HASH-Search) "kludgy-hash-search")) (test-t (string= (cl-string-downcase "A FOOL" :start 2 :end nil) "A fool")) (test-t (string= (string-capitalize "elm 13c arthur;fig don't") "Elm 13c Arthur;Fig Don'T")) (test-t (string= (string-capitalize " hello ") " Hello ")) (test-t (string= (string-capitalize "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") "Occluded Casements Forestall Inadvertent Defenestration")) (test-t (string= (string-capitalize 'kludgy-hash-search) "Kludgy-Hash-Search")) (test-t (string= (string-capitalize "DON'T!") "Don'T!")) (test-t (string= (string-capitalize "pipe 13a, foo16c") "Pipe 13a, Foo16c")) (test-t (string= (string-capitalize "a fool" :start 2 :end nil) "a Fool")) (test-t (let ((str (copy "0123ABCD890a"))) (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a") (string= str "0123AbcD890a")))) (test-t (let* ((str0 (copy "abcde")) (str (nstring-upcase str0))) (and (eq str0 str) (string= str "ABCDE")))) (test-t (let* ((str0 (copy "Dr. Livingston, I presume?")) (str (nstring-upcase str0))) (and (eq str0 str) (string= str "DR. LIVINGSTON, I PRESUME?")))) (test-t (let* ((str0 (copy "Dr. Livingston, I presume?")) (str (nstring-upcase str0 :start 6 :end 10))) (and (eq str0 str) (string= str "Dr. LiVINGston, I presume?")))) (test-t (let* ((str0 (copy "abcde")) (str (nstring-upcase str0 :start 2 :end nil))) (string= str "abCDE"))) (test-t (let* ((str0 (copy "Dr. Livingston, I presume?")) (str (nstring-downcase str0))) (and (eq str0 str) (string= str "dr. livingston, i presume?")))) (test-t (let* ((str0 (copy "ABCDE")) (str (nstring-downcase str0 :start 2 :end nil))) (string= str "ABcde"))) (test-t (let* ((str0 (copy "elm 13c arthur;fig don't")) (str (nstring-capitalize str0))) (and (eq str0 str) (string= str "Elm 13c Arthur;Fig Don'T")))) (test-t (let* ((str0 (copy " hello ")) (str (nstring-capitalize str0))) (and (eq str0 str) (string= str " Hello ")))) (test-t (let* ((str0 (copy "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")) (str (nstring-capitalize str0))) (and (eq str0 str) (string= str "Occluded Casements Forestall Inadvertent Defenestration")))) (test-t (let* ((str0 (copy "DON'T!")) (str (nstring-capitalize str0))) (and (eq str0 str) (string= str "Don'T!")))) (test-t (let* ((str0 (copy "pipe 13a, foo16c")) (str (nstring-capitalize str0))) (and (eq str0 str) (string= str "Pipe 13a, Foo16c")))) (test-t (let* ((str0 (copy "a fool")) (str (nstring-capitalize str0 :start 2 :end nil))) (string= str "a Fool"))) (test-t (string= (string-trim "abc" "abcaakaaakabcaaa") "kaaak")) (test-t (string= (string-trim '(#\space) " garbanzo beans ") "garbanzo beans")) (test-t (string= (string-trim " (*)" " ( *three (silly) words* ) ") "three (silly) words")) (test-t (string= (string-left-trim "abc" "labcabcabc") "labcabcabc")) (test-t (string= (string-left-trim " (*)" " ( *three (silly) words* ) ") "three (silly) words* ) ")) (test-t (string= (string-right-trim " (*)" " ( *three (silly) words* ) ") " ( *three (silly) words")) (test-t (string= (string-trim "ABC" "abc") "abc")) (test-t (string= (string-trim "AABBCC" "abc") "abc")) (test-t (string= (string-trim "" "abc") "abc")) (test-t (string= (string-trim "ABC" "") "")) (test-t (string= (string-trim "cba" "abc") "")) (test-t (string= (string-trim "cba" "abccba") "")) (test-t (string= (string-trim "ccbbba" "abccba") "")) (test-t (string= (string-trim "cba" "abcxabc") "x")) (test-t (string= (string-trim "xyz" "xxyabcxyyz") "abc")) (test-t (string= (string-trim "a" #\a) "")) (test-t (string= (string-left-trim "ABC" "abc") "abc")) (test-t (string= (string-left-trim "" "abc") "abc")) (test-t (string= (string-left-trim "ABC" "") "")) (test-t (string= (string-left-trim "cba" "abc") "")) (test-t (string= (string-left-trim "cba" "abccba") "")) (test-t (string= (string-left-trim "cba" "abcxabc") "xabc")) (test-t (string= (string-left-trim "xyz" "xxyabcxyz") "abcxyz")) (test-t (string= (string-left-trim "a" #\a) "")) (test-t (string= (string-right-trim "ABC" "abc") "abc")) (test-t (string= (string-right-trim "" "abc") "abc")) (test-t (string= (string-right-trim "ABC" "") "")) (test-t (string= (string-right-trim "cba" "abc") "")) (test-t (string= (string-right-trim "cba" "abccba") "")) (test-t (string= (string-right-trim "cba" "abcxabc") "abcx")) (test-t (string= (string-right-trim "xyz" "xxyabcxyz") "xxyabc")) (test-t (string= (string-right-trim "a" #\a) "")) (test-t (string= (cl-string "already a string") "already a string")) (test-t (string= (cl-string #\c) "c")) (test-t (string= "foo" "foo")) (test-t (not (string= "foo" "Foo"))) (test-t (not (string= "foo" "bar"))) (test-t (string= "together" "frog" :start1 1 :end1 3 :start2 2)) (test-t (string-equal "foo" "Foo")) (test-t (string= "abcd" "01234abcd9012" :start2 5 :end2 9)) (test-t (eql (string< "aaaa" "aaab") 3)) (test-t (eql (string>= "aaaaa" "aaaa") 4)) (test-t (eql (string-not-greaterp "Abcde" "abcdE") 5)) (test-t (eql (string-lessp "012AAAA789" "01aaab6" :start1 3 :end1 7 :start2 2 :end2 6) 6)) (test-t (not (string-not-equal "AAAA" "aaaA"))) (test-t (string= "" "")) (test-t (not (string= "abc" ""))) (test-t (not (string= "" "abc"))) (test-t (not (string= "A" "a"))) (test-t (string= "abc" "xyz" :start1 3 :start2 3)) (test-t (string= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)) (test-t (string= "axyza" "xyz" :start1 1 :end1 4)) (test-t (string= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)) (test-t (string= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)) (test-t (not (string= "love" "hate"))) (test-t (string= 'love 'love)) (test-t (not (string= 'love "hate"))) (test-t (string= #\a #\a)) (test-t (not (string/= "" ""))) (test-t (eql (string/= "abc" "") 0)) (test-t (eql (string/= "" "abc") 0)) (test-t (eql (string/= "A" "a") 0)) (test-t (not (string/= "abc" "xyz" :start1 3 :start2 3))) (test-t (not (string/= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))) (test-t (not (string/= "axyza" "xyz" :start1 1 :end1 4))) (test-t (not (string/= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))) (test-t (not (string/= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))) (test-t (eql (string/= "love" "hate") 0)) (test-t (eql (string/= "love" "loVe") 2)) (test-t (not (string/= "life" "death" :start1 3 :start2 1 :end2 2))) (test-t (eql (string/= "abcxyz" "ABCxyZ" :start1 3 :start2 3) 5)) (test-t (eql (string/= "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil) 5)) (test-t (eql (string/= "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0)) (test-t (eql (string/= "abc" "abcxyz") 3)) (test-t (eql (string/= "abcxyz" "abc") 3)) (test-t (eql (string/= "abcxyz" "") 0)) (test-t (eql (string/= "AbcDef" "cdef" :start1 2) 3)) (test-t (eql (string/= "cdef" "AbcDef" :start2 2) 1)) (test-t (= (string/= 'love "hate") 0)) (test-t (not (string/= 'love 'love))) (test-t (not (string/= #\a #\a))) (test-t (= (string/= #\a #\b) 0)) (test-t (not (string< "" ""))) (test-t (not (string< "dog" "dog"))) (test-t (not (string< " " " "))) (test-t (not (string< "abc" ""))) (test-t (eql (string< "" "abc") 0)) (test-t (eql (string< "ab" "abc") 2)) (test-t (not (string< "abc" "ab"))) (test-t (eql (string< "aaa" "aba") 1)) (test-t (not (string< "aba" "aaa"))) (test-t (not (string< "my cat food" "your dog food" :start1 6 :start2 8))) (test-t (not (string< "cat food 2 dollars" "dog food 3 dollars" :start1 3 :end1 9 :start2 3 :end2 9))) (test-t (eql (string< "xyzabc" "abcd" :start1 3) 6)) (test-t (eql (string< "abc" "abc" :end1 1) 1)) (test-t (eql (string< "xyzabc" "abc" :start1 3 :end1 5) 5)) (test-t (eql (string< "xyz" "abcxyzXYZ" :start2 3) 3)) (test-t (not (string< "abc" "abcxyz" :end2 3))) (test-t (eql (string< "xyz" "abcxyz" :end1 2 :start2 3) 2)) (test-t (not (string< "xyzabc" "abcdef" :start1 3 :end2 3))) (test-t (eql (string< "aaaa" "z") 0)) (test-t (eql (string< "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6)) (test-t (eql (string< "pppTTTaTTTqqq" "pTTTxTTT" :start1 6 :end1 7 :start2 4 :end2 5) 6)) (test-t (not (string< 'love 'hate))) (test-t (= (string< 'peace 'war) 0)) (test-t (not (string< 'love 'love))) (test-t (not (string< #\a #\a))) (test-t (= (string< #\a #\b) 0)) (test-t (not (string> "" ""))) (test-t (not (string> "dog" "dog"))) (test-t (not (string> " " " "))) (test-t (eql (string> "abc" "") 0)) (test-t (not (string> "" "abc"))) (test-t (not (string> "ab" "abc"))) (test-t (eql (string> "abc" "ab") 2)) (test-t (eql (string> "aba" "aaa") 1)) (test-t (not (string> "aaa" "aba"))) (test-t (not (string> "my cat food" "your dog food" :start1 6 :start2 8))) (test-t (not (string> "cat food 2 dollars" "dog food 3 dollars" :start1 3 :end1 9 :start2 3 :end2 9))) (test-t (eql (string> "xyzabcde" "abcd" :start1 3) 7)) (test-t (not (string> "abc" "abc" :end1 1))) (test-t (eql (string> "xyzabc" "a" :start1 3 :end1 5) 4)) (test-t (eql (string> "xyzXYZ" "abcxyz" :start2 3) 3)) (test-t (eql (string> "abcxyz" "abcxyz" :end2 3) 3)) (test-t (not (string> "xyzXYZ" "abcxyz" :end1 2 :start2 3))) (test-t (not (string> "xyzabc" "abcdef" :start1 3 :end2 3))) (test-t (eql (string> "z" "aaaa") 0)) (test-t (eql (string> "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4)) (test-t (eql (string> "pppTTTxTTTqqq" "pTTTaTTT" :start1 6 :end1 7 :start2 4 :end2 5) 6)) (test-t (= (string> 'love 'hate) 0)) (test-t (not (string> 'peace 'war))) (test-t (not (string> 'love 'love))) (test-t (not (string> #\a #\a))) (test-t (not (string> #\a #\b))) (test-t (= (string> #\z #\a) 0)) (test-t (eql (string<= "" "") 0)) (test-t (eql (string<= "dog" "dog") 3)) (test-t (eql (string<= " " " ") 1)) (test-t (not (string<= "abc" ""))) (test-t (eql (string<= "ab" "abc") 2)) (test-t (eql (string<= "aaa" "aba") 1)) (test-t (not (string<= "aba" "aaa"))) (test-t (eql (string<= "my cat food" "your dog food" :start1 6 :start2 8) 11)) (test-t (eql (string<= "cat food 2 dollars" "dog food 3 dollars" :start1 3 :end1 9 :start2 3 :end2 9) 9)) (test-t (eql (string<= "xyzabc" "abcd" :start1 3) 6)) (test-t (eql (string<= "abc" "abc" :end1 1) 1)) (test-t (eql (string<= "xyzabc" "abc" :start1 3 :end1 5) 5)) (test-t (eql (string<= "xyz" "abcxyzXYZ" :start2 3) 3)) (test-t (eql (string<= "abc" "abcxyz" :end2 3) 3)) (test-t (eql (string<= "xyz" "abcxyz" :end1 2 :start2 3) 2)) (test-t (eql (string<= "xyzabc" "abcdef" :start1 3 :end2 3) 6)) (test-t (eql (string<= "aaaa" "z") 0)) (test-t (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6)) (test-t (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT" :start1 6 :end1 7 :start2 4 :end2 5) 6)) (test-t (not (string<= 'love 'hate))) (test-t (= (string<= 'peace 'war) 0)) (test-t (= (string<= 'love 'love) 4)) (test-t (= (string<= #\a #\a) 1)) (test-t (= (string<= #\a #\b) 0)) (test-t (not (string<= #\z #\a))) (test-t (eql (string>= "" "") 0)) (test-t (eql (string>= "dog" "dog") 3)) (test-t (eql (string>= " " " ") 1)) (test-t (eql (string>= "abc" "") 0)) (test-t (not (string>= "" "abc"))) (test-t (not (string>= "ab" "abc"))) (test-t (eql (string>= "abc" "ab") 2)) (test-t (eql (string>= "aba" "aaa") 1)) (test-t (not (string>= "aaa" "aba"))) (test-t (eql (string>= "my cat food" "your dog food" :start1 6 :start2 8) 11)) (test-t (eql (string>= "cat food 2 dollars" "dog food 3 dollars" :start1 3 :end1 9 :start2 3 :end2 9) 9)) (test-t (eql (string>= "xyzabcde" "abcd" :start1 3) 7)) (test-t (not (string>= "abc" "abc" :end1 1))) (test-t (eql (string>= "xyzabc" "a" :start1 3 :end1 5) 4)) (test-t (eql (string>= "xyzXYZ" "abcxyz" :start2 3) 3)) (test-t (eql (string>= "abcxyz" "abcxyz" :end2 3) 3)) (test-t (not (string>= "xyzXYZ" "abcxyz" :end1 2 :start2 3))) (test-t (eql (string>= "xyzabc" "abcdef" :start1 3 :end2 3) 6)) (test-t (eql (string>= "z" "aaaa") 0)) (test-t (eql (string>= "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4)) (test-t (eql (string>= "pppTTTxTTTqqq" "pTTTaTTT" :start1 6 :end1 7 :start2 4 :end2 5) 6)) (test-t (= (string>= 'love 'hate) 0)) (test-t (not (string>= 'peace 'war))) (test-t (= (string>= 'love 'love) 4)) (test-t (= (string>= #\a #\a) 1)) (test-t (not (string>= #\a #\b))) (test-t (= (string>= #\z #\a) 0)) (test-t (string-equal "" "")) (test-t (not (string-equal "abc" ""))) (test-t (not (string-equal "" "abc"))) (test-t (string-equal "A" "a")) (test-t (string-equal "abc" "xyz" :start1 3 :start2 3)) (test-t (string-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)) (test-t (string-equal "axyza" "xyz" :start1 1 :end1 4)) (test-t (string-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)) (test-t (string-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)) (test-t (not (string-equal "love" "hate"))) (test-t (string-equal "xyz" "XYZ")) (test-t (not (string-equal 'love 'hate))) (test-t (not (string-equal 'peace 'war))) (test-t (string-equal 'love 'love)) (test-t (string-equal #\a #\a)) (test-t (not (string-equal #\a #\b))) (test-t (not (string-equal #\z #\a))) (test-t (not (string-not-equal "" ""))) (test-t (eql (string-not-equal "abc" "") 0)) (test-t (eql (string-not-equal "" "abc") 0)) (test-t (not (string-not-equal "A" "a"))) (test-t (not (string-not-equal "abc" "xyz" :start1 3 :start2 3))) (test-t (not (string-not-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))) (test-t (not (string-not-equal "axyza" "xyz" :start1 1 :end1 4))) (test-t (not (string-not-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))) (test-t (not (string-not-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))) (test-t (eql (string-not-equal "love" "hate") 0)) (test-t (not (string-not-equal "love" "loVe"))) (test-t (not (string-not-equal "life" "death" :start1 3 :start2 1 :end2 2))) (test-t (not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :start2 3))) (test-t (not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil))) (test-t (eql (string-not-equal "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0)) (test-t (eql (string-not-equal "abc" "abcxyz") 3)) (test-t (eql (string-not-equal "abcxyz" "abc") 3)) (test-t (eql (string-not-equal "abcxyz" "") 0)) (test-t (not (string-not-equal "AbcDef" "cdef" :start1 2))) (test-t (not (string-not-equal "cdef" "AbcDef" :start2 2))) (test-t (not (string-not-equal "ABC" "abc"))) (test-t (= (string-not-equal 'love 'hate) 0)) (test-t (= (string-not-equal 'peace 'war) 0)) (test-t (not (string-not-equal 'love 'love))) (test-t (not (string-not-equal #\a #\a))) (test-t (= (string-not-equal #\a #\b) 0)) (test-t (= (string-not-equal #\z #\a) 0)) (test-t (not (string-lessp "" ""))) (test-t (not (string-lessp "dog" "dog"))) (test-t (not (string-lessp " " " "))) (test-t (not (string-lessp "abc" ""))) (test-t (eql (string-lessp "" "abc") 0)) (test-t (eql (string-lessp "ab" "abc") 2)) (test-t (not (string-lessp "abc" "ab"))) (test-t (eql (string-lessp "aaa" "aba") 1)) (test-t (not (string-lessp "aba" "aaa"))) (test-t (not (string-lessp "my cat food" "your dog food" :start1 6 :start2 8))) (test-t (not (string-lessp "cat food 2 dollars" "dog food 3 dollars" :start1 3 :end1 9 :start2 3 :end2 9))) (test-t (eql (string-lessp "xyzabc" "abcd" :start1 3) 6)) (test-t (eql (string-lessp "abc" "abc" :end1 1) 1)) (test-t (eql (string-lessp "xyzabc" "abc" :start1 3 :end1 5) 5)) (test-t (eql (string-lessp "xyz" "abcxyzXYZ" :start2 3) 3)) (test-t (not (string-lessp "abc" "abcxyz" :end2 3))) (test-t (eql (string-lessp "xyz" "abcxyz" :end1 2 :start2 3) 2)) (test-t (not (string-lessp "xyzabc" "abcdef" :start1 3 :end2 3))) (test-t (eql (string-lessp "aaaa" "z") 0)) (test-t (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6)) (test-t (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT" :start1 6 :end1 7 :start2 4 :end2 5) 6)) (test-t (and (not (string-lessp "abc" "ABC")) (not (string-lessp "ABC" "abc")))) (test-t (not (string-lessp 'love 'hate))) (test-t (= (string-lessp 'peace 'war) 0)) (test-t (not (string-lessp 'love 'love))) (test-t (not (string-lessp #\a #\a))) (test-t (= (string-lessp #\a #\b) 0)) (test-t (not (string-lessp #\z #\a))) (test-t (not (string-greaterp "" ""))) (test-t (not (string-greaterp "dog" "dog"))) (test-t (not (string-greaterp " " " "))) (test-t (eql (string-greaterp "abc" "") 0)) (test-t (not (string-greaterp "" "abc"))) (test-t (not (string-greaterp "ab" "abc"))) (test-t (eql (string-greaterp "abc" "ab") 2)) (test-t (eql (string-greaterp "aba" "aaa") 1)) (test-t (not (string-greaterp "aaa" "aba"))) (test-t (not (string-greaterp "my cat food" "your dog food" :start1 6 :start2 8))) (test-t (not (string-greaterp "cat food 2 dollars" "dog food 3 dollars" :start1 3 :end1 9 :start2 3 :end2 9))) (test-t (eql (string-greaterp "xyzabcde" "abcd" :start1 3) 7)) (test-t (not (string-greaterp "abc" "abc" :end1 1))) (test-t (eql (string-greaterp "xyzabc" "a" :start1 3 :end1 5) 4)) (test-t (eql (string-greaterp "xyzXYZ" "abcxyz" :start2 3) 3)) (test-t (eql (string-greaterp "abcxyz" "abcxyz" :end2 3) 3)) (test-t (not (string-greaterp "xyzXYZ" "abcxyz" :end1 2 :start2 3))) (test-t (not (string-greaterp "xyzabc" "abcdef" :start1 3 :end2 3))) (test-t (eql (string-greaterp "z" "aaaa") 0)) (test-t (eql (string-greaterp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4)) (test-t (eql (string-greaterp "pppTTTxTTTqqq" "pTTTaTTT" :start1 6 :end1 7 :start2 4 :end2 5) 6)) (test-t (and (not (string-greaterp "abc" "ABC")) (not (string-greaterp "ABC" "abc")))) (test-t (= (string-greaterp 'love 'hate) 0)) (test-t (not (string-greaterp 'peace 'war))) (test-t (not (string-greaterp 'love 'love))) (test-t (not (string-greaterp #\a #\a))) (test-t (not (string-greaterp #\a #\b))) (test-t (= (string-greaterp #\z #\a) 0)) (test-t (eql (string-not-greaterp "" "") 0)) (test-t (eql (string-not-greaterp "dog" "dog") 3)) (test-t (eql (string-not-greaterp " " " ") 1)) (test-t (not (string-not-greaterp "abc" ""))) (test-t (eql (string-not-greaterp "ab" "abc") 2)) (test-t (eql (string-not-greaterp "aaa" "aba") 1)) (test-t (not (string-not-greaterp "aba" "aaa"))) (test-t (eql (string-not-greaterp "my cat food" "your dog food" :start1 6 :start2 8) 11)) (test-t (eql (string-not-greaterp "cat food 2 dollars" "dog food 3 dollars" :start1 3 :end1 9 :start2 3 :end2 9) 9)) (test-t (eql (string-not-greaterp "xyzabc" "abcd" :start1 3) 6)) (test-t (eql (string-not-greaterp "abc" "abc" :end1 1) 1)) (test-t (eql (string-not-greaterp "xyzabc" "abc" :start1 3 :end1 5) 5)) (test-t (eql (string-not-greaterp "xyz" "abcxyzXYZ" :start2 3) 3)) (test-t (eql (string-not-greaterp "abc" "abcxyz" :end2 3) 3)) (test-t (eql (string-not-greaterp "xyz" "abcxyz" :end1 2 :start2 3) 2)) (test-t (eql (string-not-greaterp "xyzabc" "abcdef" :start1 3 :end2 3) 6)) (test-t (eql (string-not-greaterp "aaaa" "z") 0)) (test-t (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6)) (test-t (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT" :start1 6 :end1 7 :start2 4 :end2 5) 6)) (test-t (and (eql (string-not-greaterp "abc" "ABC") 3) (eql (string-not-greaterp "ABC" "abc") 3))) (test-t (not (string-not-greaterp 'love 'hate))) (test-t (= (string-not-greaterp 'peace 'war) 0)) (test-t (= (string-not-greaterp 'love 'love) 4)) (test-t (= (string-not-greaterp #\a #\a) 1)) (test-t (= (string-not-greaterp #\a #\b) 0)) (test-t (not (string-not-greaterp #\z #\a))) (test-t (eql (string-not-lessp "" "") 0)) (test-t (eql (string-not-lessp "dog" "dog") 3)) (test-t (eql (string-not-lessp " " " ") 1)) (test-t (eql (string-not-lessp "abc" "") 0)) (test-t (not (string-not-lessp "" "abc"))) (test-t (not (string-not-lessp "ab" "abc"))) (test-t (eql (string-not-lessp "abc" "ab") 2)) (test-t (eql (string-not-lessp "aba" "aaa") 1)) (test-t (not (string-not-lessp "aaa" "aba"))) (test-t (eql (string-not-lessp "my cat food" "your dog food" :start1 6 :start2 8) 11)) (test-t (eql (string-not-lessp "cat food 2 dollars" "dog food 3 dollars" :start1 3 :end1 9 :start2 3 :end2 9) 9)) (test-t (eql (string-not-lessp "xyzabcde" "abcd" :start1 3) 7)) (test-t (not (string-not-lessp "abc" "abc" :end1 1))) (test-t (eql (string-not-lessp "xyzabc" "a" :start1 3 :end1 5) 4)) (test-t (eql (string-not-lessp "xyzXYZ" "abcxyz" :start2 3) 3)) (test-t (eql (string-not-lessp "abcxyz" "abcxyz" :end2 3) 3)) (test-t (not (string-not-lessp "xyzXYZ" "abcxyz" :end1 2 :start2 3))) (test-t (eql (string-not-lessp "xyzabc" "abcdef" :start1 3 :end2 3) 6)) (test-t (eql (string-not-lessp "z" "aaaa") 0)) (test-t (eql (string-not-lessp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4)) (test-t (eql (string-not-lessp "pppTTTxTTTqqq" "pTTTaTTT" :start1 6 :end1 7 :start2 4 :end2 5) 6)) (test-t (and (eql (string-not-lessp "abc" "ABC") 3) (eql (string-not-lessp "ABC" "abc") 3))) (test-t (= (string-not-lessp 'love 'hate) 0)) (test-t (not (string-not-lessp 'peace 'war))) (test-t (= (string-not-lessp 'love 'love) 4)) (test-t (= (string-not-lessp #\a #\a) 1)) (test-t (not (string-not-lessp #\a #\b))) (test-t (= (string-not-lessp #\z #\a) 0)) (test-t (stringp "aaaaaa")) (test-t (not (stringp #\a))) (test-t (not (stringp 'a))) (test-t (not (stringp '(string)))) (test-t (string= (cl-make-string 3 :initial-element #\a) "aaa")) (test-t (string= (cl-make-string 1 :initial-element #\space) " ")) (test-t (string= (cl-make-string 0) "")) (test-t (dotimes (i 10))) (test-t (= (dotimes (temp-one 10 temp-one)) 10)) (test-t (let ((temp-two 0)) (and (eq t (dotimes (temp-one 10 t) (incf temp-two))) (eql temp-two 10)))) (test-t (let ((count 0)) (eql (dotimes (i 5 count) (incf count)) 5))) (test-t (let ((count 0)) (eql (dotimes (i 1 count) (incf count)) 1))) (test-t (let ((count 0)) (zerop (dotimes (i 0 count) (incf count))))) (test-t (let ((count 0)) (zerop (dotimes (i -1 count) (incf count))))) (test-t (let ((count 0)) (zerop (dotimes (i -100 count) (incf count))))) (test-t (eql (dotimes (i 3 i)) 3)) (test-t (eql (dotimes (i 2 i)) 2)) (test-t (eql (dotimes (i 1 i)) 1)) (test-t (eql (dotimes (i 0 i)) 0)) (test-t (eql (dotimes (i -1 i)) 0)) (test-t (eql (dotimes (i -2 i)) 0)) (test-t (eql (dotimes (i -10 i)) 0)) (test-t (let ((list nil)) (and (eq (dotimes (i 10 t) (push i list)) t) (equal list '(9 8 7 6 5 4 3 2 1 0))))) (test-t (let ((list nil)) (equal (dotimes (i 10 (push i list)) (push i list)) '(10 9 8 7 6 5 4 3 2 1 0)))) (test-t (let ((list nil)) (equal (dotimes (i '10 (push i list)) (push i list)) '(10 9 8 7 6 5 4 3 2 1 0)))) (test-t (let ((list nil)) (equal (dotimes (i (/ 100 10) (push i list)) (push i list)) '(10 9 8 7 6 5 4 3 2 1 0)))) (test-t (= 3 (let ((i 3)) (dotimes (i i i) )))) (test-t (= 3 (let ((x 0)) (dotimes (i 3 x) (incf x))))) (test-t (= 3 (dotimes (i 3 i) ))) (test-t (= 3 (let ((x 0)) (dotimes (i 3 x) (declare (fixnum i)) (incf x))))) (test-t (dolist (x ()))) (test-t (dolist (x '(a)))) (test-t (eq t (dolist (x nil t)))) (test-t (= 6 (let ((sum 0)) (dolist (x '(0 1 2 3) sum) (incf sum x))))) (test-t (let ((temp-two ())) (equal (dolist (temp-one '(1 2 3 4) temp-two) (push temp-one temp-two)) '(4 3 2 1)))) (test-t (let ((temp-two 0)) (and (dolist (temp-one '(1 2 3 4)) (incf temp-two)) (eql temp-two 4)))) (test-t (not (dolist (var nil var)))) (test-t (let ((list nil)) (equal (dolist (var '(0 1 2 3) list) (push var list)) '(3 2 1 0)))) (test-t (dolist (var '(0 1 2 3)))) (test-t (eql (do ((temp-one 1 (1+ temp-one)) (temp-two 0 (1- temp-two))) ((> (- temp-one temp-two) 5) temp-one)) 4)) (test-t (eql (do ((temp-one 1 (1+ temp-one)) (temp-two 0 (1+ temp-one))) ((= 3 temp-two) temp-one)) 3)) (test-t (eql (do* ((temp-one 1 (1+ temp-one)) (temp-two 0 (1+ temp-one))) ((= 3 temp-two) temp-one)) 2)) (test-t (let ((a-vector (vector 1 nil 3 nil))) (do ((i 0 (+ i 1)) (n (array-dimension a-vector 0))) ((= i n)) (when (null (aref a-vector i)) (setf (aref a-vector i) 0))) (equalp a-vector #(1 0 3 0)))) (test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9))) (equalp (do ((i 0 (1+ i)) (n #f) (j 9 (1- j))) ((>= i j) vec) (setq n (aref vec i)) (setf (aref vec i) (aref vec j)) (setf (aref vec j) n)) #(9 8 7 6 5 4 3 2 1 0)))) (test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9))) (and (do ((i 0 (1+ i)) (n #f) (j 9 (1- j))) ((>= i j)) (setq n (aref vec i)) (setf (aref vec i) (aref vec j)) (setf (aref vec j) n)) (equalp vec #(9 8 7 6 5 4 3 2 1 0))))) (test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9))) (and (do ((i 0 (1+ i)) (n #f) (j 9 (1- j))) ((>= i j)) (setq n (aref vec i)) (setf (aref vec i) (aref vec j)) (setf (aref vec j) n)) (equalp vec #(9 8 7 6 5 4 3 2 1 0))))) (test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9))) (and (do ((n #f) (i 0 (1+ i)) (j 9 (1- j))) ((>= i j)) (setq n (aref vec i)) (setf (aref vec i) (aref vec j)) (setf (aref vec j) n)) (equalp vec #(9 8 7 6 5 4 3 2 1 0))))) (test-t (let ((vec (vector 0 1 2 3 4 5 6 7 8 9))) (and (do ((i 0 (1+ i)) (j 9 (1- j)) (n #f)) ((>= i j)) (setq n (aref vec i)) (setf (aref vec i) (aref vec j)) (setf (aref vec j) n)) (equalp vec #(9 8 7 6 5 4 3 2 1 0))))) (test-t (= (funcall (lambda (x) (+ x 3)) 4) 7)) (test-t (= (funcall (lambda args (apply + args)) 1 2 3 4) 10)) (test-t (functionp (lambda args (apply + args)))) (test-t (consp (cons 'a 'b))) (test-t (consp '(1 . 2))) (test-t (consp (list nil))) (test-t (not (consp 'a))) (test-t (not (consp nil))) (test-t (not (consp 1))) (test-t (not (consp #\a))) (test-t (let ((a (cons 1 2))) (and (eql (car a) 1) (eql (cdr a) 2)))) (test-t (equal (cons 1 nil) '(1))) (test-t (equal (cons nil nil) '(()))) (test-t (equal (cons 'a (cons 'b (cons 'c ()))) '(a b c))) (test-t (atom 'a)) (test-t (atom nil)) (test-t (atom 1)) (test-t (atom #\a)) (test-t (not (atom (cons 1 2)))) (test-t (not (atom '(a . b)))) (test-t (not (atom (list nil)))) (test-t (listp nil)) (test-t (listp '(a b c))) (test-t (listp '(a . b))) (test-t (listp (cons 'a 'b))) (test-t (not (listp 1))) (test-t (not (listp 't))) (test-t (null ())) (test-t (null nil)) (test-t (not (null t))) (test-t (null (cdr '(a)))) (test-t (not (null (cdr '(1 . 2))))) (test-t (not (null 'a))) (test-t (endp ())) (test-t (not (endp '(1)))) (test-t (not (endp '(1 2)))) (test-t (not (endp '(1 2 3)))) (test-t (not (endp (cons 1 2)))) (test-t (endp (cddr '(1 2)))) (test-t (let ((a (cons 1 2))) (and (eq (rplaca a 0) a) (equal a '(0 . 2))))) (test-t (let ((a (list 1 2 3))) (and (eq (rplaca a 0) a) (equal a '(0 2 3))))) (test-t (let ((a (cons 1 2))) (and (eq (rplacd a 0) a) (equal a '(1 . 0))))) (test-t (let ((a (list 1 2 3))) (and (eq (rplacd a 0) a) (equal a '(1 . 0))))) (test-t (eq (car '(a . b)) 'a)) (test-t (let ((a (cons 1 2))) (eq (car (list a)) a))) (test-t (eq (cdr '(a . b)) 'b)) (test-t (eq (rest '(a . b)) 'b)) (test-t (let ((a (cons 1 2))) (eq (cdr (cons 1 a)) a))) (test-t (let ((a (cons 1 2))) (eq (rest (cons 1 a)) a))) (test-t (eq (caar '((a) b c)) 'a)) (test-t (eq (cadr '(a b c)) 'b)) (test-t (eq (cdar '((a . aa) b c)) 'aa)) (test-t (eq (cddr '(a b . c)) 'c)) (test-t (eq (caaar '(((a)) b c)) 'a)) (test-t (eq (caadr '(a (b) c)) 'b)) (test-t (eq (cadar '((a aa) b c)) 'aa)) (test-t (eq (caddr '(a b c)) 'c)) (test-t (eq (cdaar '(((a . aa)) b c)) 'aa)) (test-t (eq (cdadr '(a (b . bb) c)) 'bb)) (test-t (eq (cddar '((a aa . aaa) b c)) 'aaa)) (test-t (eq (cdddr '(a b c . d)) 'd)) (test-t (eq (caaaar '((((a))) b c)) 'a)) (test-t (eq (caaadr '(a ((b)) c)) 'b)) (test-t (eq (caadar '((a (aa)) b c)) 'aa)) (test-t (eq (caaddr '(a b (c))) 'c)) (test-t (eq (cadaar '(((a aa)) b c)) 'aa)) (test-t (eq (cadadr '(a (b bb) c)) 'bb)) (test-t (eq (caddar '((a aa aaa) b c)) 'aaa)) (test-t (eq (cadddr '(a b c d)) 'd)) (test-t (eq (cdaaar '((((a . aa))) b c)) 'aa)) (test-t (eq (cdaadr '(a ((b . bb)) c)) 'bb)) (test-t (eq (cdadar '((a (aa . aaa)) b c)) 'aaa)) (test-t (eq (cdaddr '(a b (c . cc))) 'cc)) (test-t (eq (cddaar '(((a aa . aaa)) b c)) 'aaa)) (test-t (eq (cddadr '(a (b bb . bbb) c)) 'bbb)) (test-t (eq (cdddar '((a aa aaa . aaaa) b c)) 'aaaa)) (test-t (eq (cddddr '(a b c d . e)) 'e)) (test-t (eq (copy-tree nil) nil)) (test-t (let* ((a (list 'a)) (b (list 'b)) (c (list 'c)) (x3 (cons c nil)) (x2 (cons b x3)) (x (cons a x2)) (y (copy-tree x))) (and (not (eq x y)) (not (eq (car x) (car y))) (not (eq (cdr x) (cdr y))) (not (eq (cadr x) (cadr y))) (not (eq (cddr x) (cddr y))) (not (eq (caddr x) (caddr y))) (eq (cdddr x) (cdddr y)) (equal x y) (eq (car x) a) (eq (car a) 'a) (eq (cdr a) nil) (eq (cdr x) x2) (eq (car x2) b) (eq (car b) 'b) (eq (cdr b) nil) (eq (cdr x2) x3) (eq (car x3) c) (eq (car c) 'c) (eq (cdr c) nil) (eq (cdr x3) nil)))) (test-t (let* ((x (list (list 'a 1) (list 'b 2) (list 'c 3))) (y (copy-tree x))) (and (not (eq (car x) (car y))) (not (eq (cadr x) (cadr y))) (not (eq (caddr x) (caddr y)))))) (test-t (let* ((x (list (list (list 1)))) (y (copy-tree x))) (and (not (eq x y)) (not (eq (car x) (car y))) (not (eq (caar x) (caar y)))))) (test-t (let ((x (list 'a 'b 'c 'd))) (and (equal (sublis '((a . 1) (b . 2) (c . 3)) x) '(1 2 3 d)) (equal x '(a b c d))))) (test-t (eq (sublis () ()) ())) (test-t (equal (sublis () '(1 2 3)) '(1 2 3))) (test-t (eq (sublis '((a . 1) (b . 2)) ()) nil)) (test-t (equal (sublis '((a . 1) (b . 2) (c . 3)) '(((a)) (b) c)) '(((1)) (2) 3))) (test-t (equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3)) '((((a))) ((b)) (c))) '((((a))) ((b)) (c)))) (test-t (equal (sublis '(((a) . 1) ((b) . 2) ((c) . 3)) '((((a))) ((b)) (c)) :test equal) '(((1)) (2) 3))) (test-t (equal (nsublis '((a . 1) (b . 2) (c . 3)) (list 'a 'b 'c 'd)) '(1 2 3 d))) (test-t (let* ((x (list 'a 'b 'c 'd)) (y (nsublis '((a . 1) (b . 2) (c . 3)) x))) (and (eq x y) (equal x '(1 2 3 d))))) (test-t (let ((x (list 'l 'm 'n))) (and (eq (nsublis '((a . 1) (b . 2) (c . 3)) x) x) (equal x '(l m n))))) (test-t (let* ((n (cons 'n nil)) (m (cons 'm n)) (l (cons 'l m)) (x (nsublis '((a . 1) (b . 2) (c . 3)) l))) (and (eq x l) (eq (car l) 'l) (eq (cdr l) m) (eq (car m) 'm) (eq (cdr m) n) (eq (car n) 'n) (eq (cdr n) nil)))) (test-t (eq (nsublis () ()) ())) (test-t (equal (nsublis () '(1 2 3)) '(1 2 3))) (test-t (eq (nsublis '((a . 1) (b . 2)) ()) nil)) (test-t (equal (nsublis '((a b c) (b c d) (c d e)) (list 'a 'b 'c)) '((b c) (c d) (d e)))) (test-t (equal (nsublis '((a . 1) (b . 2) (c . 3)) (copy-tree '(((a)) (b) c))) '(((1)) (2) 3))) (test-t (equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3)) (copy-tree '((((a))) ((b)) (c)))) '((((a))) ((b)) (c)))) (test-t (equal (nsublis '(((a) . 1) ((b) . 2) ((c) . 3)) (copy-tree '((((a))) ((b)) (c))) :test equal) '(((1)) (2) 3))) (test-t (tree-equal 'a 'a)) (test-t (not (tree-equal 'a 'b))) (test-t (tree-equal '(a (b (c))) '(a (b (c))))) (test-t (tree-equal '(a (b (c))) '(a (b (c))) :test eq)) (test-t (not (tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c")))))) (test-t (tree-equal '("a" ("b" ("c"))) '("a" ("b" ("c"))) :test equal)) (test-t (not (tree-equal '(a b) '(a (b))))) (test-t (eq (copy-list ()) ())) (test-t (equal (copy-list '(a b c)) '(a b c))) (test-t (equal (copy-list '(a . b)) '(a . b))) (test-t (let* ((x '(a b c)) (y (copy-list x))) (and (equal x y) (not (eq x y))))) (test-t (let* ((a (list 'a)) (b (list 'b)) (c (list 'c)) (x (list a b c)) (y (copy-list x))) (and (equal x y) (not (eq x y)) (eq (car x) (car y)) (eq (cadr x) (cadr y)) (eq (caddr x) (caddr y)) (eq (caar x) 'a) (eq (caadr x) 'b) (eq (caaddr x) 'c)))) (test-t (null (list))) (test-t (equal (list 1) '(1))) (test-t (equal (list 1 2 3) '(1 2 3))) (test-t (equal (list* 1 2 '(3)) '(1 2 3))) (test-t (equal (list* 1 2 'x) '(1 2 . x))) (test-t (equal (list* 1 2 '(3 4)) '(1 2 3 4))) (test-t (eq (list* 'x) 'x)) (test-t (eql (list-length ()) 0)) (test-t (eql (list-length '(1)) 1)) (test-t (eql (list-length '(1 2)) 2)) (test-t (equal (cl-make-list 5) '(() () () () ()))) (test-t (equal (cl-make-list 3 :initial-element 'rah) '(rah rah rah))) (test-t (equal (cl-make-list 2 :initial-element '(1 2 3)) '((1 2 3) (1 2 3)))) (test-t (null (cl-make-list 0))) (test-t (null (cl-make-list 0 :initial-element 'new-element))) (test-t (let ((place nil)) (and (equal (push 0 place) '(0)) (equal place '(0))))) (test-t (let ((place (list 1 2 3))) (and (equal (push 0 place) '(0 1 2 3)) (equal place '(0 1 2 3))))) (test-t (let ((a (list (list 1 2 3) 9))) (and (equal (push 0 (car a)) '(0 1 2 3)) (equal a '((0 1 2 3) 9))))) (test-t (let ((place (list 1 2 3))) (and (eql (pop place) 1) (equal place '(2 3))))) (test-t (let ((a (list (list 1 2 3) 9))) (and (eql (pop (car a)) 1) (equal a '((2 3) 9))))) (test-t (let ((x (list 'a 'b 'c))) (and (eq (pop (cdr x)) 'b) (equal x '(a c))))) (test-t (eq (first '(a . b)) 'a)) (test-t (null (first nil))) (test-t (let ((a (cons 1 2))) (eq (first (list a)) a))) (test-t (eql (first '(1 2 3)) '1)) (test-t (eql (second '(1 2 3)) '2)) (test-t (eql (third '(1 2 3)) '3)) (test-t (eql (fourth '(1 2 3 4)) '4)) (test-t (eql (fifth '(1 2 3 4 5)) '5)) (test-t (eql (sixth '(1 2 3 4 5 6)) '6)) (test-t (eql (seventh '(1 2 3 4 5 6 7)) '7)) (test-t (eql (eighth '(1 2 3 4 5 6 7 8)) '8)) (test-t (eql (ninth '(1 2 3 4 5 6 7 8 9)) '9)) (test-t (eql (tenth '(1 2 3 4 5 6 7 8 9 10)) '10)) (test-t (let ((x '(a b c))) (eq (nthcdr 0 x) x))) (test-t (let ((x '(a b c))) (eq (nthcdr 1 x) (cdr x)))) (test-t (let ((x '(a b c))) (eq (nthcdr 2 x) (cddr x)))) (test-t (let ((x '(a b c))) (eq (nthcdr 3 x) (cdddr x)))) (test-t (equal (nthcdr 0 '(0 1 2)) '(0 1 2))) (test-t (equal (nthcdr 1 '(0 1 2)) '(1 2))) (test-t (equal (nthcdr 2 '(0 1 2)) '(2))) (test-t (equal (nthcdr 3 '(0 1 2)) ())) (test-t (eql (nthcdr 1 '(0 . 1)) 1)) (test-t (eql (nth 0 '(a b c)) 'a)) (test-t (eql (nth 1 '(a b c)) 'b)) (test-t (eql (nth 2 '(a b c)) 'c)) (test-t (eql (nth 3 '(a b c)) ())) (test-t (eql (nth 4 '(a b c)) ())) (test-t (eql (nth 5 '(a b c)) ())) (test-t (eql (nth 6 '(a b c)) ())) (test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 0 x) 'z) 'z) (equal x '(z b c))))) (test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 1 x) 'z) 'z) (equal x '(a z c))))) (test-t (let ((x (list 'a 'b 'c))) (and (eq (setf (nth 2 x) 'z) 'z) (equal x '(a b z))))) (test-t (let ((0-to-3 (list 0 1 2 3))) (and (equal (setf (nth 2 0-to-3) "two") "two") (equal 0-to-3 '(0 1 "two" 3))))) (test-t (let* ((x (list 'a 'b 'c))) (eq (nconc x) x))) (test-t (let* ((x (list 'a 'b 'c)) (y (list 'd 'e 'f)) (list (nconc x y))) (and (eq list x) (eq (nthcdr 3 list) y) (equal list '(a b c d e f))))) (test-t (let* ((x (list 'a)) (y (list 'b)) (z (list 'c)) (list (nconc x y z))) (and (eq x list) (eq (first list) 'a) (eq y (cdr list)) (eq (second list) 'b) (eq z (cddr list)) (eq (third list) 'c)))) (test-t (equal (append '(a b) () '(c d) '(e f)) '(a b c d e f))) (test-t (null (append))) (test-t (null (append ()))) (test-t (null (append () ()))) (test-t (eq (append 'a) 'a)) (test-t (eq (append () 'a) 'a)) (test-t (eq (append () () 'a) 'a)) (test-t (equal (append '(a b) 'c) '(a b . c))) (test-t (let* ((x '(a b c)) (y '(d e f)) (z (append x y))) (and (equal z '(a b c d e f)) (eq (nthcdr 3 z) y) (not (eq x z))))) (test-t (equal (revappend '(a b c) '(d e f)) '(c b a d e f))) (test-t (let* ((x '(a b c)) (y '(d e f)) (z (revappend x y))) (and (equal z '(c b a d e f)) (not (eq x z)) (eq (nthcdr 3 z) y)))) (test-t (let ((x '(a b c))) (eq (revappend () x) x))) (test-t (null (revappend () ()))) (test-t (eq (revappend () 'a) 'a)) (test-t (equal (revappend '(a) 'b) '(a . b))) (test-t (equal (revappend '(a) ()) '(a))) (test-t (equal (revappend '(1 2 3) ()) '(3 2 1))) (test-t (equal (nreconc (list 'a 'b 'c) '(d e f)) '(c b a d e f))) (test-t (let* ((x (list 'a 'b 'c)) (y '(d e f)) (z (nreconc x y))) (and (equal z '(c b a d e f)) (eq (nthcdr 3 z) y)))) (test-t (equal (nreconc (list 'a) 'b) '(a . b))) (test-t (equal (nreconc (list 'a) ()) '(a))) (test-t (equal (nreconc (list 1 2 3) ()) '(3 2 1))) (test-t (null (butlast nil))) (test-t (null (butlast nil 1))) (test-t (null (butlast nil 2))) (test-t (null (butlast nil 3))) (test-t (equal (butlast '(1 2 3 4 5)) '(1 2 3 4))) (test-t (equal (butlast '(1 2 3 4 5) 1) '(1 2 3 4))) (test-t (equal (butlast '(1 2 3 4 5) 2) '(1 2 3))) (test-t (equal (butlast '(1 2 3 4 5) 3) '(1 2))) (test-t (equal (butlast '(1 2 3 4 5) 4) '(1))) (test-t (equal (butlast '(1 2 3 4 5) 5) ())) (test-t (equal (butlast '(1 2 3 4 5) 6) ())) (test-t (equal (butlast '(1 2 3 4 5) 7) ())) (test-t (let ((a '(1 2 3 4 5))) (equal (butlast a 3) '(1 2)) (equal a '(1 2 3 4 5)))) (test-t (null (nbutlast nil))) (test-t (null (nbutlast nil 1))) (test-t (null (nbutlast nil 2))) (test-t (null (nbutlast nil 3))) (test-t (equal (nbutlast (list 1 2 3 4 5)) '(1 2 3 4))) (test-t (equal (nbutlast (list 1 2 3 4 5) 1) '(1 2 3 4))) (test-t (equal (nbutlast (list 1 2 3 4 5) 2) '(1 2 3))) (test-t (equal (nbutlast (list 1 2 3 4 5) 3) '(1 2))) (test-t (equal (nbutlast (list 1 2 3 4 5) 4) '(1))) (test-t (equal (nbutlast (list 1 2 3 4 5) 5) ())) (test-t (equal (nbutlast (list 1 2 3 4 5) 6) ())) (test-t (equal (nbutlast (list 1 2 3 4 5) 7) ())) (test-t (equal (nbutlast (list* 1 2 3 4 5 6)) '(1 2 3 4))) (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 1) '(1 2 3 4))) (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 2) '(1 2 3))) (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 3) '(1 2))) (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 4) '(1))) (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 5) ())) (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 6) ())) (test-t (equal (nbutlast (list* 1 2 3 4 5 6) 7) ())) (test-t (let* ((a '(1 2 3 4 5)) (b (nbutlast a 3))) (and (eq a b) (equal a '(1 2))))) (test-t (let ((x '(0 1 2 3 4 5 6 7 8 9))) (eq (last x) (nthcdr 9 x)))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 0) nil))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x) (nthcdr 4 x)))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 1) (nthcdr 4 x)))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 2) (cdddr x)))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 3) (cddr x)))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 4) (cdr x)))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 5) x))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 6) x))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 7) x))) (test-t (let ((x '(0 1 2 3 4))) (eq (last x 8) x))) (test-t (tailp () ())) (test-t (tailp () '(1))) (test-t (tailp () '(1 2 3 4 5 6 7 8 9))) (test-t (let ((x '(1 2 3))) (and (tailp x x) (tailp (cdr x) x) (tailp (cddr x) x) (tailp (cdddr x) x)))) (test-t (let ((x '(1 . 2))) (and (tailp x x) (tailp (cdr x) x)))) (test-t (not (tailp 'x '(1 2 3 4 5 6)))) (test-t (not (tailp (list 1 2 3) '(1 2 3)))) (test-t (define (ldiff . args) #f)) (test-t (null (ldiff () ()))) (test-t (equal (ldiff '(1 . 2) 2) '(1))) (test-t (equal (ldiff '(1 2 3 4 5 6 7 8 9) ()) '(1 2 3 4 5 6 7 8 9))) (test-t (let ((x '(1 2 3))) (and (null (ldiff x x)) (equal (ldiff x (cdr x)) '(1)) (equal (ldiff x (cddr x)) '(1 2)) (equal (ldiff x (cdddr x)) '(1 2 3))))) (test-t (let* ((x '(1 2 3)) (y '(a b c)) (z (ldiff x y))) (and (not (eq x z)) (equal z '(1 2 3))))) (test-t (equal (cl-member 'a '(a b c d)) '(a b c d))) (test-t (equal (cl-member 'b '(a b c d)) '(b c d))) (test-t (equal (cl-member 'c '(a b c d)) '(c d))) (test-t (equal (cl-member 'd '(a b c d)) '(d))) (test-t (equal (cl-member 'e '(a b c d)) ())) (test-t (equal (cl-member 'f '(a b c d)) ())) (test-t (let ((x '(a b c d))) (eq (cl-member 'a x) x) (eq (cl-member 'b x) (cdr x)) (eq (cl-member 'c x) (cddr x)) (eq (cl-member 'd x) (cdddr x)) (eq (cl-member 'e x) nil))) (test-t (equal (cl-member 'a '(a b c d) :test eq) '(a b c d))) (test-t (equal (cl-member 'b '(a b c d) :test eq) '(b c d))) (test-t (equal (cl-member 'c '(a b c d) :test eq) '(c d))) (test-t (equal (cl-member 'd '(a b c d) :test eq) '(d))) (test-t (equal (cl-member 'e '(a b c d) :test eq) ())) (test-t (equal (cl-member 'f '(a b c d) :test eq) ())) (test-t (null (cl-member 'a ()))) (test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e))) (y (cl-member 'd x :key cdr :test eq))) (and (equal y '((4 . d) (5 . e))) (eq y (nthcdr 3 x))))) (test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e))) (y (cl-member 'd x :key cdr))) (and (equal y '((4 . d) (5 . e))) (eq y (nthcdr 3 x))))) (test-t (equal (member-if (lambda (x) (eql x 'a)) '(a b c d)) '(a b c d))) (test-t (equal (member-if (lambda (x) (eql x 'b)) '(a b c d)) '(b c d))) (test-t (equal (member-if (lambda (x) (eql x 'c)) '(a b c d)) '(c d))) (test-t (equal (member-if (lambda (x) (eql x 'd)) '(a b c d)) '(d))) (test-t (equal (member-if (lambda (x) (eql x 'e)) '(a b c d)) ())) (test-t (equal (member-if (lambda (x) (eql x 'f)) '(a b c d)) ())) (test-t (null (member-if (lambda (x) (eql x 'a)) ()))) (test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e))) (y (member-if (lambda (p) (eq p 'd)) x :key cdr))) (and (equal y '((4 . d) (5 . e))) (eq y (nthcdr 3 x))))) (test-t (null (member-if zerop '(7 8 9)))) (test-t (equal (member-if-not (lambda (x) (not (eql x 'a))) '(a b c d)) '(a b c d))) (test-t (equal (member-if-not (lambda (x) (not (eql x 'b))) '(a b c d)) '(b c d))) (test-t (equal (member-if-not (lambda (x) (not (eql x 'c))) '(a b c d)) '(c d))) (test-t (equal (member-if-not (lambda (x) (not (eql x 'd))) '(a b c d)) '(d))) (test-t (equal (member-if-not (lambda (x) (not (eql x 'e))) '(a b c d)) ())) (test-t (equal (member-if-not (lambda (x) (not (eql x 'f))) '(a b c d)) ())) (test-t (null (member-if-not (lambda (x) (not (eql x 'a))) ()))) (test-t (let* ((x '((1 . a) (2 . b) (3 . c) (4 . d) (5 . e))) (y (member-if-not (lambda (p) (not (eq p 'd))) x :key cdr))) (and (equal y '((4 . d) (5 . e))) (eq y (nthcdr 3 x))))) (test-t (let ((dummy nil) (list-1 '(1 2 3 4))) (and (eq (mapc (lambda x (setq dummy (append dummy x))) list-1 '(a b c d e) '(x y z)) list-1) (equal dummy '(1 a x 2 b y 3 c z))))) (test-t (let* ((x '(0 1 2 3)) (y nil) (z (mapc (lambda (a b c) (push (list a b c) y)) x '(1 2 3 4) '(2 3 4 5)))) (and (eq z x) (equal y '((3 4 5) (2 3 4) (1 2 3) (0 1 2)))))) (test-t (let* ((x '(0 1 2 3)) (y nil) (z (mapc (lambda (a b c) (push (list a b c) y)) nil x '(1 2 3 4) '(2 3 4 5)))) (and (null z) (null y)))) (test-t (let ((sum 0)) (mapc (lambda rest (setq sum (+ sum (apply + rest)))) '(0 1 2) '(1 2 0) '(2 0 1)) (eql sum 9))) (test-t (let ((result 'initial-value) (list-1 nil)) (and (eq (mapc (lambda (a b) (setq result (cons (cons a b) result))) list-1) list-1) (eq result 'initial-value)))) (test-t (let ((result 'initial-value) (list-1 nil)) (and (eq (mapc (lambda (a b) (setq result (cons (cons a b) result))) list-1 '(1 2 3)) list-1) (eq result 'initial-value)))) (test-t (let ((result 'initial-value) (list-1 '(1 2 3))) (and (eq (mapc (lambda (a b) (setq result (cons (cons a b) result))) list-1 ()) list-1) (eq result 'initial-value)))) (test-t (equal (mapcar car '((1 2) (2 3) (3 4) (4 5))) '(1 2 3 4))) (test-t (null (mapcar identity ()))) (test-t (equal (mapcar list '(0 1 2 3) '(a b c d) '(w x y z)) '((0 a w) (1 b x) (2 c y) (3 d z)))) (test-t (null (mapcar list () '(0 1 2 3) '(1 2 3 4) '(2 3 4 5)))) (test-t (null (mapcar list '(0 1 2 3) () '(1 2 3 4) '(2 3 4 5)))) (test-t (null (mapcar list '(0 1 2 3) '(1 2 3 4) () '(2 3 4 5)))) (test-t (null (mapcar list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) ()))) (test-t (equal (mapcar list '(0) '(a b) '(x y z)) '((0 a x)))) (test-t (equal (mapcar list '(a b) '(0) '(x y z)) '((a 0 x)))) (test-t (equal (mapcar list '(a b) '(x y z) '(0)) '((a x 0)))) (test-t (equal (mapcar cons '(a b c) '(1 2 3)) '((a . 1) (b . 2) (c . 3)))) (test-t (equal (mapcan cdr (copy-tree '((1 2) (2 3) (3 4) (4 5)))) '(2 3 4 5))) (test-t (equal (mapcan append '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c) (d e f)) (list (list 'x 'y 'z) (list 'y 'z) (list 'z))) '(1 2 3 a x y z 4 5 6 b c y z 7 8 9 d e f z))) (test-t (null (mapcan append '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c)) ()))) (test-t (null (mapcan append '((1 2 3) (4 5 6) (7 8 9)) () '((a) (b c))))) (test-t (null (mapcan append () '((1 2 3) (4 5 6) (7 8 9)) '((a) (b c))))) (test-t (equal (mapcan list (list 1 2 3 4 5) (list 2 3 4 5 6) (list 3 4 5 6 7) (list 4 5 6 7 8)) '(1 2 3 4 2 3 4 5 3 4 5 6 4 5 6 7 5 6 7 8))) (test-t (equal (mapcan (lambda (x y) (if (null x) () (list x y))) '(() () () d e) '(1 2 3 4 5 6)) '(d 4 e 5))) (test-t (equal (mapcan (lambda (x) (if (numberp x) (list x) ())) '(a 1 b c 3 4 d 5)) '(1 3 4 5))) (test-t (equal (maplist identity '(a b c d)) '((a b c d) (b c d) (c d) (d)))) (test-t (equal (maplist car '((1 2) (2 3) (3 4) (4 5))) '((1 2) (2 3) (3 4) (4 5)))) (test-t (equal (maplist list '(a b c) '(b c d) '(c d e)) '(((a b c) (b c d) (c d e)) ((b c) (c d) (d e)) ((c) (d) (e))))) (test-t (equal (maplist append '(a b c) '(b c d) '(c d e)) '((a b c b c d c d e) (b c c d d e) (c d e)))) (test-t (equal (maplist append '(a b c) '(b c) '(c)) '((a b c b c c)))) (test-t (null (maplist append () '(a b c) '(b c) '(c)))) (test-t (null (maplist append '(a b c) () '(b c) '(c)))) (test-t (null (maplist append '(a b c) '(b c) '(c) ()))) (test-t (let ((x '((1 2) (2 3) (3 4) (4 5))) (y nil)) (and (eq (mapl (lambda (a) (push (car a) y)) x) x) (equal y '((4 5) (3 4) (2 3) (1 2)))))) (test-t (let ((x nil)) (and (null (mapl (lambda rest (push rest x)) () '(0) '(0 1))) (null x)))) (test-t (let ((x nil)) (and (equal (mapl (lambda rest (push rest x)) '(0) () '(0 1)) '(0)) (null x)))) (test-t (let ((x nil)) (and (equal (mapl (lambda rest (push rest x)) '(0) '(0 1) ()) '(0)) (null x)))) (test-t (equal (mapcon car (copy-tree '((1 2) (2 3) (3 4) (4 5)))) '(1 2 2 3 3 4 4 5))) (test-t (equal (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6)) '((0 1 2 3) (1 2 3 4) (2 3 4 5) (3 4 5 6) (1 2 3) (2 3 4) (3 4 5) (4 5 6) (2 3) (3 4) (4 5) (5 6) (3) (4) (5) (6)))) (test-t (null (mapcon list () '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6)))) (test-t (null (mapcon list '(0 1 2 3) () '(1 2 3 4) '(2 3 4 5) '(3 4 5 6)))) (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) () '(2 3 4 5) '(3 4 5 6)))) (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) () '(3 4 5 6)))) (test-t (null (mapcon list '(0 1 2 3) '(1 2 3 4) '(2 3 4 5) '(3 4 5 6) ()))) (test-t (let* ((x '((apple . 1) (orange . 2) (grapes . 3))) (y (acons 'plum 9 x))) (and (equal y '((plum . 9) (apple . 1) (orange . 2) (grapes . 3))) (eq x (cdr y))))) (test-t (equal (acons 'a '0 nil) '((a . 0)))) (test-t (equal (acons 'apple 1 (acons 'orange 2 (acons 'grapes '3 nil))) '((apple . 1) (orange . 2) (grapes . 3)))) (test-t (equal (acons () () ()) '((())))) (test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist) (cadr alist)))) (test-t (null (cl-assoc 'no-such-key '((x . 100) (y . 200) (z . 50))))) (test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist :test eq) (cadr alist)))) (test-t (null (cl-assoc 'key ()))) (test-t (null (cl-assoc () '(())))) (test-t (null (cl-assoc () '(() ())))) (test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (cl-assoc 'y alist) (car (cddddr alist))))) (test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (cl-assoc () alist) (cadddr alist)))) (test-t (let ((alist '((x . 100) (y . 200) (x . 100) (z . 50)))) (eq (cl-assoc 'y alist) (cadr alist)))) (test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (assoc-if (lambda (arg) (eq arg 'y)) alist) (cadr alist)))) (test-t (null (assoc-if consp '((x . 100) (y . 200) (z . 50))))) (test-t (null (assoc-if (lambda (x) (eq x 'key)) ()))) (test-t (null (assoc-if identity '(())))) (test-t (null (assoc-if identity '(() ())))) (test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (assoc-if (lambda (arg) (eq arg 'y)) alist) (car (cddddr alist))))) (test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (assoc-if (lambda (arg) (null arg)) alist) (cadddr alist)))) (test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (assoc-if-not (lambda (arg) (not (eq arg 'y))) alist) (cadr alist)))) (test-t (null (assoc-if-not (complement consp) '((x . 100) (y . 200) (z . 50))))) (test-t (null (assoc-if-not (lambda (x) (not (eq x 'key))) ()))) (test-t (null (assoc-if-not identity '(())))) (test-t (null (assoc-if-not identity '(() ())))) (test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (assoc-if-not (lambda (arg) (not (eq arg 'y))) alist) (car (cddddr alist))))) (test-t (equal (copy-alist '((a . 10) (b . 100) (c . 1000))) '((a . 10) (b . 100) (c . 1000)))) (test-t (let* ((alist '((a . 10) (b . 100) (c . 1000))) (copy (copy-alist alist))) (and (not (eq alist copy)) (not (eq (cdr alist) (cdr copy))) (not (eq (cddr alist) (cddr copy))) (not (eq (car alist) (car copy))) (not (eq (cadr alist) (cadr copy))) (not (eq (caddr alist) (caddr copy)))))) (test-t (let* ((alist '((a 10 x) (b 100 y) (c 1000 z))) (copy (copy-alist alist))) (and (not (eq alist copy)) (not (eq (cdr alist) (cdr copy))) (not (eq (cddr alist) (cddr copy))) (not (eq (car alist) (car copy))) (not (eq (cadr alist) (cadr copy))) (not (eq (caddr alist) (caddr copy))) (eq (cdar alist) (cdar copy)) (eq (cdadr alist) (cdadr copy)) (eq (cdaddr alist) (cdaddr copy))))) (test-t (let* ((alist (pairlis '(x y z) '(xx yy zz) '((a . aa) (b . bb))))) (and (equal (cl-assoc 'x alist) '(x . xx)) (equal (cl-assoc 'y alist) '(y . yy)) (equal (cl-assoc 'z alist) '(z . zz)) (equal (cl-assoc 'a alist) '(a . aa)) (equal (cl-assoc 'b alist) '(b . bb)) (null (cl-assoc 'key alist))))) (test-t (let* ((alist (pairlis '(x y z) '(xx yy zz)))) (and (equal (cl-assoc 'x alist) '(x . xx)) (equal (cl-assoc 'y alist) '(y . yy)) (equal (cl-assoc 'z alist) '(z . zz)) (null (cl-assoc 'key alist))))) (test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist) (cadr alist)))) (test-t (null (rassoc 'no-such-datum '((x . 100) (y . 200) (z . 50))))) (test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist :test =) (cadr alist)))) (test-t (null (rassoc 'key ()))) (test-t (null (rassoc () '(())))) (test-t (null (rassoc () '(() ())))) (test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (rassoc '200 alist) (car (cddddr alist))))) (test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (rassoc () alist) (cadddr alist)))) (test-t (let ((alist '((x . 100) (y . 200) (x . 100) (z . 50)))) (eq (rassoc '200 alist) (cadr alist)))) (test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc-if (lambda (arg) (= arg 200)) alist) (cadr alist)))) (test-t (null (rassoc-if consp '((x . 100) (y . 200) (z . 50))))) (test-t (null (rassoc-if (lambda (x) (eq x 'key)) ()))) (test-t (null (rassoc-if identity '(())))) (test-t (null (rassoc-if identity '(() ())))) (test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (rassoc-if (lambda (arg) (= arg 200)) alist) (car (cddddr alist))))) (test-t (let ((alist '((1 . a) () (2 . b) (())))) (eq (rassoc-if (lambda (arg) (null arg)) alist) (cadddr alist)))) (test-t (let ((alist '((x . 100) (y . 200) (z . 50)))) (eq (rassoc-if-not (lambda (arg) (not (= arg 200))) alist) (cadr alist)))) (test-t (null (rassoc-if-not (complement consp) '((x . 100) (y . 200) (z . 50))))) (test-t (null (rassoc-if-not (lambda (x) (not (eq x 'key))) ()))) (test-t (null (rassoc-if-not identity '(())))) (test-t (null (rassoc-if-not identity '(() ())))) (test-t (let ((alist '(() () () (x . 100) (y . 200) (z . 50)))) (eq (rassoc-if-not (lambda (arg) (not (= arg 200))) alist) (car (cddddr alist))))) (test-t (let ((set '(a b c))) (eq (adjoin 'a set) set))) (test-t (let* ((set '(a b c)) (new-set (adjoin 'x set))) (and (equal new-set '(x a b c)) (eq set (cdr new-set))))) (test-t (equal (adjoin 1 nil) '(1))) (test-t (let ((set '((test-item 1)))) (equal (adjoin '(test-item 1) set) '((test-item 1) (test-item 1))))) (test-t (let ((set '((test-item 1)))) (eq (adjoin '(test-item 1) set :test equal) set))) (test-t (let ((set '((test-item 1)))) (eq (adjoin '(test-item) set :key car) set))) (test-t (let ((set '((test-item 1)))) (eq (adjoin '(test-item) set :key car :test eq) set))) (test-t (let ((set '(("test-item" 1)))) (eq (adjoin '("test-item") set :key car :test equal) set))) (test-t (let ((place nil)) (and (equal (pushnew 'a place) '(a)) (equal place '(a))))) (test-t (let ((place '("love" "peace"))) (equal (pushnew "war" place :test equal) '("war" "love" "peace")))) (test-t (let ((place '("love" "peace"))) (and (eq (pushnew "peace" place :test equal) place) (equal place '("love" "peace"))))) (test-t (let ((place '(("love" . l) ("peace" . p)))) (equal (pushnew '("war" . w) place :test equal :key car) '(("war" . w) ("love" . l) ("peace" . p))))) (test-t (let ((place '(("love" . l) ("peace" . p)))) (and (eq (pushnew '("love" . l) place :test equal :key car) place) (equal place '(("love" . l) ("peace" . p)))))) (test-t (let* ((list '((1) (1 2) (1 2 3))) (original list)) (and (equal (pushnew '(1) list :test equal) '((1) (1 2) (1 2 3))) (eq list original)))) (test-t (let* ((list '((1) (1 2) (1 2 3))) (original list)) (and (equal (pushnew '(1) list :test equal :key nil) '((1) (1 2) (1 2 3))) (eq list original)))) (test-t (eql (length "abc") 3)) (test-t (zerop (length ""))) (test-t (zerop (length #()))) (test-t (zerop (length ()))) (test-t (eql (length '(0)) 1)) (test-t (eql (length '(0 1)) 2)) (test-t (eql (length '(0 1 2)) 3)) (test-t (eql (length '(0 1 2 3)) 4)) (test-t (eql (length '(0 1 2 3 4)) 5)) (test-t (eql (length '(0 1 2 3 4 5)) 6)) (test-t (eql (length '(0 1 2 3 4 5 6)) 7)) (test-t (eql (length #(0)) 1)) (test-t (eql (length #(0 1)) 2)) (test-t (eql (length #(0 1 2)) 3)) (test-t (eql (length #(0 1 2 3)) 4)) (test-t (eql (length #(0 1 2 3 4)) 5)) (test-t (eql (length #(0 1 2 3 4 5)) 6)) (test-t (eql (length #(0 1 2 3 4 5 6)) 7)) (test-t (eql (length (make-array 100)) 100)) (test-t (eql (length (make-sequence 'list 20)) 20)) (test-t (eql (length (make-sequence 'string 10)) 10)) (test-t (eql (length (make-sequence 'bit-vector 3)) 3)) (test-t (eql (length (make-sequence 'bit-vector 64)) 64)) (test-t (eql (length (make-sequence 'simple-vector 64)) 64)) (test-t (string= (copy "love") "love")) (test-t (equalp (copy #(a b c d)) #(a b c d))) (test-t (equal (copy '(love)) '(love))) (test-t (equal (copy '(love hate war peace)) '(love hate war peace))) (test-t (null (copy nil))) (test-t (string= (copy "") "")) (test-t (let* ((seq0 "love&peace") (seq (copy seq0))) (and (not (eq seq0 seq)) (string= seq0 seq)))) (test-t (let* ((seq0 (list 'love 'and 'peace)) (seq (copy seq0))) (and (not (eq seq0 seq)) (equal seq0 seq)))) (test-t (let* ((c0 (list 'love)) (c1 (list 'peace)) (seq (copy (list c0 c1)))) (and (equal seq '((love) (peace))) (eq (car seq) c0) (eq (cadr seq) c1)))) (test-t (let* ((seq0 #(t nil t nil)) (seq (copy seq0))) (and (not (eq seq0 seq)) (equalp seq seq0)))) (test-t (vectorp (copy (vector)))) (test-t (simple-vector-p (copy (vector)))) (test-t (simple-vector-p (copy (vector 0 1)))) (test-t (simple-string-p (copy "xyz"))) (test-t (char= (elt "0123456789" 6) #\6)) (test-t (eq (elt #(a b c d e f g) 0) 'a)) (test-t (eq (elt '(a b c d e f g) 4) 'e)) (test-t (let ((str (copy "0123456789"))) (and (char= (elt str 6) #\6) (setf (elt str 0) #\#) (string= str "#123456789")))) (test-t (let ((list (list 0 1 2 3))) (and (= (elt list 2) 2) (setf (elt list 1) 9) (= (elt list 1) 9) (equal list '(0 9 2 3))))) (test-t (let ((vec (vector 'a 'b 'c))) (and (eq (elt vec 0) 'a) (eq (elt vec 1) 'b) (eq (elt vec 2) 'c)))) (test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list nil) list) (every null list)))) (test-t (let ((v (vector 'x 'y 'z))) (and (eq (cl-fill v 'a) v) (every (lambda (arg) (eq arg 'a)) v)))) (test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :start 2) list) (equal list '(0 1 9 9))))) (test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :start 1 :end 3) list) (equal list '(0 9 9 3))))) (test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :start 1 :end nil) list) (equal list '(0 9 9 9))))) (test-t (let ((list (list 0 1 2 3))) (and (eq (cl-fill list '9 :end 1) list) (equal list '(9 1 2 3))))) (test-t (let ((v (vector 0 1 2 3))) (and (eq (cl-fill v 't :start 3) v) (equalp v #(0 1 2 t))))) (test-t (let ((v (vector 0 1 2 3))) (and (eq (cl-fill v 't :start 2 :end 4) v) (equalp v #(0 1 t t))))) (test-t (let ((v (vector 0 1 2 3))) (and (eq (cl-fill v 't :start 2 :end nil) v) (equalp v #(0 1 t t))))) (test-t (let ((v (vector 0 1 2 3))) (and (eq (cl-fill v 't :end 3) v) (equalp v #(t t t 3))))) (test-t (null (make-sequence 'list 0))) (test-t (string= (make-sequence 'string 26 :initial-element #\.) "..........................")) (test-t (equal (make-sequence 'list 3 :initial-element 'a) '(a a a))) (test-t (null (make-sequence 'null 0 :initial-element 'a))) (test-t (equalp (make-sequence 'vector 3 :initial-element 'z) #(z z z))) (test-t (string= (make-sequence 'string 4 :initial-element '#\z) "zzzz")) (test-t (vectorp (make-sequence 'vector 10))) (test-t (string= (subseq "012345" 2) "2345")) (test-t (string= (subseq "012345" 3 5) "34")) (test-t (equal (subseq '(0 1 2 3) 0) '(0 1 2 3))) (test-t (equal (subseq '(0 1 2 3) 1) '(1 2 3))) (test-t (equal (subseq '(0 1 2 3) 2) '(2 3))) (test-t (equal (subseq '(0 1 2 3) 3) '(3))) (test-t (equal (subseq '(0 1 2 3) 4) ())) (test-t (equalp (subseq #(a b c d) 0) #(a b c d))) (test-t (equalp (subseq #(a b c d) 1) #(b c d))) (test-t (equalp (subseq #(a b c d) 2) #(c d))) (test-t (equalp (subseq #(a b c d) 3) #(d))) (test-t (equalp (subseq #(a b c d) 4) #())) (test-t (string= (subseq "0123" 0) "0123")) (test-t (string= (subseq "0123" 1) "123")) (test-t (string= (subseq "0123" 2) "23")) (test-t (string= (subseq "0123" 3) "3")) (test-t (string= (subseq "0123" 4) "")) (test-t (equal (subseq '(0 1 2 3) 0 4) '(0 1 2 3))) (test-t (equal (subseq '(0 1 2 3) 0 nil) '(0 1 2 3))) (test-t (let* ((list0 '(0 1 2 3)) (list (subseq list0 0 4))) (and (not (eq list0 list)) (equal list0 list)))) (test-t (let* ((list0 '(0 1 2 3)) (list (subseq list0 0 nil))) (and (not (eq list0 list)) (equal list0 list)))) (test-t (equal (subseq '(0 1 2 3) 1 3) '(1 2))) (test-t (equal (subseq '(0 1 2 3) 2 2) ())) (test-t (equal (subseq '(0 1 2 3) 0 0) ())) (test-t (equal (subseq '(0 1 2 3) 1 1) ())) (test-t (equal (subseq '(0 1 2 3) 3 3) ())) (test-t (equal (subseq '(0 1 2 3) 4 4) ())) (test-t (equalp (subseq #(0 1 2 3) 0 4) #(0 1 2 3))) (test-t (equalp (subseq #(0 1 2 3) 0 nil) #(0 1 2 3))) (test-t (let* ((vec0 #(0 1 2 3)) (vec (subseq vec0 0 4))) (and (not (eq vec0 vec)) (equalp vec0 vec)))) (test-t (let* ((vec0 #(0 1 2 3)) (vec (subseq vec0 0 nil))) (and (not (eq vec0 vec)) (equalp vec0 vec)))) (test-t (equalp (subseq #(0 1 2 3) 1 3) #(1 2))) (test-t (equalp (subseq #(0 1 2 3) 2 2) #())) (test-t (equalp (subseq #(0 1 2 3) 0 0) #())) (test-t (equalp (subseq #(0 1 2 3) 1 1) #())) (test-t (equalp (subseq #(0 1 2 3) 3 3) #())) (test-t (equalp (subseq #(0 1 2 3) 4 4) #())) (test-t (string= (cl-map 'string (lambda (x y) (char "01234567890ABCDEF" (mod (+ x y) 16))) '(1 2 3 4) '(10 9 8 7)) "AAAA")) (test-t (equal (cl-map 'list - '(1 2 3 4)) '(-1 -2 -3 -4))) (test-t (string= (cl-map 'string (lambda (x) (if (oddp x) #\1 #\0)) '(1 2 3 4)) "1010")) (test-t (equal (cl-map 'list + '(0 1) '(1 0)) '(1 1))) (test-t (equal (cl-map 'list - '(0 1) '(1 0)) '(-1 1))) (test-t (every null (list (cl-map 'list + ()) (cl-map 'list + () ()) (cl-map 'list + () () ()) (cl-map 'list + () () () ()) (cl-map 'list + () () () () ())))) (test-t (equal (cl-map 'list + '(0 1 2)) '(0 1 2))) (test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3)) '(1 3 5))) (test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4)) '(3 6 9))) (test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5)) '(6 10 14))) (test-t (equal (cl-map 'list + '(1 2) '(1 2 3)) '(2 4))) (test-t (equal (cl-map 'list + '(0 1 2) '(2 3) '(2 3 4)) '(4 7))) (test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2) '(3 4 5)) '(6))) (test-t (equal (cl-map 'list + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) ()) ())) (test-t (null (cl-map 'null + ()))) (test-t (equalp (cl-map 'vector + #()) #())) (test-t (equalp (cl-map 'vector + #() #()) #())) (test-t (equalp (cl-map 'vector + #() #() #()) #())) (test-t (equalp (cl-map 'vector + #() #() #() #()) #())) (test-t (equalp (cl-map 'vector + #() #() #() #() #()) #())) (test-t (equalp (cl-map 'vector + () #()) #())) (test-t (equalp (cl-map 'vector + () #() "") #())) (test-t (equalp (cl-map 'vector + '(0 1 2)) #(0 1 2))) (test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3)) #(1 3 5))) (test-t (equalp (cl-map 'vector + #(0 1 2) '(1 2 3) #(2 3 4)) #(3 6 9))) (test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3) '(2 3 4) #(3 4 5)) #(6 10 14))) (test-t (equalp (cl-map 'vector + '(1 2) '(1 2 3)) #(2 4))) (test-t (equalp (cl-map 'vector + '(0 1 2) '(2 3) '(2 3 4)) #(4 7))) (test-t (equalp (cl-map 'vector + '(0 1 2) '(1 2 3) '(2) '(3 4 5)) #(6))) (test-t (equalp (cl-map 'vector + '(0 1 2) '(1 2 3) '(2 3 4) '(3 4 5) ()) #())) (test-t (equalp (cl-map 'vector + #(1 2) #(1 2 3)) #(2 4))) (test-t (equalp (cl-map 'vector + #(0 1 2) #(2 3) #(2 3 4)) #(4 7))) (test-t (equalp (cl-map 'vector + #(0 1 2) '(1 2 3) #(2) '(3 4 5)) #(6))) (test-t (equalp (cl-map 'vector + '(0 1 2) #(1 2 3) '(2 3 4) '(3 4 5) ()) #())) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "") "")) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "") "")) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "") "")) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "" "") "")) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" "" "" "" "") "")) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" ()) "")) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) "" #() ()) "")) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) () () "" "") "")) (test-t (string= (cl-map 'string (lambda rest (char-upcase (car rest))) #() #() #() #() #()) "")) (test-t (string= (cl-map 'string (lambda (a b) (if (char< a b) b a)) "axbycz" "xaybzc") "xxyyzz")) (test-t (string= (cl-map 'string (lambda (a b) (if (char< a b) b a)) "axbycz" "xayb") "xxyy")) (test-t (let ((list ())) (and (null (cl-map nil (lambda rest (setq list (cons (apply + rest) list))) '(0 1 2 3) '(1 2 3 4))) (equal list '(7 5 3 1))))) (test-t (let ((list ())) (and (null (cl-map nil (lambda rest (setq list (cons (apply + rest) list))) '(0 1 2 3) '(1 2 3 4) '(2 3 4 5))) (equal list (cl-reverse '(3 6 9 12)))))) (test-t (let ((list ())) (and (null (cl-map nil (lambda rest (setq list (cons (apply + rest) list))) '(0 1 2 3) '(1) '(2 3 4 5))) (equal list '(3))))) (test-t (string= (cl-map 'string char-upcase "abc") "ABC")) (test-t (let ((a (list 1 2 3 4)) (b (list 10 10 10 10))) (and (equal (map-into a + a b) '(11 12 13 14)) (equal a '(11 12 13 14)) (equal b '(10 10 10 10))))) (test-t (let ((a '(11 12 13 14)) (k '(one two three))) (equal (map-into a cons k a) '((one . 11) (two . 12) (three . 13) 14)))) (test-t (null (map-into nil identity))) (test-t (null (map-into nil identity ()))) (test-t (null (map-into nil identity '(0 1 2) '(9 8 7)))) (test-t (let ((list (list 0 1 2))) (and (eq (map-into list identity) list) (equal list '(0 1 2))))) (test-t (let ((list (list 0 1 2))) (and (eq (map-into list identity ()) list) (equal list '(0 1 2))))) (test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec identity) vec) (equalp vec #(0 1 2))))) (test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec identity #()) vec) (equalp vec #(0 1 2))))) (test-t (let ((vec (vector 0 1 2))) (and (eq (map-into vec + #() () #()) vec) (equalp vec #(0 1 2))))) (test-t (equal (map-into (list nil nil) + '(0 1) '(1 0)) '(1 1))) (test-t (equal (map-into (list nil nil) - '(0 1) '(1 0)) '(-1 1))) (test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(0 1 2)) list) (equal list '(0 1 2))))) (test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(0 1 2) '(1 2 3)) list) (equal list '(1 3 5))))) (test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(0 1 2) '(1 2 3) '(2 3 4)) list) (equal list '(3 6 9))))) (test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(1 2) '(1 2 3)) list) (equal list '(2 4 ()))))) (test-t (let ((list (cl-make-list 1 :initial-element nil))) (and (eq (map-into list + '(1 2 3) '(1 2 3)) list) (equal list '(2))))) (test-t (let ((list (cl-make-list 3 :initial-element nil))) (and (eq (map-into list + '(1 2 3 4) '(1 2 3) '(0)) list) (equal list '(2 () ()))))) (test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(0 1 2)) vec) (equalp vec #(0 1 2))))) (test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(0 1 2) #(1 2 3)) vec) (equalp vec #(1 3 5))))) (test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(0 1 2) '(1 2 3) #(2 3 4)) vec) (equalp vec #(3 6 9))))) (test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(1 2) #(1 2 3)) vec) (equalp vec #(2 4 ()))))) (test-t (let ((vec (make-sequence 'vector 1 :initial-element nil))) (and (eq (map-into vec + '(1 2) #(1 2 3)) vec) (equalp vec #(2))))) (test-t (let ((vec (make-sequence 'vector 3 :initial-element nil))) (and (eq (map-into vec + '(1 2 3 4) #(1 2 3) '(0)) vec) (equalp vec #(2 () ()))))) (test-t (null (cl-reverse nil))) (test-t (string= (cl-reverse "") "")) (test-t (equalp (cl-reverse #()) #())) (test-t (equal (cl-reverse '(0 1 2 3)) '(3 2 1 0))) (test-t (string= (cl-reverse "0123") "3210")) (test-t (equalp (cl-reverse #(a b c d)) #(d c b a))) (test-t (null (nreverse nil))) (test-t (string= (nreverse (copy "")) "")) (test-t (equalp (nreverse (copy #())) #())) (test-t (equal (nreverse (list 0 1 2 3)) '(3 2 1 0))) (test-t (string= (nreverse (copy "0123")) "3210")) (test-t (equalp (cl-reverse (copy #(a b c d))) #(d c b a))) (test-t (char= (find #\d "edcba" :test char>) #\c)) (test-t (eql (find-if oddp '(1 2 3 4 5) :end 3 :from-end t) 3)) (test-t (eq (find 'a '(a b c)) 'a)) (test-t (eq (find 'b '(a b c)) 'b)) (test-t (eq (find 'c '(a b c)) 'c)) (test-t (null (find 'x '(a b c)))) (test-t (null (find 'a '(a b c) :start 1))) (test-t (null (find 'b '(a b c) :start 2))) (test-t (null (find 'c '(a b c) :start 3))) (test-t (null (find 'a '(a b c) :start 0 :end 0))) (test-t (null (find 'a '(a b c) :start 0 :end 0 :from-end t))) (test-t (null (find 'a '(a b c) :start 1 :end 1))) (test-t (null (find 'a '(a b c) :start 1 :end 1 :from-end t))) (test-t (null (find 'a '(a b c) :start 2 :end 2))) (test-t (null (find 'a '(a b c) :start 2 :end 2 :from-end t))) (test-t (null (find 'a '(a b c) :start 3 :end 3))) (test-t (null (find 'a '(a b c) :start 3 :end 3 :from-end t))) (test-t (eq (find 'a '(a b c) :end nil) 'a)) (test-t (eq (find 'b '(a b c) :end nil) 'b)) (test-t (eq (find 'c '(a b c) :end nil) 'c)) (test-t (eq (find 'a '(a b c) :end 1) 'a)) (test-t (eq (find 'b '(a b c) :end 2) 'b)) (test-t (eq (find 'c '(a b c) :end 3) 'c)) (test-t (null (find 'a '(a b c) :end 0))) (test-t (null (find 'b '(a b c) :end 1))) (test-t (null (find 'c '(a b c) :end 2))) (test-t (null (find 'a '((a) (b) (c))))) (test-t (equal (find 'a '((a) (b) (c)) :key car) '(a))) (test-t (equal (find 'b '((a) (b) (c)) :key car) '(b))) (test-t (equal (find 'c '((a) (b) (c)) :key car) '(c))) (test-t (null (find 'z '((a) (b) (c)) :key car))) (test-t (let ((list '((a) (b) (c)))) (and (eq (find 'a list :key car) (car list)) (eq (find 'b list :key car) (cadr list)) (eq (find 'c list :key car) (caddr list)) (null (find 'z list :key car))))) (test-t (null (find '(a) '((a) (b) (c))))) (test-t (equal (find '(a) '((a) (b) (c)) :test equal) '(a))) (test-t (null (find '("a") '(("a") ("b") ("c"))))) (test-t (null (find '("a") '(("A") ("B") ("c")) :test equal))) (test-t (eql (find 3 '(0 1 2 3 4 5)) 3)) (test-t (eql (find 3 '(0 1 2 3 4 5) :test <) 4)) (test-t (eql (find 3 '(0 1 2 3 4 5) :test >) 0)) (test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c)) :key car) '(a))) (test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a))) (test-t (equal (find 'b '((a) (b) (c) (a a) (b b) (c c)) :key car) '(b))) (test-t (equal (find 'b '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b))) (test-t (equal (find 'c '((a) (b) (c) (a a) (b b) (c c)) :key car) '(c))) (test-t (equal (find 'c '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c))) (test-t (null (find 'z '((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (find 'z '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a))) (test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a))) (test-t (equal (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a))) (test-t (null (find 'a '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (null (find #\c '("abc" "bcd" "cde")))) (test-t (string= (find #\c '("abc" "bcd" "cde") :key (lambda (arg) (char arg 0)) :test char=) "cde")) (test-t (eq (find 'a #(a b c)) 'a)) (test-t (eq (find 'b #(a b c)) 'b)) (test-t (eq (find 'c #(a b c)) 'c)) (test-t (null (find 'x #(a b c)))) (test-t (null (find 'a #(a b c) :start 1))) (test-t (null (find 'b #(a b c) :start 2))) (test-t (null (find 'c #(a b c) :start 3))) (test-t (null (find 'a #(a b c) :start 0 :end 0))) (test-t (null (find 'a #(a b c) :start 0 :end 0 :from-end t))) (test-t (null (find 'a #(a b c) :start 1 :end 1))) (test-t (null (find 'a #(a b c) :start 1 :end 1 :from-end t))) (test-t (null (find 'a #(a b c) :start 2 :end 2))) (test-t (null (find 'a #(a b c) :start 2 :end 2 :from-end t))) (test-t (null (find 'a #(a b c) :start 3 :end 3))) (test-t (null (find 'a #(a b c) :start 3 :end 3 :from-end t))) (test-t (eq (find 'a #(a b c) :end nil) 'a)) (test-t (eq (find 'b #(a b c) :end nil) 'b)) (test-t (eq (find 'c #(a b c) :end nil) 'c)) (test-t (eq (find 'a #(a b c) :end 1) 'a)) (test-t (eq (find 'b #(a b c) :end 2) 'b)) (test-t (eq (find 'c #(a b c) :end 3) 'c)) (test-t (null (find 'a #(a b c) :end 0))) (test-t (null (find 'b #(a b c) :end 1))) (test-t (null (find 'c #(a b c) :end 2))) (test-t (null (find 'a #((a) (b) (c))))) (test-t (equal (find 'a #((a) (b) (c)) :key car) '(a))) (test-t (equal (find 'b #((a) (b) (c)) :key car) '(b))) (test-t (equal (find 'c #((a) (b) (c)) :key car) '(c))) (test-t (null (find 'z #((a) (b) (c)) :key car))) (test-t (let ((vector #((a) (b) (c)))) (and (eq (find 'a vector :key car) (aref vector 0)) (eq (find 'b vector :key car) (aref vector 1)) (eq (find 'c vector :key car) (aref vector 2)) (null (find 'z vector :key car))))) (test-t (null (find '(a) #((a) (b) (c))))) (test-t (equal (find '(a) #((a) (b) (c)) :test equal) '(a))) (test-t (null (find '("a") #(("a") ("b") ("c"))))) (test-t (null (find '("a") #(("A") ("B") ("c")) :test equal))) (test-t (eql (find 3 #(0 1 2 3 4 5)) 3)) (test-t (eql (find 3 #(0 1 2 3 4 5) :test <) 4)) (test-t (eql (find 3 #(0 1 2 3 4 5) :test >) 0)) (test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c)) :key car) '(a))) (test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a))) (test-t (equal (find 'b #((a) (b) (c) (a a) (b b) (c c)) :key car) '(b))) (test-t (equal (find 'b #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b))) (test-t (equal (find 'c #((a) (b) (c) (a a) (b b) (c c)) :key car) '(c))) (test-t (equal (find 'c #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c))) (test-t (null (find 'z #((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (find 'z #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a))) (test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a))) (test-t (equal (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a))) (test-t (null (find 'a #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (null (find #\c #("abc" "bcd" "cde")))) (test-t (null (find #\z "abcABC"))) (test-t (eql (find #\a "abcABC") #\a)) (test-t (eql (find #\A "abcABC") #\A)) (test-t (eql (find #\A "abcABC" :test char-equal) #\a)) (test-t (eql (find #\A "abcABC" :test char-equal :from-end t) #\A)) (test-t (eql (find #\a "abcABC" :test char-equal :from-end t) #\A)) (test-t (eql (find #\a "abcABC" :test char-equal :from-end t :end 4) #\A)) (test-t (eql (find #\a "abcABC" :test char-equal :from-end t :end 3) #\a)) (test-t (eq (find-if (lambda (x) (eq x 'a)) '(a b c)) 'a)) (test-t (eq (find-if (lambda (x) (eq x 'b)) '(a b c)) 'b)) (test-t (eq (find-if (lambda (x) (eq x 'c)) '(a b c)) 'c)) (test-t (null (find-if (lambda (arg) (eq arg 'x)) '(a b c)))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 1))) (test-t (null (find-if (lambda (x) (eq x 'b)) '(a b c) :start 2))) (test-t (null (find-if (lambda (x) (eq x 'c)) '(a b c) :start 3))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 0 :end 0 :from-end t))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 1 :end 1 :from-end t))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 2 :end 2 :from-end t))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3))) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :start 3 :end 3 :from-end t))) (test-t (eq (find-if (lambda (x) (eq x 'a)) '(a b c) :end nil) 'a)) (test-t (eq (find-if (lambda (x) (eq x 'b)) '(a b c) :end nil) 'b)) (test-t (eq (find-if (lambda (x) (eq x 'c)) '(a b c) :end nil) 'c)) (test-t (eq (find-if (lambda (x) (eq x 'a)) '(a b c) :end 1) 'a)) (test-t (eq (find-if (lambda (x) (eq x 'b)) '(a b c) :end 2) 'b)) (test-t (eq (find-if (lambda (x) (eq x 'c)) '(a b c) :end 3) 'c)) (test-t (null (find-if (lambda (x) (eq x 'a)) '(a b c) :end 0))) (test-t (null (find-if (lambda (x) (eq x 'b)) '(a b c) :end 1))) (test-t (null (find-if (lambda (x) (eq x 'c)) '(a b c) :end 2))) (test-t (null (find-if (lambda (x) (eq x 'a)) '((a) (b) (c))))) (test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c)) :key car) '(a))) (test-t (equal (find-if (lambda (x) (eq x 'b)) '((a) (b) (c)) :key car) '(b))) (test-t (equal (find-if (lambda (x) (eq x 'c)) '((a) (b) (c)) :key car) '(c))) (test-t (null (find-if (lambda (x) (eq x 'z)) '((a) (b) (c)) :key car))) (test-t (let ((list '((a) (b) (c)))) (and (eq (find-if (lambda (x) (eq x 'a)) list :key car) (car list)) (eq (find-if (lambda (x) (eq x 'b)) list :key car) (cadr list)) (eq (find-if (lambda (x) (eq x 'c)) list :key car) (caddr list)) (null (find-if (lambda (x) (eq x 'z)) list :key car))))) (test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(a))) (test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a))) (test-t (equal (find-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(b))) (test-t (equal (find-if (lambda (x) (eq x 'b)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b))) (test-t (equal (find-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car) '(c))) (test-t (equal (find-if (lambda (x) (eq x 'c)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c))) (test-t (null (find-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (find-if (lambda (x) (eq x 'z)) '((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a))) (test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a))) (test-t (equal (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a))) (test-t (null (find-if (lambda (x) (eq x 'a)) '((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (eq (find-if (lambda (x) (eq x 'a)) #(a b c)) 'a)) (test-t (eq (find-if (lambda (x) (eq x 'b)) #(a b c)) 'b)) (test-t (eq (find-if (lambda (x) (eq x 'c)) #(a b c)) 'c)) (test-t (null (find-if (lambda (arg) (eq arg 'x)) #(a b c)))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 1))) (test-t (null (find-if (lambda (x) (eq x 'b)) #(a b c) :start 2))) (test-t (null (find-if (lambda (x) (eq x 'c)) #(a b c) :start 3))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 0 :end 0 :from-end t))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 1 :end 1 :from-end t))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 2 :end 2 :from-end t))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3))) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :start 3 :end 3 :from-end t))) (test-t (eq (find-if (lambda (x) (eq x 'a)) #(a b c) :end nil) 'a)) (test-t (eq (find-if (lambda (x) (eq x 'b)) #(a b c) :end nil) 'b)) (test-t (eq (find-if (lambda (x) (eq x 'c)) #(a b c) :end nil) 'c)) (test-t (eq (find-if (lambda (x) (eq x 'a)) #(a b c) :end 1) 'a)) (test-t (eq (find-if (lambda (x) (eq x 'b)) #(a b c) :end 2) 'b)) (test-t (eq (find-if (lambda (x) (eq x 'c)) #(a b c) :end 3) 'c)) (test-t (null (find-if (lambda (x) (eq x 'a)) #(a b c) :end 0))) (test-t (null (find-if (lambda (x) (eq x 'b)) #(a b c) :end 1))) (test-t (null (find-if (lambda (x) (eq x 'c)) #(a b c) :end 2))) (test-t (null (find-if (lambda (x) (eq x 'a)) #((a) (b) (c))))) (test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c)) :key car) '(a))) (test-t (equal (find-if (lambda (x) (eq x 'b)) #((a) (b) (c)) :key car) '(b))) (test-t (equal (find-if (lambda (x) (eq x 'c)) #((a) (b) (c)) :key car) '(c))) (test-t (null (find-if (lambda (x) (eq x 'z)) #((a) (b) (c)) :key car))) (test-t (let ((vector #((a) (b) (c)))) (and (eq (find-if (lambda (x) (eq x 'a)) vector :key car) (aref vector 0)) (eq (find-if (lambda (x) (eq x 'b)) vector :key car) (aref vector 1)) (eq (find-if (lambda (x) (eq x 'c)) vector :key car) (aref vector 2)) (null (find-if (lambda (x) (eq x 'z)) vector :key car))))) (test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(a))) (test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(a a))) (test-t (equal (find-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(b))) (test-t (equal (find-if (lambda (x) (eq x 'b)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(b b))) (test-t (equal (find-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car) '(c))) (test-t (equal (find-if (lambda (x) (eq x 'c)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t) '(c c))) (test-t (null (find-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car))) (test-t (null (find-if (lambda (x) (eq x 'z)) #((a) (b) (c) (a a) (b b) (c c)) :key car :from-end t))) (test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t) '(a a a))) (test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end nil) '(a a a))) (test-t (equal (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :end 6) '(a a))) (test-t (null (find-if (lambda (x) (eq x 'a)) #((a) (b) (c) (a a) (b b) (c c) (a a a)) :key car :from-end t :start 1 :end 3))) (test-t (let ((lst (copy "012345678"))) (and (equal (replace lst lst :start1 2 :start2 0) "010123456") (equal lst "010123456")))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z)))) (and (eq list0 list) (equal list0 '(x y z d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1))) (and (eq list0 list) (equal list0 '(a x y z e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :end1 nil))) (and (eq list0 list) (equal list0 '(a x y z e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :start2 1))) (and (eq list0 list) (equal list0 '(a y z d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :start2 1 :end2 nil))) (and (eq list0 list) (equal list0 '(a y z d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :end1 nil :start2 1 :end2 nil))) (and (eq list0 list) (equal list0 '(a y z d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :end1 2 :start2 1))) (and (eq list0 list) (equal list0 '(a y c d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 1 :end1 1))) (and (eq list0 list) (equal list0 '(a b c d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 2 :end1 2))) (and (eq list0 list) (equal list0 '(a b c d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 3 :end1 3))) (and (eq list0 list) (equal list0 '(a b c d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 4 :end1 4))) (and (eq list0 list) (equal list0 '(a b c d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 '(x y z) :start1 5 :end1 5))) (and (eq list0 list) (equal list0 '(a b c d e))))) (test-t (null (replace nil nil))) (test-t (null (replace nil '(a b c)))) (test-t (let* ((list0 (list 'a 'b 'c)) (list (replace list0 ()))) (and (eq list0 list) (equal list0 '(a b c))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0))) (and (eq list0 list) (equal list0 '(a b c d e))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0 :start1 3))) (and (eq list0 list) (equal list0 '(a b c a b))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0 :start1 1))) (and (eq list0 list) (equal list0 '(a a b c d))))) (test-t (let* ((list0 (list 'a 'b 'c 'd 'e)) (list (replace list0 list0 :start1 1 :end1 3))) (and (eq list0 list) (equal list0 '(a a b d e))))) (test-t (let* ((list0 (list 'a 'b 'c)) (list (replace list0 '(x y z)))) (and (eq list0 list) (equal list0 '(x y z))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z)))) (and (eq vector0 vector) (equalp vector0 #(x y z d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1))) (and (eq vector0 vector) (equalp vector0 #(a x y z e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :end1 nil))) (and (eq vector0 vector) (equalp vector0 #(a x y z e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :start2 1))) (and (eq vector0 vector) (equalp vector0 #(a y z d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :start2 1 :end2 nil))) (and (eq vector0 vector) (equalp vector0 #(a y z d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :end1 nil :start2 1 :end2 nil))) (and (eq vector0 vector) (equalp vector0 #(a y z d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :end1 2 :start2 1))) (and (eq vector0 vector) (equalp vector0 #(a y c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 1 :end1 1))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 2 :end1 2))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 3 :end1 3))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 4 :end1 4))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 '(x y z) :start1 5 :end1 5))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (null (replace nil #()))) (test-t (null (replace nil #(a b c)))) (test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 ()))) (and (eq vector0 vector) (equalp vector0 #(a b c))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 3))) (and (eq vector0 vector) (equalp vector0 #(a b c a b))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 1))) (and (eq vector0 vector) (equalp vector0 #(a a b c d))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 vector0 :start1 1 :end1 3))) (and (eq vector0 vector) (equalp vector0 #(a a b d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 '(x y z)))) (and (eq vector0 vector) (equalp vector0 #(x y z))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z)))) (and (eq vector0 vector) (equalp vector0 #(x y z d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1))) (and (eq vector0 vector) (equalp vector0 #(a x y z e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :end1 nil))) (and (eq vector0 vector) (equalp vector0 #(a x y z e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :start2 1))) (and (eq vector0 vector) (equalp vector0 #(a y z d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :start2 1 :end2 nil))) (and (eq vector0 vector) (equalp vector0 #(a y z d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :end1 nil :start2 1 :end2 nil))) (and (eq vector0 vector) (equalp vector0 #(a y z d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :end1 2 :start2 1))) (and (eq vector0 vector) (equalp vector0 #(a y c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 1 :end1 1))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 2 :end1 2))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 3 :end1 3))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 4 :end1 4))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c 'd 'e)) (vector (replace vector0 #(x y z) :start1 5 :end1 5))) (and (eq vector0 vector) (equalp vector0 #(a b c d e))))) (test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 #()))) (and (eq vector0 vector) (equalp vector0 #(a b c))))) (test-t (let* ((vector0 (vector 'a 'b 'c)) (vector (replace vector0 #(x y z)))) (and (eq vector0 vector) (equalp vector0 #(x y z))))) (test-t (let* ((str0 (copy "abc")) (str (replace str0 "xyz"))) (and (eq str0 str) (equalp str0 "xyz")))) (test-t (let* ((str0 (copy "")) (str (replace str0 ""))) (and (eq str0 str) (equalp str0 "")))) (test-t (let* ((str0 (copy "")) (str (replace str0 "xyz"))) (and (eq str0 str) (equalp str0 "")))) (test-t (let* ((str0 (copy "abc")) (str (replace str0 ""))) (and (eq str0 str) (equalp str0 "abc")))) (test-t (let* ((str0 (copy "abcdef")) (str (replace str0 "xyz" :start1 3))) (and (eq str0 str) (equalp str0 "abcxyz")))) (test-t (let* ((str0 (copy "abcdef")) (str (replace str0 "xyz" :start1 4 :start2 1))) (and (eq str0 str) (equalp str0 "abcdyz")))) (test-t (let* ((str0 (copy "abcdef")) (str (replace str0 "xyz" :start1 1 :end1 2 :start2 1))) (and (eq str0 str) (equalp str0 "aycdef")))) (test-t (let* ((str0 (copy "abcdef")) (str (replace str0 "xyz" :start1 1 :start2 1 :end2 2))) (and (eq str0 str) (equalp str0 "aycdef")))) (test-t (let* ((str0 (copy "abcdef")) (str (replace str0 str0 :start1 1))) (and (eq str0 str) (equalp str0 "aabcde")))) (test-t (string= (concatenate 'string "all" " " "together" " " "now") "all together now")) (test-t (equal (concatenate 'list () '(a b c) '(x y z)) '(a b c x y z))) (test-t (equal (concatenate 'list '(a) #(b) '(c) #(x y) '(z)) '(a b c x y z))) (test-t (null (concatenate 'list))) (test-t (let* ((list0 '(a b c)) (list (concatenate 'list list0))) (and (not (eq list0 list)) (equal list list0) (equal list '(a b c))))) (test-t (equalp (concatenate 'vector () '(a b c) '(x y z)) #(a b c x y z))) (test-t (equalp (concatenate 'vector '(a) #(b) '(c) #(x y) '(z)) #(a b c x y z))) (test-t (equalp (concatenate 'vector) #())) (test-t (let* ((vector0 #(a b c)) (vector (concatenate 'vector vector0))) (and (not (eq vector0 vector)) (equalp vector vector0) (equalp vector #(a b c))))) (test-t (string= (concatenate 'string "abc" "def" "ghi" "jkl" "mno" "pqr") "abcdefghijklmnopqr")) (test-t (string= (concatenate 'string "" "abc" "" "def" "" "ghi" "" "" "jkl" "" "mno" "" "pqr" "" "") "abcdefghijklmnopqr")) (test-t (string= (concatenate 'string) "")) (test-t (string= (concatenate 'string "abc" '(#\d #\e #\f #\g) #(#\h #\i #\j #\k #\l)) "abcdefghijkl")) ;; ;; ----------------------------------- end sacla --------------------------------------------- ;; (let ((boole-n-vector (vector boole-clr boole-and boole-andc1 boole-2 boole-andc2 boole-1 boole-xor boole-ior boole-nor boole-eqv boole-c1 boole-orc1 boole-c2 boole-orc2 boole-nand boole-set))) (do ((n 0 (+ n 1))) ((= n 16)) (if (not (= n (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111))) (format #t "~A: ~A ~A~%" n (boole-n-vector n) (logand (boole (boole-n-vector n) #b0101 #b0011) #b1111)))) (let ((lst ())) (do ((n #b0000 (+ n 1))) ((> n #b1111)) (set! lst (cons (boole (boole-n-vector n) 5 3) lst))) (if (not (equal? (reverse lst) (list 0 1 2 3 4 5 6 7 -8 -7 -6 -5 -4 -3 -2 -1))) (format #t ";boole: ~A~%" (reverse lst))))) (test (digit-char-p #\a) #f) (test (digit-char-p #\a 16) 10) (test (let ((v (vector 1 2 3 4 5))) (cl-fill v 32 :start 2 :end 3)) #(1 2 32 4 5)) (test (let ((v (vector 1 2 3 4 5))) (cl-fill v 32 :start 2)) #(1 2 32 32 32)) (test (let ((v (vector 1 2 3))) (cl-fill v 32)) #(32 32 32)) (test (let ((lst (list 1 2 3))) (cl-fill lst "hi")) '("hi" "hi" "hi")) (test (some zero? '(1 2 3)) #f) (test (some zero? '(1 0 3)) #t) (test (some (lambda args (apply > args)) #(1 2 3) #(2 3 4)) #f) (test (some (lambda args (apply > args)) #(1 2 3) #(2 3 1)) #t) (test (some (lambda (a) (and (positive? a) a)) '(0 -3 1 2)) 1) (test (notany zero? '(1 2 3)) #t) (test (notany zero? '(1 0 3)) #f) (test (notany (lambda args (apply > args)) #(1 2 3) #(2 3 4)) #t) (test (notany (lambda args (apply > args)) #(1 2 3) #(2 3 1)) #f) (test (notany (lambda (a) (and (positive? a) a)) '(0 -3 1 2)) #f) (test (every zero? '(1 2 3)) #f) (test (every zero? '(0 0)) #t) (test (every (lambda args (apply < args)) #(1 2 3) #(2 3 4)) #t) (test (every (lambda args (apply < args)) #(1 2 3) #(2 3 1)) #f) (test (notevery zero? '(1 2 3)) #t) (test (notevery zero? '(0 0)) #f) (test (notevery (lambda args (apply < args)) #(1 2 3) #(2 3 4)) #f) (test (notevery (lambda args (apply < args)) #(1 2 3) #(2 3 1)) #t) (test ((complement >) 1 2 3) #t) (test (cl-abs -1) 1) (test (cl-abs 1.0) 1.0) (test (cl-abs 1+i) (magnitude 1+i)) (test (signum 3) 1) (test (signum 0) 0) (test (signum -3) -1) (test (signum 3.0) 1.0) (test (isqrt 12) 3) (test (1+ 1) 2) (test (1- 1) 0) (test (/= 0 0) #f) (test (/= 1 2 3) #t) (test (/= 3 45 3) #f) (test (zerop 0) #t) (test (zerop 1) #f) (test (minusp -1) #t) (test (minusp 1) #f) (test (plusp 1) #t) (test (plusp -1) #f) (test (oddp 3) #t) (test (oddp 4) #f) (test (evenp 3) #f) (test (evenp 4) #t) (test (conjugate 1+i) 1-i) (test (conjugate 3.7) 3.7) (test (ldb (byte 8 8) #x123) 1) (test (ldb (byte 8 0) #x123) #x23) (test (ldb (byte 4 4) #x123) 2) (test (ldb (byte 1 4) #x123) 0) (test (ldb (byte 1 5) #x123) 1) (test (ldb (byte 16 16) -1) 65535) (test (ldb (byte 12 18) #x12345678) 1165) (test (dpb 1 (byte 8 0) #x100) #x101) (test (dpb #x22 (byte 8 1) #x100) #x44) ;! (test (dpb #x22 (byte 8 8) #x100) #x2200) ; not #x2300 (test (dpb #x1001 (byte 16 0) -1) -61439) (test (dpb #x1 (byte 8 8) #xffffff) #xff01ff) (test (dpb #x1 (byte 8 16) #xffffff) #x1ffff) (test (dpb #x1 (byte 8 16) #xffffffff) #xff01ffff) (test (dpb -1 (byte 8 0) 0) 255) (test (dpb -1 (byte 8 2) 0) 1020) (test (dpb 0 (byte 16 16) #xffffffff) 65535) (test (mask-field (byte 8 8) #xfffffff) #xff00) (test (mask-field (byte 1 8) #xfffffff) #x100) (test (ldb-test (byte 1 8) #xfffffff) #t) (test (ldb-test (byte 1 8) #x10ff) #f) (test (deposit-field #xabcdef (byte 8 8) 0) #xcd00) (test (deposit-field #xabcdef (byte 8 4) 0) #xde0) (test (deposit-field #xabcdef (byte 8 8) #xffffffff) #xffffcdff) (test (identity 1) 1) (test (stringp "hi") #t) (test (stringp #\h) #f) (test (characterp #\a) #t) (test (characterp "a") #f) (test (realp 1) #t) (test (realp 3.14) #t) (test (realp 1.0+i) #f) (test (complexp 1) #f) (test (complexp 1.0+i) #t) (test (floatp 1) #f) (test (floatp 3.14) #t) (test (rationalp 1) #t) (test (rationalp 1.12) #f) (test (rationalp 3/4) #t) (test (rationalp "hiho") #f) (test (integerp "hiho") #f) (test (integerp 3.14) #f) (test (integerp 3) #t) (test (numberp 3) #t) (test (numberp "hiho") #f) (test (consp ()) #f) (test (consp '(1 2)) #t) (test (consp 3) #f) (test (atom 3) #t) (test (atom ()) #t) (test (atom '(1 2 3)) #f) (test (vectorp #(1 2 3)) #t) (test (vectorp "hiho") #f) (test (symbolp 'hi) #t) (test (symbolp "hiho") #f) (test (last '(1 2 3)) '(3)) (test (last ()) ()) (test (tree-equal () ()) #t) (test (tree-equal (list 1 2 (list 3 5) 5) (list 1 2 (list 3 4) 5)) #f) (test (tree-equal (list 1 2 (list 3 4) 5) (list 1 2 (list 3 4) 5)) #t) (test (nthcdr 0 '(1 2 3)) '(1 2 3)) (test (nthcdr 2 '(1 2 3)) '(3)) (test (nthcdr 4 '(1 2 3)) ()) (test (listp ()) #t) (test (listp 3) #f) (test (listp '(1 . 2)) #t) (test (listp (list 1 2)) #t) (test (null ()) #t) (test (null '(1 2 3)) #f) (test (butlast '(1 2 3 4)) '(1 2 3)) (test (butlast '((1 2) (3 4))) '((1 2))) (test (butlast '(1)) ()) (test (butlast ()) ()) (test (copy-list ()) ()) (test (copy-list '(1 2 3)) '(1 2 3)) (test (copy-tree '(1 (2 3) 4)) '(1 (2 3) 4)) (test (rest '(1 2 3)) '(2 3)) (test (let ((i1 1) (i2 2)) (setf i1 3) (list i1 i2)) (list 3 2)) (test (let ((i1 1) (i2 2)) (setf i1 123 i2 32) (list i1 i2)) (list 123 32)) (test (let ((hi (vector 1 2 3))) (setf (hi 0) (+ 1 2) (hi 2) (* 2 3)) hi) (vector 3 2 6)) (test (let ((val 0)) (progn (+ val 1))) 1) (test (let ((val 0)) (prog1 (+ val 1) (+ val 2))) 1) (test (let ((val 0)) (prog2 (+ val 1) (+ val 2) (+ val 3))) 2) (test (let ((lst (list 1))) (push 2 lst)) (list 2 1)) (test (let ((lst (list 1 2 3))) (list (pop lst) lst)) (list 1 (list 2 3))) (test (let ((x 0)) (incf x) x) 1) (test (let ((x 0)) (incf x 2) x) 2) (test (let ((x 0)) (decf x) x) -1) (test (let ((x 0)) (decf x 2) x) -2) (test (let ((lst (list 1 2))) (pushnew 1 lst)) (list 1 2)) (test (let ((lst (list 1 2))) (pushnew 3 lst)) (list 3 1 2)) (test (let ((a 1) (b 2)) (psetq a b b a) (list a b)) '(2 1)) (test (let ((a 1) (b 2) (c 3)) (psetq a (+ b c) b (+ a c) c (+ a b)) (list a b c)) '(5 4 3)) (test (let ((val #f)) (unless val 1)) 1) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (first val)) 1) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (second val)) 2) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (third val)) 3) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (fourth val)) 4) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (fifth val)) 5) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (sixth val)) 6) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (seventh val)) 7) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (eighth val)) 8) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (ninth val)) 9) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (tenth val)) 10) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 7 val)) 8) (test (let ((val (list 1 2 3 4 5 6 7 8 9 10))) (nth 17 val)) ()) (test (let () (enum one two three) (list one two three)) '(0 1 2)) (test (let () (defstruct x1 a b c) (let ((xx1 (make-x1 1 2 3))) (list (x1-a xx1) (x1-b xx1) (x1-c xx1) (x1? xx1)))) '(1 2 3 #t)) (test (let () (defstruct x1 a (b "hi") (c 3/4)) (let ((xx1 (make-x1 1))) (list (x1-a xx1) (x1-b xx1) (x1-c xx1) (x1? xx1)))) '(1 "hi" 3/4 #t)) (test (let () (defstruct x1 a (b "hi") (c 3/4)) (let ((xx1 (make-x1 :b 1))) (list (x1-a xx1) (x1-b xx1) (x1-c xx1) (x1? xx1)))) '(#f 1 3/4 #t)) (test (let () (defstruct x1 a b c) (let ((xx1 (make-x1 1 2 3))) (set! (x1-a xx1) 32) (list (x1-a xx1) (x1-b xx1) (x1-c xx1)))) '(32 2 3)) (let () (defstruct ship (x 0.0) (y 0.0 :type 'real)) (test (let ((s1 (make-ship 1.0 2.0))) (let ((s2 (copy-ship s1))) (list (ship-x s2) (ship-y s2)))) '(1.0 2.0)) (test (let ((s3 (make-ship :y 1.0 :x 2.0))) (list (ship-x s3) (ship-y s3))) '(2.0 1.0))) (let() (defstruct ship1 x y) (let ((s1 (make-ship1 "hi" (list 1 2 3)))) (let ((s2 (copy-ship1 s1))) (test (list (ship1-x s2) (ship1-y s2)) '("hi" (1 2 3)))))) (let () (defstruct ship2 (x 0.0) (y 1.0 :read-only #t)) (let ((s1 (make-ship2))) (test (let ((tag (catch #t (lambda () (set! (ship2-y s1) 123.0)) (lambda args (car args))))) tag) 'no-setter) (set! (ship2-x s1) 123.0) (test (ship2-x s1) 123.0))) (let () (defstruct (ship3 (:conc-name hi)) (x 0.0) (y 1.0 :read-only #t)) (let ((s1 (make-ship3 :x 3.0))) (test (list (hi-x s1) (hi-y s1)) '(3.0 1.0)))) (let () (defstruct (ship4 (:constructor new-ship)) (x 0.0) (y 1.0 :read-only #t)) (let ((s1 (new-ship 1.0 2.0))) (test (list (ship4-x s1) (ship4-y s1)) '(1.0 2.0)))) ) ) ; end CL (if (not (eq? else 'else)) (set! else 'else)) ; loop sets else! ;;; -------------------------------------------------------------------------------- ;;; NUMBERS ;;; -------------------------------------------------------------------------------- (test (let () (set! most-positive-fixnum 2)) 'error) (test (let ((most-positive-fixnum 2)) most-positive-fixnum) 'error) (test (let () (set! most-negative-fixnum 2)) 'error) (test (let ((most-negative-fixnum 2)) most-negative-fixnum) 'error) (test (let () (set! pi 2)) 'error) (test (let ((pi 2)) pi) 'error) (if (not (nan? +nan.0)) (format #t ";(string->number \"+nan.0\") returned ~A~%" +nan.0)) (if (infinite? +nan.0) (format #t ";+nan.0 is infinite?~%")) (if (not (infinite? +inf.0)) (format #t ";(string->number \"+inf.0\") returned ~A~%" +inf.0)) (if (nan? +inf.0) (format #t ";+inf.0 is NaN?~%")) (if (not (infinite? -inf.0)) (format #t ";(string->number \"-inf.0\") returned ~A~%" -inf.0)) (if (nan? -inf.0) (format #t ";-inf.0 is NaN?~%")) (define-constant inf+infi (complex +inf.0 +inf.0)) (define-constant nan+nani (complex +nan.0 +nan.0)) (define-constant 0+infi (complex 0 +inf.0)) (define-constant 0+nani (complex 0 +nan.0)) (test (equal? +inf.0 +inf.0) #t) (test (equal? +inf.0 -inf.0) #f) (test (equal? +nan.0 +inf.0) #f) (test (= +nan.0 +nan.0) #f) (test (equal? +inf.0 +nan.0) #f) ; (test (equal? +nan.0 +nan.0) (eqv? +nan.0 +nan.0)) ; these are confusing: (equal? 0/0 0/0) is a different case ;;; -------------------------------------------------------------------------------- ;;; number? ;;; -------------------------------------------------------------------------------- ;;; (synonym for complex?) (test (number? -) #f) (test (number? +) #f) (test (number? 12) #t) (test (number? 3) #t ) (test (number? (expt 2 130)) #t) (test (number? 5/3+7.2i) #t) (test (number? #f) #f) (test (number? (cons 1 2)) #f) (test (number? 2.5-.5i) #t) (test (number? most-negative-fixnum) #t) (test (number? 1e-308) #t) (test (number? 1e308) #t) (test (number? 0+0i) #t) (test (number? (log 0)) #t) (test (number? (real-part (log 0))) #t) (test (number? '-1-i) #t) (test (number? -1.797693134862315699999999999999999999998E308) #t) (test (number? -2.225073858507201399999999999999999999996E-308) #t) (test (number? -9223372036854775808) #t) (test (number? 1.110223024625156799999999999999999999997E-16) #t) (test (number? 9223372036854775807) #t) (test (number? +inf.0) #t) (test (number? -inf.0) #t) (test (number? +nan.0) #t) (test (number? inf+infi) #t) (test (number? nan+nani) #t) (test (number? 0+infi) #t) (test (number? 0+nani) #t) (test (number? pi) #t) (test (number? 0/0) #t) (test (number? 1/-4) 'error) (test (number? '+nan.0) #t) ; i.e. is +nan.0 read as a number so #r(+nan.0) is legal (test (number? '-nan.0) #t) (test (number? '+inf.0) #t) (test (number? '-inf.0) #t) (for-each (lambda (n) (let ((nb (catch #t (lambda () (number? n)) (lambda args 'error)))) (if (not nb) (format #t ";(number? ~A) -> #f?~%" n)))) (list '1e311 '1e-311 '0e311 '2.1e40000)) (when with-bignums (test (number? 1234567891234567890/1234567) #t) (test (number? 9223372036854775808) #t) (test (number? 9223372036854775808.1) #t) (test (number? 9223372036854775808.1+1.5i) #t) (test (number? 9223372036854775808/3) #t)) (test (number?) 'error) (test (number? 1 2) 'error) (for-each (lambda (op opname) (for-each (lambda (arg) (if (op arg) (format #t ";(~A ~A) -> #t?~%" op arg))) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #))) (list number? complex? real? rational? integer? float?) (list 'number? 'complex? 'real? 'rational? 'integer? float?)) ;;; -------------------------------------------------------------------------------- ;;; complex? ;;; -------------------------------------------------------------------------------- (test (complex? 1/2) #t) (test (complex? 2) #t) (test (complex? (sqrt 2)) #t) (test (complex? 1.0) #t) (test (complex? 1+i) #t) (test (complex? most-negative-fixnum) #t) (test (complex? 1/0) #t) ; nan is complex?? I guess so -- it's a "real"... (test (complex? (log 0.0)) #t) (test (complex? 0/0) #t) (test (complex? 1+0/0i) #t) (test (complex? -1.797693134862315699999999999999999999998E308) #t) (test (complex? -2.225073858507201399999999999999999999996E-308) #t) (test (complex? -9223372036854775808) #t) (test (complex? 1.110223024625156799999999999999999999997E-16) #t) (test (complex? 9223372036854775807) #t) (test (complex? 3) #t ) (test (complex? +inf.0) #t) (test (complex? -inf.0) #t) (test (complex? +nan.0) #t) ; this should be #f (test (complex? pi) #t) (for-each (lambda (arg) (if (not (complex? arg)) (format #t ";(complex? ~A) -> #f?~%" arg))) (list 1 1.0 1.0+0.5i 1/2)) (when with-bignums (test (complex? 1234567891234567890/1234567) #t) (test (complex? 9223372036854775808) #t) (test (complex? 9223372036854775808.1) #t) (test (complex? 9223372036854775808.1+1.5i) #t) (test (complex? 0+92233720368547758081.0i) #t) (test (complex? 9223372036854775808/3) #t)) (test (complex?) 'error) (test (complex? 1 2) 'error) ;;; -------------------------------------------------------------------------------- ;;; real? ;;; -------------------------------------------------------------------------------- (test (real? 1) #t) (test (real? most-negative-fixnum) #t) (test (real? 1/2) #t) (test (real? 1.0) #t) (test (real? (+ 1+i 1-i)) #t) (test (real? (- 1+i 1+i)) #t) (test (real? (+ 1+i -1-i)) #t) (test (real? (/ 1+i 1+i)) #t) (test (real? (* 0+i 0+i)) #t) (test (real? (magnitude 1+i)) #t) (test (real? (string->number "1+0i")) #t) (test (real? (complex 1 0)) #t) (test (real? (complex 0 0)) #t) (test (real? (complex 1 0.0)) #t) (test (real? (complex 0.0 -0.0)) #t) (test (real? (make-polar 0 0)) #t) (test (real? (make-polar 1 0)) #t) (test (real? (angle 1+i)) #t) (test (real? (real-part 1+i)) #t) (test (real? (imag-part 1+i)) #t) (test (real? (expt 0+i 0+i)) #t) (test (real? (log 0)) #f) (test (real? (real-part (log 0))) #t) (test (real? +inf.0) #t) (test (real? -inf.0) #t) (test (real? +nan.0) #t) ; see below (test (real? pi) #t) (test (real? 0+i) #f) (test (real? 1.0-0.1i) #f) (test (real? (sqrt 2)) #t) (test (real? 1+i) #f) (test (real? 1e9-0i) #t) (test (real? 0+0i) #t) (test (real? 1.0+0i) #t) (test (real? 1.0+0.0i) #t) (test (real? 1+0.0i) #t) (test (real? 1-0.0i) #t) (test (real? 1+0i) #t) (test (real? -0+1e22i) #f) (test (real? -0+1e-22i) #f) (test (real? 0+1e-322i) #f) (test (real? 1+0/0i) #f) ; bignum direct 1+0/0i -> 1.0 (test (real? 1.0000000000000000000000000000+0.0000000000000000000000000000i) #t) (test (real? 1.0+0.0000000000000000000000000000i) #t) (test (real? 1.0000000000000000000000000000+0.0i) #t) (test (real? 1.0000000000000000000000000000+0e10i) #t) (test (real? 1.0+0.0000000000000000000000000000e10i) #t) (test (real? 1.0000000000000000000000000000+0.0e10i) #t) (test (real? 0+00000000000000000000000000000000/123456789012345678901234567890i) #t) (test (real? -1.797693134862315699999999999999999999998E308) #t) (test (real? -2.225073858507201399999999999999999999996E-308) #t) (test (real? -9223372036854775808) #t) (test (real? 1.110223024625156799999999999999999999997E-16) #t) (test (real? 9223372036854775807) #t) (when with-bignums (test (real? 9.92209574402351949043519108941671096176E-1726-4.788930572030484370393069119625570107346E-1726i) #f) (test (real? 1234567891234567890/1234567) #t) (test (real? 9223372036854775808) #t) (test (real? 9223372036854775808.1) #t) (test (real? 9223372036854775808.1+1.5i) #f) (test (real? 9223372036854775808/3) #t)) (test (real? case) #f) (test (real?) 'error) (test (real? 1 2) 'error) (test (real? (real-part (log 0.0))) #t) ; -inf (test (real? (/ (real-part (log 0.0)) (real-part (log 0.0)))) #t) ; nan -- I think this should be #f ;;; float? (test (float? 1) #f) (test (float? 1/2) #f) (test (float? 1.4) #t) (test (float? 1+i) #f) (test (float?) 'error) (test (float? 1.0 1.0) 'error) (test (float? #\a) #f) (test (float? (real-part (log 0.0))) #t) (test (float? 1/0) #t) (test (float? pi) #t) (test (float? 1e-308) #t) (when with-bignums (test (float? (bignum "1.0")) #t)) ;;; byte? (test (byte? 1) #t) (test (byte? 1/2) #f) (test (byte? 1.4) #f) (test (byte? 1+i) #f) (test (byte?) 'error) (test (byte? 1 1) 'error) (test (byte? #\a) #f) (test (byte? 0) #t) (test (byte? -1) #f) (test (byte? 256) #f) (test (byte? 255) #t) (when with-bignums (test (byte? (bignum "1")) #t)) (for-each (lambda (arg) (if (byte? arg) (format #t ";(byte? ~A) -> #t?~%" arg)) (if (float? arg) (format #t ";(float? ~A) -> #t?~%" arg))) (list "hi" '(1 2) (integer->char 65) 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand #\f (lambda (a) (+ a 1)) :hi (if #f #f) # #)) ;;; -------------------------------------------------------------------------------- ;;; rational? ;;; -------------------------------------------------------------------------------- (test (rational? 3) #t) (test (rational? 1/2) #t) (test (rational? 2) #t) (test (rational? (sqrt 2)) #f) (test (rational? 1.0) #f) (test (rational? 1+i) #f) (test (rational? most-negative-fixnum) #t) (test (rational? 0/0) #f) ; I like this (test (rational? 1/0) #f) (test (rational? (/ 1 2)) #t) (test (rational? (/ 1 2/3)) #t) (test (rational? (/ 2/5 2/3)) #t) (test (rational? (/ 2/5 -3)) #t) (test (rational? (/ -4 4)) #t) (test (rational? (/ 1.0 2)) #f) (test (rational? 1/2+i) #f) (test (rational? -1.797693134862315699999999999999999999998E308) #f) (test (rational? -2.225073858507201399999999999999999999996E-308) #f) (test (rational? -9223372036854775808) #t) (test (rational? 1.110223024625156799999999999999999999997E-16) #f) (test (rational? 9223372036854775807) #t) (test (rational? +inf.0) #f) (test (rational? -inf.0) #f) (test (rational? +nan.0) #f) ; guile says #t! (test (rational? pi) #f) (test (rational? 9223372036854775806/9223372036854775807) #t) (test (rational? 1+0i) #f) ; ?? (test (rational? 1+0.0i) #f) ; ?? see integer? (when with-bignums (test (rational? 1234567891234567890/1234567) #t) (test (rational? 9223372036854775808) #t) (test (rational? 9223372036854775808.1) #f) (test (rational? 9223372036854775808.1+1.5i) #f) (test (rational? 9223372036854775808/3) #t)) (test (rational?) 'error) (test (rational? 1 2) 'error) ;;; -------------------------------------------------------------------------------- ;;; integer? ;;; -------------------------------------------------------------------------------- (test (integer? 0.0) #f) (test (integer? 3) #t) (test (integer? 1/2) #f) (test (integer? 1/1) #t) (test (integer? 2) #t) (test (integer? (sqrt 2)) #f) (test (integer? 1.0) #f) (test (integer? 1+i) #f) (test (integer? most-negative-fixnum) #t) (test (integer? 250076005727/500083) #t) (test (integer? 1+0i) #f) ; hmmm -- guile says #t, but it thinks 1.0 is an integer (test (integer? 0/0) #f) (test (integer? 1/0) #f) (test (integer? (/ 2 1)) #t) (test (integer? (/ 2 1.0)) #f) (test (integer? -1.797693134862315699999999999999999999998E308) #f) (test (integer? -2.225073858507201399999999999999999999996E-308) #f) (test (integer? -9223372036854775808) #t) (test (integer? 1.110223024625156799999999999999999999997E-16) #f) (test (integer? 9223372036854775807) #t) (test (integer? (expt 2.3 54)) #f) (test (integer? 10000000000000000.5) #f) (test (integer? (expt 2 54)) #t) (test (integer? (expt 2.0 54)) #f) (test (integer? most-positive-fixnum) #t) (test (integer? (/ most-positive-fixnum most-positive-fixnum)) #t) (test (integer? +inf.0) #f) (test (integer? -inf.0) #f) (test (integer? +nan.0) #f) (test (integer? pi) #f) (test (integer? 9223372036854775806/9223372036854775807) #f) (test (integer? 1+0.0i) #f) (when with-bignums (test (integer? 1234567891234567890/1234567) #f) (test (integer? 9223372036854775808) #t) (test (integer? 9223372036854775808.1) #f) (test (integer? 9223372036854775808.1+1.5i) #f) (test (integer? 9223372036854775808/3) #f) (test (integer? 9223372036854775808/9223372036854775808) #t) (test (integer? 21345678912345678912345678913456789123456789123456789) #t)) (test (integer?) 'error) (test (integer? 1 2) 'error) ;;; -------------------------------------------------------------------------------- ;;; infinite? ;;; -------------------------------------------------------------------------------- ;;; (define (infinite? x) (and (number? x) (or (= x +inf.0) (= x -inf.0)))) but this misses complex cases ;;; ;;; a number can be both NaN and infinite...: (test (nan? (complex 0/0 (real-part (log 0)))) #t) (test (infinite? (complex 0/0 (real-part (log 0)))) #t) ;;; maybe we should restrict nan? and infinite? to reals? (test (infinite? 0) #f) (test (infinite? 1.0) #f) (test (infinite? 1/2) #f) (test (infinite? 1+i) #f) (test (infinite? most-positive-fixnum) #f) (test (infinite? +inf.0) #t) (test (infinite? -inf.0) #t) (test (infinite? +nan.0) #f) (test (infinite? pi) #f) (test (infinite? (imag-part (sinh (log 0.0)))) #t) (test (infinite? (complex -inf.0 +inf.0)) #t) (test (infinite? (+ (complex 1 +inf.0))) #t) (test (infinite? most-negative-fixnum) #f) (test (infinite? -1.797693134862315699999999999999999999998E308) #f) (test (infinite? -2.225073858507201399999999999999999999996E-308) #f) (test (infinite? (real-part inf+infi)) #t) (test (infinite? (real-part 0+infi)) #f) (test (infinite? (imag-part inf+infi)) #t) (test (infinite? (imag-part 0+infi)) #t) (test (infinite? (imag-part (complex 0.0 (real-part (log 0))))) #t) (test (infinite? (real-part (complex 0.0 (real-part (log 0))))) #f) (test (infinite? (complex 0.0 (real-part (log 0)))) #t) (test (infinite? (real-part (complex (real-part (log 0)) 1.0))) #t) (test (infinite? (imag-part (complex (real-part (log 0)) 1.0))) #f) (test (infinite? (complex (real-part (log 0)) 1.0)) #t) (test (infinite? (imag-part (complex (real-part (log 0)) (real-part (log 0))))) #t) (test (infinite? (real-part (complex (real-part (log 0)) (real-part (log 0))))) #t) (test (infinite? (complex (real-part (log 0)) (real-part (log 0)))) #t) ;; if mpc version > 0.8.2 ;; (test (infinite? (sin 1+1e10i)) #t) ;; this hangs in earlier versions (when with-bignums (test (infinite? (log (bignum "0.0"))) #t) (test (infinite? 1e310) #f) (test (infinite? 1e400) #f) (test (infinite? 1.695681258519314941339000000000000000003E707) #f) (test (infinite? 7151305879464824441563197685/828567267217721441067369971) #f)) (test (infinite?) 'error) (test (infinite? 1 2) 'error) ;;; -------------------------------------------------------------------------------- ;;; nan? ;;; nan ;;; nan-payload ;;; -------------------------------------------------------------------------------- ;;; (define (nan? x) (and (number? x) (not (= x x)))) (test (nan? +inf.0) #f) (test (nan? -inf.0) #f) (test (nan? +nan.0) #t) (test (nan? pi) #f) (test (nan? (imag-part 0+0/0i)) #t) (test (nan? (imag-part (sinh 0+0/0i))) #t) (test (nan? (imag-part (sinh 1-0/0i))) #t) (test (nan? (log 10 0/0)) #t) (test (nan? (* 0 +inf.0)) #t) (test (nan? (real-part nan+nani)) #t) (test (nan? (imag-part nan+nani)) #t) (test (nan? (real-part 0+nani)) #f) (test (nan? (imag-part 0+nani)) #t) (when with-bignums (test (nan? (bignum "1/0")) #t) (test (nan? 7151305879464824441563197685/828567267217721441067369971) #f) (test (nan? 1624540914719833702142058941.4) #f)) (test (nan?) 'error) (test (nan? 1 2) 'error) #| (define digits (vector #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) (do ((i 0 (+ i 1))) ((= i 10000)) (let ((int-digits (random 80)) (frac-digits (random 80)) (exp-digits (+ 1 (random 5))) (signed (> (random 10) 5)) (signed-exponent (> (random 10) 5))) (let ((str (make-string (+ 1 int-digits 1 frac-digits 2 exp-digits) #\space)) (j 0)) (if signed (begin (set! (str j) #\-) (set! j (+ j 1)))) (do ((k 0 (+ k 1))) ((= k int-digits)) (set! (str j) (digits (random 10))) (set! j (+ j 1))) (set! (str j) #\.) (set! j (+ j 1)) (do ((k 0 (+ k 1))) ((= k frac-digits)) (set! (str j) (digits (random 10))) (set! j (+ j 1))) (set! (str j) #\e) (set! j (+ j 1)) (if signed-exponent (begin (set! (str j) #\-) (set! j (+ j 1)))) (do ((k 0 (+ k 1))) ((= k exp-digits)) (if (< k 3) (set! (str j) (digits (random 10))) (set! (str j) (digits (random 4)))) (set! j (+ j 1))) (let ((num (string->number (substring str 0 j)))) (if (or (nan? num) (infinite? num)) (format #t "~A: ~S -> ~A~%" (if (infinite? num) 'inf 'nan) str num))) ))) |# ;;; these all relate to inf/nan (unless with-bignums (test (* 1e12000 1e12000) +inf.0) (test (<= 0 +inf.0 +nan.0) #f) (test (<= 1 +nan.0) #f) (test (<= +nan.0 1) #f) (test (<= +nan.0 +inf.0) #f) (test (<= +nan.0 +nan.0) #f) (test (>= 1 +nan.0) #f) (test (>= +nan.0 1) #f) (test (>= +nan.0 +inf.0) #f) (test (>= +nan.0 +nan.0) #f) (test (floor +inf.0) 'error) (test (inexact->exact (complex 1 +inf.0)) 'error) (test (nan? (expt 0 +nan.0)) #t) (test (nan? (expt 1 +nan.0)) #t) (test (nan? (expt +nan.0 +inf.0)) #t) (test (nan? (expt +nan.0 +nan.0)) #t) (test (rationalize 1e19) 'error) (test (round +inf.0) 'error) (test (truncate +inf.0) 'error)) (num-test (/ -1 -inf.0 -9223372036854775808) 0.0) (num-test (angle -inf.0) pi) (num-test (angle +inf.0) 0.0) (num-test (atan +inf.0) 1.5707963267949) ;; (test (let ((val (atanh +inf.0))) (or (nan? val) (equivalent? val 0+1.5707963267949i))) #t) ; different if g++ (num-test (tanh -inf.0) -1.0) (num-test (tanh +inf.0) 1.0) (test (* -inf.0 +inf.0) -inf.0) (test (* +inf.0) +inf.0) (test (+ 0 +inf.0) +inf.0) (test (+ +inf.0) +inf.0) (test (- -inf.0 +inf.0) -inf.0) (test (- 0 +inf.0) -inf.0) (test (- +inf.0) -inf.0) (test (/ 0 +inf.0) 0.0) (test (/ +inf.0) 0.0) (test (/ +nan.0 0) 'error) (test (< -inf.0 0.0) #t) (test (< -inf.0 +inf.0) #t) (test (< -inf.0 +inf.0) #t) (test (< 0 +inf.0 -inf.0) #f) (test (< 0 +inf.0) #t) (test (< +inf.0 -inf.0) #f) (test (< +nan.0 +inf.0) #f) (test (< +nan.0 +nan.0) #f) (test (<= -inf.0 0.0 +inf.0 +inf.0) #t) (test (<= -inf.0 +inf.0) #t) (test (<= 0 +inf.0 -inf.0) #f) (test (<= 0 +inf.0) #t) (test (= (* (+ +inf.0 +inf.0) -inf.0) -inf.0) #t) (test (= (* -3.4 -inf.0) +inf.0) #t) (test (= (* -inf.0 -inf.0) +inf.0) #t) (test (= (* +inf.0 -inf.0) -inf.0) #t) (test (= (* +inf.0 +inf.0) +inf.0) #t) (test (= (+ 1 +inf.0) +inf.0) #t) (test (= (+ +inf.0 +inf.0) +inf.0) #t) (test (= (- -inf.0) +inf.0) #t) (test (= (- 0.0 +inf.0) -inf.0) #t) (test (= (- +inf.0) -inf.0) #t) (test (= (/ 0.0 +inf.0) 0.0) #t) (test (= (abs -inf.0) +inf.0) #t) (test (= (abs +inf.0) +inf.0) #t) (test (= (exp -inf.0) 0.0) #t) (unless with-bignums (test (= (exp +inf.0) +inf.0) #t) (test (= (exp most-positive-fixnum) +inf.0) #t)) (test (= (exp most-negative-fixnum) 0.0) #t) (test (= (expt -inf.0 0) 1.0) #t) (test (= (expt 0.0 +inf.0) 0.0) #t) (test (= (expt 1 -inf.0) 1.0) #t) (test (= (expt 1 +inf.0) 1.0) #t) (test (= (expt 2 -inf.0) 0.0) #t) (test (= (expt +inf.0 0) 1.0) #t) (test (= (log +inf.0) +inf.0) #t) (test (= (magnitude -inf.0) +inf.0) #t) (test (= (magnitude +inf.0) +inf.0) #t) ;(if (not (provided? 'pure-s7)) (test (= (make-polar +inf.0 0) +inf.0) #t)) (test (= (complex 0 +inf.0) (sqrt -inf.0)) #t) ; (sqrt -inf.0) -> 0+infi ! (test (= (complex +inf.0 0) +inf.0) #t) (test (= (max -inf.0 +inf.0) +inf.0) #t) (test (= (min -inf.0 +inf.0) -inf.0) #t) (test (= (sqrt +inf.0) +inf.0) #t) (test (infinite? (imag-part (sqrt -inf.0))) #t) (test (= -inf.0 -inf.0) #t) (test (= -inf.0 +inf.0) #f) (test (= 0 +inf.0 -inf.0) #f) (test (= 0 +inf.0) #f) (test (= 0.0 +nan.0) #f) (test (= +inf.0 0.0) #f) (test (= +inf.0 +inf.0) #t) (test (= +inf.0 most-positive-fixnum) #f) (test (= +inf.0 +nan.0) #f) (test (= +nan.0 +inf.0) #f) (test (nan? nan+nani) #t) (test (> -inf.0 +inf.0) #f) (test (> 0 +inf.0 -inf.0) #f) (test (> 0 +inf.0) #f) (test (> +inf.0 0.0) #t) (test (> +inf.0 1.0e308) #t) (test (> +inf.0 most-positive-fixnum) #t) (test (> +nan.0 +inf.0) #f) (test (> +nan.0 +nan.0) #f) (test (>= -inf.0 +inf.0) #f) (test (>= 0 +inf.0) #f) (test (>= +inf.0 -inf.0 0.0) #f) (test (abs +inf.0) +inf.0) (test (acosh +inf.0) +inf.0) (test (angle +inf.0) 0.0) (test (ash -inf.0 +inf.0) 'error) (test (ash +nan.0 +inf.0) 'error) (test (ash +nan.0 +nan.0) 'error) (test (asinh +inf.0) +inf.0) (test (ceiling +inf.0) 'error) (test (ceiling +nan.0) 'error) (test (complex? nan+nani) #t) (test (cosh +inf.0) +inf.0) (test (even? +inf.0) 'error) (test (exact? (complex 1 +inf.0)) #f) (test (exp +inf.0) +inf.0) (test (expt +nan.0) 'error) (test (floor +nan.0) 'error) (test (gcd -inf.0 +inf.0) 'error) (test (gcd +nan.0 +inf.0) 'error) (test (gcd +nan.0 +nan.0) 'error) (test (imag-part (complex 1 +inf.0)) +inf.0) (test (imag-part +nan.0) 0.0) (test (inexact? (complex 1 +inf.0)) #t) (test (infinite? 1 2) 'error) (test (lcm -inf.0 +inf.0) 'error) (test (lcm +nan.0 +inf.0) 'error) (test (lcm +nan.0 +nan.0) 'error) (test (lcm +nan.0) 'error) (test (log 8.0 +inf.0) 0.0) (test (log +inf.0) +inf.0) (test (logand -inf.0 +inf.0) 'error) (test (logand +nan.0 +inf.0) 'error) (test (logand +nan.0 +nan.0) 'error) (test (logior -inf.0 +inf.0) 'error) (test (logior +nan.0 +inf.0) 'error) (test (logior +nan.0 +nan.0) 'error) (test (lognot -inf.0) 'error) (test (lognot +nan.0) 'error) (test (logbit? -inf.0 +inf.0) 'error) (test (logbit? +nan.0 +inf.0) 'error) (test (logbit? +nan.0 +nan.0) 'error) (test (logxor -inf.0 +inf.0) 'error) (test (logxor +nan.0 +inf.0) 'error) (test (logxor +nan.0 +nan.0) 'error) (test (magnitude +inf.0) +inf.0) (test (random-state +inf.0) 'error) (test (random-state +nan.0) 'error) (test (max -inf.0 +inf.0) +inf.0) (test (max 0 +inf.0 -inf.0) +inf.0) (test (max 0 +inf.0) +inf.0) (test (max +inf.0) +inf.0) (test (min -inf.0 +inf.0) -inf.0) (test (min 0 +inf.0 -inf.0) -inf.0) (test (min 0 +inf.0) 0) (test (min +inf.0) +inf.0) (test (nan? (* 0 +nan.0)) #t) (test (nan? (+ (values +inf.0 -inf.0) +inf.0)) #t) (test (nan? (- -inf.0 -inf.0)) #t) (test (nan? (- +inf.0 +inf.0)) #t) (test (nan? (- +nan.0 +nan.0)) #t) (test (nan? (- +nan.0)) #t) (test (nan? (* 0 (log 0))) #t) (test (nan? (/ -1 +nan.0 -inf.0)) #t) (test (nan? (/ -inf.0 -inf.0)) #t) (test (nan? (/ 0 +nan.0)) #t) ;(test (nan? (/ 0 (log 0))) #t) ;why not just 0.0? (test (nan? (/ +inf.0 -inf.0)) #t) (test (nan? (/ +inf.0 +inf.0)) #t) (test (nan? (/ +inf.0 +nan.0)) #t) (test (nan? (/ +nan.0 +inf.0)) #t) (test (nan? (/ +nan.0 +nan.0)) #t) (test (nan? (/ +nan.0)) #t) (test (nan? (abs +nan.0)) #t) ;(test (nan? (acos +inf.0)) #t) (test (nan? (angle +nan.0)) #t) ;(test (nan? (asin +inf.0)) #t) (test (nan? (asin +nan.0)) #t) (test (nan? (exp +nan.0)) #t) (test (nan? (imag-part (complex 0 +nan.0))) #t) (test (nan? (imag-part nan+nani)) #t) (test (nan? (log 8.0 +nan.0)) #t) (test (nan? (log +nan.0 +nan.0)) #t) (test (nan? (magnitude nan+nani)) #t) (test (nan? (magnitude +nan.0)) #t) (test (nan? (make-polar -inf.0 +inf.0)) #t) (test (nan? (make-polar +nan.0 0)) #t) (test (nan? (complex +nan.0 0)) #t) (test (nan? (max 0 +inf.0 +nan.0)) #t) (test (nan? (max 1 +nan.0)) #t) (test (nan? (min 0 +inf.0 +nan.0)) #t) (test (nan? (min 1 +nan.0)) #t) ;(test (nan? (modulo 1 +inf.0)) #t) ;(test (nan? (modulo 1 +nan.0)) #t) ;(test (nan? (modulo +inf.0 1)) #t) ;(test (nan? (modulo +nan.0 1)) #t) (test (nan? (random +nan.0)) #t) (test (nan? (real-part (exp nan+nani))) #t) (test (nan? (real-part (log nan+nani))) #t) (test (nan? (real-part (log +nan.0))) #t) (test (nan? (real-part (complex -inf.0 0))) #f) (test (nan? (real-part (sqrt +nan.0))) #t) (test (nan? (real-part nan+nani)) #t) (test (nan? (sin -inf.0)) #t) (test (nan? (sin +inf.0)) #t) (test (nan? (sin +nan.0)) #t) (test (nan? (string->number "+nan.0")) #t) (test (nan? -inf.0) #f) (test (nan? 1 2) 'error) (test (nan? most-negative-fixnum) #f) (test (nan? most-positive-fixnum) #f) (test (negative? (/ (real-part (log 0.0)) (real-part (log 0.0)))) #f) ; and yet it prints as -nan.0 (test (nan? (quotient 1 +nan.0)) #t) (test (nan? (quotient +nan.0 1)) #t) (test (random +nan.0 +inf.0) 'error) (test (rationalize -inf.0) 'error) (test (rationalize 0.5 +inf.0) 0) (test (rationalize 178978.5 -inf.0) 0) (test (rationalize 178987.5 +nan.0) 'error) (test (rationalize 198797.5 +inf.0) 0) (test (rationalize +inf.0) 'error) (test (rationalize +nan.0 +nan.0) 'error) (test (rationalize +nan.0) 'error) (test (real-part (complex 1 +inf.0)) 1.0) (test (real? nan+nani) #f) (test (nan? (remainder 1 +nan.0)) #t) (test (nan? (remainder +nan.0 1)) #t) (test (round +inf.0) 'error) (test (round +nan.0)'error) (test (sinh +inf.0) +inf.0) (test (sqrt +inf.0) +inf.0) (test (truncate +inf.0) 'error) (test (truncate +nan.0) 'error) (test (zero? (complex 1 +inf.0)) #f) (test (zero? (real-part (complex 0 -inf.0))) #t) (test (zero? 0/0) #f) (test (zero? +inf.0) #f) ;; (test (nan? (angle +nan.0)) #t) ;; but (* 0 (expt 10 310)) -> -nan if not GMP -- is this a bug? ;;(atanh -inf.0) 0+1.5707963267949i ; different if g++ ;;(test (/ 0 +inf.0 -inf.0) 0.0) ;;(test (= (expt 1 nan+nani) 1) #t) ; or maybe NaN? ;;(test (= (expt 1 +nan.0) 1) #t) ;;(test (= (expt 2 +inf.0) +inf.0) #t) ;;(test (= (expt +inf.0 -inf.0) 0.0) #t) ;;(test (= (expt +inf.0 +inf.0) +inf.0) #t) ;;(test (= (expt +nan.0 0) 1.0) #t) ;hmmm ;;(test (= (expt +nan.0 +nan.0) 0) #t) ;;(test (>= 0 +inf.0 -inf.0) #t) ;;(test (angle (complex 1 +inf.0)) 1.5707963267949) ;;(test (atanh (complex 1 +inf.0)) -0+1.5707963267949i) ;;(test (nan? (atan -inf.0 +inf.0)) #t) ; ?? ;;(test (nan? (expt 0 +inf.0)) #t) ;;(test (nan? (quotient -inf.0 +inf.0)) #t) ;;(test (nan? (quotient 1 +nan.0)) #t) ;;(test (nan? (quotient +nan.0 1)) #t) ;;(test (nan? (quotient +nan.0 +inf.0)) #t) ;;(test (nan? (quotient +nan.0 +nan.0)) #t) ;;(test (tan (complex 1 +inf.0)) 0+1i) ;;(log +nan.0 0) (log 0 +inf.0) (log 0 -inf.0) (for-each (lambda (x) (test (infinite? x) #f) ; these were errors, but now infinite? is used in signatures (test (nan? x) #f)) (list #\a "hi" #f #(1 2) () '(1 . 2) _ht_ _undef_ _null_ _c_obj_ 'hi abs # #)) (for-each (lambda (n) (test (infinite? n) #f) (test (nan? n) #f)) (list 0.0 -0.0 .1 1+i 0-i 1/10)) (for-each (lambda (op) (test (number? (op +inf.0)) #t) (test (number? (op -inf.0)) #t) (test (number? (op +nan.0)) #t)) (list magnitude abs exp angle sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin real-part imag-part exact->inexact)) (for-each (lambda (op) (test (op +inf.0) 'error) (test (op -inf.0) 'error) (test (op +nan.0) 'error)) (list floor ceiling truncate round)) (for-each (lambda (op) (test (number? (op +inf.0 +inf.0)) #t) (test (number? (op +nan.0 -inf.0)) #t)) (list + - * / expt complex make-polar)) (for-each (lambda (op) (test (boolean? (op +inf.0)) #t) (test (boolean? (op +nan.0)) #t) (test (op) 'error)) (list number? integer? real? complex? rational? zero? positive? negative? inexact? exact?)) (for-each (lambda (op) (test (boolean? (op +inf.0 -inf.0)) #t) (test (boolean? (op +nan.0 -inf.0)) #t)) (list = < > <= >=)) (for-each (lambda (op) (test (op +inf.0) 'error) (test (op +nan.0) 'error)) (list even? odd? numerator denominator lcm gcd inexact->exact logior logxor logand lognot logbit? ash integer-length)) (let ((d1 1e-312) (d2 1e-316) (d3 1e-320)) (when (not (zero? d3)) (unless with-bignums (test (= d1 d2 d3) #f) (test (not (= d2 (* 2 d1))) #t)) (test (< d1 d2 d3) #f) (test (> d1 d2 d3) #t) (test (rationalize d1) 0) (test (rationalize d3) 0) (test (rationalize (- d1)) 0) (num-test (string->number (number->string d1)) d1) (test (< (sin d3) (sin d2) (sin d1)) #t) (test (< (log d3) (log d2) (log d1)) #t) (test (< (abs d3) (abs d2) (abs d1)) #t) (test (< (sqrt d3) (sqrt d2) (sqrt d1)) #t) (test (<= (exp d3) (exp d2) (exp d3)) #t) ; all might be 1.0 )) (define (nan-eqv? x y) (and (nan? x) (nan? y) (= (nan-payload x) (nan-payload y)))) (test (nan-eqv? (nan 123) +nan.123) #t) (test (nan? (nan)) #t) (test (nan-eqv? (nan) +nan.0) #t) (test (nan? (nan 123)) #t) (test (nan-payload (nan 123)) 123) (test (nan-eqv? (nan 0) +nan.0) #t) (test (nan-eqv? +nan.123 +nan.123) #t) (test (nan-eqv? -nan.123 +nan.123) #t) (test (nan-eqv? -nan.0 +nan.0) #t) (test (nan? +nan.123) #t) (test (nan? +nan.1.2) 'error) ;error: unbound variable +nan.1.2 in (+nan.1.2) (test +nan.1i 'error) (test (nan-payload +nan.123) 123) (test (nan 123.1) 'error) ;error: nan argument, 123.1, is a real but should be an integer (test (nan -123) 'error) ;error: nan argument, (-123), is out of range (it is negative) (test (nan-payload 123) 'error) ;error: nan-payload argument, 123, is an integer but should be a NaN (test (nan (+ (ash 1 51) 1)) 'error) ;error: nan argument, (2251799813685249), is out of range (it is too large) ; somewhat arbitrary, see above (test (arity nan) (cons 0 1)) (test (arity nan-payload) (cons 1 1)) (test (signature nan) '(real? integer?)) (test (signature nan-payload) '(integer? real?)) (test (eval-string "+nan.2i") 'error) ;error: unbound variable +nan.2i (test (eval-string "+nan.0i") 'error) ;error: unbound variable +nan.0i (test (eval-string "+nan.-123") 'error) (test (nan? +nan.123+nan.321i) #t) ; don't use (+ +nan.123 (* 0+i +nan.321)) because 0*nan->nan, and then it's up to chance which nan is in the real part! (test (nan-payload (real-part +nan.123+nan.321i)) 123) (test (nan-payload (imag-part +nan.123+nan.321i)) 321) (test (nan? +nan.123+1.0i) #t) (test (nan? +nan.0+1.0i) #t) (test (nan? 1.0+nan.123i) #t) (test (nan? 1.0-nan.123i) #t) (test (nan? 1.0+nan.0i) #t) (test (nan-payload (imag-part 1.0+nan.123i)) 123) (test (nan-payload (imag-part 1.0-nan.123i)) 123) ; prints as 1.0+nan.123i because we don't care about negative NaNs (test (nan-payload (imag-part +inf.0+nan.123i)) 123) (test (nan-payload (real-part +nan.123-inf.0i)) 123) (test (nan? +nan.123+nan.0i) #t) (test (nan-payload (real-part +nan.123+nan.0i)) 123) (test (nan-payload (imag-part +nan.123+nan.0i)) 0) (test (nan? +nan.123-nan.321i) #t) (test (nan-payload (real-part +nan.123-nan.321i)) 123) (test (nan-payload (imag-part +nan.123-nan.321i)) 321) (for-each (lambda (arg) (test (nan? arg) #f) (test (nan-payload arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (nan 1 2) 'error) (test (nan-payload +nan.123 321) 'error) (test (nan-payload) 'error) ;;; NaN pass-through tests (test (nan-eqv? (magnitude +nan.123+1.0i) +nan.123) #t) (test (nan-eqv? (magnitude +nan.123+nan.321i) +nan.123) #t) (test (nan-eqv? (magnitude +1.0+nan.321i) +nan.321) #t) (test (nan-eqv? (abs +nan.123) +nan.123) #t) (test (nan-eqv? (abs -nan.123) +nan.123) #t) (test (nan-eqv? (abs +nan.0) +nan.0) #t) (test (nan-eqv? (abs -nan.0) +nan.0) #t) (test (nan-eqv? (/ +nan.123) +nan.123) #t) (test (nan-eqv? (/ 1.5 +nan.123) +nan.123) #t) (test (nan-eqv? (/ +nan.123 1.5) +nan.123) #t) ;;; -------------------------------------------------------------------------------- ;;; zero? ;;; -------------------------------------------------------------------------------- (test (zero? 0) #t) (test (zero? 0.0) #t) (test (zero? 0/1) #t) (test (zero? -0) #t) (test (zero? -0.0) #t) (test (zero? 0.0) #t) (test (zero? 1) #f) (test (zero? -1) #f) (test (zero? -100) #f) (test (zero? -0/4) #t) (test (zero? 0+0i) #t) (test (zero?) 'error) (test (zero? "hi") 'error) (test (zero? 1.0+23.0i 1.0+23.0i) 'error) (test (zero? 0+i) #f) (test (zero? 0-0i) #t) (test (zero? 0.0-0.0i) #t) (test (zero? +0.0) #t) (test (zero? 1e-20) #f) (test (zero? -1.797693134862315699999999999999999999998E308) #f) (test (zero? -2.225073858507201399999999999999999999996E-308) #f) (test (zero? 2.2250738585072012e-308) #f) ; gauche says one of these can hang (test (zero? 2.2250738585072013e-308) #f) (test (zero? 2.2250738585072014e-308) #f) (test (zero? 2.2250738585072015e-308) #f) (test (zero? 2.2250738585072011e-308) #f) (test (zero? 2.2250738585072010e-308) #f) (test (zero? 2.2250738585072010e-309) #f) (test (zero? 2.2250738585072010e-310) #f) (test (zero? -9223372036854775808) #f) (test (zero? 1.110223024625156799999999999999999999997E-16) #f) (test (zero? 9223372036854775807) #f) (test (zero? +nan.0) #f) (test (zero? pi) #f) (test (zero? -1/9223372036854775807) #f) (test (zero? 1/2) #f) (test (zero? 0-i) #f) (test (zero? 0.00001) #f) (test (zero? most-negative-fixnum) #f) (test (zero? most-positive-fixnum) #f) (test (undefined? 18446744073709551616) (not with-bignums)) (test (zero? (* 0 most-positive-fixnum most-positive-fixnum)) #t) (test (zero? (* 0.0 most-positive-fixnum most-positive-fixnum)) #t) (test (zero? (* most-positive-fixnum most-negative-fixnum 0)) #t) (test (zero? (* most-positive-fixnum most-negative-fixnum 0.0)) #t) (test (undefined? 1000000000000000000000000000000000) (not with-bignums)) (test (zero? 000000000000000000000000000000000) #t) (when with-bignums (test (zero? (- (expt 2.3 54) (floor (expt 2.3 54)))) #f) (test (zero? 1e-600) #f) (test (zero? 9.92209574402351949043519108941671096176E-1726) #f) (test (zero? 12345678901234567890) #f) (test (zero? 9223372036854775808) #f) (test (zero? 9223372036854775808.1) #f) (test (zero? 9223372036854775808.1+1.5i) #f) (test (zero? 9223372036854775808/3) #f)) (test (zero?) 'error) (test (zero? 1 2) 'error) (test (zero? 0.@2211) #t) (test (zero? 0@0) #t) ; ?? (expt 0 0) -> 1 but 0@0 -> 0.0 because (expt 0.0 0) -> 0.0? (for-each (lambda (arg) (test (zero? arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; positive? ;;; -------------------------------------------------------------------------------- (test (positive? 4/3) #t) (test (positive? 4) #t) (test (positive? -4) #f) (test (positive? -4/3) #f) (test (positive? 0) #f) (test (positive? 0.0) #f) (test (positive? -0) #f) (test (positive? -0.0) #f) (test (positive? 1-0.0i) #t) (test (positive? 1.0) #t) (test (positive? -1.797693134862315699999999999999999999998E308) #f) (test (positive? -2.225073858507201399999999999999999999996E-308) #f) (test (positive? -9223372036854775808) #f) (test (positive? 1.110223024625156799999999999999999999997E-16) #t) (test (positive? 9223372036854775807) #t) (test (positive? most-negative-fixnum) #f) (test (positive? most-positive-fixnum) #t) (test (positive? +inf.0) #t) (test (positive? -inf.0) #f) (test (positive? +nan.0) #f) (for-each (lambda (n) (if (not (positive? n)) (format #t ";(positive? ~A) -> #f?~%") n)) (list 1 123 123456123 1.4 0.001 1/2 124124124.2)) (for-each (lambda (n) (if (positive? n) (format #t ";(positive? ~A) -> #t?~%" n))) (list -1 -123 -123456123 -3/2 -0.00001 -1.4 -123124124.1)) (when with-bignums (test (positive? 1000000000000000000000000000000000) #t) (test (positive? -1000000000000000000000000000000000) #f) (test (positive? 9.92209574402351949043519108941671096176E-1726) #t) (test (positive? 12345678901234567890) #t) (test (positive? -12345678901234567890) #f) (test (positive? 9223372036854775808) #t) (test (positive? 9223372036854775808.1) #t) (test (positive? 9223372036854775808/3) #t) (test (positive? (/ most-positive-fixnum most-negative-fixnum)) #f) (test (positive? 0+92233720368547758081.0i) 'error)) (test (positive? 1.23+1.0i) 'error) (test (positive? 1.23 1.23) 'error) (test (positive?) 'error) (test (positive? 1 2) 'error) (for-each (lambda (arg) (test (positive? arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; negative? ;;; -------------------------------------------------------------------------------- (test (negative? 4) #f) (test (negative? 4/3) #f) (test (negative? -4) #t) (test (negative? -4/3) #t) (test (negative? -0/4) #f) (test (negative? 0) #f) (test (negative? -0) #f) (test (negative? 0.0) #f) (test (negative? -0.0) #f) (test (negative? (- 0.0)) #f) (test (negative? (expt -0.0 1)) #f) (test (negative? (/ -0.0 1.0)) #f) (test (negative? (* -0.0 1.0)) #f) (test (negative?) 'error) (test (negative? 1-0i) #f) (test (negative? -1.797693134862315699999999999999999999998E308) #t) (test (negative? -2.225073858507201399999999999999999999996E-308) #t) (test (negative? -9223372036854775808) #t) (test (negative? 1.110223024625156799999999999999999999997E-16) #f) (test (negative? 9223372036854775807) #f) (test (negative? most-negative-fixnum) #t) (test (negative? most-positive-fixnum) #f) (test (negative? +inf.0) #f) (test (negative? -inf.0) #t) (test (negative? +nan.0) #f) ;; (negative? -1/0): #f? (positive? 1/0) is also #f, but (negative? -nan.0): #f (guile agrees) -- so what's the point of -nan.0?? ;; chibi says (negative? -nan.0) #t, but (positive? +nan.0) #f?? (for-each (lambda (n) (if (negative? n) (format #t ";(negative? ~A) -> #t?~%" n))) (list 1 123 123456123 1.4 0.001 1/2 12341243124.2)) (for-each (lambda (n) (if (not (negative? n)) (format #t ";(negative? ~A) -> #f?~%" n))) (list -1 -123 -123456123 -2/3 -0.00001 -1.4 -123124124.1)) (let ((val1 (catch #t (lambda () (negative? 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (negative? -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (when with-bignums (test (negative? 1000000000000000000000000000000000) #f) (test (negative? -1000000000000000000000000000000000) #t) (test (negative? -9.92209574402351949043519108941671096176E-1726) #t) (test (negative? 12345678901234567890) #f) (test (negative? -12345678901234567890) #t) (test (negative? 9223372036854775808) #f) (test (negative? 9223372036854775808.1) #f) (test (negative? 9223372036854775808/3) #f) (test (negative? 0+92233720368547758081.0i) 'error)) (test (negative? -1-i) 'error) (test (negative? 1.23+1.0i) 'error) (test (negative? 1.23 1.23) 'error) (test (negative? 1 2) 'error) (for-each (lambda (arg) (test (negative? arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; odd? ;;; -------------------------------------------------------------------------------- (test (odd? 3) #t) (test (odd? 2) #f) (test (odd? -4) #f) (test (odd? -1) #t) (test (odd? 0) #f) (test (odd? -0) #f) (test (odd? -9223372036854775808) #f) (test (odd? 9223372036854775807) #t) (test (odd? most-positive-fixnum) #t) (test (odd? most-negative-fixnum) #f) (test (odd? -2147483647) #t) (test (odd? -2147483648) #f) (test (odd? -2147483649) #t) (test (odd? 2147483647) #t) (test (odd? 2147483648) #f) (test (odd? 2147483649) #t) (for-each (lambda (n) (if (odd? n) (format #t ";(odd? ~A) -> #t?~%" n))) (list 0 2 1234 -4 -10000002 1000000006)) (for-each (lambda (n) (if (not (odd? n)) (format #t ";(odd? ~A) -> #f?~%" n))) (list 1 -1 31 50001 543321)) (when with-bignums (test (odd? 12345678901234567891) #t) (test (odd? 12345678901234567890) #f) (test (odd? -1231234567891234567891) #t) (test (odd? -1231234567891234567891) #t) (test (odd? -1239223372036854775808) #f) (test (odd? -9223372036854775808) #f) (test (odd? 1231234567891234567891) #t) (test (odd? 1234567891234567891) #t) (test (odd? 1239223372036854775808) #f) (test (odd? 9223372036854775808) #f) (test (odd? 9223372036854775808/9223372036854775807) 'error) (test (odd? 0+92233720368547758081.0i) 'error)) (test (odd?) 'error) (test (odd? 1.23) 'error) (test (odd? 1.0) 'error) (test (odd? 1+i) 'error) (test (odd? 123 123) 'error) (test (odd? +inf.0) 'error) (test (odd? +nan.0) 'error) (test (odd? 1/2) 'error) (for-each (lambda (arg) (test (odd? arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; even? ;;; -------------------------------------------------------------------------------- (test (even? 3) #f) (test (even? 2) #t) (test (even? -4) #t) (test (even? -1) #f) (test (even? -0) #t) (test (even? -9223372036854775808) #t) (test (even? 9223372036854775807) #f) (test (even? most-positive-fixnum) #f) (test (even? most-negative-fixnum) #t) (test (even? -2147483647) #f) (test (even? -2147483648) #t) (test (even? -2147483649) #f) (test (even? 2147483647) #f) (test (even? 2147483648) #t) (test (even? 2147483649) #f) (for-each (lambda (n) (if (not (even? n)) (format #t ";(even? ~A) -> #f?~%" n))) (list 0 2 1234 -4 -10000002 1000000006)) (for-each (lambda (n) (if (even? n) (format #t ";(even? ~A) -> #t?~%" n))) (list 1 -1 31 50001 543321)) (let ((top-exp 60)) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (+ 2 (inexact->exact (expt 2 i)))) (val2 (- val1 1)) (ev1 (even? val1)) (ov1 (odd? val1)) (ev2 (even? val2)) (ov2 (odd? val2))) (if (not ev1) (begin (set! happy #f) (display "not (even? ") (display val1) (display ")?") (newline))) (if ev2 (begin (set! happy #f) (display "(even? ") (display val2) (display ")?") (newline))) (if ov1 (begin (set! happy #f) (display "(odd? ") (display val1) (display ")?") (newline))) (if (not ov2) (begin (set! happy #f) (display "not (odd? ") (display val2) (display ")?") (newline))))))) (when with-bignums (test (even? 12345678901234567890) #t) (test (even? 12345678901234567891) #f) (test (even? -1231234567891234567891) #f) (test (even? -1234567891234567891) #f) (test (even? -1239223372036854775808) #t) (test (even? -9223372036854775808) #t) (test (even? 1231234567891234567891) #f) (test (even? 1234567891234567891) #f) (test (even? 1239223372036854775808) #t) (test (even? 9223372036854775808) #t) (test (even? 9223372036854775808/9223372036854775807) 'error) (test (even? 0+92233720368547758081.0i) 'error)) (test (even?) 'error) (test (even? 1.23) 'error) (test (even? 1.0) 'error) (test (even? 123 123) 'error) (test (even? 1+i) 'error) (test (even? 1+0i) 'error) (test (even? +nan.0) 'error) (test (even? 1/2) 'error) (for-each (lambda (arg) (test (even? arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; exact? ;;; -------------------------------------------------------------------------------- (test (exact? 1/0) #f) (test (exact? '0/1) #t) (test (exact? (/ 1 2)) #t) (test (exact? -0) #t) (test (exact? -1.797693134862315699999999999999999999998E308) #f) (test (exact? -2.225073858507201399999999999999999999996E-308) #f) (test (exact? -9223372036854775808) #t) (test (exact? 0/0) #f) (test (exact? 0/1) #t) (test (exact? 1.0) #f) (test (exact? 1.110223024625156799999999999999999999997E-16) #f) (test (exact? 1.5+0.123i) #f) (test (exact? 1/2) #t) (test (exact? 3) #t) (test (exact? 3.123) #f) (test (exact? 9223372036854775807) #t) (test (exact? most-positive-fixnum) #t) (test (exact? pi) #f) (test (exact? +inf.0) #f) (test (exact? -inf.0) #f) (test (exact? +nan.0) #f) (test (exact? (imag-part 1+0i)) #f) (test (exact? (imag-part 1+0.0i)) #f) (test (exact? (imag-part 1+1i)) #f) (when with-bignums (test (exact? 12345678901234567890) #t) (test (exact? 9223372036854775808.1) #f) (test (exact? 9223372036854775808) #t) (test (exact? 9223372036854775808/3) #t) (test (exact? 9223372036854775808.1+1.0i) #f)) (test (exact?) 'error) (test (exact? "hi") 'error) (test (exact? 1.0+23.0i 1.0+23.0i) 'error) (for-each (lambda (arg) (test (exact? arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; inexact? ;;; -------------------------------------------------------------------------------- (test (inexact? -1) #f) (test (inexact? -1.797693134862315699999999999999999999998E308) #t) (test (inexact? -2.225073858507201399999999999999999999996E-308) #t) (test (inexact? -9223372036854775808) #f) (test (inexact? 1.0) #t) (test (inexact? 1.110223024625156799999999999999999999997E-16) #t) (test (inexact? 1.5+0.123i) #t) (test (inexact? 1/2) #f) (test (inexact? 3) #f) (test (inexact? 3.123) #t) (test (inexact? 9223372036854775807) #f) (test (inexact? +inf.0) #t) (test (inexact? -inf.0) #t) (test (inexact? +nan.0) #t) (when with-bignums (test (inexact? 12345678901234567890) #f) (test (inexact? 9223372036854775808.1) #t) (test (inexact? 9223372036854775808) #f) (test (inexact? 9223372036854775808/3) #f) (test (inexact? 9223372036854775808.1+1.0i) #t)) (test (inexact? "hi") 'error) (test (inexact? 1.0+23.0i 1.0+23.0i) 'error) (test (inexact?) 'error) (for-each (lambda (arg) (test (inexact? arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; exact->inexact ;;; -------------------------------------------------------------------------------- (num-test (exact->inexact 0+1.5i) 0+1.5i) (num-test (exact->inexact 1) 1.0) (num-test (exact->inexact 1.0) 1.0) (num-test (exact->inexact 3/2) 1.5) (num-test (exact->inexact -3/2) -1.5) (test (infinite? (exact->inexact +inf.0)) #t) (test (nan? (exact->inexact +nan.0)) #t) (num-test (exact->inexact most-positive-fixnum) 9.223372036854775807E18) (num-test (exact->inexact most-negative-fixnum) -9.223372036854775808E18) (num-test (exact->inexact 17/12) 1.416666666666666666666666666666666666665E0) (num-test (exact->inexact 41/29) 1.413793103448275862068965517241379310344E0) (num-test (exact->inexact 99/70) 1.414285714285714285714285714285714285714E0) (num-test (exact->inexact 577/408) 1.414215686274509803921568627450980392157E0) (num-test (exact->inexact 1393/985) 1.414213197969543147208121827411167512692E0) (num-test (exact->inexact 3363/2378) 1.414213624894869638351555929352396972245E0) (num-test (exact->inexact 19601/13860) 1.414213564213564213564213564213564213564E0) (num-test (exact->inexact 47321/33461) 1.414213562057320462628134245838438779476E0) (num-test (exact->inexact 114243/80782) 1.414213562427273402490653858532841474586E0) (num-test (exact->inexact 275807/195025) 1.414213562363799512882963722599666709396E0) (num-test (exact->inexact 1607521/1136689) 1.414213562372821413772808569450394962913E0) (num-test (exact->inexact 3880899/2744210) 1.414213562373141997150363856993451667326E0) (num-test (exact->inexact 9369319/6625109) 1.414213562373086993738518113437831739826E0) (num-test (exact->inexact 54608393/38613965) 1.414213562373094811682768138418315757008E0) (num-test (exact->inexact 131836323/93222358) 1.414213562373095089484863706193743779791E0) (num-test (exact->inexact 318281039/225058681) 1.414213562373095041821559418096829599746E0) (num-test (exact->inexact 1855077841/1311738121) 1.414213562373095048596212902163571413046E0) (num-test (exact->inexact 4478554083/3166815962) 1.414213562373095048836942801793292211529E0) (num-test (exact->inexact -1.797693134862315699999999999999999999998E308) -1.797693134862315699999999999999999999998E308) (num-test (exact->inexact -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (exact->inexact -9223372036854775808) -9.223372036854775808E18) (num-test (exact->inexact 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16) (num-test (exact->inexact 9223372036854775807) 9.223372036854775807E18) (num-test (exact->inexact 9007199254740991) 9.007199254740991E15) (test (= (exact->inexact 9007199254740992) (exact->inexact 9007199254740991)) #f) (when with-bignums (num-test (truncate (exact->inexact most-positive-fixnum)) 9223372036854775807) (test (= (exact->inexact 9007199254740993) (exact->inexact 9007199254740992)) #f) (num-test (exact->inexact 73786976294838206464) (expt 2.0 66)) (num-test (exact->inexact (bignum "0+1.5i")) 0+1.5i) (test (< (abs (- (expt 2 66.5) (exact->inexact 19459393535087060477929284/186481))) 1e-9) #t) (test (< (abs (- (exact->inexact -186198177976134811212136169603791619/103863) (- (expt 2 100.5)))) 1e-9) #t)) (test (exact->inexact "hi") 'error) (test (exact->inexact 1.0+23.0i 1.0+23.0i) 'error) (test (exact->inexact) 'error) (for-each (lambda (arg) (test (exact->inexact arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (integer? (* 0 1.0)) #f) ; s7.html check -- we want 0.0 here, not 0 [for exact->inexact replacement code] (test (rational? (* 1.0 0)) #f) ;;; -------------------------------------------------------------------------------- ;;; inexact->exact ;;; -------------------------------------------------------------------------------- (num-test (inexact->exact 0.0) 0) (num-test (inexact->exact 1) 1) (num-test (inexact->exact 1.0) 1) (num-test (inexact->exact 1.5) 3/2) (test (inexact->exact most-negative-fixnum) most-negative-fixnum) (num-test (inexact->exact 1.0000000000000000000000000000+0.0000000000000000000000000000i) 1) (num-test (inexact->exact 1.0+0.0000000000000000000000000000i) 1) (num-test (inexact->exact 1.0000000000000000000000000000+0.0i) 1) (num-test (inexact->exact 1.0000000000000000000000000000+0e10i) 1) (num-test (inexact->exact 1.0+0.0000000000000000000000000000e10i) 1) (num-test (inexact->exact 1.0000000000000000000000000000+0.0e10i) 1) (num-test (inexact->exact -2.225073858507201399999999999999999999996E-308) 0) (num-test (inexact->exact -9223372036854775808) -9223372036854775808) (num-test (inexact->exact 1.110223024625156799999999999999999999997E-16) 0) (num-test (inexact->exact 9223372036854775807) 9223372036854775807) (num-test (inexact->exact -2305843009213693952/4611686018427387903) -2305843009213693952/4611686018427387903) ;(num-test (inexact->exact 9007199254740995.0) 9007199254740995) ;this can't work in the non-gmp case -- see s7.c under BIGNUM_PLUS (if with-bignums (begin (num-test (inexact->exact .1e20) 10000000000000000000) (num-test (inexact->exact 1e19) 10000000000000000000) (num-test (inexact->exact 1e20) 100000000000000000000) (num-test (inexact->exact 9007199254740995.0) 9007199254740995) (num-test (inexact->exact 4611686018427388404.0) 4611686018427388404) (test (inexact->exact (bignum "0+1.5i")) 'error)) (begin (test (inexact->exact 1.1e54) 'error) (test (inexact->exact 1.1e564) 'error) (test (inexact->exact .1e20) 'error) (test (inexact->exact 1e19) 'error) (test (inexact->exact 1e20) 'error))) (test (inexact->exact +inf.0) 'error) (test (inexact->exact +nan.0) 'error) (test (inexact->exact "hi") 'error) (test (inexact->exact 0+1.5i) 'error) (test (inexact->exact 1+i) 'error) (test (inexact->exact 1.0+23.0i 1.0+23.0i) 'error) (test (inexact->exact) 'error) (for-each (lambda (arg) (test (inexact->exact arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; numerator ;;; -------------------------------------------------------------------------------- (test (numerator (/ 8 -6)) -4) (test (numerator -1/10) -1) (test (numerator -1/2) -1) (test (numerator -10/1) -10) (test (numerator -10/1234) -5) (test (numerator -10/3) -10) (test (numerator -10/500029) -10) (test (numerator -1234/10) -617) (test (numerator -1234/2) -617) (test (numerator -2/1) -2) (test (numerator -2/1234) -1) (test (numerator -2/3) -2) (test (numerator -2/500029) -2) (test (numerator -2/6) -1) (test (numerator -3/10) -3) (test (numerator -3/2) -3) (test (numerator -500029/10) -500029) (test (numerator -500029/2) -500029) (test (numerator 0/1) 0) (test (numerator 0/10) 0) (test (numerator 0/1234) 0) (test (numerator 0/2) 0) (test (numerator 0/3) 0) (test (numerator 0/500029) 0) (test (numerator 1) 1) (test (numerator 1/1) 1) (test (numerator 1/1234) 1) (test (numerator 1/3) 1) (test (numerator 1/500029) 1) (test (numerator 10/10) 1) (test (numerator 10/2) 5) (test (numerator 12/6000996) 1) (test (numerator 1234/1) 1234) (test (numerator 1234/3) 1234) (test (numerator 1234/500029) 1234) (test (numerator 2/10) 1) (test (numerator 2/2) 1) (test (numerator 2/3) 2) (test (numerator 2/4) 1) (test (numerator 3/1) 3) (test (numerator 3/1234) 3) (test (numerator 3/3) 1) (test (numerator 3/500029) 3) (test (numerator 5/2) 5) (test (numerator 500029/1) 500029) (test (numerator 500029/1234) 500029) (test (numerator 500029/3) 500029) (test (numerator 500029/500029) 1) (test (numerator -9223372036854775808) -9223372036854775808) (test (numerator 9223372036854775807) 9223372036854775807) (test (numerator (/ 2 -1)) -2) (test (numerator (/ most-positive-fixnum 2)) most-positive-fixnum) (test (numerator (/ most-negative-fixnum 3)) most-negative-fixnum) (test (numerator (/ most-negative-fixnum most-positive-fixnum)) most-negative-fixnum) (when with-bignums (test (numerator 1195068768795265792518361315725116351898245581/48889032896862784894921) 24444516448431392447461) (test (numerator 24444516448431392447461/1195068768795265792518361315725116351898245581) 1) (test (numerator -46116860184273879035/27670116110564327424) -46116860184273879035) (test (numerator (/ 9223372036854775808 -9223372036854775807)) -9223372036854775808) (test (numerator 1234567891234567890/1234567) 1234567891234567890) (test (numerator 9223372036854775808/9223372036854775807) 9223372036854775808) (test (numerator 0+92233720368547758081.0i) 'error)) (test (numerator 0.0) 'error) ; guile thinks this is ok (test (numerator 1.23 1.23) 'error) (test (numerator 1.23+1.0i) 'error) (test (numerator) 'error) (test (numerator +inf.0) 'error) (test (numerator +nan.0) 'error) (test (numerator "hi") 'error) (test (numerator 1+i) 'error) (test (numerator 2.3+0.5i) 'error) (for-each (lambda (arg) (test (numerator arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; denominator ;;; -------------------------------------------------------------------------------- (test (denominator (/ 8 -6)) 3) (test (denominator -1/10) 10) (test (denominator -1/2) 2) (test (denominator -10/1) 1) (test (denominator -10/1234) 617) (test (denominator -10/3) 3) (test (denominator -10/500029) 500029) (test (denominator -1234/10) 5) (test (denominator -1234/2) 1) (test (denominator -2/1) 1) (test (denominator -2/1234) 617) (test (denominator -2/3) 3) (test (denominator -2/500029) 500029) (test (denominator -2/6) 3) (test (denominator -3/10) 10) (test (denominator -3/2) 2) (test (denominator -500029/10) 10) (test (denominator -500029/2) 2) (test (denominator 0) 1) (test (denominator 0/1) 1) (test (denominator 0/10) 1) (test (denominator 0/1234) 1) (test (denominator 0/2) 1) (test (denominator 0/3) 1) (test (denominator 0/500029) 1) (test (denominator 1) 1) (test (denominator 1/1) 1) (test (denominator 1/1234) 1234) (test (denominator 1/3) 3) (test (denominator 1/500029) 500029) (test (denominator 10/10) 1) (test (denominator 10/2) 1) (test (denominator 12/6000996) 500083) (test (denominator 1234/1) 1) (test (denominator 1234/3) 3) (test (denominator 1234/500029) 500029) (test (denominator 2/10) 5) (test (denominator 2/2) 1) (test (denominator 2/3) 3) (test (denominator 2/4) 2) (test (denominator 3/1) 1) (test (denominator 3/1234) 1234) (test (denominator 3/3) 1) (test (denominator 3/500029) 500029) (test (denominator 5/2) 2) (test (denominator 500029/1) 1) (test (denominator 500029/1234) 1234) (test (denominator 500029/3) 3) (test (denominator 500029/500029) 1) (test (denominator -9223372036854775808) 1) (test (denominator 9223372036854775807) 1) (test (denominator (/ 2 -1)) 1) (test (denominator (/ 1 most-positive-fixnum)) most-positive-fixnum) (test (denominator (/ most-negative-fixnum most-positive-fixnum)) most-positive-fixnum) (when with-bignums (test (denominator 1195068768795265792518361315725116351898245581/48889032896862784894921) 1) (test (denominator 24444516448431392447461/1195068768795265792518361315725116351898245581) 48889032896862784894921) (test (denominator -46116860184273879035/27670116110564327424) 27670116110564327424) (test (denominator (/ 9223372036854775808 -9223372036854775807)) 9223372036854775807) (test (denominator 1234567891234567890/1234567) 1234567) (test (denominator 9223372036854775808/9223372036854775807) 9223372036854775807) (test (denominator 0+92233720368547758081.0i) 'error)) (test (denominator 0.0) 'error) (test (denominator 1.23 1.23) 'error) (test (denominator 1.23+1.0i) 'error) (test (denominator) 'error) (test (denominator +inf.0) 'error) (test (denominator +nan.0) 'error) (test (denominator "hi") 'error) (test (denominator 1+i) 'error) (test (denominator 2.3+0.5i) 'error) (for-each (lambda (arg) (test (denominator arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; real-part ;;; -------------------------------------------------------------------------------- (num-test (real-part -0.0+0.00000001i) 0.0) (num-test (real-part -0.0+1234.0i) 0.0) (num-test (real-part -0.0-3.14159265358979i) 0.0) (num-test (real-part -0.00000001+1.0i) -0.00000001) (num-test (real-part -0.00000001-0.0i) -0.00000001) (num-test (real-part -1.0+3.14159265358979i) -1.0) (num-test (real-part -1.0-0.00000001i) -1.0) (num-test (real-part -1.0-1234.0i) -1.0) (num-test (real-part -1234.0+1.0i) -1234.0) (num-test (real-part -1234.0-0.0i) -1234.0) (num-test (real-part -3.14159265358979+0.0i) -3.14159265358979) (num-test (real-part -3.14159265358979-1.0i) -3.14159265358979) (num-test (real-part 0.0+0.0i) 0.0) (num-test (real-part 0.0-1.0i) 0.0) (num-test (real-part 0.00000001+0.00000001i) 0.00000001) (num-test (real-part 0.00000001+1234.0i) 0.00000001) (num-test (real-part 0.00000001-3.14159265358979i) 0.00000001) (num-test (real-part 1) 1) (num-test (real-part 1.0+1.0i) 1.0) (num-test (real-part 1.0-0.0i) 1.0) (num-test (real-part 1.4+0.0i) 1.4) (num-test (real-part 1234.0+0.00000001i) 1234.0) (num-test (real-part 1234.0+1234.0i) 1234.0) (num-test (real-part 1234.0-3.14159265358979i) 1234.0) (num-test (real-part 2.0) 2.0) (num-test (real-part 2/3) 2/3) (num-test (real-part 3.14159265358979+3.14159265358979i) 3.14159265358979) (num-test (real-part 3.14159265358979-0.00000001i) 3.14159265358979) (num-test (real-part 3.14159265358979-1234.0i) 3.14159265358979) (num-test (real-part 3/4+1/2i) 0.75) (num-test (real-part 5) 5) (num-test (real-part -1.797693134862315699999999999999999999998E308) -1.797693134862315699999999999999999999998E308) (num-test (real-part -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (real-part -9223372036854775808) -9223372036854775808) (num-test (real-part 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16) (num-test (real-part 9223372036854775807) 9223372036854775807) (test (real-part +inf.0) +inf.0) (num-test (real-part (+ 2 0+1/0i)) 2) (when with-bignums (num-test (real-part 0+1e400i) 0.0) (num-test (real-part 0+9223372036854775808.0i) 0.0) (num-test (real-part 1.5+9223372036854775808.0i) 1.5) (num-test (real-part 9223372036854775808.0) 9223372036854775808.0) (num-test (real-part 9223372036854775808.0+1.5i) 9.223372036854775808E18)) (test (denominator (real-part 3/4+1/2i)) 'error) (num-test (denominator (real-part 01/100)) 100) (test (real-part "hi") 'error) (test (real-part 1.0+23.0i 1.0+23.0i) 'error) (test (real-part) 'error) (for-each (lambda (arg) (test (real-part arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; imag-part ;;; -------------------------------------------------------------------------------- (num-test (imag-part -0.0+0.00000001i) 0.00000001) (num-test (imag-part -0.0+1234.0i) 1234.0) (num-test (imag-part -0.0-3.14159265358979i) -3.14159265358979) (num-test (imag-part -0.00000001+1.0i) 1.0) (num-test (imag-part -0.00000001-0.0i) 0.0) (num-test (imag-part -1.0+3.14159265358979i) 3.14159265358979) (num-test (imag-part -1.0-0.00000001i) -0.00000001) (num-test (imag-part -1.0-1234.0i) -1234.0) (num-test (imag-part -1234.0+1.0i) 1.0) (num-test (imag-part -1234.0-0.0i) 0.0) (num-test (imag-part -2.0) 0.0) (num-test (imag-part -3.14159265358979+0.0i) 0.0) (num-test (imag-part -3.14159265358979-1.0i) -1.0) (num-test (imag-part 0+i) 1.0) (num-test (imag-part 0.0+0.0i) 0.0) (num-test (imag-part 0.0-1.0i) -1.0) (num-test (imag-part 0.00000001+0.00000001i) 0.00000001) (num-test (imag-part 0.00000001+1234.0i) 1234.0) (num-test (imag-part 0.00000001-3.14159265358979i) -3.14159265358979) (num-test (imag-part 1) 0.0) (num-test (imag-part 1+i) 1.0) (num-test (imag-part 1-i) -1.0) (num-test (imag-part 1.0+1.0i) 1.0) (num-test (imag-part 1.0-0.0i) 0.0) (num-test (imag-part 1.4+0.0i) 0.0) (num-test (imag-part 1234.0+0.00000001i) 0.00000001) (num-test (imag-part 1234.0+1234.0i) 1234.0) (num-test (imag-part 1234.0-3.14159265358979i) -3.14159265358979) (num-test (imag-part 2/3) 0.0) (num-test (imag-part 3.14159265358979+3.14159265358979i) 3.14159265358979) (num-test (imag-part 3.14159265358979-0.00000001i) -0.00000001) (num-test (imag-part 3.14159265358979-1234.0i) -1234.0) (num-test (imag-part 5) 0.0) (num-test (imag-part -1.797693134862315699999999999999999999998E308) 0.0) (num-test (imag-part -2.225073858507201399999999999999999999996E-308) 0.0) (num-test (imag-part -9223372036854775808) 0) (num-test (imag-part 1.110223024625156799999999999999999999997E-16) 0.0) (num-test (imag-part 9223372036854775807) 0) (if (not with-bignums) (test (nan? (imag-part (+ 2 0+1/0i))) #t)) (num-test (imag-part 0/0+0i) 0.0) (num-test (imag-part 1/0) 0.0) ;(num-test (imag-part (log 1/0)) pi) ; hmmm -- I could imagine other choices here and below ;(num-test (imag-part (sqrt 1/0)) 0.0) ;(test (nan? (imag-part (sqrt (log 1/0)))) #t) (when with-bignums (num-test (imag-part 0+1e400i) 1e400) (num-test (imag-part 0+9223372036854775808.0i) 9223372036854775808.0) (num-test (imag-part 1.5+9223372036854775808.0i) 9.223372036854775808E18) (num-test (imag-part 9223372036854775808.0) 0) (num-test (imag-part 9223372036854775808.0+1.5i) 1.5)) (test (imag-part "hi") 'error) (test (imag-part 1.0+23.0i 1.0+23.0i) 'error) (test (imag-part) 'error) (for-each (lambda (arg) (test (imag-part arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; complex ;;; -------------------------------------------------------------------------------- (num-test (complex -0 -1) -0.0-1.0i) (num-test (complex -0 -10) -0.0-10.0i) (num-test (complex -0 -1234) -0.0-1234.0i) (num-test (complex -0 -2) -0.0-2.0i) (num-test (complex -0 -3) -0.0-3.0i) (num-test (complex -0 -500029) -0.0-500029.0i) (num-test (complex -0 1) -0.0+1.0i) (num-test (complex -0 10) -0.0+10.0i) (num-test (complex -0 1234) -0.0+1234.0i) (num-test (complex -0 2) -0.0+2.0i) (num-test (complex -0 3) -0.0+3.0i) (num-test (complex -0 500029) -0.0+500029.0i) (num-test (complex -0.0 -0.00000001) -0.0-0.00000001i) (num-test (complex -0.0 -1.0) -0.0-1.0i) (num-test (complex -0.0 -1234.0) -0.0-1234.0i) (num-test (complex -0.0 -3.14159265358979) -0.0-3.14159265358979i) (num-test (complex -0.0 0.00000001) -0.0+0.00000001i) (num-test (complex -0.0 1.0) -0.0+1.0i) (num-test (complex -0.0 1234.0) -0.0+1234.0i) (num-test (complex -0.0 pi) -0.0+3.14159265358979i) (num-test (complex -0.00000001 -0.00000001) -0.00000001-0.00000001i) (num-test (complex -0.00000001 -1.0) -0.00000001-1.0i) (num-test (complex -0.00000001 -1234.0) -0.00000001-1234.0i) (num-test (complex -0.00000001 -3.14159265358979) -0.00000001-3.14159265358979i) (num-test (complex -0.00000001 0.00000001) -0.00000001+0.00000001i) (num-test (complex -0.00000001 1.0) -0.00000001+1.0i) (num-test (complex -0.00000001 1234.0) -0.00000001+1234.0i) (num-test (complex -0.00000001 pi) -0.00000001+3.14159265358979i) (num-test (complex -1 -1) -1.0-1.0i) (num-test (complex -1 -10) -1.0-10.0i) (num-test (complex -1 -1234) -1.0-1234.0i) (num-test (complex -1 -2) -1.0-2.0i) (num-test (complex -1 -3) -1.0-3.0i) (num-test (complex -1 -500029) -1.0-500029.0i) (num-test (complex -1 1) -1.0+1.0i) (num-test (complex -1 10) -1.0+10.0i) (num-test (complex -1 1234) -1.0+1234.0i) (num-test (complex -1 2) -1.0+2.0i) (num-test (complex -1 3) -1.0+3.0i) (num-test (complex -1 500029) -1.0+500029.0i) (num-test (complex -1.0 -0.00000001) -1.0-0.00000001i) (num-test (complex -1.0 -1.0) -1.0-1.0i) (num-test (complex -1.0 -1234.0) -1.0-1234.0i) (num-test (complex -1.0 -3.14159265358979) -1.0-3.14159265358979i) (num-test (complex -1.0 0.00000001) -1.0+0.00000001i) (num-test (complex -1.0 1.0) -1.0+1.0i) (num-test (complex -1.0 1234.0) -1.0+1234.0i) (num-test (complex -1.0 pi) -1.0+3.14159265358979i) (num-test (complex -2 -1) -2.0-1.0i) (num-test (complex -2 -10) -2.0-10.0i) (num-test (complex -2 -1234) -2.0-1234.0i) (num-test (complex -2 -2) -2.0-2.0i) (num-test (complex -2 -3) -2.0-3.0i) (num-test (complex -2 -500029) -2.0-500029.0i) (num-test (complex -2 1) -2.0+1.0i) (num-test (complex -2 10) -2.0+10.0i) (num-test (complex -2 1234) -2.0+1234.0i) (num-test (complex -2 2) -2.0+2.0i) (num-test (complex -2 3) -2.0+3.0i) (num-test (complex -2 500029) -2.0+500029.0i) (num-test (complex 0 -1) 0.0-1.0i) (num-test (complex 0 -10) 0.0-10.0i) (num-test (complex 0 -1234) 0.0-1234.0i) (num-test (complex 0 -2) 0.0-2.0i) (num-test (complex 0 -3) 0.0-3.0i) (num-test (complex 0 -500029) 0.0-500029.0i) (num-test (complex 0 0) 0) (num-test (complex 0 1) 0.0+1.0i) (num-test (complex 0 10) 0.0+10.0i) (num-test (complex 0 1234) 0.0+1234.0i) (num-test (complex 0 2) 0.0+2.0i) (num-test (complex 0 3) 0.0+3.0i) (num-test (complex 0 500029) 0.0+500029.0i) (num-test (complex 0.0 -0.00000001) 0.0-0.00000001i) (num-test (complex 0.0 -1.0) 0.0-1.0i) (num-test (complex 0.0 -1234.0) 0.0-1234.0i) (num-test (complex 0.0 -3.14159265358979) 0.0-3.14159265358979i) (num-test (complex 0.0 0.0) 0.0) (num-test (complex 0.0 0.00000001) 0.0+0.00000001i) (num-test (complex 0.0 1.0) 0.0+1.0i) (num-test (complex 0.0 1234.0) 0.0+1234.0i) (num-test (complex 0.0 pi) 0.0+3.14159265358979i) (num-test (complex 0.00000001 -0.00000001) 0.00000001-0.00000001i) (num-test (complex 0.00000001 -1.0) 0.00000001-1.0i) (num-test (complex 0.00000001 -1234.0) 0.00000001-1234.0i) (num-test (complex 0.00000001 -3.14159265358979) 0.00000001-3.14159265358979i) (num-test (complex 0.00000001 0.00000001) 0.00000001+0.00000001i) (num-test (complex 0.00000001 1.0) 0.00000001+1.0i) (num-test (complex 0.00000001 1234.0) 0.00000001+1234.0i) (num-test (complex 0.00000001 pi) 0.00000001+3.14159265358979i) (num-test (complex 1 -1) 1.0-1.0i) (num-test (complex 1 -10) 1.0-10.0i) (num-test (complex 1 -1234) 1.0-1234.0i) (num-test (complex 1 -2) 1.0-2.0i) (num-test (complex 1 -3) 1.0-3.0i) (num-test (complex 1 -500029) 1.0-500029.0i) (num-test (complex 1 1) 1.0+1.0i) (num-test (complex 1 10) 1.0+10.0i) (num-test (complex 1 1234) 1.0+1234.0i) (num-test (complex 1 2) 1.0+2.0i) (num-test (complex 1 3) 1.0+3.0i) (num-test (complex 1 500029) 1.0+500029.0i) (num-test (complex 1.0 -0.00000001) 1.0-0.00000001i) (num-test (complex 1.0 -1.0) 1.0-1.0i) (num-test (complex 1.0 -1234.0) 1.0-1234.0i) (num-test (complex 1.0 -3.14159265358979) 1.0-3.14159265358979i) (num-test (complex 1.0 0.00000001) 1.0+0.00000001i) (num-test (complex 1.0 1.0) 1.0+1.0i) (num-test (complex 1.0 1234.0) 1.0+1234.0i) (num-test (complex 1.0 pi) 1.0+3.14159265358979i) (num-test (complex 2 -1) 2.0-1.0i) (num-test (complex 2 -10) 2.0-10.0i) (num-test (complex 2 -1234) 2.0-1234.0i) (num-test (complex 2 -2) 2.0-2.0i) (num-test (complex 2 -3) 2.0-3.0i) (num-test (complex 2 -500029) 2.0-500029.0i) (num-test (complex 2 1) 2.0+1.0i) (num-test (complex 2 10) 2.0+10.0i) (num-test (complex 2 1234) 2.0+1234.0i) (num-test (complex 2 2) 2.0+2.0i) (num-test (complex 2 3) 2.0+3.0i) (num-test (complex 2 500029) 2.0+500029.0i) (num-test (complex 1/2 0) 1/2) (num-test (complex 1/2 1/2) 0.5+0.5i) (num-test (complex 0 1/2) 0+0.5i) (test (nan? (complex +nan.0 +nan.0)) #t) (test (nan? (complex +nan.0 +inf.0)) #t) (when with-bignums (test (nan? (complex (bignum "0/0") 0)) #t) (test (nan? (complex 0 (bignum "0/0"))) #t) (num-test (complex 0 (* 2 most-positive-fixnum)) 0.0+1.8446744073709551614E19i) (num-test (- (complex 2e20 (* 2 most-positive-fixnum)) 0+1.8446744073709551614E19i) 2e20) (num-test (imag-part (complex 1.0 1180591620717411303424/717897987691852588770249)) 1.644511672909387396372163624382128338027E-3) (test (complex 0.0 0+92233720368547758081.0i) 'error)) (test (complex 0 0+0/0i) 'error) (test (complex 0+0/0i 0) 'error) (test (complex 1.23 1.23 1.23) 'error) (test (complex 1.23) 'error) (test (complex 1.23+1.0i 1.23+1.0i) 'error) (test (complex) 'error) (test (complex 1.0 1.0+0.1i) 'error) (test (complex 1.0+0.1i 1.0) 'error) (for-each (lambda (x) (test (complex x 0-i) 'error)) (list 0 1 1/2 1.0 0.0 0+i)) (for-each (lambda (x) (test (complex 0-i x) 'error)) (list 0 1 pi (- pi) 1/2 0.0 1.0 0+i)) (test (equivalent? (complex 1.0 1/2) 1+0.5i) #t) (for-each (lambda (arg) (test (complex arg 0.0) 'error) (test (complex 0.0 arg) 'error) (test (complex arg +nan.0) 'error) (test (complex +nan.0 arg) 'error) (test (complex arg +inf.0) 'error) (test (complex +inf.0 arg) 'error) (test (complex 1 arg) 'error) (test (complex 1/2 arg) 'error) (test (complex 1+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; make-polar ;;; -------------------------------------------------------------------------------- (num-test (make-polar -0 -1) 0) (num-test (make-polar -0 -10) 0) (num-test (make-polar -0 -1234) 0) (num-test (make-polar -0 -2) 0) (num-test (make-polar -0 -3) 0) (num-test (make-polar -0 -500029) 0) (num-test (make-polar -0 1) 0) (num-test (make-polar -0 10) 0) (num-test (make-polar -0 1234) 0) (num-test (make-polar -0 2) 0) (num-test (make-polar -0 3) 0) (num-test (make-polar -0 500029) 0) (num-test (make-polar -0.0 -0.00000001) 0.0) (num-test (make-polar -0.0 -1.0) 0.0) (num-test (make-polar -0.0 -1234.0) 0.0) (num-test (make-polar -0.0 -3.14159265358979) 0.0) (num-test (make-polar -0.0 0.00000001) 0.0) (num-test (make-polar -0.0 1.0) 0.0) (num-test (make-polar -0.0 1234.0) 0.0) (num-test (make-polar -0.0 pi) 0.0) (num-test (make-polar -0.00000001 -0.00000001) -0.00000001+1e-16i) (num-test (make-polar -0.00000001 -1.0) -0.00000000540302+0.00000000841471i) (num-test (make-polar -0.00000001 -1234.0) 0.00000000798551+0.00000000601928i) (num-test (make-polar -0.00000001 (- pi)) 0.00000001) (num-test (make-polar -0.00000001 0.00000001) -0.00000001-1e-16i) (num-test (make-polar -0.00000001 1.0) -0.00000000540302-0.00000000841471i) (num-test (make-polar -0.00000001 1234.0) 0.00000000798551-0.00000000601928i) (num-test (make-polar -0.00000001 pi) 0.00000001-0.0i) (num-test (make-polar -1 -1) -0.54030230586814+0.84147098480790i) (num-test (make-polar -1 -10) 0.83907152907645-0.54402111088937i) (num-test (make-polar -1 -1234) 0.79855062358758+0.60192765476250i) (num-test (make-polar -1 -2) 0.41614683654714+0.90929742682568i) (num-test (make-polar -1 -3) 0.98999249660045+0.14112000805987i) (num-test (make-polar -1 -500029) -0.85414905629947+0.52002825848479i) (num-test (make-polar -1 1) -0.54030230586814-0.84147098480790i) (num-test (make-polar -1 10) 0.83907152907645+0.54402111088937i) (num-test (make-polar -1 1234) 0.79855062358758-0.60192765476250i) (num-test (make-polar -1 2) 0.41614683654714-0.90929742682568i) (num-test (make-polar -1 3) 0.98999249660045-0.14112000805987i) (num-test (make-polar -1 500029) -0.85414905629947-0.52002825848479i) (num-test (make-polar -1.0 -0.00000001) -1.0+0.00000001i) (num-test (make-polar -1.0 -1.0) -0.54030230586814+0.84147098480790i) (num-test (make-polar -1.0 -1234.0) 0.79855062358758+0.60192765476250i) (num-test (make-polar -1.0 (- pi)) 1.0) (num-test (make-polar -1.0 0.00000001) -1.0-0.00000001i) (num-test (make-polar -1.0 1.0) -0.54030230586814-0.84147098480790i) (num-test (make-polar -1.0 1234.0) 0.79855062358758-0.60192765476250i) (num-test (make-polar -1.0 pi) 1.0-0.0i) (num-test (make-polar -1234 -1) -666.73304544128450+1038.37519525294420i) (num-test (make-polar -1234 -10) 1035.41426688034221-671.32205083748227i) (num-test (make-polar -1234 -1234) 985.41146950707912+742.77872597692169i) (num-test (make-polar -1234 -2) 513.52519629917379+1122.07302470289119i) (num-test (make-polar -1234 -3) 1221.65074080494969+174.14208994587614i) (num-test (make-polar -1234 -500029) -1054.01993547355005+641.71487097022577i) (num-test (make-polar -1234 1) -666.73304544128450-1038.37519525294420i) (num-test (make-polar -1234 10) 1035.41426688034221+671.32205083748227i) (num-test (make-polar -1234 1234) 985.41146950707912-742.77872597692169i) (num-test (make-polar -1234 2) 513.52519629917379-1122.07302470289119i) (num-test (make-polar -1234 3) 1221.65074080494969-174.14208994587614i) (num-test (make-polar -1234 500029) -1054.01993547355005-641.71487097022577i) (num-test (make-polar -1234.0 -1.0) -666.73304544128450+1038.37519525294420i) (num-test (make-polar -1234.0 -1234.0) 985.41146950707912+742.77872597692169i) (num-test (make-polar -1234.0 (- pi)) 1234.0+0.00000000000015i) (num-test (make-polar -1234.0 1.0) -666.73304544128450-1038.37519525294420i) (num-test (make-polar -1234.0 1234.0) 985.41146950707912-742.77872597692169i) (num-test (make-polar -1234.0 pi) 1234.0-0.00000000000015i) (num-test (make-polar -2 -1) -1.08060461173628+1.68294196961579i) (num-test (make-polar -2 -10) 1.67814305815290-1.08804222177874i) (num-test (make-polar -2 -1234) 1.59710124717517+1.20385530952499i) (num-test (make-polar -2 -2) 0.83229367309428+1.81859485365136i) (num-test (make-polar -2 -3) 1.97998499320089+0.28224001611973i) (num-test (make-polar -2 -500029) -1.70829811259895+1.04005651696957i) (num-test (make-polar -2 1) -1.08060461173628-1.68294196961579i) (num-test (make-polar -2 10) 1.67814305815290+1.08804222177874i) (num-test (make-polar -2 1234) 1.59710124717517-1.20385530952499i) (num-test (make-polar -2 2) 0.83229367309428-1.81859485365136i) (num-test (make-polar -2 3) 1.97998499320089-0.28224001611973i) (num-test (make-polar -2 500029) -1.70829811259895-1.04005651696957i) (num-test (make-polar 0 -1) 0) (num-test (make-polar 0 -10) 0) (num-test (make-polar 0 -1234) 0) (num-test (make-polar 0 -2) 0) (num-test (make-polar 0 -3) 0) (num-test (make-polar 0 -500029) 0) (num-test (make-polar 0 0) 0) (num-test (make-polar 0 1) 0) (num-test (make-polar 0 10) 0) (num-test (make-polar 0 1234) 0) (num-test (make-polar 0 2) 0) (num-test (make-polar 0 3) 0) (num-test (make-polar 0 500029) 0) (num-test (make-polar 0 922337203685477) 0) (num-test (make-polar 0 1/922337203685477) 0) (num-test (make-polar 0.0 -0.00000001) 0.0) (num-test (make-polar 0.0 -1.0) 0.0) (num-test (make-polar 0.0 -1234.0) 0.0) (num-test (make-polar 0.0 -3.14159265358979) 0.0) (num-test (make-polar 0.0 0.0) 0.0) (num-test (make-polar 0.0 0.00000001) 0.0) (num-test (make-polar 0.0 1.0) 0.0) (num-test (make-polar 0.0 1234.0) 0.0) (num-test (make-polar 0.0 pi) 0.0) (num-test (make-polar 0.00000001 -0.00000001) 0.00000001-1e-16i) (num-test (make-polar 0.00000001 -1.0) 0.00000000540302-0.00000000841471i) (num-test (make-polar 0.00000001 -1234.0) -0.00000000798551-0.00000000601928i) (num-test (make-polar 0.00000001 -3.14159265358979) -0.00000001-0.0i) (num-test (make-polar 0.00000001 0.00000001) 0.00000001+1e-16i) (num-test (make-polar 0.00000001 1.0) 0.00000000540302+0.00000000841471i) (num-test (make-polar 0.00000001 1234.0) -0.00000000798551+0.00000000601928i) (num-test (make-polar 0.00000001 pi) -0.00000001) (num-test (make-polar 1 -1) 0.54030230586814-0.84147098480790i) (num-test (make-polar 1 -10) -0.83907152907645+0.54402111088937i) (num-test (make-polar 1 -1234) -0.79855062358758-0.60192765476250i) (num-test (make-polar 1 -2) -0.41614683654714-0.90929742682568i) (num-test (make-polar 1 -3) -0.98999249660045-0.14112000805987i) (num-test (make-polar 1 -500029) 0.85414905629947-0.52002825848479i) (num-test (make-polar 1 1) 0.54030230586814+0.84147098480790i) (num-test (make-polar 1 10) -0.83907152907645-0.54402111088937i) (num-test (make-polar 1 1234) -0.79855062358758+0.60192765476250i) (num-test (make-polar 1 2) -0.41614683654714+0.90929742682568i) (num-test (make-polar 1 3) -0.98999249660045+0.14112000805987i) (num-test (make-polar 1 500029) 0.85414905629947+0.52002825848479i) (num-test (make-polar 1.0 -0.00000001) 1.0-0.00000001i) (num-test (make-polar 1.0 -1.0) 0.54030230586814-0.84147098480790i) (num-test (make-polar 1.0 -1234.0) -0.79855062358758-0.60192765476250i) (num-test (make-polar 1.0 -3.14159265358979) -1.0-0.0i) (num-test (make-polar 1.0 0.00000001) 1.0+0.00000001i) (num-test (make-polar 1.0 1.0) 0.54030230586814+0.84147098480790i) (num-test (make-polar 1.0 1234.0) -0.79855062358758+0.60192765476250i) (num-test (make-polar 1.0 pi) -1.0) (num-test (make-polar 1234 -1) 666.73304544128450-1038.37519525294420i) (num-test (make-polar 1234 -10) -1035.41426688034221+671.32205083748227i) (num-test (make-polar 1234 -1234) -985.41146950707912-742.77872597692169i) (num-test (make-polar 1234 -2) -513.52519629917379-1122.07302470289119i) (num-test (make-polar 1234 -3) -1221.65074080494969-174.14208994587614i) (num-test (make-polar 1234 -500029) 1054.01993547355005-641.71487097022577i) (num-test (make-polar 1234 1) 666.73304544128450+1038.37519525294420i) (num-test (make-polar 1234 10) -1035.41426688034221-671.32205083748227i) (num-test (make-polar 1234 1234) -985.41146950707912+742.77872597692169i) (num-test (make-polar 1234 2) -513.52519629917379+1122.07302470289119i) (num-test (make-polar 1234 3) -1221.65074080494969+174.14208994587614i) (num-test (make-polar 1234 500029) 1054.01993547355005+641.71487097022577i) (num-test (make-polar 1234.0 -1.0) 666.73304544128450-1038.37519525294420i) (num-test (make-polar 1234.0 -1234.0) -985.41146950707912-742.77872597692169i) (num-test (make-polar 1234.0 -3.14159265358979) -1234.0-0.00000000000015i) (num-test (make-polar 1234.0 1.0) 666.73304544128450+1038.37519525294420i) (num-test (make-polar 1234.0 1234.0) -985.41146950707912+742.77872597692169i) (num-test (make-polar 1234.0 pi) -1234.0+0.00000000000015i) (num-test (make-polar 2 -1) 1.08060461173628-1.68294196961579i) (num-test (make-polar 2 -10) -1.67814305815290+1.08804222177874i) (num-test (make-polar 2 -1234) -1.59710124717517-1.20385530952499i) (num-test (make-polar 2 -2) -0.83229367309428-1.81859485365136i) (num-test (make-polar 2 -3) -1.97998499320089-0.28224001611973i) (num-test (make-polar 2 -500029) 1.70829811259895-1.04005651696957i) (num-test (make-polar 2 1) 1.08060461173628+1.68294196961579i) (num-test (make-polar 2 10) -1.67814305815290-1.08804222177874i) (num-test (make-polar 2 1234) -1.59710124717517+1.20385530952499i) (num-test (make-polar 2 2) -0.83229367309428+1.81859485365136i) (num-test (make-polar 2 3) -1.97998499320089+0.28224001611973i) (num-test (make-polar 2 500029) 1.70829811259895+1.04005651696957i) (num-test (angle (make-polar 1.0 4.0)) (- 4 (* 2 pi))) (num-test (make-polar 1/2 0) 1/2) (num-test (make-polar 1/2 pi) -1/2) (num-test (make-polar 1 0) 1) (num-test (make-polar 1 1/2) 0.87758256189037+0.4794255386042i) (num-test (make-polar 0 1/2) 0.0) (test (nan? (make-polar 0 0/0)) #t) (test (nan? (make-polar +nan.0 +nan.0)) #t) (num-test (make-polar 1.0 (* 200 pi)) 1.0) (num-test (make-polar 1.0 (* 2000000 pi)) 1.0) (num-test (make-polar 1.0 (* 2000000000 pi)) 1.0) (let ((val1 (catch #t (lambda () (make-polar 1.0 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (make-polar 1.0 -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (when with-bignums (test (nan? (make-polar (bignum "0/0") 0)) #t) (test (nan? (make-polar 0 (bignum "0/0"))) #t) (num-test (make-polar (bignum "1.0") (bignum "0.0")) 1.0) (num-test (make-polar 1000000000000000000000000.0 0.0) 1e24) (num-test (make-polar 1000000000000000000000000.0 pi) -1e24) (num-test (angle (make-polar 1000000000000000000000000.0 4.0)) (- 4 (* 2 pi))) (num-test (make-polar 1000000000000000000000000.0 4.0) -6.536436208636119146391681830977503814246E23-7.568024953079282513726390945118290941345E23i) (num-test (make-polar 1000000000000000000000000.0 -4.0) -6.536436208636119146391681830977503814246E23+7.568024953079282513726390945118290941345E23i) (num-test (magnitude (make-polar 1e24 (* 1e19 pi))) 1e24) (num-test (magnitude (make-polar 100000000000000000000000000000000000000.0 (* 1.5 pi))) 1e38) (num-test (magnitude (make-polar 100000000000000000000000000000000000000.0 .01)) 1e38) (num-test (angle (make-polar 100000000000000000000000000000000000000.0 (* 100 pi))) 0.0) (test (make-polar 0.0 0+92233720368547758081.0i) 'error)) (test (make-polar 0 0+0/0i) 'error) (test (make-polar 0+0/0i 0) 'error) (test (make-polar 1.23 1.23 1.23) 'error) (test (make-polar 1.23) 'error) (test (make-polar 1.23+1.0i 1.23+1.0i) 'error) (test (make-polar) 'error) (test (make-polar 1.0 1.0+0.1i) 'error) (test (make-polar 1.0+0.1i 0.0) 'error) (for-each (lambda (x) (test (make-polar x 0-i) 'error)) (list 0 1 1/2 1.0 0.0 0+i)) (for-each (lambda (x) (test (make-polar 0-i x) 'error)) (list 0 1 1/2 pi (- pi) 0.0 1.0 0+i)) (for-each (lambda (arg) (test (make-polar arg 0.0) 'error) (test (make-polar 0.0 arg) 'error) (test (make-polar 1 arg) 'error) (test (make-polar 1/2 arg) 'error) (test (make-polar 1+i arg) 'error) (test (make-polar arg +nan.0) 'error) (test (make-polar +nan.0 arg) 'error) (test (make-polar arg +inf.0) 'error) (test (make-polar +inf.0 arg) 'error)) (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; abs ;;; -------------------------------------------------------------------------------- (num-test (abs -0) 0) (num-test (abs -0.0) 0.0) (num-test (abs -0.00000001) 0.00000001) (num-test (abs -0/1) 0/1) (num-test (abs -0/10) 0/10) (num-test (abs -0/1234) 0/1234) (num-test (abs -0/2) 0/2) (num-test (abs -0/3) 0/3) (num-test (abs -0/500029) 0/500029) (num-test (abs -1) 1) (num-test (abs -1.0) 1.0) (num-test (abs -1/1) 1/1) (num-test (abs -1/10) 1/10) (num-test (abs -1/1234) 1/1234) (num-test (abs -1/2) 1/2) (num-test (abs -1/3) 1/3) (num-test (abs -1/500029) 1/500029) (num-test (abs -1/9223372036854775807) 1/9223372036854775807) (num-test (abs -1234) 1234) (num-test (abs -1234.0) 1234.0) (num-test (abs -1234/1) 1234/1) (num-test (abs -1234/10) 1234/10) (num-test (abs -1234/2) 1234/2) (num-test (abs -1234/3) 1234/3) (num-test (abs -1234/500029) 1234/500029) (num-test (abs -123456789) 123456789) (num-test (abs -1234567890) 1234567890) (num-test (abs -2) 2) (num-test (abs -2/1) 2/1) (num-test (abs -2/10) 2/10) (num-test (abs -2/1234) 2/1234) (num-test (abs -2/2) 2/2) (num-test (abs -2/3) 2/3) (num-test (abs -2/500029) 2/500029) (num-test (abs -3) 3) (num-test (abs -3.14159265358979) pi) (num-test (abs -3/500029) 3/500029) (num-test (abs -500029) 500029) (num-test (abs -500029/1) 500029/1) (num-test (abs -500029/10) 500029/10) (num-test (abs -500029/1234) 500029/1234) (num-test (abs -500029/2) 500029/2) (num-test (abs -500029/3) 500029/3) (num-test (abs -500029/500029) 500029/500029) (num-test (abs -6) 6) (num-test (abs -7) 7) (num-test (abs 0) 0) (num-test (abs 0.0) 0.0) (num-test (abs 0.00000001) 0.00000001) (num-test (abs 0/1) 0/1) (num-test (abs 0/10) 0/10) (num-test (abs 0/1234) 0/1234) (num-test (abs 0/2) 0/2) (num-test (abs 0/3) 0/3) (num-test (abs 0/500029) 0/500029) (num-test (abs 1) 1) (num-test (abs 1.0) 1.0) (num-test (abs 1/1) 1/1) (num-test (abs 1/10) 1/10) (num-test (abs 1/1234) 1/1234) (num-test (abs 1/2) 1/2) (num-test (abs 1/3) 1/3) (num-test (abs 1/500029) 1/500029) (num-test (abs 1234) 1234) (num-test (abs 1234.0) 1234.0) (num-test (abs 1234/1) 1234/1) (num-test (abs 1234/10) 1234/10) (num-test (abs 1234/2) 1234/2) (num-test (abs 1234/3) 1234/3) (num-test (abs 1234/500029) 1234/500029) (num-test (abs 2) 2) (num-test (abs 2/1) 2/1) (num-test (abs 2/10) 2/10) (num-test (abs 2/1234) 2/1234) (num-test (abs 2/2) 2/2) (num-test (abs 2/3) 2/3) (num-test (abs 2/500029) 2/500029) (num-test (abs 3) 3) (num-test (abs 500029) 500029) (num-test (abs 500029/1) 500029/1) (num-test (abs 500029/10) 500029/10) (num-test (abs 500029/1234) 500029/1234) (num-test (abs 500029/2) 500029/2) (num-test (abs 500029/3) 500029/3) (num-test (abs 500029/500029) 500029/500029) (num-test (abs 6) 6) (num-test (abs 7) 7) (num-test (abs pi) pi) (num-test (abs -2.225073858507201399999999999999999999996E-308) 2.225073858507201399999999999999999999996E-308) (num-test (abs 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16) (num-test (abs 9223372036854775807) 9223372036854775807) (test (= (abs (+ most-negative-fixnum 1)) most-positive-fixnum) #t) (test (abs most-positive-fixnum) most-positive-fixnum) (num-test (abs -922337203685477580) 922337203685477580) (test (abs -9223372036854775808) (if with-bignums 9223372036854775808 'error)) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'abs num (abs num) val))) (vector (list 0 0) (list 1 1) (list 2 2) (list 3 3) (list -1 1) (list -2 2) (list -3 3) (list 9223372036854775807 9223372036854775807) (list 1/2 1/2) (list 1/3 1/3) (list -1/2 1/2) (list -1/3 1/3) (list 1/9223372036854775807 1/9223372036854775807) (list 0.0 0.0) (list 1.0 1.0) (list 2.0 2.0) (list -2.0 2.0) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 1e+16 1e+16) )) (when with-bignums (num-test (abs -1e310) 1e310) (num-test (abs -.1e310) 1e309) (num-test (abs -.00001e309) 1e304) (num-test (abs most-negative-fixnum) 9223372036854775808) (num-test (abs -.1e-400) 1.000000000000000000000000000000000000001E-401) (num-test (abs -1.797693134862315699999999999999999999998E308) 1.797693134862315699999999999999999999998E308) (num-test (abs -12345678901234567890) 12345678901234567890) (num-test (abs 12345678901234567890) 12345678901234567890) (num-test (abs 9223372036854775808.0) 9223372036854775808.0) (num-test (abs -9223372036854775808.0) 9223372036854775808.0) (num-test (abs 9223372036854775808/3) 9223372036854775808/3) (num-test (abs -9223372036854775808/3) 9223372036854775808/3) (num-test (abs 9223372036854775808) 9223372036854775808) (num-test (abs -9223372036854775808) 9223372036854775808) (num-test (abs 1231234567891234567895/4924938271564938271564) 1231234567891234567895/4924938271564938271564) (num-test (abs -1231234567891234567895/4924938271564938271564) 1231234567891234567895/4924938271564938271564) (num-test (abs 5/4924938271564938271564) 5/4924938271564938271564) (num-test (abs -5/4924938271564938271564) 5/4924938271564938271564) (num-test (abs 1231234567891234567895.4924938271564938271564) 1231234567891234567895.4924938271564938271564) (num-test (abs -1231234567891234567895.4924938271564938271564) 1231234567891234567895.4924938271564938271564) (test (< (abs (- 217307123869033896670383722255101771944951615456222473725950809456844385078286527901170732595082536915607499776643486838126400154358628745576030002134993982282420557293291331398770482226850626076965834765751024210059623687394545134173058036837172944503241193618487196846261991269480351798163386073355597133702428176134419602160051931823812274538708325328119629419660293102211559158897247464223430070715316610068188075169995173607390273159413073729599663002285391560133032803005324145809498542320942319/69171005865679080805116192745197553936743146778127491628445014149228719516632195993428601364184241694325570308897501794466504355763015991674090032275753543906386364041957503000266249940077862458146827521257517440768326138892186263673940157476537922438310169667984623997354774657585797547359740040386280140433453254961653602051204994301868729700341678413408419088335979860854285428030584998257285624659397393914631805389952520897186723117920856639645035858695810847480593484518166856238091362466500961 pi)) 1e-30) #t) (test (< (abs (- 86506249226122124054607019515040072569389309675677090446756879032293209564976057920114008345082990143050895371432654098617595803586181179031736344131661104245709204440599410618785461104070923873664766537405043170624321277708803595336768044461421851475181966244993926088957647640608814315524675779027527947452743019231877030652479460288601395608061537360792381908211008391170537372395545350366754911899795085297260398105485029514527793853213999006311528934617756311568188335120606938078206683552323219/31823870623143321794788842272907994994917601540780651644441590671647399038540853367332145707942720183928541015066510539504636213034857780420049324239395126123695561521079512763516656025946557452382852551302156382716241918690232497805575429042492016743374932252325803315778289435501557305339709678335435100310171257145989526559485407857600325792028152511795618358674583299689136950642929744615564346477399823659926550178426308547711386364571735861738189405232059295317994009776897697526162381026548407 (exp 1.0))) 1e-10) #t) (test (< (abs (- 394372834342725903069943709807632345074473102456264/125532772013612015195543173729505082616186012726141 pi)) 1e-100) #t) (test (< (abs (- 37263594917349868210957473113622483286895975031882232950275573404793068492510874215659862655765029385/11861370656940517106115970314230542917832783292279765360251185207749769595904108589726721941267812387 pi)) 1e-200) #t) (test (< (abs (- 9723120205746844213570925835953968530586731050832362731080980958991370971563630998369876152193644009314571826202389376113741653418445346223192649145551112347805140423409409719828584948506325652698166338315337526327656688617124164275819596889301942895/3094965286042593318538169915190725425595617454610327314732861344227207817775353866654459841280603529756895813991351842180977260125352058245398197717632118060786828996125027995519815695529226138848308047979443033939320415958110104195587441744710374021 pi)) 1e-500) #t) (test (< (abs (- 217307123869033896670383722255101771944951615456222473725950809456844385078286527901170732595082536915607499776643486838126400154358628745576030002134993982282420557293291331398770482226850626076965834765751024210059623687394545134173058036837172944503241193618487196846261991269480351798163386073355597133702428176134419602160051931823812274538708325328119629419660293102211559158897247464223430070715316610068188075169995173607390273159413073729599663002285391560133032803005324145809498542320942319/69171005865679080805116192745197553936743146778127491628445014149228719516632195993428601364184241694325570308897501794466504355763015991674090032275753543906386364041957503000266249940077862458146827521257517440768326138892186263673940157476537922438310169667984623997354774657585797547359740040386280140433453254961653602051204994301868729700341678413408419088335979860854285428030584998257285624659397393914631805389952520897186723117920856639645035858695810847480593484518166856238091362466500961 pi)) 1e-1000) #t) (test (< (abs (- 86506249226122124054607019515040072569389309675677090446756879032293209564976057920114008345082990143050895371432654098617595803586181179031736344131661104245709204440599410618785461104070923873664766537405043170624321277708803595336768044461421851475181966244993926088957647640608814315524675779027527947452743019231877030652479460288601395608061537360792381908211008391170537372395545350366754911899795085297260398105485029514527793853213999006311528934617756311568188335120606938078206683552323219/31823870623143321794788842272907994994917601540780651644441590671647399038540853367332145707942720183928541015066510539504636213034857780420049324239395126123695561521079512763516656025946557452382852551302156382716241918690232497805575429042492016743374932252325803315778289435501557305339709678335435100310171257145989526559485407857600325792028152511795618358674583299689136950642929744615564346477399823659926550178426308547711386364571735861738189405232059295317994009776897697526162381026548407 (exp (bignum "1.0")))) 1e-1000) #t)) (test (abs 0+0i) 0.0) (test (abs 1.23 1.23) 'error) (test (abs 1.23+1.0i) 'error) (test (abs) 'error) (test (nan? (abs 1/0)) #t) (test (positive? (abs (real-part (log 0.0)))) #t) (if (not pure-s7) (test (abs 1.0+0.1i) 'error)) ;; an optimizer bug (let () (define (t1) (let ((a 1+i) (b 0+i)) (abs (- a b)))) (num-test (t1) 1.0)) (for-each (lambda (arg) (test (abs arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; magnitude ;;; -------------------------------------------------------------------------------- (num-test (magnitude (complex (expt 2 62) (expt 2 62))) 6.521908912666391106174785903126254184439E18) (num-test (magnitude (complex most-positive-fixnum most-negative-fixnum)) 1.30438178253327822116424650250659608445E19) (num-test (magnitude (complex most-positive-fixnum most-positive-fixnum)) 1.304381782533278221093535824387941332006E19) (num-test (magnitude -0) 0) (num-test (magnitude -0.0) 0.0) (num-test (magnitude -0.0+0.00000001i) 0.00000001) (num-test (magnitude -0.0+1.0i) 1.0) (num-test (magnitude -0.0+1234.0i) 1234.0) (num-test (magnitude -0.0+3.14159265358979i) 3.14159265358979) (num-test (magnitude -0.0-0.00000001i) 0.00000001) (num-test (magnitude -0.0-1.0i) 1.0) (num-test (magnitude -0.0-1234.0i) 1234.0) (num-test (magnitude -0.0-3.14159265358979i) 3.14159265358979) (num-test (magnitude -0.00000001) 0.00000001) (num-test (magnitude -0.00000001+0.00000001i) 0.00000001414214) (num-test (magnitude -0.00000001+1.0i) 1.0) (num-test (magnitude -0.00000001+1234.0i) 1234.0) (num-test (magnitude -0.00000001+3.14159265358979i) pi) (num-test (magnitude -0.00000001-0.00000001i) 0.00000001414214) (num-test (magnitude -0.00000001-1.0i) 1.0) (num-test (magnitude -0.00000001-1234.0i) 1234.0) (num-test (magnitude -0.00000001-3.14159265358979i) pi) (num-test (magnitude -0/1) 0/1) (num-test (magnitude -0/10) 0/10) (num-test (magnitude -0/1234) 0/1234) (num-test (magnitude -0/2) 0/2) (num-test (magnitude -0/3) 0/3) (num-test (magnitude -0/500029) 0/500029) (num-test (magnitude -1) 1) (num-test (magnitude -1.0) 1.0) (num-test (magnitude -1.0+0.00000001i) 1.0) (num-test (magnitude -1.0+1.0i) 1.41421356237310) (num-test (magnitude -1.0+1234.0i) 1234.00040518631931) (num-test (magnitude -1.0+3.14159265358979i) 3.29690830947562) (num-test (magnitude -1.0-0.00000001i) 1.0) (num-test (magnitude -1.0-1.0i) 1.41421356237310) (num-test (magnitude -1.0-1234.0i) 1234.00040518631931) (num-test (magnitude -1.0-3.14159265358979i) 3.29690830947562) (num-test (magnitude -1.0e+00+0.0e+00i) 1e0) (num-test (magnitude -1.0e+00+1.0e+00i) 1.4142135623730950488e0) (num-test (magnitude -1.0e+00+1.19209289550781250e-07i) 1.0000000000000071054e0) (num-test (magnitude -1.0e+00+2.0e+00i) 2.2360679774997896964e0) (num-test (magnitude -1.0e+00+5.0e-01i) 1.1180339887498948482e0) (num-test (magnitude -1.0e+00+8.3886080e+06i) 8.3886080000000596046e6) (num-test (magnitude -1.0e+00-1.0e+00i) 1.4142135623730950488e0) (num-test (magnitude -1.0e+00-1.19209289550781250e-07i) 1.0000000000000071054e0) (num-test (magnitude -1.0e+00-2.0e+00i) 2.2360679774997896964e0) (num-test (magnitude -1.0e+00-5.0e-01i) 1.1180339887498948482e0) (num-test (magnitude -1.0e+00-8.3886080e+06i) 8.3886080000000596046e6) (num-test (magnitude -1.19209289550781250e-07+0.0e+00i) 1.1920928955078125e-7) (num-test (magnitude -1.19209289550781250e-07+1.0e+00i) 1.0000000000000071054e0) (num-test (magnitude -1.19209289550781250e-07+1.19209289550781250e-07i) 1.6858739404357612715e-7) (num-test (magnitude -1.19209289550781250e-07+2.0e+00i) 2.0000000000000035527e0) (num-test (magnitude -1.19209289550781250e-07+5.0e-01i) 5.0000000000001421085e-1) (num-test (magnitude -1.19209289550781250e-07+8.3886080e+06i) 8.3886080e6) (num-test (magnitude -1.19209289550781250e-07-1.0e+00i) 1.0000000000000071054e0) (num-test (magnitude -1.19209289550781250e-07-1.19209289550781250e-07i) 1.6858739404357612715e-7) (num-test (magnitude -1.19209289550781250e-07-2.0e+00i) 2.0000000000000035527e0) (num-test (magnitude -1.19209289550781250e-07-5.0e-01i) 5.0000000000001421085e-1) (num-test (magnitude -1.19209289550781250e-07-8.3886080e+06i) 8.3886080e6) (num-test (magnitude -1/1) 1/1) (num-test (magnitude -1/10) 1/10) (num-test (magnitude -1/1234) 1/1234) (num-test (magnitude -1/2) 1/2) (num-test (magnitude -1/3) 1/3) (num-test (magnitude -1/500029) 1/500029) (num-test (magnitude -1234/500029) 1234/500029) (num-test (magnitude -2) 2) (num-test (magnitude -2.0e+00+0.0e+00i) 2e0) (num-test (magnitude -2.0e+00+1.0e+00i) 2.2360679774997896964e0) (num-test (magnitude -2.0e+00+1.19209289550781250e-07i) 2.0000000000000035527e0) (num-test (magnitude -2.0e+00+2.0e+00i) 2.8284271247461900976e0) (num-test (magnitude -2.0e+00+5.0e-01i) 2.0615528128088302749e0) (num-test (magnitude -2.0e+00+8.3886080e+06i) 8.3886080000002384186e6) (num-test (magnitude -2.0e+00-1.0e+00i) 2.2360679774997896964e0) (num-test (magnitude -2.0e+00-1.19209289550781250e-07i) 2.0000000000000035527e0) (num-test (magnitude -2.0e+00-2.0e+00i) 2.8284271247461900976e0) (num-test (magnitude -2.0e+00-5.0e-01i) 2.0615528128088302749e0) (num-test (magnitude -2.0e+00-8.3886080e+06i) 8.3886080000002384186e6) (num-test (magnitude -2/1) 2/1) (num-test (magnitude -2/10) 2/10) (num-test (magnitude -2/1234) 2/1234) (num-test (magnitude -2/2) 2/2) (num-test (magnitude -2/3) 2/3) (num-test (magnitude -2/500029) 2/500029) (num-test (magnitude -5.0e-01+0.0e+00i) 5e-1) (num-test (magnitude -5.0e-01+1.0e+00i) 1.1180339887498948482e0) (num-test (magnitude -5.0e-01+1.19209289550781250e-07i) 5.0000000000001421085e-1) (num-test (magnitude -5.0e-01+2.0e+00i) 2.0615528128088302749e0) (num-test (magnitude -5.0e-01+5.0e-01i) 7.0710678118654752440e-1) (num-test (magnitude -5.0e-01+8.3886080e+06i) 8.3886080000000149012e6) (num-test (magnitude -5.0e-01-1.0e+00i) 1.1180339887498948482e0) (num-test (magnitude -5.0e-01-1.19209289550781250e-07i) 5.0000000000001421085e-1) (num-test (magnitude -5.0e-01-2.0e+00i) 2.0615528128088302749e0) (num-test (magnitude -5.0e-01-5.0e-01i) 7.0710678118654752440e-1) (num-test (magnitude -5.0e-01-8.3886080e+06i) 8.3886080000000149012e6) (num-test (magnitude -500029) 500029) (num-test (magnitude -500029/1) 500029/1) (num-test (magnitude -500029/10) 500029/10) (num-test (magnitude -500029/1234) 500029/1234) (num-test (magnitude -500029/2) 500029/2) (num-test (magnitude -500029/3) 500029/3) (num-test (magnitude -500029/500029) 500029/500029) (num-test (magnitude -8.3886080e+06+0.0e+00i) 8.388608e6) (num-test (magnitude -8.3886080e+06+1.0e+00i) 8.3886080000000596046e6) (num-test (magnitude -8.3886080e+06+1.19209289550781250e-07i) 8.3886080e6) (num-test (magnitude -8.3886080e+06+2.0e+00i) 8.3886080000002384186e6) (num-test (magnitude -8.3886080e+06+5.0e-01i) 8.3886080000000149012e6) (num-test (magnitude -8.3886080e+06+8.3886080e+06i) 1.1863283203031444111e7) (num-test (magnitude -8.3886080e+06-1.0e+00i) 8.3886080000000596046e6) (num-test (magnitude -8.3886080e+06-1.19209289550781250e-07i) 8.3886080e6) (num-test (magnitude -8.3886080e+06-2.0e+00i) 8.3886080000002384186e6) (num-test (magnitude -8.3886080e+06-5.0e-01i) 8.3886080000000149012e6) (num-test (magnitude -8.3886080e+06-8.3886080e+06i) 1.1863283203031444111e7) (num-test (magnitude .1e-18-.1e-18i) 1.4142135623731e-19) (num-test (magnitude .1e200+.1e200i) 1.4142135623731e+199) (num-test (magnitude 0) 0) (num-test (magnitude 0.0) 0.0) (num-test (magnitude 0.0+0.00000001i) 0.00000001) (num-test (magnitude 0.0+1.0i) 1.0) (num-test (magnitude 0.0+1234.0i) 1234.0) (num-test (magnitude 0.0+3.14159265358979i) 3.14159265358979) (num-test (magnitude 0.0-0.00000001i) 0.00000001) (num-test (magnitude 0.0-1.0i) 1.0) (num-test (magnitude 0.0-1234.0i) 1234.0) (num-test (magnitude 0.0-3.14159265358979i) 3.14159265358979) (num-test (magnitude 0.00000001) 0.00000001) (num-test (magnitude 0.00000001+0.00000001i) 0.00000001414214) (num-test (magnitude 0.00000001+1.0i) 1.0) (num-test (magnitude 0.00000001+1234.0i) 1234.0) (num-test (magnitude 0.00000001+3.14159265358979i) pi) (num-test (magnitude 0.00000001-0.00000001i) 0.00000001414214) (num-test (magnitude 0.00000001-1.0i) 1.0) (num-test (magnitude 0.00000001-1234.0i) 1234.0) (num-test (magnitude 0.00000001-3.14159265358979i) pi) (num-test (magnitude 0.0e+00+0.0e+00i) 0e0) (num-test (magnitude 0.0e+00+1.0e+00i) 1e0) (num-test (magnitude 0.0e+00+1.19209289550781250e-07i) 1.1920928955078125e-7) (num-test (magnitude 0.0e+00+2.0e+00i) 2e0) (num-test (magnitude 0.0e+00+5.0e-01i) 5e-1) (num-test (magnitude 0.0e+00+8.3886080e+06i) 8.388608e6) (num-test (magnitude 0.0e+00-1.0e+00i) 1e0) (num-test (magnitude 0.0e+00-1.19209289550781250e-07i) 1.1920928955078125e-7) (num-test (magnitude 0.0e+00-2.0e+00i) 2e0) (num-test (magnitude 0.0e+00-5.0e-01i) 5e-1) (num-test (magnitude 0.0e+00-8.3886080e+06i) 8.388608e6) (num-test (magnitude 0/1) 0/1) (num-test (magnitude 0/10) 0/10) (num-test (magnitude 0/1234) 0/1234) (num-test (magnitude 0/2) 0/2) (num-test (magnitude 0/3) 0/3) (num-test (magnitude 0/500029) 0/500029) (num-test (magnitude 1) 1) (num-test (magnitude 1.0) 1.0) (num-test (magnitude 1.0+0.00000001i) 1.0) (num-test (magnitude 1.0+1.0i) 1.41421356237310) (num-test (magnitude 1.0+1234.0i) 1234.00040518631931) (num-test (magnitude 1.0+3.14159265358979i) 3.29690830947562) (num-test (magnitude 1.0-0.00000001i) 1.0) (num-test (magnitude 1.0-1.0i) 1.41421356237310) (num-test (magnitude 1.0-1234.0i) 1234.00040518631931) (num-test (magnitude 1.0-3.14159265358979i) 3.29690830947562) (num-test (magnitude 1.0e+00+0.0e+00i) 1e0) (num-test (magnitude 1.0e+00+1.0e+00i) 1.4142135623730950488e0) (num-test (magnitude 1.0e+00+1.19209289550781250e-07i) 1.0000000000000071054e0) (num-test (magnitude 1.0e+00+2.0e+00i) 2.2360679774997896964e0) (num-test (magnitude 1.0e+00+5.0e-01i) 1.1180339887498948482e0) (num-test (magnitude 1.0e+00+8.3886080e+06i) 8.3886080000000596046e6) (num-test (magnitude 1.0e+00-1.0e+00i) 1.4142135623730950488e0) (num-test (magnitude 1.0e+00-1.19209289550781250e-07i) 1.0000000000000071054e0) (num-test (magnitude 1.0e+00-2.0e+00i) 2.2360679774997896964e0) (num-test (magnitude 1.0e+00-5.0e-01i) 1.1180339887498948482e0) (num-test (magnitude 1.0e+00-8.3886080e+06i) 8.3886080000000596046e6) (num-test (magnitude 1.19209289550781250e-07+0.0e+00i) 1.1920928955078125e-7) (num-test (magnitude 1.19209289550781250e-07+1.0e+00i) 1.0000000000000071054e0) (num-test (magnitude 1.19209289550781250e-07+1.19209289550781250e-07i) 1.6858739404357612715e-7) (num-test (magnitude 1.19209289550781250e-07+2.0e+00i) 2.0000000000000035527e0) (num-test (magnitude 1.19209289550781250e-07+5.0e-01i) 5.0000000000001421085e-1) (num-test (magnitude 1.19209289550781250e-07+8.3886080e+06i) 8.3886080e6) (num-test (magnitude 1.19209289550781250e-07-1.0e+00i) 1.0000000000000071054e0) (num-test (magnitude 1.19209289550781250e-07-1.19209289550781250e-07i) 1.6858739404357612715e-7) (num-test (magnitude 1.19209289550781250e-07-2.0e+00i) 2.0000000000000035527e0) (num-test (magnitude 1.19209289550781250e-07-5.0e-01i) 5.0000000000001421085e-1) (num-test (magnitude 1.19209289550781250e-07-8.3886080e+06i) 8.3886080e6) (num-test (magnitude 1/1) 1/1) (num-test (magnitude 1/10) 1/10) (num-test (magnitude 1/1234) 1/1234) (num-test (magnitude 1/2) 1/2) (num-test (magnitude 1/3) 1/3) (num-test (magnitude 1/500029) 1/500029) (num-test (magnitude 1e18+1e18i) 1.414213562373095048801688724209698078569E18) (num-test (magnitude 2) 2) (num-test (magnitude 2.0e+00+0.0e+00i) 2e0) (num-test (magnitude 2.0e+00+1.0e+00i) 2.2360679774997896964e0) (num-test (magnitude 2.0e+00+1.19209289550781250e-07i) 2.0000000000000035527e0) (num-test (magnitude 2.0e+00+2.0e+00i) 2.8284271247461900976e0) (num-test (magnitude 2.0e+00+5.0e-01i) 2.0615528128088302749e0) (num-test (magnitude 2.0e+00+8.3886080e+06i) 8.3886080000002384186e6) (num-test (magnitude 2.0e+00-1.0e+00i) 2.2360679774997896964e0) (num-test (magnitude 2.0e+00-1.19209289550781250e-07i) 2.0000000000000035527e0) (num-test (magnitude 2.0e+00-2.0e+00i) 2.8284271247461900976e0) (num-test (magnitude 2.0e+00-5.0e-01i) 2.0615528128088302749e0) (num-test (magnitude 2.0e+00-8.3886080e+06i) 8.3886080000002384186e6) (num-test (magnitude 2/1) 2/1) (num-test (magnitude 2/10) 2/10) (num-test (magnitude 2/1234) 2/1234) (num-test (magnitude 2/2) 2/2) (num-test (magnitude 2/3) 2/3) (num-test (magnitude 2/500029) 2/500029) (num-test (magnitude 5.0e-01+0.0e+00i) 5e-1) (num-test (magnitude 5.0e-01+1.0e+00i) 1.1180339887498948482e0) (num-test (magnitude 5.0e-01+1.19209289550781250e-07i) 5.0000000000001421085e-1) (num-test (magnitude 5.0e-01+2.0e+00i) 2.0615528128088302749e0) (num-test (magnitude 5.0e-01+5.0e-01i) 7.0710678118654752440e-1) (num-test (magnitude 5.0e-01+8.3886080e+06i) 8.3886080000000149012e6) (num-test (magnitude 5.0e-01-1.0e+00i) 1.1180339887498948482e0) (num-test (magnitude 5.0e-01-1.19209289550781250e-07i) 5.0000000000001421085e-1) (num-test (magnitude 5.0e-01-2.0e+00i) 2.0615528128088302749e0) (num-test (magnitude 5.0e-01-5.0e-01i) 7.0710678118654752440e-1) (num-test (magnitude 5.0e-01-8.3886080e+06i) 8.3886080000000149012e6) (num-test (magnitude 500029) 500029) (num-test (magnitude 500029/1) 500029/1) (num-test (magnitude 500029/10) 500029/10) (num-test (magnitude 500029/1234) 500029/1234) (num-test (magnitude 500029/2) 500029/2) (num-test (magnitude 500029/3) 500029/3) (num-test (magnitude 500029/500029) 500029/500029) (num-test (magnitude 8.3886080e+06+0.0e+00i) 8.388608e6) (num-test (magnitude 8.3886080e+06+1.0e+00i) 8.3886080000000596046e6) (num-test (magnitude 8.3886080e+06+1.19209289550781250e-07i) 8.3886080e6) (num-test (magnitude 8.3886080e+06+2.0e+00i) 8.3886080000002384186e6) (num-test (magnitude 8.3886080e+06+5.0e-01i) 8.3886080000000149012e6) (num-test (magnitude 8.3886080e+06+8.3886080e+06i) 1.1863283203031444111e7) (num-test (magnitude 8.3886080e+06-1.0e+00i) 8.3886080000000596046e6) (num-test (magnitude 8.3886080e+06-1.19209289550781250e-07i) 8.3886080e6) (num-test (magnitude 8.3886080e+06-2.0e+00i) 8.3886080000002384186e6) (num-test (magnitude 8.3886080e+06-5.0e-01i) 8.3886080000000149012e6) (num-test (magnitude 8.3886080e+06-8.3886080e+06i) 1.1863283203031444111e7) (num-test (magnitude most-positive-fixnum) most-positive-fixnum) (num-test (magnitude pi) pi) (num-test (magnitude -2.225073858507201399999999999999999999996E-308) 2.225073858507201399999999999999999999996E-308) (if (not with-bignums) (num-test (magnitude -9223372036854775808) 9223372036854775807)) ; changed 28-Apr-15 (num-test (magnitude 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16) (num-test (magnitude 9223372036854775807) 9223372036854775807) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'magnitude num (magnitude num) val))) (vector (list 0 0) (list 1 1) (list 2 2) (list 3 3) (list -1 1) (list -2 2) (list -3 3) (list 9223372036854775807 9223372036854775807) (list 1/2 1/2) (list 1/3 1/3) (list -1/2 1/2) (list -1/3 1/3) (list 1/9223372036854775807 1/9223372036854775807) (list 0.0 0.0) (list 1.0 1.0) (list 2.0 2.0) (list -2.0 2.0) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 1e+16 1e+16) (list 0+1i 1.0) (list 0+2i 2.0) (list 0-1i 1.0) (list 1+1i 1.4142135623731) (list 1-1i 1.4142135623731) (list -1+1i 1.4142135623731) (list -1-1i 1.4142135623731) (list 0.1+0.1i 0.14142135623731) (list 1e+16+1e+16i 1.4142135623731e+16) (list 1e-16+1e-16i 1.4142135623731e-16) )) (when with-bignums (num-test (magnitude (complex (expt 2 63) (expt 2 63))) 1.304381782533278221234957180625250836888E19) (num-test (magnitude most-negative-fixnum) 9223372036854775808) (num-test (magnitude 1e400+1e400i) 1.414213562373095048801688724209698078569E400) (num-test (magnitude .1e400+.1e400i) 1.41421356237309504880168872420969807857E399) (num-test (magnitude .001e310+.001e310i) 1.414213562373095048801688724209698078572E307) (num-test (magnitude 1e-310+1e-310i) 1.414213562373095048801688724209698078569E-310) (num-test (magnitude 1e-400+1e-400i) 1.414213562373095048801688724209698078568E-400) (num-test (magnitude -1.797693134862315699999999999999999999998E308) 1.797693134862315699999999999999999999998E308) (num-test (magnitude 9223372036854775808.1) 9223372036854775808.1) (num-test (magnitude 9223372036854775808) 9223372036854775808) (num-test (magnitude 9223372036854775808/3) 9223372036854775808/3) (num-test (magnitude 9223372036854775808.1+1.0e19i) 1.360406526484765934746566522678055771386E19) (num-test (magnitude 1.0e19+9223372036854775808.1i) 1.360406526484765934746566522678055771386E19) (num-test (magnitude 14142135623730950488.0168872420969+14142135623730950488.0168872420969i) 1.9999999999999999999999999999999885751772054578776001965575456E19)) (test (magnitude "hi") 'error) (test (magnitude 1.0+23.0i 1.0+23.0i) 'error) (test (magnitude) 'error) (for-each (lambda (arg) (test (magnitude arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; (magnitude -9223372036854775808) -> -9223372036854775808? ;;; -------------------------------------------------------------------------------- ;;; angle ;;; -------------------------------------------------------------------------------- (num-test (angle (make-polar 1.0 (+ pi .0001))) (- .0001 pi)) (num-test (angle (make-polar 1.0 (- pi .0001))) (- pi .0001)) (num-test (angle -0) 0) (num-test (angle -0.0+0.00000001i) 1.57079632679490) (num-test (angle -0.0+1.0i) 1.57079632679490) (num-test (angle -0.0+1234.0i) 1.57079632679490) (num-test (angle -0.0+3.14159265358979i) 1.57079632679490) (num-test (angle -0.0-0.00000001i) -1.57079632679490) (num-test (angle -0.0-1.0i) -1.57079632679490) (num-test (angle -0.0-1234.0i) -1.57079632679490) (num-test (angle -0.0-3.14159265358979i) -1.57079632679490) (num-test (angle -0.00000001) pi) (num-test (angle -0.00000001+0.00000001i) 2.35619449019234) (num-test (angle -0.00000001+1.0i) 1.57079633679490) (num-test (angle -0.00000001+1234.0i) 1.57079632680300) (num-test (angle -0.00000001+3.14159265358979i) 1.57079632997800) (num-test (angle -0.00000001-0.00000001i) -2.35619449019234) (num-test (angle -0.00000001-1.0i) -1.57079633679490) (num-test (angle -0.00000001-1234.0i) -1.57079632680300) (num-test (angle -0.00000001-3.14159265358979i) -1.57079632997800) (num-test (angle -1) pi) (num-test (angle -1.0) pi) (num-test (angle -1.0+0.00000001i) 3.14159264358979) (num-test (angle -1.0+1.0i) 2.35619449019234) (num-test (angle -1.0+1234.0i) 1.57160669938898) (num-test (angle -1.0+3.14159265358979i) 1.87896539791088) (num-test (angle -1.0-0.00000001i) -3.14159264358979) (num-test (angle -1.0-1.0i) -2.35619449019234) (num-test (angle -1.0-1234.0i) -1.57160669938898) (num-test (angle -1.0-3.14159265358979i) -1.87896539791088) (num-test (angle -1.0e+00+0.0e+00i) pi) (num-test (angle -1.0e+00+1.0e+00i) 2.3561944901923449288e0) (num-test (angle -1.0e+00+1.19209289550781250e-07i) 3.1415925343805036877e0) (num-test (angle -1.0e+00+2.0e+00i) 2.0344439357957027354e0) (num-test (angle -1.0e+00+5.0e-01i) 2.6779450445889871222e0) (num-test (angle -1.0e+00+8.3886080e+06i) 1.570796446004186170e0) (num-test (angle -1.0e+00-1.0e+00i) -2.3561944901923449288e0) (num-test (angle -1.0e+00-1.19209289550781250e-07i) -3.1415925343805036877e0) (num-test (angle -1.0e+00-2.0e+00i) -2.0344439357957027354e0) (num-test (angle -1.0e+00-5.0e-01i) -2.6779450445889871222e0) (num-test (angle -1.0e+00-8.3886080e+06i) -1.570796446004186170e0) (num-test (angle -1.19209289550781250e-07+0.0e+00i) pi) (num-test (angle -1.19209289550781250e-07+1.0e+00i) 1.570796446004186170e0) (num-test (angle -1.19209289550781250e-07+1.19209289550781250e-07i) 2.3561944901923449288e0) (num-test (angle -1.19209289550781250e-07+2.0e+00i) 1.5707963863995413946e0) (num-test (angle -1.19209289550781250e-07+5.0e-01i) 1.5707965652134757208e0) (num-test (angle -1.19209289550781250e-07+8.3886080e+06i) 1.5707963267949108301e0) (num-test (angle -1.19209289550781250e-07-1.0e+00i) -1.570796446004186170e0) (num-test (angle -1.19209289550781250e-07-1.19209289550781250e-07i) -2.3561944901923449288e0) (num-test (angle -1.19209289550781250e-07-2.0e+00i) -1.5707963863995413946e0) (num-test (angle -1.19209289550781250e-07-5.0e-01i) -1.5707965652134757208e0) (num-test (angle -1.19209289550781250e-07-8.3886080e+06i) -1.5707963267949108301e0) (num-test (angle -1/1) pi) (num-test (angle -1/10) pi) (num-test (angle -1/1234) pi) (num-test (angle -1/2) pi) (num-test (angle -1/3) pi) (num-test (angle -1/500029) pi) (num-test (angle -2) pi) (num-test (angle -2.0e+00+0.0e+00i) pi) (num-test (angle -2.0e+00+1.0e+00i) 2.6779450445889871222e0) (num-test (angle -2.0e+00+1.19209289550781250e-07i) 3.1415925939851484631e0) (num-test (angle -2.0e+00+2.0e+00i) 2.3561944901923449288e0) (num-test (angle -2.0e+00+5.0e-01i) 2.8966139904629290843e0) (num-test (angle -2.0e+00+8.3886080e+06i) 1.5707965652134757208e0) (num-test (angle -2.0e+00-1.0e+00i) -2.6779450445889871222e0) (num-test (angle -2.0e+00-1.19209289550781250e-07i) -3.1415925939851484631e0) (num-test (angle -2.0e+00-2.0e+00i) -2.3561944901923449288e0) (num-test (angle -2.0e+00-5.0e-01i) -2.8966139904629290843e0) (num-test (angle -2.0e+00-8.3886080e+06i) -1.5707965652134757208e0) (num-test (angle -2.225073858507201399999999999999999999996E-308) 3.141592653589793238462643383279502884195E0) (num-test (angle -2/1) pi) (num-test (angle -2/10) pi) (num-test (angle -2/1234) pi) (num-test (angle -2/2) pi) (num-test (angle -2/3) pi) (num-test (angle -2/500029) pi) (num-test (angle -5.0e-01+0.0e+00i) pi) (num-test (angle -5.0e-01+1.0e+00i) 2.0344439357957027354e0) (num-test (angle -5.0e-01+1.19209289550781250e-07i) 3.1415924151712141369e0) (num-test (angle -5.0e-01+2.0e+00i) 1.8157749899217607734e0) (num-test (angle -5.0e-01+5.0e-01i) 2.3561944901923449288e0) (num-test (angle -5.0e-01+8.3886080e+06i) 1.5707963863995413946e0) (num-test (angle -5.0e-01-1.0e+00i) -2.0344439357957027354e0) (num-test (angle -5.0e-01-1.19209289550781250e-07i) -3.1415924151712141369e0) (num-test (angle -5.0e-01-2.0e+00i) -1.8157749899217607734e0) (num-test (angle -5.0e-01-5.0e-01i) -2.3561944901923449288e0) (num-test (angle -5.0e-01-8.3886080e+06i) -1.5707963863995413946e0) (num-test (angle -500029) pi) (num-test (angle -500029/1) pi) (num-test (angle -500029/10) pi) (num-test (angle -500029/1234) pi) (num-test (angle -500029/2) pi) (num-test (angle -500029/3) pi) (num-test (angle -500029/500029) pi) (num-test (angle -8.3886080e+06+0.0e+00i) pi) (num-test (angle -8.3886080e+06+1.0e+00i) 3.1415925343805036877e0) (num-test (angle -8.3886080e+06+1.19209289550781250e-07i) 3.1415926535897790276e0) (num-test (angle -8.3886080e+06+2.0e+00i) 3.1415924151712141369e0) (num-test (angle -8.3886080e+06+5.0e-01i) 3.1415925939851484631e0) (num-test (angle -8.3886080e+06+8.3886080e+06i) 2.3561944901923449288e0) (num-test (angle -8.3886080e+06-1.0e+00i) -3.1415925343805036877e0) (num-test (angle -8.3886080e+06-1.19209289550781250e-07i) -3.1415926535897790276e0) (num-test (angle -8.3886080e+06-2.0e+00i) -3.1415924151712141369e0) (num-test (angle -8.3886080e+06-5.0e-01i) -3.1415925939851484631e0) (num-test (angle -8.3886080e+06-8.3886080e+06i) -2.3561944901923449288e0) (num-test (angle -9223372036854775808) 3.141592653589793238462643383279502884195E0) (num-test (angle 0) 0) (num-test (angle 0.0) 0.0) (num-test (angle 0.0+0.00000001i) 1.57079632679490) (num-test (angle 0.0+1.0i) 1.57079632679490) (num-test (angle 0.0+1234.0i) 1.57079632679490) (num-test (angle 0.0+3.14159265358979i) 1.57079632679490) (num-test (angle 0.0-0.00000001i) -1.57079632679490) (num-test (angle 0.0-1.0i) -1.57079632679490) (num-test (angle 0.0-1234.0i) -1.57079632679490) (num-test (angle 0.0-3.14159265358979i) -1.57079632679490) (num-test (angle 0.00000001) 0.0) (num-test (angle 0.00000001+0.00000001i) 0.78539816339745) (num-test (angle 0.00000001+1.0i) 1.57079631679490) (num-test (angle 0.00000001+1234.0i) 1.57079632678679) (num-test (angle 0.00000001+3.14159265358979i) 1.57079632361180) (num-test (angle 0.00000001-0.00000001i) -0.78539816339745) (num-test (angle 0.00000001-1.0i) -1.57079631679490) (num-test (angle 0.00000001-1234.0i) -1.57079632678679) (num-test (angle 0.00000001-3.14159265358979i) -1.57079632361180) (num-test (angle 0.0e+00+0.0e+00i) 0e0) (num-test (angle 0.0e+00+1.0e+00i) 1.5707963267948966192e0) (num-test (angle 0.0e+00+1.19209289550781250e-07i) 1.5707963267948966192e0) (num-test (angle 0.0e+00+2.0e+00i) 1.5707963267948966192e0) (num-test (angle 0.0e+00+5.0e-01i) 1.5707963267948966192e0) (num-test (angle 0.0e+00+8.3886080e+06i) 1.5707963267948966192e0) (num-test (angle 0.0e+00-1.0e+00i) -1.5707963267948966192e0) (num-test (angle 0.0e+00-1.19209289550781250e-07i) -1.5707963267948966192e0) (num-test (angle 0.0e+00-2.0e+00i) -1.5707963267948966192e0) (num-test (angle 0.0e+00-5.0e-01i) -1.5707963267948966192e0) (num-test (angle 0.0e+00-8.3886080e+06i) -1.5707963267948966192e0) (num-test (angle 1) 0) (num-test (angle 1.0) 0.0) (num-test (angle 1.0+0.00000001i) 0.00000001) (num-test (angle 1.0+1.0i) 0.78539816339745) (num-test (angle 1.0+1234.0i) 1.56998595420081) (num-test (angle 1.0+3.14159265358979i) 1.26262725567891) (num-test (angle 1.0-0.00000001i) -0.00000001) (num-test (angle 1.0-1.0i) -0.78539816339745) (num-test (angle 1.0-1234.0i) -1.56998595420081) (num-test (angle 1.0-3.14159265358979i) -1.26262725567891) (num-test (angle 1.0e+00+0.0e+00i) 0e0) (num-test (angle 1.0e+00+1.0e+00i) 7.8539816339744830962e-1) (num-test (angle 1.0e+00+1.19209289550781250e-07i) 1.1920928955078068531e-7) (num-test (angle 1.0e+00+2.0e+00i) 1.1071487177940905030e0) (num-test (angle 1.0e+00+5.0e-01i) 4.6364760900080611621e-1) (num-test (angle 1.0e+00+8.3886080e+06i) 1.5707962075856070685e0) (num-test (angle 1.0e+00-1.0e+00i) -7.8539816339744830962e-1) (num-test (angle 1.0e+00-1.19209289550781250e-07i) -1.1920928955078068531e-7) (num-test (angle 1.0e+00-2.0e+00i) -1.1071487177940905030e0) (num-test (angle 1.0e+00-5.0e-01i) -4.6364760900080611621e-1) (num-test (angle 1.0e+00-8.3886080e+06i) -1.5707962075856070685e0) (num-test (angle 1.110223024625156799999999999999999999997E-16) 0.0) (num-test (angle 1.19209289550781250e-07+0.0e+00i) 0e0) (num-test (angle 1.19209289550781250e-07+1.0e+00i) 1.5707962075856070685e0) (num-test (angle 1.19209289550781250e-07+1.19209289550781250e-07i) 7.8539816339744830962e-1) (num-test (angle 1.19209289550781250e-07+2.0e+00i) 1.5707962671902518438e0) (num-test (angle 1.19209289550781250e-07+5.0e-01i) 1.5707960883763175177e0) (num-test (angle 1.19209289550781250e-07+8.3886080e+06i) 1.5707963267948824084e0) (num-test (angle 1.19209289550781250e-07-1.0e+00i) -1.5707962075856070685e0) (num-test (angle 1.19209289550781250e-07-1.19209289550781250e-07i) -7.8539816339744830962e-1) (num-test (angle 1.19209289550781250e-07-2.0e+00i) -1.5707962671902518438e0) (num-test (angle 1.19209289550781250e-07-5.0e-01i) -1.5707960883763175177e0) (num-test (angle 1.19209289550781250e-07-8.3886080e+06i) -1.5707963267948824084e0) (num-test (angle 1/1) 0) (num-test (angle 1/10) 0) (num-test (angle 1/1234) 0) (num-test (angle 1/2) 0) (num-test (angle 1/3) 0) (num-test (angle 1/500029) 0) (num-test (angle 2) 0) (num-test (angle 2.0e+00+0.0e+00i) 0e0) (num-test (angle 2.0e+00+1.0e+00i) 4.6364760900080611621e-1) (num-test (angle 2.0e+00+1.19209289550781250e-07i) 5.9604644775390554414e-8) (num-test (angle 2.0e+00+2.0e+00i) 7.8539816339744830962e-1) (num-test (angle 2.0e+00+5.0e-01i) 2.4497866312686415417e-1) (num-test (angle 2.0e+00+8.3886080e+06i) 1.5707960883763175177e0) (num-test (angle 2.0e+00-1.0e+00i) -4.6364760900080611621e-1) (num-test (angle 2.0e+00-1.19209289550781250e-07i) -5.9604644775390554414e-8) (num-test (angle 2.0e+00-2.0e+00i) -7.8539816339744830962e-1) (num-test (angle 2.0e+00-5.0e-01i) -2.4497866312686415417e-1) (num-test (angle 2.0e+00-8.3886080e+06i) -1.5707960883763175177e0) (num-test (angle 2/1) 0) (num-test (angle 2/10) 0) (num-test (angle 2/1234) 0) (num-test (angle 2/2) 0) (num-test (angle 2/3) 0) (num-test (angle 2/500029) 0) (num-test (angle 3) 0) (num-test (angle 3.14159265358979+0.00000001i) 0.00000000318310) (num-test (angle 3.14159265358979+1.0i) 0.30816907111598) (num-test (angle 3.14159265358979+1234.0i) 1.56825047114960) (num-test (angle 3.14159265358979+3.14159265358979i) 0.78539816339745) (num-test (angle 3.14159265358979-0.00000001i) -0.00000000318310) (num-test (angle 3.14159265358979-1.0i) -0.30816907111598) (num-test (angle 3.14159265358979-1234.0i) -1.56825047114960) (num-test (angle 3.14159265358979-3.14159265358979i) -0.78539816339745) (num-test (angle 5.0e-01+0.0e+00i) 0.0) (num-test (angle 5.0e-01+1.0e+00i) 1.1071487177940905030e0) (num-test (angle 5.0e-01+1.19209289550781250e-07i) 2.3841857910155798249e-7) (num-test (angle 5.0e-01+2.0e+00i) 1.3258176636680324651e0) (num-test (angle 5.0e-01+5.0e-01i) 7.8539816339744830962e-1) (num-test (angle 5.0e-01+8.3886080e+06i) 1.5707962671902518438e0) (num-test (angle 5.0e-01-1.0e+00i) -1.1071487177940905030e0) (num-test (angle 5.0e-01-1.19209289550781250e-07i) -2.3841857910155798249e-7) (num-test (angle 5.0e-01-2.0e+00i) -1.3258176636680324651e0) (num-test (angle 5.0e-01-5.0e-01i) -7.8539816339744830962e-1) (num-test (angle 5.0e-01-8.3886080e+06i) -1.5707962671902518438e0) (num-test (angle 500029) 0) (num-test (angle 500029/1) 0) (num-test (angle 500029/10) 0) (num-test (angle 500029/1234) 0) (num-test (angle 500029/2) 0) (num-test (angle 500029/3) 0) (num-test (angle 500029/500029) 0) (num-test (angle 8.3886080e+06+0.0e+00i) 0e0) (num-test (angle 8.3886080e+06+1.0e+00i) 1.1920928955078068531e-7) (num-test (angle 8.3886080e+06+1.19209289550781250e-07i) 1.4210854715202003717e-14) (num-test (angle 8.3886080e+06+2.0e+00i) 2.3841857910155798249e-7) (num-test (angle 8.3886080e+06+5.0e-01i) 5.9604644775390554414e-8) (num-test (angle 8.3886080e+06+8.3886080e+06i) 7.8539816339744830962e-1) (num-test (angle 8.3886080e+06-1.0e+00i) -1.1920928955078068531e-7) (num-test (angle 8.3886080e+06-1.19209289550781250e-07i) -1.4210854715202003717e-14) (num-test (angle 8.3886080e+06-2.0e+00i) -2.3841857910155798249e-7) (num-test (angle 8.3886080e+06-5.0e-01i) -5.9604644775390554414e-8) (num-test (angle 8.3886080e+06-8.3886080e+06i) -7.8539816339744830962e-1) (num-test (angle 9223372036854775807) 0) (num-test (angle pi) 0.0) (let ((val1 (catch #t (lambda () (angle 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (angle -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (when with-bignums (num-test (angle -1.797693134862315699999999999999999999998E308) 3.141592653589793238462643383279502884195E0) (num-test (angle (complex 1.0 1.0)) (angle (complex (expt 2 70) (expt 2 70)))) (num-test (angle (make-polar 1000000000000000000000000.0 (* .1 pi))) (* .1 pi)) (num-test (angle (complex most-positive-fixnum most-positive-fixnum)) 7.853981633974483096156608458198757210488E-1)) (test (angle) 'error) (test (angle "hi") 'error) (test (angle 1.0+23.0i 1.0+23.0i) 'error) (for-each (lambda (arg) (test (angle arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; integer-length ;;; -------------------------------------------------------------------------------- ;;; integer-length (test (integer-length 0) 0) (test (integer-length 1) 1) (test (integer-length 2) 2) (test (integer-length 3) 2) (test (integer-length 4) 3) (test (integer-length 7) 3) (test (integer-length 8) 4) (test (integer-length 21) 5) (test (integer-length 215) 8) (test (integer-length 12341234) 24) (test (integer-length -1) 0) (test (integer-length -2) 1) (test (integer-length -3) 2) (test (integer-length -4) 2) (test (integer-length -7) 3) (test (integer-length -8) 3) (test (integer-length -9) 4) (test (integer-length -21) 5) (test (integer-length -215) 8) (test (integer-length -12341234) 24) (test (integer-length 127) 7) (test (integer-length 128) 8) (test (integer-length 129) 8) (test (integer-length -127) 7) (test (integer-length -128) 7) (test (integer-length -129) 8) (test (integer-length most-negative-fixnum) (if with-bignums 64 63)) (test (integer-length most-positive-fixnum) 63) (test (integer-length) 'error) (test (integer-length 1 2) 'error) (test (integer-length 1/2) 'error) (test (integer-length 1.2) 'error) (test (integer-length 1+2i) 'error) (test (integer-length 1/0) 'error) (test (integer-length (log 0)) 'error) (when with-bignums (test (integer-length (bignum "100000000000000000000000000000000000")) (ceiling (log (bignum "100000000000000000000000000000000001") 2))) (test (integer-length (+ (expt 2 48) (expt 2 46))) 49) (test (integer-length (ash 1 64)) 65) (test (integer-length 9223372036854775808) 64) (test (integer-length (* 4 most-positive-fixnum)) 65) (test (integer-length (* most-positive-fixnum most-positive-fixnum)) 126) (test (integer-length 0+92233720368547758081.0i) 'error) (test (integer-length 92233720368547758081.0) 'error)) (for-each (lambda (arg) (test (integer-length arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; integer-decode-float ;;; -------------------------------------------------------------------------------- (if (not with-bignums) (let () (define (idf-test val1 val2) (test (cadr val1) (cadr val2)) (test (caddr val1) (caddr val2)) (test (< (abs (- (car val1) (car val2))) 1000) #t)) (idf-test (integer-decode-float 0.0) '(0 0 1)) (idf-test (integer-decode-float -0.0) '(0 0 1)) (idf-test (integer-decode-float 1.0) '(4503599627370496 -52 1)) (idf-test (integer-decode-float -1.0) '(4503599627370496 -52 -1)) (idf-test (integer-decode-float 0.2) '(7205759403792794 -55 1)) (idf-test (integer-decode-float -0.2) '(7205759403792794 -55 -1)) (idf-test (integer-decode-float 3.0) '(6755399441055744 -51 1)) (idf-test (integer-decode-float -3.0) '(6755399441055744 -51 -1)) (idf-test (integer-decode-float 0.04) '(5764607523034235 -57 1)) (idf-test (integer-decode-float -0.04) '(5764607523034235 -57 -1)) (idf-test (integer-decode-float 50.0) '(7036874417766400 -47 1)) (idf-test (integer-decode-float -50.0) '(7036874417766400 -47 -1)) (idf-test (integer-decode-float 0.006) '(6917529027641082 -60 1)) (idf-test (integer-decode-float -0.006) '(6917529027641082 -60 -1)) (idf-test (integer-decode-float 7000.0) '(7696581394432000 -40 1)) (idf-test (integer-decode-float -7000.0) '(7696581394432000 -40 -1)) (idf-test (integer-decode-float 0.0008) '(7378697629483821 -63 1)) (idf-test (integer-decode-float -0.0008) '(7378697629483821 -63 -1)) (idf-test (integer-decode-float 90000.0) '(6184752906240000 -36 1)) (idf-test (integer-decode-float -90000.0) '(6184752906240000 -36 -1)) (idf-test (integer-decode-float 0.00001) '(5902958103587057 -69 1)) (idf-test (integer-decode-float 1.0e-6) '(4722366482869645 -72 1)) (idf-test (integer-decode-float 1.0e-8) '(6044629098073146 -79 1)) (idf-test (integer-decode-float 1.0e-12) '(4951760157141521 -92 1)) (idf-test (integer-decode-float 1.0e-16) '(8112963841460668 -106 1)) (idf-test (integer-decode-float 1.0e-17) '(6490371073168535 -109 1)) (idf-test (integer-decode-float 1.0e-18) '(5192296858534828 -112 1)) (idf-test (integer-decode-float 1.0e-19) '(8307674973655724 -116 1)) (idf-test (integer-decode-float 1.0e-25) '(8711228593176025 -136 1)) (idf-test (integer-decode-float 1.0e6) '(8589934592000000 -33 1)) (idf-test (integer-decode-float 1.0e12) '(8192000000000000 -13 1)) (idf-test (integer-decode-float 1.0e17) '(6250000000000000 4 1)) (idf-test (integer-decode-float 1.0e18) '(7812500000000000 7 1)) (idf-test (integer-decode-float 1.0e19) '(4882812500000000 11 1)) (idf-test (integer-decode-float 1.0e20) '(6103515625000000 14 1)) (idf-test (integer-decode-float 1.0e-100) '(7880401239278896 -385 1)) (idf-test (integer-decode-float 1.0e100) '(5147557589468029 280 1)) (idf-test (integer-decode-float 1.0e200) '(5883593420661338 612 1)) (idf-test (integer-decode-float 1.0e-200) '(6894565328877484 -717 1)) (idf-test (integer-decode-float 1.0e307) '(8016673440035891 967 1)) (let ((val (integer-decode-float 1.0e-307))) (if (and (not (equal? val '(5060056332682765 -1072 1))) (not (equal? val '(5060056332682766 -1072 1)))) (format #t ";(integer-decode-float 1.0e-307) got ~A?~%" val))) (test (integer-decode-float (/ 1.0e-307 100.0e0)) '(4706001880677807 -1075 1)) ; denormal (test (integer-decode-float (/ (log 0.0))) '(6755399441055744 972 -1)) ; nan (test (integer-decode-float (- (real-part (log 0.0)))) '(4503599627370496 972 1)) ; +inf (test (integer-decode-float (real-part (log 0.0))) '(4503599627370496 972 -1)) ; -inf (test (integer-decode-float 1.797e308) '(9003726357340310 971 1)) (test (integer-decode-float 1.0e-322) '(4503599627370516 -1075 1)) (test (integer-decode-float (expt 2.0 31)) (list #x10000000000000 -21 1)) (test (integer-decode-float (expt 2.0 52)) (list #x10000000000000 0 1)) (test (pair? (member (integer-decode-float 1e23) '((5960464477539062 24 1) (5960464477539063 24 1)))) #t) (test (integer-decode-float 1/0) '(6755399441055744 972 1)) ; nan (test (integer-decode-float (real-part (log 0))) '(4503599627370496 972 -1)) ; -inf (test (integer-decode-float (- (real-part (log 0)))) '(4503599627370496 972 1)) ; inf (test (integer-decode-float (/ (real-part (log 0)) (real-part (log 0)))) '(6755399441055744 972 1)) ; nan (test (integer-decode-float (- (/ (real-part (log 0)) (real-part (log 0))))) '(6755399441055744 972 -1)) ; -nan ) ;; with-bignums (let-temporarily (((*s7* 'bignum-precision) 128)) (test (integer-decode-float 2.225e-308) '(340271071678961823938180190063081855376 -1150 1)) (test (integer-decode-float (bignum "3.1")) '(263718834363727316739901693351052705792 -126 1)) (test (integer-decode-float (bignum "1E430")) '(229073916549713112029076262063818929063 1301 1)) (test (integer-decode-float (bignum "1E310")) '(295763046541693677743187899379506632913 902 1)) (test (integer-decode-float (bignum "-1E310")) '(295763046541693677743187899379506632913 902 -1)) (test (integer-decode-float 0+92233720368547758081.0i) 'error) (test (integer-decode-float 92233720368547758081/123) 'error)) ) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (- 1.0e6 (random 2.0e6)))) (let* ((data (integer-decode-float val)) (signif (car data)) (expon (cadr data)) (sign (caddr data))) (num-test (* sign signif (expt 2.0 expon)) val)))) (test (integer-decode-float) 'error) (for-each (lambda (arg) (test (integer-decode-float arg) 'error)) (list -1 0 #\a #(1 2 3) 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1))) (test (integer-decode-float 1.0 1.0) 'error) ;;; -------------------------------------------------------------------------------- ;;; lognot ;;; -------------------------------------------------------------------------------- (for-each (lambda (op) (for-each (lambda (arg) (let ((val (catch #t (lambda () (op arg)) (lambda args 'error)))) (if (not (equal? val 'error)) (format #t ";(~A ~A) -> ~A?~%" op arg val)))) (list "hi" _ht_ _undef_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 3/4 3.1+i abs #\f (lambda (a) (+ a 1))))) (list logior logand lognot logxor logbit? ash integer-length)) (for-each (lambda (op) (for-each (lambda (arg) (let ((val (catch #t (lambda () (op 1 arg)) (lambda args 'error)))) (if (not (equal? val 'error)) (format #t ";(~A ~A) -> ~A?~%" op arg val)))) (list "hi" _ht_ _undef_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) 3.14 -1/2 1+i abs #\f (lambda (a) (+ a 1))))) (list logior logand logxor lognot logbit?)) (test (lognot 0) -1) (test (lognot -1) 0) (test (lognot 1) -2) (test (lognot #b101) -6) (test (lognot -6) #b101) (test (lognot 12341234) -12341235) (test (lognot #b-101) 4) (test (lognot (+ 1 (lognot 1000))) 999) (test (lognot -9223372036854775808) 9223372036854775807) (test (lognot 9223372036854775807) -9223372036854775808) (test (lognot most-positive-fixnum) most-negative-fixnum) (when with-bignums (test (lognot 9223372036854775808) -9223372036854775809) (test (lognot 618970019642690137449562111) (- (expt 2 89))) (num-test (lognot (+ (expt 2 48) (expt 2 46))) -351843720888321) (test (lognot 0+92233720368547758081.0i) 'error) (test (lognot 92233720368547758081.0) 'error)) (test (lognot) 'error) (test (lognot 1.0) 'error) (test (lognot 1+i) 'error) (test (lognot 1/2) 'error) (test (lognot #f) 'error) (test (lognot 1/1) -2) ;;; -------------------------------------------------------------------------------- ;;; logior ;;; -------------------------------------------------------------------------------- ;;; logior (test (logior 0 1) 1) (test (logior #b101 #b10001) 21) (test (logior 1 3 6) 7) (test (logior -6 1) -5) (test (logior -6 3) -5) (test (logior #b1 #b11 #b111 #b1111) #b1111) (test (logior -1 0 -1 -1) -1) (test (logior 3 3 3 3) 3) (test (logior 1) 1) (test (logior -1) -1) (test (logior 12341234 10001111) 12378103) (test (logior 1 2 4 8) 15) (test (logior 0 1/1) 1) (test (logior 1/1 0) 1) (test (logior -1 1 0) -1) (test (logior 1 2 3 4) 7) (test (logior 1 3 5 7) 7) (test (logior -9223372036854775808 -9223372036854775808) -9223372036854775808) (test (logior -9223372036854775808 9223372036854775807 -9223372036854775808) -1) (test (logior 9223372036854775807 -9223372036854775808) -1) (test (logior 9223372036854775807 9223372036854775807) 9223372036854775807) (test (logior) 0) (when with-bignums (test (logior (expt 2 63) (expt 2 75)) (+ (expt 2 63) (expt 2 75))) (test (logior (+ (expt 2 48) (expt 2 46)) (expt 2 48)) 351843720888320) (test (logior 0+92233720368547758081.0i) 'error) (test (logior 92233720368547758081.0) 'error)) (test (logior 0 1.0) 'error) (test (logior 0 1/2) 'error) (test (logior 1.0 0) 'error) (test (logior 1/2 0) 'error) (test (logior 1+i) 'error) (test (logior -1 #\a) 'error) (test (logior -1 "hi") 'error) (test (logior #f "hi") 'error) (let () (define (make-bit-vector n) (make-int-vector (ceiling (/ n 63)))) (define (bit-vector-ref v n) (logbit? (int-vector-ref v (quotient n 63)) (remainder n 63))) (define (bit-vector-set! v n t-or-f) (int-vector-set! v (quotient n 63) (let ((cur (int-vector-ref v (quotient n 63))) (bit (ash 1 (remainder n 63)))) (if t-or-f (logior cur bit) (logand cur (lognot bit)))))) (let ((bv (make-bit-vector 128))) (if (bit-vector-ref bv 72) (format *stderr* "default #f: ~A~%" (bit-vector-ref bv 72))) (bit-vector-set! bv 72 #t) (if (not (bit-vector-ref bv 72)) (format *stderr* "set: ~A~%" (bit-vector-ref bv 72))) (bit-vector-set! bv 72 #f) (if (bit-vector-ref bv 72) (format *stderr* "clear #f: ~A~%" (bit-vector-ref bv 72))))) ;;; -------------------------------------------------------------------------------- ;;; logand ;;; -------------------------------------------------------------------------------- (test (logand 0 1) 0) (test (logand 0 -1) 0) (test (logand #b101 #b10001) 1) (test (logand 1 3 6) 0) (test (logand -1 3 6) 2) (test (logand -6 1) 0) (test (logand -6 3) 2) (test (logand #b1 #b11 #b111 #b1111) #b1) (test (logand -1 0 -1 -1) 0) (test (logand 3 3 3 3) 3) (test (logand 0) 0) (test (logand -1) -1) (test (logand 12341234 10001111) 9964242) (test (logand -1 1) 1) (test (logand -1 -1) -1) (test (logand 1 -1) 1) (test (logand 1 1) 1) (test (logand 16 31) 16) (test (logand 0 1/1) 0) (test (logand 1/1 0) 0) (test (logand 1 -1 -1) 1) (test (logand 1 2 3 4) 0) (test (logand 1 3 5 7) 1) (test (logand -9223372036854775808 -1) -9223372036854775808) (test (logand -9223372036854775808 -9223372036854775808) -9223372036854775808) (test (logand -9223372036854775808 1) 0) (test (logand -9223372036854775808 9223372036854775807 -9223372036854775808) 0) (test (logand 9223372036854775807 -1) 9223372036854775807) (test (logand 9223372036854775807 -9223372036854775808) 0) (test (logand 9223372036854775807 1) 1) (test (logand 9223372036854775807 9223372036854775807) 9223372036854775807) (test (logand) -1) (when with-bignums (test (logand 9223372036854775808 -9223372036854775809) 0) (test (logand 618970019642690137449562111 (expt 2 88)) (expt 2 88)) (test (logand (+ (expt 2 48) (expt 2 46)) (expt 2 48)) 281474976710656) (test (logand 0+92233720368547758081.0i) 'error) (test (logand 92233720368547758081.0) 'error)) (test (logand 0 1.0) 'error) (test (logand 1+i) 'error) (test (logand 0 1/2) 'error) (test (logand 1.0 0) 'error) (test (logand 1/2 0) 'error) (test (logand 0 #\a) 'error) (test (logand 0 "hi") 'error) (test (logand #f ()) 'error) (when with-bignums (let () ; from bug-guile (define (k n t) (logand (ash n t) 4294967295)) (define run (lambda (q) (k (+ (ash (k q -96) 30) (ash (k q -96) -2)) 0))) (test (run 589567850402597453564513526754136399297876517360) 2079550178))) ;;; -------------------------------------------------------------------------------- ;;; logxor ;;; -------------------------------------------------------------------------------- (test (logxor 0 1) 1) (test (logxor #b101 #b10001) 20) (test (logxor 1 3 6) 4) (test (logxor -6 1) -5) (test (logxor -6 3) -7) (test (logxor #b1 #b11 #b111 #b1111) #b1010) (test (logxor 12341234 10001111) 2413861) (test (logxor 1 3 7 15) 10) (test (logxor 0 1/1) 1) (test (logxor 1/1 0) 1) (test (logxor 0 1 -1) -2) (test (logxor -1 -1 -1) -1) ;; to get the bits that are on in just 1 argument? (logxor (logxor a b c) (logand a b c)) (test (logxor 1 2 3 4) 4) (test (logxor 1 3 5 7) 0) (test (logxor -1 8 8) -1) (test (logxor 8 8 8) 8) (test (logxor -1 most-positive-fixnum) most-negative-fixnum) (test (logxor most-negative-fixnum most-positive-fixnum) -1) (test (logxor -100 -100 -100) -100) (test (logxor -100 -100 -100 -1) 99) (test (logxor -100 -100 -100 -1 -1) -100) (test (logxor 4/2 11/11) 3) (test (logxor -9223372036854775808 -9223372036854775808) 0) (test (logxor -9223372036854775808 9223372036854775807 -9223372036854775808) 9223372036854775807) (test (logxor 9223372036854775807 -9223372036854775808) -1) (test (logxor 9223372036854775807 9223372036854775807) 0) (test (logxor) 0) (when with-bignums (test (logxor 37788155234994016485376 (+ (expt 2 63) 1)) (+ 1 (expt 2 75))) (test (logxor (+ (expt 2 48) (expt 2 46)) (expt 2 48)) 70368744177664) (test (logxor 0+92233720368547758081.0i) 'error) (test (logxor 92233720368547758081.0) 'error)) (test (logxor 0 1.0) 'error) (test (logxor 0 1/2) 'error) (test (logxor 1.0 0) 'error) (test (logxor 1/2 0) 'error) ;;; log-n-of (let ((top-checked-bit (if with-bignums 64 63))) (define (log-none-of . ints) ; bits on in none of ints (lognot (apply logior ints))) (define (log-all-of . ints) ; bits on in all of ints (apply logand ints)) (define (log-any-of . ints) ; bits on in at least 1 of ints (apply logior ints)) (define (log-1-of . ints) ; bits on in exactly 1 of ints (let ((len (length ints))) (cond ((= len 0) 0) ((= len 1) (car ints)) ((= len 2) (apply logxor ints)) ((= len 3) (logxor (apply logxor ints) (apply logand ints))) (#t (do ((iors ()) (i 0 (+ i 1))) ((= i len) (apply logior iors)) (let ((cur (ints i))) (set! (ints i) 0) (set! iors (cons (logand cur (lognot (apply logior ints))) iors)) (set! (ints i) cur))))))) (test (log-1-of 1 1) 0) (test (log-1-of 1 2) 3) (test (log-1-of 1 2 2) 1) (test (log-1-of 1 2 2 1) 0) (test (log-1-of 1 2 3 4 8 9) 4) (test (log-1-of -1 1 2 3) -4) (test (log-1-of 1 2 3 5) 4) (test (log-1-of -6 -31 -19 -9) 0) (test (log-1-of -45 -15 -7 -3) 6) (test (log-1-of -1 most-positive-fixnum -1) 0) (test (log-1-of -1 most-negative-fixnum -1) 0) (test (log-1-of 1 most-negative-fixnum 1) most-negative-fixnum) (test (log-1-of 31 11 27 -38) -60) (test (log-1-of -254) #b-11111110) ; (-254) (test (log-1-of 406 26 439 -361 -133 -480 312) #b1000000) ; (64) (test (log-1-of 47 110) #b1000001) ; (65) (test (log-1-of) 0) (test (log-1-of -52 108 97 48) #b-1101111) ; (-111) (test (log-1-of -113 -391 -129 -58 -374 -297 -498) #b0) ; (0) (test (log-1-of -251 138 418 494 -300 -224) #b10001) ; (17) (test (log-1-of 385 364 372) #b10011001) ; (153) (test (log-1-of -221 -56 173) #b1000110) ; (70) (test (log-1-of 31 -309 244 -478 396 -352 162 -479 -500) #b100000000) ; (256) (test (log-1-of -152 495 80 -403 -439 387) #b10000) ; (16) (test (log-1-of 115 71 110 568 10 382 124 378 23) #b1000000000) ; (512) (test (log-1-of 766 332 285 280 489 229) #b1000000010) ; (514) (test (log-1-of 424 935) #b1000001111) ; (527) (test (log-1-of 788 268 388) #b1010011000) ; (664) (test (log-1-of 389 237 398 530) #b1001110000) ; (624) (test (log-1-of 554 550 215 44 892 668) #b100000001) ; (257) (test (log-1-of 562 171 772 480 6 211 542 678) #b0) ; (0) (do ((i 0 (+ i 1))) ((= i 10)) (let ((len (+ 1 (random 10))) (ints ())) (do ((k 0 (+ k 1))) ((= k len)) (set! ints (cons (- (random 1000) 500) ints))) (let ((result (apply log-1-of ints))) ;;(format #t "(test (log-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result) (do ((b 0 (+ b 1))) ((= b top-checked-bit)) (let ((counts 0)) (for-each (lambda (int) (if (logbit? int b) ;(not (zero? (logand int (ash 1 b)))) (set! counts (+ counts 1)))) ints) (if (logbit? result b) ;(not (zero? (logand result (ash 1 b)))) (if (not (= counts 1)) (format #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts)) (if (= counts 1) (format #t ";(log-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts = 1 but we're off]~%" ints result (ash 1 b))))))))) (define (log-n-1-of . ints) ; bits on in exactly n-1 of ints (let ((len (length ints))) (cond ((= len 0) 0) ((= len 1) 0) ((= len 2) (apply logxor ints)) ((= len 3) (logand (lognot (apply logxor ints)) (apply logior ints))) (#t (do ((iors ()) (i 0 (+ i 1))) ((= i len) (apply logior iors)) (let ((cur (ints i))) (set! (ints i) -1) (set! iors (cons (logand (lognot cur) (apply logand ints)) iors)) (set! (ints i) cur))))))) (test (log-n-1-of 1 1) 0) (test (log-n-1-of 1 2) 3) (test (log-n-1-of 1 2 2) 2) (test (log-n-1-of 1 2 2 3) 2) (test (log-n-1-of -336 -225 275) #b-11111101) ; (-253) (test (log-n-1-of -35 32 -17 -310 256 -360 171 -370) #b0) ; (0) (test (log-n-1-of 311 237) #b111011010) ; (474) (test (log-n-1-of 32 348 -340 147) #b0) ; (0) (test (log-n-1-of -334 -267 -478 -93 239 423 18 496) #b100000) ; (32) (test (log-n-1-of -347 149 135 107 -436) #b101) ; (5) (test (log-n-1-of -181 406 480 390 207 13 0) #b0) ; (0) (test (log-n-1-of 348) #b0) ; (0) (test (log-n-1-of -498 226) #b-100010100) ; (-276) (test (log-n-1-of 259 -171 146 -344 63 -240 290 -418) #b0) ; (0) (test (log-n-1-of 86 -74 61 -138 215 -277 358) #b110) ; (6) (test (log-n-1-of -144 425 -356 -341 211 -390) #b0) ; (0) (test (log-n-1-of -223 390 195 265) #b100000001) ; (257) (test (log-n-1-of 103 263 -92 -7) #b100100101) ; (293) (test (log-n-1-of -78 -199 68 218 -98 -464 307 301) #b0) ; (0) (test (log-n-1-of -355 258 -134 -371 211) #b0) ; (0) (test (log-n-1-of -222 -39 408 -50 -207 58) #b100000000) ; (256) (test (log-n-1-of 66 93 484) #b100) ; (4) (test (log-n-1-of 36 -384 3 49 359 -284 -284 -133 268) #b0) ; (0) (test (log-n-1-of -339 -50 243 -159 -159) #b-110011111) ; (-415) (test (log-n-1-of 154 -260 -219 400 -196 -236 421 -277 375 -67) #b0) ; (0) (test (log-n-1-of 45 112) #b1011101) ; (93) (test (log-n-1-of -493 131 48 45 311 197 491 -86 164) #b0) ; (0) (test (log-n-1-of 371 -75 -107 -348 -9 7 -129) #b101) ; (5) (test (log-n-1-of 349 -219 -160) #b-110011011) ; (-411) (test (log-n-1-of 412 456 407 -13 352 467 327 147) #b100000000) ; (256) (test (log-n-1-of 133 -133 -471 -284 -58 -266) #b-1000000000) ; (-512) (test (log-n-1-of 43 -339 22 150 49 259) #b0) ; (0) (test (log-n-1-of 258 -138 185 400 -476 -312 69 380) #b0) ; (0) (test (log-n-1-of 260 -85 -208 -21) #b-111100000) ; (-480) (test (log-n-1-of -294 177 -78) #b-111011110) ; (-478) (test (log-n-1-of -40 81 445 -300) #b11000000) ; (192) (test (log-n-1-of -325 -393 411 -441 -221 -43 -231 -283 -223) #b-1000000000) ; (-512) (test (log-n-1-of 18 -36 -351 -160 211 412) #b0) ; (0) (do ((i 0 (+ i 1))) ((= i 10)) (let ((len (+ 1 (random 10))) (ints ())) (do ((k 0 (+ k 1))) ((= k len)) (set! ints (cons (- (random 1000) 500) ints))) (let ((result (apply log-n-1-of ints))) ;;(format #t "(test (log-n-1-of ~{~D~^ ~}) #b~B) ; (~D)~%" ints result result) (do ((b 0 (+ b 1))) ((= b top-checked-bit)) (let ((counts 0)) (for-each (lambda (int) (if (logbit? int b) ;(not (zero? (logand int (ash 1 b)))) (set! counts (+ counts 1)))) ints) (if (logbit? result b) ;(not (zero? (logand result (ash 1 b)))) (if (not (= counts (- len 1))) (format #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" ints result (ash 1 b) counts)) (if (and (> len 1) (= counts (- len 1))) (format #t ";(log-n-1-of ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" ints result (ash 1 b) counts)))))))) (define (log-n-of n . ints) ; bits on in exactly n of ints (let ((len (length ints))) (cond ((= len 0) (if (= n 0) -1 0)) ((= n 0) (apply log-none-of ints)) ((= n len) (apply log-all-of ints)) ((> n len) 0) ((= n 1) (apply log-1-of ints)) ((= n (- len 1)) (apply log-n-1-of ints)) ;; now n is between 2 and len-2, and len is 3 or more ;; I think it would be less inefficient here to choose either this or the n-1 case based on n<=len/2 (#t (do ((1s ()) (prev ints) (i 0 (+ i 1))) ((= i len) (apply logior 1s)) (let ((cur (ints i))) (if (= i 0) (set! 1s (cons (logand cur (apply log-n-of (- n 1) (cdr ints))) 1s)) (let ((mid (cdr prev))) (set! (cdr prev) (if (= i (- len 1)) () (cdr mid))) (set! 1s (cons (logand cur (apply log-n-of (- n 1) ints)) 1s)) (set! (cdr prev) mid) (set! prev mid))))))))) (test (log-n-of 1) 0) (test (log-n-of 0) -1) (test (log-n-of 0 -2) 1) (test (log-n-of 0 92 -451 317 -269 -300 245 461 -64) #b0) (test (log-n-of 0 287) #b-100100000) ; (-288) (test (log-n-of 0 -180 441 -487) #b10) ; (2) (test (log-n-of 0 274 150) #b-110010111) ; (-407) (test (log-n-of 0 140 -307 8 216 -392 8 -486 147 -469) #b100000000) ; (256) (test (log-n-of 1 1 1) 0) (test (log-n-of 1 1 2) 3) (test (log-n-of 2 1 2) 0) (test (log-n-of 2 2 2) 2) (test (log-n-of 2 2 2 2) 0) (test (log-n-of 3 2 2 2) 2) (test (log-n-of 3 2 2 3) 2) (test (log-n-of 3 2 1 3 3) 3) (test (log-n-of 1 158 172 -4 432 147 497 -236 85 -454 -447) #b0) ; (0) (test (log-n-of 1 377 -232 295) #b-110111010) ; (-442) (test (log-n-of 1 -110) #b-1101110) ; (-110) (test (log-n-of 1 304 -36 64 -140 -165 -85) #b0) ; (0) (test (log-n-of 1 226 -135 -392 55 -358 260 -447) #b0) ; (0) (test (log-n-of 1 -241 454 178 107 312) #b-1000000000) ; (-512) (test (log-n-of 1 -122 419 -121) #b100000) ; (32) (test (log-n-of 1 378 -233 -332 -308) #b1) ; (1) (test (log-n-of 1 -381 44 -99 -161 338) #b100000) ; (32) (test (log-n-of 2 6 -45 331 339 156 207 -308) #b-1000000000) ; (-512) (test (log-n-of 2 -483) #b0) ; (0) (test (log-n-of 2 -113 75 465 -434 -164 291) #b10010000) ; (144) (test (log-n-of 2 -95 -314 187 40) #b-111110101) ; (-501) (test (log-n-of 2 126 -254) #b10) ; (2) (test (log-n-of 2 -228) #b0) ; (0) (test (log-n-of 2 -472 163 6 -185 -208 -481 -60 -331 479) #b0) ; (0) (test (log-n-of 2 357 -468 490 -423 33) #b-11111100) ; (-252) (test (log-n-of 2 13 343 -276 148 -425 -116 361 -305 344 -361) #b100000) ; (32) (test (log-n-of 2 -79) #b0) ; (0) (test (log-n-of 3 268 134 46 -207 414) #b100001010) ; (266) (test (log-n-of 3 455 -138 58 -225 -250) #b-111110000) ; (-496) (test (log-n-of 3 -267 154 -217 468 -455 43 307 364) #b-101000000) ; (-320) (test (log-n-of 3 14 197 65 -327 -86 -438) #b-100111101) ; (-317) (test (log-n-of 3 229 452 434 -75 -405 440 -420 40) #b-111111111) ; (-511) (test (log-n-of 3 -24 -450 437 -467 -487 -479 14 394 -433 53) #b110000000) ; (384) (test (log-n-of 3 474 442 303 -203 -59) #b10111111) ; (191) (test (log-n-of 3 -401 104 66) #b1000000) ; (64) (test (log-n-of 3 -129 79 215 -272 -259) #b-101010110) ; (-342) (test (log-n-of 3 -139 36 -489 352 -364 498 -11) #b10000001) ; (129) (test (log-n-of 4 23) #b0) ; (0) (test (log-n-of 4 407 225 417 269 -174 181 -332) #b100110100) ; (308) (test (log-n-of 4 439 480 -278 168 189) #b0) ; (0) (test (log-n-of 4 -206 295) #b0) ; (0) (test (log-n-of 4 -260 24 -320) #b0) ; (0) (test (log-n-of 4 354 -463 -66 137 -364) #b0) ; (0) (test (log-n-of 4 -117 -68 -343 -285) #b-110000000) ; (-384) (test (log-n-of 4 -206 -449 118 -211 -125 391 232) #b-11111011) ; (-251) (test (log-n-of 4 -164 -499 -291 325 -143 -268 135 103) #b10000) ; (16) (do ((i 0 (+ i 1))) ((= i 10)) (let ((len (+ 1 (random 10))) (ints ()) (n (random 5))) (do ((k 0 (+ k 1))) ((= k len)) (set! ints (cons (- (random 1000) 500) ints))) (let ((result (apply log-n-of n ints))) ;;(format #t "(test (log-n-of ~D ~{~D~^ ~}) #b~B) ; (~D)~%" n ints result result) (do ((b 0 (+ b 1))) ((= b top-checked-bit)) (let ((counts 0)) (for-each (lambda (int) (if (logbit? int b) ;(not (zero? (logand int (ash 1 b)))) (set! counts (+ counts 1)))) ints) (if (logbit? result b) ;(not (zero? (logand result (ash 1 b)))) (if (not (= counts n)) (format #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts)) (if (and (> len 1) (= counts n)) (format #t ";(log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts)))))))) (define (simple-log-n-of n . ints) ; bits on in exactly n of ints (let ((len (length ints))) (cond ((= len 0) (if (= n 0) -1 0)) ((= n 0) (lognot (apply logior ints))) ((= n len) (apply logand ints)) ((> n len) 0) (#t (do ((1s 0) (prev ints) (i 0 (+ i 1))) ((= i len) 1s) (let ((cur (ints i))) (if (= i 0) (set! 1s (logior 1s (logand cur (apply simple-log-n-of (- n 1) (cdr ints))))) (let* ((mid (cdr prev)) (nxt (if (= i (- len 1)) () (cdr mid)))) (set! (cdr prev) nxt) (set! 1s (logior 1s (logand cur (apply simple-log-n-of (- n 1) ints)))) (set! (cdr prev) mid) (set! prev mid))))))))) (test (simple-log-n-of 1 0 0 -1 0) -1) (test (simple-log-n-of 1 0 -1 -1 0) 0) (test (simple-log-n-of 2 0 -1 -1 0) -1) (test (simple-log-n-of 2 0 -1 -1 -1) 0) (test (simple-log-n-of 3 0 -1 -1 -1) -1) (test (simple-log-n-of 4 0 -1 -1 -1) 0) (do ((i 0 (+ i 1))) ((= i 10)) (let ((len (+ 1 (random 10))) (ints ()) (n (random 5))) (do ((k 0 (+ k 1))) ((= k len)) (set! ints (cons (- (random 1000) 500) ints))) (let ((result (apply simple-log-n-of n ints))) (do ((b 0 (+ b 1))) ((= b top-checked-bit)) (let ((counts 0)) (for-each (lambda (int) (if (logbit? int b) ;(not (zero? (logand int (ash 1 b)))) (set! counts (+ counts 1)))) ints) (if (logbit? result b) ;(not (zero? (logand result (ash 1 b)))) (if (not (= counts n)) (format #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're on]~%" n ints result (ash 1 b) counts)) (if (and (> len 1) (= counts n)) (format #t ";(simple-log-n-of ~D ~{~D~^ ~}) -> ~A, [#b~B, counts: ~D but we're off]~%" n ints result (ash 1 b) counts))))))))) (let () ; from sbcl/contrib/sb-rotate-byte (define (rotate-byte count bytespec integer) ; logrot? (let* ((size (car bytespec)) (count (- count (* (round (/ count size)) size))) (mask (ash (- (ash 1 size) 1) (cdr bytespec))) (field (logand mask integer))) (logior (logand integer (lognot mask)) (logand mask (logior (ash field count) (ash field ((if (positive? count) - +) count size))))))) (test (rotate-byte 6 (cons 8 0) -3) -129) (test (rotate-byte 3 (cons 32 0) 3) 24) (test (rotate-byte 3 (cons 16 0) 3) 24) (test (rotate-byte 5 (cons 32 0) 5) 160) (test (rotate-byte 5 (cons 32 0) (ash 1 26)) (ash 1 31))) ;;; -------------------------------------------------------------------------------- ;;; logbit? ;;; -------------------------------------------------------------------------------- (test (logbit? 0 1) #f) (test (logbit? 0 0) #f) (test (logbit? 0 -1) 'error) (test (logbit? #b101 1) #f) (test (logbit? #b101 0) #t) (test (logbit? 1 3 6) 'error) (test (logbit? -1 3) #t) (test (logbit? -1 0) #t) (test (logbit? -6 0) #f) (test (logbit? -6 3) #t) (test (logbit? 4 1) #f) (test (logbit? 1 1) #f) (test (logbit? 1 0) #t) (test (logbit? -9223372036854775808 1) #f) (test (logbit? most-positive-fixnum 31) #t) (test (logbit? most-positive-fixnum 68) #f) (test (logbit? most-positive-fixnum 63) #f) (test (logbit? most-positive-fixnum 62) #t) (test (logbit? (ash 1 12) 12) #t) (test (logbit? (ash 1 12) 11) #f) (test (logbit? (ash 1 32) 32) #t) (test (logbit? (ash 1 31) 31) #t) (test (logbit? (ash 1 31) 30) #f) (test (logbit? (ash 1 31) 32) #f) (test (logbit? (ash 1 32) 31) #f) (test (logbit? (ash 1 62) 62) #t) (test (logbit? (ash 1 62) 61) #f) (test (logbit? -1 most-negative-fixnum) 'error) (test (logbit? most-negative-fixnum 63) #t) (test (logbit? most-negative-fixnum 62) #f) (test (logbit? -31 63) #t) (test (logbit? 1 most-positive-fixnum) #f) (test (logbit? 0 most-positive-fixnum) #f) (test (logbit? -1 most-positive-fixnum) #t) (test (logbit? -1 64) #t) (test (logbit? 1 64) #f) ;;; (test (logbit? most-negative-fixnum most-positive-fixnum) #t) ;?? (test (logbit? most-negative-fixnum most-negative-fixnum) 'error) (test (logbit? most-positive-fixnum most-positive-fixnum) #f) (test (logbit? (ash most-negative-fixnum 1) 1) #f) (when with-bignums (test (logbit? (ash 1 64) 64) #t) (test (logbit? (ash 1 64) 63) #f) (test (logbit? most-negative-fixnum 63) #t) (test (logbit? (bignum "-1") 64) #t)) (test (logbit? 0 1.0) 'error) (test (logbit? 1+i) 'error) (test (logbit? 1+i 0) 'error) (test (logbit? 0 1/2) 'error) (test (logbit? 1.0 0) 'error) (test (logbit? 1/2 0) 'error) (test (logbit? -1/2 0) 'error) (test (logbit? 1/2 123123123) 'error) (test (logbit? 0 #\a) 'error) (test (logbit? 0 "hi") 'error) (test (logbit? #f ()) 'error) (test (logbit?) 'error) (test (logbit? 0) 'error) (test (logbit? -1/9223372036854775807 7) 'error) (test (logbit? -1/9223372036854775807 123123123) 'error) (test (logbit? 1/0 123123123) 'error) (test (logbit? (c-pointer 0) 123123123) 'error) (do ((i 0 (+ i 1))) ((= i 100)) (let ((x (random most-positive-fixnum)) ; or most-negative-fixnum (index (random 63))) (let ((on? (logbit? x index)) (ash? (not (zero? (logand x (ash 1 index)))))) (if (not (eq? on? ash?)) (format #t "(logbit? ~A ~A): ~A ~A~%" x index on? ash?))))) (let () (define (f1) (do ((i 0 (+ i 1))) ((= i 1)) (logbit? i -1))) (test (f1) 'error)) ; logbit_b_ii error ;;; -------------------------------------------------------------------------------- ;;; ash ;;; -------------------------------------------------------------------------------- (test (ash #b-1100 -2) -3) (test (ash #b-1100 2) -48) (test (ash (ash 1 31) -31) 1) (test (ash (expt 2 31) (- (expt 2 31))) 0) (test (ash -0 -10) 0) (test (ash -1 -12) -1) (test (ash -1 -3) -1) (test (ash -1 -8) -1) (test (ash -1 0) -1) (test (ash -1 30) -1073741824) (test (ash -1 8) -256) (test (ash -129876 -1026) -1) (test (ash -2 -3) -1) (test (ash -3 -3) -1) (test (ash -3 3) -24) (test (ash -31 -100) -1) (test (ash -31 -20) -1) (test (ash -31 -60) -1) (test (ash -31 -70) -1) (test (ash -31 most-negative-fixnum) -1) (test (ash 0 (expt 2 32)) 0) (test (ash 0 -10) 0) (test (ash 0 0) 0) (test (ash 0 1) 0) (test (ash 0 100) 0) (test (ash 1 (- (expt 2 31))) 0) (test (ash 1 (- (expt 2 32))) 0) (test (ash 1 -1) 0) (test (ash 1 -100) 0) (test (ash 1 10) 1024) (test (ash 1 31) 2147483648) (test (ash 1 32) 4294967296) (test (ash 1/1 10) 1024) (test (ash 1024 -8) 4) (test (ash 123 0) 123) (test (ash 1234 -6) 19) (test (ash 1234 6) 78976) (test (ash 12341234 -16) 188) (test (ash 12341234 6) 789838976) (test (ash 2 -1) 1) (test (ash 2 -2) 0) (test (> (ash 1 30) 1) #t) (test (> (ash 1 62) 1) #t) (test (ash most-positive-fixnum -2) 2305843009213693951) (test (ash most-positive-fixnum -62) 1) (test (ash (ash most-negative-fixnum -2) 2) most-negative-fixnum) ;; (test (ash most-positive-fixnum 2) 'error) if not bignums? (test (ash 1000000000 -100000000000) 0) (test (ash -1 63) most-negative-fixnum) (test (* 2 (ash -1 62)) most-negative-fixnum) (do ((i 0 (+ i 1))) ((= i 15)) (test (= (expt (ash 1 i) 2) (ash 1 (* 2 i)) (expt 2 (* 2 i)) (* (- (expt 2 i)) (- (ash 1 i))) (ash 2 (- (* i 2) 1))) #t)) (when with-bignums (test (ash 1 48) 281474976710656) (test (ash most-positive-fixnum 2) 36893488147419103228) (test (ash 281474976710656 -48) 1) (test (ash -100000000000000000000000000000000 -100) -79) ;; (floor (/ -100000000000000000000000000000000 (expt 2 100))) = -79 (test (ash -100000000000000000000000000000000 -200) -1) (test (ash 1 63) 9223372036854775808) (test (ash 1 64) 18446744073709551616) (test (ash 1 100) 1267650600228229401496703205376) (test (ash 18446744073709551616 -63) 2) (test (ash 1267650600228229401496703205376 -100) 1) (test (ash 1 89) (expt 2 89)) (test (ash 1 0+92233720368547758081.0i) 'error) (test (ash 1 92233720368547758081.0) 'error) (test (ash 0+92233720368547758081.0i -1) 'error) (test (ash 92233720368547758081.0 1) 'error) (test (ash 9223372036854775807 1) 18446744073709551614) (test (ash -9223372036854775807 1) -18446744073709551614) (test (ash 4294967297 (ash 1 43)) 'error) ; else gmp aborts the program! (test (ash 1 (ash 1 37)) 'error) (test (ash 12 (ash 1 32)) 'error)) ; not sure where the boundary is (malloc failure?) (test (ash 1 (expt 2 32)) 'error) (test (ash) 'error) (test (ash 1) 'error) (test (ash 1 2 3) 'error) (for-each (lambda (arg) (test (ash 1 arg) 'error) (test (ash arg 1) 'error)) (list #\a #f _ht_ _undef_ _null_ _c_obj_ #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1))) (let () ;; fails if x=0: (define (2^n? x) (zero? (logand x (- x 1)))) (define (2^n? x) (and (not (zero? x)) (zero? (logand x (- x 1))))) (define (2^n-1? x) (zero? (logand x (+ x 1)))) (define (x+y x y) (- x (lognot y) 1)) (define (0? x) (negative? (logand (lognot x) (- x 1)))) (define (<=0? x) (negative? (logior x (- x 1)))) (define (>=0? x) (negative? (lognot x))) (define (>0? x) (negative? (logand (- x) (lognot x)))) (define-macro (<=> x y) `(begin (set! ,x (logxor ,x ,y)) (set! ,y (logxor ,y ,x)) (set! ,x (logxor ,x ,y)))) (test (2^n? 32) #t) (test (2^n? 0) #f) (test (2^n? 2305843009213693952) #t) (test (2^n? 2305843009213693950) #f) (test (2^n? 17) #f) (test (2^n? 1) #t) (test (2^n-1? 31) #t) (test (2^n-1? 32) #f) (test (2^n-1? 18014398509481985) #f) (test (2^n-1? 18014398509481983) #t) (test (x+y 41 3) 44) (test (0? 0) #t) (test (0? 123) #f) (test (<=0? 0) #t) (test (<=0? -2) #t) (test (<=0? 2) #f) (test (>=0? -1) #f) (test (>0? 1) #t) (test (let ((x 1) (y 321)) (<=> x y) (list x y)) (list 321 1)) ) (unless with-bignums ;; these added 28-Jan-18 but maybe they're a bad idea (test #xffffffffffffffff -1) (test #x7fffffffffffffff most-positive-fixnum) (test #x7ffffffffffffffe (- most-positive-fixnum 1)) (test #x8000000000000000 most-negative-fixnum) (test #x8000000000000001 (+ most-negative-fixnum 1)) (test #xfffffffffffffffe -2)) (define (bit-reverse int) ;; from "Hacker's Delight" Henry Warren p101, but 64 bit (let ((x int)) (set! x (logior (ash (logand x #x5555555555555555) 1) (ash (logand x #xAAAAAAAAAAAAAAAA) -1))) (set! x (logior (ash (logand x #x3333333333333333) 2) (ash (logand x #xCCCCCCCCCCCCCCCC) -2))) (set! x (logior (ash (logand x #x0F0F0F0F0F0F0F0F) 4) (ash (logand x #xF0F0F0F0F0F0F0F0) -4))) (set! x (logior (ash (logand x #x00FF00FF00FF00FF) 8) (ash (logand x #xFF00FF00FF00FF00) -8))) (set! x (logior (ash (logand x #x0000FFFF0000FFFF) 16) (ash (logand x #xFFFF0000FFFF0000) -16))) (logior (ash (logand x #x00000000FFFFFFFF) 32) (ash (logand x #xFFFFFFFF00000000) -32)))) (let ((x (ash (bit-reverse #x01234566) -32))) (test x 1721943168)) (unless with-bignums (test (let () (define (func) ((lambda* ((x 1)) (do ((i 0 (+ i 1))) ((= i 1) 1) (ash x 1234))))) (define (hi) (func)) (hi)) 'error)) ;; from CL spec (test (let ((str "")) (let ((show (lambda (m x y) (set! str (string-append str (format #f "[m = #o~6,'0O, x = #o~6,'0O, y = #o~6,'0O] " m x y)))))) (let ((m #o007750) (x #o452576) (y #o317407)) (show m x y) (let ((z (logand (logxor x y) m))) (set! x (logxor z x)) (set! y (logxor z y)) (show m x y)))) str) "[m = #o007750, x = #o452576, y = #o317407] [m = #o007750, x = #o457426, y = #o312557] ") #| (DEFUN HAULONG (ARG) (INTEGER-LENGTH (ABS ARG))) (DEFUN HAIPART (X N) (SETQ X (ABS X)) (IF (MINUSP N) (LOGAND X (- (ASH 1 (- N)) 1)) (ASH X (MIN (- N (HAULONG X)) 0)))) |# ;;; -------------------------------------------------------------------------------- ;;; truncate ;;; -------------------------------------------------------------------------------- (test (truncate (/ (- most-positive-fixnum 1) most-positive-fixnum)) 0) (test (truncate (/ -1 most-positive-fixnum)) 0) (test (truncate (/ 1 most-positive-fixnum)) 0) (test (truncate (/ most-negative-fixnum most-positive-fixnum)) -1) (test (truncate (/ most-positive-fixnum (- most-positive-fixnum 1))) 1) (test (truncate -0) 0) (test (truncate -0.0) 0) (test (truncate -0.1) 0) (test (truncate -0.9) 0) (test (truncate -1) -1) (test (truncate -1.1) -1) (test (truncate -1.9) -1) (test (truncate -1/10) 0) (test (truncate -1/2) 0) (test (truncate -100/3) -33) (test (truncate -11/10) -1) (test (truncate -17/2) -8) (test (truncate -19/10) -1) (test (truncate -2.225073858507201399999999999999999999996E-308) 0) (test (truncate -2/3) 0) (test (truncate -200/3) -66) (test (truncate -3/2) -1) (test (truncate -9/10) 0) (test (truncate -9223372036854775808) -9223372036854775808) (test (truncate 0) 0) (test (truncate 0.0) 0) (test (truncate 0.1) 0) (test (truncate 0.9) 0) (test (truncate 1) 1) (test (truncate 1.1) 1) (test (truncate 1.110223024625156799999999999999999999997E-16) 0) (test (truncate 1.9) 1) (test (truncate 1/10) 0) (test (truncate 1/2) 0) (test (truncate 100/3) 33) (test (truncate 11/10) 1) (test (truncate 17.3) 17) (test (truncate 19) 19) (test (truncate 19/10) 1) (test (truncate 2.4) 2) (test (truncate 2.5) 2) (test (truncate 2.6) 2) (test (truncate 2/3) 0) (test (truncate 200/3) 66) (test (truncate 3/2) 1) (test (truncate 9/10) 0) (test (truncate 9223372036854775807) 9223372036854775807) (test (truncate most-negative-fixnum) most-negative-fixnum) (test (truncate most-positive-fixnum) most-positive-fixnum) (test (truncate 1+0i) 1) (when with-bignums (test (truncate 8388608.9999999995) 8388608) (test (truncate -8388609.0000000005) -8388609) (test (truncate -8388609.9999999995) -8388609)) (test (= (truncate (* 111738283365989051/177100989030047175 1.0)) (truncate 130441933147714940/206745572560704147)) #t) (test (= (truncate (* 114243/80782 114243/80782 1.0)) (truncate (* 275807/195025 275807/195025))) #f) (test (= (truncate (* 131836323/93222358 131836323/93222358 1.0)) (truncate (* 318281039/225058681 318281039/225058681))) #f) (test (= (truncate (* 1393/985 1393/985 1.0)) (truncate (* 3363/2378 3363/2378))) #f) (test (= (truncate (* 1607521/1136689 1607521/1136689 1.0)) (truncate (* 3880899/2744210 3880899/2744210))) #f) (when with-bignums (test (= (truncate (* 1855077841/1311738121 1855077841/1311738121 1.0)) (truncate (* 4478554083/3166815962 4478554083/3166815962))) #f) (test (= (truncate (* 318281039/225058681 318281039/225058681 1.0)) (truncate (* 1855077841/1311738121 1855077841/1311738121))) #t)) (test (= (truncate (* 19601/13860 19601/13860 1.0)) (truncate (* 47321/33461 47321/33461))) #f) (test (= (truncate (* 275807/195025 275807/195025 1.0)) (truncate (* 1607521/1136689 1607521/1136689))) #t) (test (= (truncate (* 3363/2378 3363/2378 1.0)) (truncate (* 19601/13860 19601/13860))) #t) (test (= (truncate (* 3880899/2744210 3880899/2744210 1.0)) (truncate (* 9369319/6625109 9369319/6625109))) #f) (test (= (truncate (* 47321/33461 47321/33461 1.0)) (truncate (* 114243/80782 114243/80782))) #f) (test (= (truncate (* 54608393/38613965 54608393/38613965 1.0)) (truncate (* 131836323/93222358 131836323/93222358))) #f) (test (= (truncate (* 9369319/6625109 9369319/6625109 1.0)) (truncate (* 54608393/38613965 54608393/38613965))) #t) (when with-bignums (test (truncate (+ (expt 2.0 62) 512)) 4611686018427388416) (test (truncate (+ (expt 2.0 62) 513)) 4611686018427388417) (test (truncate (exact->inexact most-negative-fixnum)) most-negative-fixnum) (test (truncate (exact->inexact most-positive-fixnum)) most-positive-fixnum) (test (truncate 1e19) 10000000000000000000) (test (truncate 1e32) 100000000000000000000000000000000) (test (truncate -1e19) -10000000000000000000) (test (truncate -1e32) -100000000000000000000000000000000) (test (truncate 100000000000000000000000000000000/3) 33333333333333333333333333333333) (test (truncate -100000000000000000000000000000000/3) -33333333333333333333333333333333) (test (truncate 200000000000000000000000000000000/3) 66666666666666666666666666666666) (test (truncate -200000000000000000000000000000000/3) -66666666666666666666666666666666) (let-temporarily (((*s7* 'bignum-precision) 512)) (test (= (truncate (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301 1.0)) (truncate (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902))) #f) (test (= (truncate (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440 1.0)) (truncate (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041))) #f) (test (= (truncate (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088 1.0)) (truncate (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #f) (test (= (truncate (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389 1.0)) (truncate (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))) #f) (test (= (truncate (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112 1.0)) (truncate (* 3796553736732654909229441/2684568892382786771291329 3796553736732654909229441/2684568892382786771291329))) #f) (test (= (truncate (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085 1.0)) (truncate (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692))) #f) (test (= (truncate (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701 1.0)) (truncate (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300))) #f) (test (= (truncate (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118 1.0)) (truncate (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161))) #f) (test (= (truncate (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902 1.0)) (truncate (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112))) #t) (test (= (truncate (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041 1.0)) (truncate (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085))) #t) (test (= (truncate (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905 1.0)) (truncate (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701))) #t) (test (= (truncate (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268 1.0)) (truncate (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118))) #t) (test (= (truncate (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300 1.0)) (truncate (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301))) #f) (test (= (truncate (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161 1.0)) (truncate (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440))) #f) (test (= (truncate (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729 1.0)) (truncate (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088))) #f) (test (= (truncate (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0)) (truncate (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #f))) (test (truncate) 'error) (test (truncate 1.23+1.0i) 'error) (for-each (lambda (arg) (test (truncate arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (let () (define (func) (let ((x #f) (i 0)) (begin (do ((i 0 (+ i 1))) ((= i 1)) (truncate -1e18))))) (define (hi) (func)) (hi)) (if with-bignums #t 'error)) ;;; -------------------------------------------------------------------------------- ;;; floor ;;; -------------------------------------------------------------------------------- (test (floor (+ 1 (expt 2 30))) 1073741825) (test (floor (/ (- most-positive-fixnum 1) most-positive-fixnum)) 0) (test (floor (/ -1 most-positive-fixnum)) -1) (test (floor (/ 1 most-positive-fixnum)) 0) (test (floor (/ most-negative-fixnum most-positive-fixnum)) -2) (test (floor -0) 0) (test (floor -0.0) 0) (test (floor -0.1) -1) (test (floor -0.9) -1) (test (floor -1) -1) (test (floor -1.1) -2) (test (floor -1.9) -2) (test (floor -1/10) -1) (test (floor -1/2) -1) (test (floor -100/3) -34) (test (floor -11/10) -2) (test (floor -17/2) -9) (test (floor -19/10) -2) (test (floor -2.225073858507201399999999999999999999996E-308) -1) (test (floor -2/3) -1) (test (floor -200/3) -67) (test (floor -3/2) -2) (test (floor -9/10) -1) (test (floor -9223372036854775808) -9223372036854775808) (test (floor 0) 0) (test (floor 0.0) 0) (test (floor 0.1) 0) (test (floor 0.9) 0) (test (floor 1) 1) (test (floor 1.0-00.i) 1) (test (floor 1.1) 1) (test (floor 1.110223024625156799999999999999999999997E-16) 0) (test (floor 1.9) 1) (test (floor 1/10) 0) (test (floor 1/2) 0) (test (floor 100/3) 33) (test (floor 11/10) 1) (test (floor 17.3) 17) (test (floor 19) 19) (test (floor 19/10) 1) (test (floor 2.5) 2) (test (floor 2.6) 2) (test (floor 2/3) 0) (test (floor 200/3) 66) (test (floor 3/2) 1) (test (floor 9/10) 0) (test (floor 9223372036854775807) 9223372036854775807) (test (floor most-negative-fixnum) most-negative-fixnum) (test (floor most-positive-fixnum) most-positive-fixnum) (test (floor (+ 0.7 8388608.0)) 8388608) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 512)) (test (floor (cosh (bignum 128))) 19438542029972975461113368441787390363640875315414994428) (test (ceiling (cosh (bignum 128))) 19438542029972975461113368441787390363640875315414994429) (test (round (cosh (bignum 128))) 19438542029972975461113368441787390363640875315414994429) (test (truncate (cosh (bignum 128))) 19438542029972975461113368441787390363640875315414994428) (test (equivalent? (acosh 19438542029972975461113368441787390363640875315414994428) 128.0) #t))) (if with-bignums (begin (test (floor 8388608.9999999995) 8388608) (test (floor 8388607.9999999995) 8388607) (test (floor 8388608.0000000005) 8388608) (test (floor 9007199254740992.95) 9007199254740992) (test (floor 9007199254740990.95) 9007199254740990) (test (floor 9007199254740993.95) 9007199254740993) (test (floor (+ 0.995 (expt 2.0 46))) 70368744177664) (test (floor (+ 0.9995 (expt 2.0 45))) 35184372088832)) (begin (test (floor 1e308) 'error) (test (floor 1e19) 'error) (test (floor -1e308) 'error) (test (floor -1e19) 'error))) (test (= (floor (* 111738283365989051/177100989030047175 1.0)) (floor 130441933147714940/206745572560704147)) #t) (test (= (floor (* 114243/80782 114243/80782 1.0)) (floor (* 275807/195025 275807/195025))) #f) (test (= (floor (* 131836323/93222358 131836323/93222358 1.0)) (floor (* 318281039/225058681 318281039/225058681))) #f) (test (= (floor (* 1393/985 1393/985 1.0)) (floor (* 3363/2378 3363/2378))) #f) (test (= (floor (* 1607521/1136689 1607521/1136689 1.0)) (floor (* 3880899/2744210 3880899/2744210))) #f) (if with-bignums (test (= (floor (* 1855077841/1311738121 1855077841/1311738121 1.0)) (floor (* 4478554083/3166815962 4478554083/3166815962))) #f)) (test (= (floor (* 19601/13860 19601/13860 1.0)) (floor (* 47321/33461 47321/33461))) #f) (test (= (floor (* 275807/195025 275807/195025 1.0)) (floor (* 1607521/1136689 1607521/1136689))) #t) (if with-bignums (test (= (floor (* 318281039/225058681 318281039/225058681 1.0)) (floor (* 1855077841/1311738121 1855077841/1311738121))) #t)) (test (= (floor (* 3363/2378 3363/2378 1.0)) (floor (* 19601/13860 19601/13860))) #t) (test (= (floor (* 3880899/2744210 3880899/2744210 1.0)) (floor (* 9369319/6625109 9369319/6625109))) #f) (test (= (floor (* 47321/33461 47321/33461 1.0)) (floor (* 114243/80782 114243/80782))) #f) (test (= (floor (* 54608393/38613965 54608393/38613965 1.0)) (floor (* 131836323/93222358 131836323/93222358))) #f) (test (= (floor (* 9369319/6625109 9369319/6625109 1.0)) (floor (* 54608393/38613965 54608393/38613965))) #t) (test (let () (define (func) (do ((_var_ #f) (i 0 (+ i 1))) ((= i 10000) _var_) (set! _var_ (integer->char (floor 3441313796169221281/1720656898084610641))))) (func)) #\x1) (when with-bignums (test (floor (+ (expt 2.0 62) 512)) 4611686018427388416) (test (floor (+ (expt 2.0 62) 513)) 4611686018427388417) (test (floor (exact->inexact most-negative-fixnum)) most-negative-fixnum) (test (floor (exact->inexact most-positive-fixnum)) most-positive-fixnum) (test (floor 1e19) 10000000000000000000) (test (floor 1e32) 100000000000000000000000000000000) (test (floor -1e19) -10000000000000000000) (test (floor -1e32) -100000000000000000000000000000000) (test (floor 100000000000000000000000000000000/3) 33333333333333333333333333333333) (test (floor -100000000000000000000000000000000/3) -33333333333333333333333333333334) (test (floor 200000000000000000000000000000000/3) 66666666666666666666666666666666) (test (floor -200000000000000000000000000000000/3) -66666666666666666666666666666667) (test (= (floor (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440 1.0)) (floor (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041))) #f) (test (= (floor (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088 1.0)) (floor (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #f) (test (= (floor (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389 1.0)) (floor (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))) #f) (test (= (floor (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118 1.0)) (floor (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161))) #f) (test (= (floor (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041 1.0)) (floor (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085))) #t) (test (= (floor (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268 1.0)) (floor (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118))) #t) (test (= (floor (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692 1.0)) (floor (* 96845919575610633161/68480406462161287469 96845919575610633161/68480406462161287469))) #f) (test (= (floor (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300 1.0)) (floor (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301))) #f) (test (= (floor (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161 1.0)) (floor (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440))) #f) (test (= (floor (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0)) (floor (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #f)) (let ((val1 (catch #t (lambda () (floor 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (floor -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (test (floor) 'error) (test (floor 1.23+1.0i) 'error) (test (floor 1.23 1.23) 'error) (let () (define (f1 x) (floor (/ x 3))) (test (f1 6) 2) (test (f1 7) 2) (test (f1 7.3) 2)) (for-each (lambda (arg) (test (floor arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (floor (atanh (logand))))) (define (hi) (func)) (hi)) 'error) ; floor_i_p real arg case ;;; -------------------------------------------------------------------------------- ;;; ceiling ;;; -------------------------------------------------------------------------------- (test (ceiling (/ (- most-positive-fixnum 1) most-positive-fixnum)) 1) (test (ceiling (/ -1 most-positive-fixnum)) 0) (test (ceiling (/ 1 most-positive-fixnum)) 1) (test (ceiling (/ most-negative-fixnum most-positive-fixnum)) -1) (test (ceiling (/ most-positive-fixnum (- most-positive-fixnum 1))) 2) (test (ceiling -.0001) 0) (test (ceiling -0) 0) (test (ceiling -0.0) 0) (test (ceiling -0.1) 0) (test (ceiling -0.9) 0) (test (ceiling -1) -1) (test (ceiling -1.1) -1) (test (ceiling -1.9) -1) (test (ceiling -1/10) 0) (test (ceiling -1/2) 0) (test (ceiling -100/3) -33) (test (ceiling -11/10) -1) (test (ceiling -17/2) -8) (test (ceiling -19/10) -1) (test (ceiling -2.225073858507201399999999999999999999996E-308) 0) (test (ceiling -2/3) 0) (test (ceiling -200/3) -66) (test (ceiling -2147483647.8) -2147483647) (test (ceiling -3/2) -1) (test (ceiling -9/10) 0) (test (ceiling -9223372036854775808) -9223372036854775808) (test (ceiling .0001) 1) (test (ceiling 0) 0) (test (ceiling 0.0) 0) (test (ceiling 0.1) 1) (test (ceiling 0.9) 1) (test (ceiling 1) 1) (test (ceiling 1.01e-123) 1) (test (ceiling 1.1) 2) (test (ceiling 1.110223024625156799999999999999999999997E-16) 1) (test (ceiling 1.9) 2) (test (ceiling 1/10) 1) (test (ceiling 1/2) 1) (test (ceiling 100/3) 34) (test (ceiling 11/10) 2) (test (ceiling 17.3) 18) (test (ceiling 19) 19) (test (ceiling 19/10) 2) (test (ceiling 2.4) 3) (test (ceiling 2.5) 3) (test (ceiling 2.6) 3) (test (ceiling 2/3) 1) (test (ceiling 200/3) 67) (test (ceiling 2147483646.8) 2147483647) (test (ceiling 3/2) 2) (test (ceiling 9/10) 1) (test (ceiling 9223372036854775807) 9223372036854775807) (test (ceiling most-negative-fixnum) most-negative-fixnum) (test (ceiling most-positive-fixnum) most-positive-fixnum) (test (ceiling 8922337203685477.9) 8922337203685478) (if with-bignums (begin (test (ceiling 8388608.0000000005) 8388609) (test (ceiling 8388609.0000000005) 8388610) (test (ceiling 8388607.9999999995) 8388608) (test (ceiling 9223372036854775806.9) 9223372036854775807)) (begin (test (ceiling 1e308) 'error) (test (ceiling 1e19) 'error) (test (ceiling -1e308) 'error) (test (ceiling -1e19) 'error) ;; but unfortunately (ceiling 9223372036854775806.9) => -9223372036854775808 ;; (ceiling 922337203685477580.9) => 922337203685477632 ;; (ceiling 9223372036854770.9) => 9223372036854770 )) (test (= (ceiling (* 111738283365989051/177100989030047175 1.0)) (ceiling 130441933147714940/206745572560704147)) #t) (test (= (ceiling (* 114243/80782 114243/80782 1.0)) (ceiling (* 275807/195025 275807/195025))) #f) (if with-bignums (test (= (ceiling (* 131836323/93222358 131836323/93222358 1.0)) (ceiling (* 318281039/225058681 318281039/225058681))) #f)) (test (= (ceiling (* 1393/985 1393/985 1.0)) (ceiling (* 3363/2378 3363/2378))) #f) (test (= (ceiling (* 1607521/1136689 1607521/1136689 1.0)) (ceiling (* 3880899/2744210 3880899/2744210))) #f) (if with-bignums (test (= (ceiling (* 1855077841/1311738121 1855077841/1311738121 1.0)) (ceiling (* 4478554083/3166815962 4478554083/3166815962))) #f)) (test (= (ceiling (* 19601/13860 19601/13860 1.0)) (ceiling (* 47321/33461 47321/33461))) #f) (test (= (ceiling (* 275807/195025 275807/195025 1.0)) (ceiling (* 1607521/1136689 1607521/1136689))) #t) (test (= (ceiling (* 318281039/225058681 318281039/225058681 1.0)) (ceiling (* 1855077841/1311738121 1855077841/1311738121))) #t) (test (= (ceiling (* 3363/2378 3363/2378 1.0)) (ceiling (* 19601/13860 19601/13860))) #t) (test (= (ceiling (* 3880899/2744210 3880899/2744210 1.0)) (ceiling (* 9369319/6625109 9369319/6625109))) #f) (test (= (ceiling (* 47321/33461 47321/33461 1.0)) (ceiling (* 114243/80782 114243/80782))) #f) (test (= (ceiling (* 54608393/38613965 54608393/38613965 1.0)) (ceiling (* 131836323/93222358 131836323/93222358))) #f) (test (= (ceiling (* 9369319/6625109 9369319/6625109 1.0)) (ceiling (* 54608393/38613965 54608393/38613965))) #t) (when with-bignums (test (ceiling (+ (expt 2.0 62) 512)) 4611686018427388416) (test (ceiling (+ (expt 2.0 62) 513)) 4611686018427388417) (test (ceiling (exact->inexact most-negative-fixnum)) most-negative-fixnum) (test (ceiling (exact->inexact most-positive-fixnum)) most-positive-fixnum) (test (ceiling 123456789012345678901234567890.1) 123456789012345678901234567891) (test (ceiling -123456789012345678901234567890.1) -123456789012345678901234567890) (test (ceiling 9223372036854775806.7) 9223372036854775807) (test (ceiling -9223372036854775807.9) -9223372036854775807) (test (ceiling -1e19) -10000000000000000000) (test (ceiling -1e32) -100000000000000000000000000000000) (test (ceiling 100000000000000000000000000000000/3) 33333333333333333333333333333334) (test (ceiling -100000000000000000000000000000000/3) -33333333333333333333333333333333) (test (ceiling 200000000000000000000000000000000/3) 66666666666666666666666666666667) (test (ceiling -200000000000000000000000000000000/3) -66666666666666666666666666666666) (test (= (ceiling (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440 1.0)) (ceiling (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041))) #f) ;; (test (= (ceiling (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088 1.0)) ;; (ceiling (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #f) ;; this requires much more precision (2048 bits) (test (= (ceiling (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088)) (ceiling (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #f) (test (= (ceiling (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389 1.0)) (ceiling (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))) #f) (test (= (ceiling (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085 1.0)) (ceiling (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692))) #f) (test (= (ceiling (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701 1.0)) (ceiling (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300))) #f) (test (= (ceiling (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118 1.0)) (ceiling (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161))) #f) (test (= (ceiling (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041 1.0)) (ceiling (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085))) #t) (test (= (ceiling (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268 1.0)) (ceiling (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118))) #t) (test (= (ceiling (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161 1.0)) (ceiling (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440))) #f) (test (= (ceiling (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729 1.0)) (ceiling (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088))) #f) (test (= (ceiling (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0)) (ceiling (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #f) (test (= (ceiling (* 96845919575610633161/68480406462161287469 96845919575610633161/68480406462161287469 1.0)) (ceiling (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729))) #t)) (let ((val1 (catch #t (lambda () (ceiling 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (ceiling -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (test (ceiling) 'error) (test (ceiling 1.23+1.0i) 'error) (test (ceiling 1.23 1.23) 'error) (for-each (lambda (arg) (test (ceiling arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (ceiling (atanh (logand))))) (define (hi) (func)) (hi)) 'error) (test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (ceiling 1.0))) (vector-ref v 0))) (f))) #t) (test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (floor 1.0))) (vector-ref v 0))) (f))) #t) (test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (round 1.0))) (vector-ref v 0))) (f))) #t) (test (integer? (let () (define (f) (let ((v (vector #f))) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! v 0 (truncate 1.0))) (vector-ref v 0))) (f))) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (ceiling pi)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (floor pi)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (round pi)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (truncate pi)))) (define (hi) (func)) (hi)) #t) ;;; -------------------------------------------------------------------------------- ;;; round ;;; -------------------------------------------------------------------------------- (test (round (/ (- most-positive-fixnum 1) most-positive-fixnum)) 1) (test (round (/ -1 most-positive-fixnum)) 0) (test (round (/ 1 most-positive-fixnum)) 0) (test (round (/ most-negative-fixnum most-positive-fixnum)) -1) (test (round -0) 0) (test (round -0.0) 0) (test (round -0.1) 0) (test (round -0.9) -1) (test (round -1) -1) (test (round -1.1) -1) (test (round -1.9) -2) (test (round -1/10) 0) (test (round -1/2) 0) (test (round -100/3) -33) (test (round -11/10) -1) (test (round -17/2) -8) (test (round -19/10) -2) (test (round -2.225073858507201399999999999999999999996E-308) 0) (test (round -2/3) -1) (test (round -200/3) -67) (test (round -3/2) -2) (test (round -9/10) -1) (test (round -9223372036854775808) -9223372036854775808) (test (round 0) 0) (test (round 0.0) 0) (test (round 0.1) 0) (test (round 0.9) 1) (test (round 1) 1) (test (round 1.1) 1) (test (round 1.110223024625156799999999999999999999997E-16) 0) (test (round 1.9) 2) (test (round 1/10) 0) (test (round 1/2) 0) (test (round 100/3) 33) (test (round 11/10) 1) (test (round 17.3) 17) (test (round 19) 19) (test (round 19/10) 2) (test (round 2.4) 2) (test (round 2.5) 2) (test (round 2.6) 3) (test (round 2/3) 1) (test (round 200/3) 67) (test (round 3.5) 4) (test (round 3/2) 2) (test (round 9/10) 1) (test (round 9223372036854775807) 9223372036854775807) (test (round most-negative-fixnum) most-negative-fixnum) (test (round most-positive-fixnum) most-positive-fixnum) (test (round (+ 8388608 .1)) 8388608) (test (round (+ 8388608 .9)) 8388609) (test (round (- 8388608 .1)) 8388608) (test (round (- 8388608 .9)) 8388607) (test (round 9007199254740990.501) 9007199254740991) (test (round 9007199254740990.499) 9007199254740990) (if with-bignums (begin (test (round (bignum +nan.0)) 'error) (test (round 9007199254740992.51) 9007199254740993) (test (round 9007199254740993.99) 9007199254740994)) (begin (test (round 1e308) 'error) (test (round 1e19) 'error) (test (round -1e308) 'error) (test (round -1e19) 'error))) (test (= (round (* 111738283365989051/177100989030047175 1.0)) (round 130441933147714940/206745572560704147)) #t) (test (= (round (* 114243/80782 114243/80782 1.0)) (round (* 275807/195025 275807/195025))) #t) (test (= (round (* 131836323/93222358 131836323/93222358 1.0)) (round (* 318281039/225058681 318281039/225058681))) #t) (test (= (round (* 1393/985 1393/985 1.0)) (round (* 3363/2378 3363/2378))) #t) (test (= (round (* 1607521/1136689 1607521/1136689 1.0)) (round (* 3880899/2744210 3880899/2744210))) #t) (if (provided? 'overflow-checks) (test (= (round (* 1855077841/1311738121 1855077841/1311738121 1.0)) (round (* 4478554083/3166815962 4478554083/3166815962))) #t)) (test (= (round (* 19601/13860 19601/13860 1.0)) (round (* 47321/33461 47321/33461))) #t) (test (= (round (* 275807/195025 275807/195025 1.0)) (round (* 1607521/1136689 1607521/1136689))) #t) (test (= (round (* 318281039/225058681 318281039/225058681 1.0)) (round (* 1855077841/1311738121 1855077841/1311738121))) #t) (test (= (round (* 3363/2378 3363/2378 1.0)) (round (* 19601/13860 19601/13860))) #t) (test (= (round (* 3880899/2744210 3880899/2744210 1.0)) (round (* 9369319/6625109 9369319/6625109))) #t) (test (= (round (* 47321/33461 47321/33461 1.0)) (round (* 114243/80782 114243/80782))) #t) (test (= (round (* 54608393/38613965 54608393/38613965 1.0)) (round (* 131836323/93222358 131836323/93222358))) #t) (test (= (round (* 9369319/6625109 9369319/6625109 1.0)) (round (* 54608393/38613965 54608393/38613965))) #t) (test (round 1.23 1.23) 'error) (test (round 1.23+1.0i) 'error) (test (round) 'error) (for-each (lambda (arg) (test (round arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (round 400000000000000000/800000000000000001) 0) (test (round 400000000000000000/800000000000000000) 0) (test (round 400000000000000000/799999999999999999) 1) (when with-bignums (test (round (+ (expt 2.0 62) 512)) 4611686018427388416) (test (round (+ (expt 2.0 62) 513)) 4611686018427388417) (test (round (exact->inexact most-negative-fixnum)) most-negative-fixnum) (test (round (exact->inexact most-positive-fixnum)) most-positive-fixnum) (test (round -1e19) -10000000000000000000) (test (round -1e32) -100000000000000000000000000000000) (test (round 100000000000000000000000000000000/3) 33333333333333333333333333333333) (test (round -100000000000000000000000000000000/3) -33333333333333333333333333333333) (test (round 200000000000000000000000000000000/3) 66666666666666666666666666666667) (test (round -200000000000000000000000000000000/3) -66666666666666666666666666666667) (test (= (round (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440 1.0)) (round (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041))) #t) (test (= (round (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088 1.0)) (round (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905))) #t) (test (= (round (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389 1.0)) (round (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268))) #t) (test (= (round (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085 1.0)) (round (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692))) #t) (test (= (round (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118 1.0)) (round (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161))) #t) (test (= (round (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041 1.0)) (round (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085))) #t) (test (= (round (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268 1.0)) (round (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118))) #t) (test (= (round (* 40114893348711941777/28365513113449345692 40114893348711941777/28365513113449345692 1.0)) (round (* 96845919575610633161/68480406462161287469 96845919575610633161/68480406462161287469))) #t) (test (= (round (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161 1.0)) (round (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440))) #t) (test (= (round (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490 1.0)) (round (* 14398739476117879/10181446324101389 14398739476117879/10181446324101389))) #t) (test (= (round (* 96845919575610633161/68480406462161287469 96845919575610633161/68480406462161287469 1.0)) (round (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729))) #t)) (test (equal? (let ((vals ())) (do ((k 1/3 (+ k 1/3))) ((> k 2) (reverse vals)) (set! vals (cons (round k) vals)))) (list 0 1 1 1 2 2)) #t) (test (equal? (let ((vals ())) (do ((k 1/3 (+ k 1/3))) ((> k 2) (reverse vals)) (set! vals (cons (round (- k)) vals)))) (list 0 -1 -1 -1 -2 -2)) #t) (test (equal? (let ((vals ())) (do ((k 1/2 (+ k 1/2))) ((> k 3) (reverse vals)) (set! vals (cons (round k) vals)))) (list 0 1 2 2 2 3)) #t) (test (equal? (let ((vals ())) (do ((k 1/2 (+ k 1/2))) ((> k 3) (reverse vals)) (set! vals (cons (round (- k)) vals)))) (list 0 -1 -2 -2 -2 -3)) #t) (let ((top-exp 60)) (if with-bignums (set! top-exp 150)) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (/ (- (expt 2 i) 1) 2)) (val2 (expt 2 (- i 1))) (fv (floor val1)) (rv (round val1)) (cv (ceiling val1)) (tv (truncate val1))) (if (not (= fv (- val2 1))) (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv))) (if (not (= cv val2)) (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv))) (if (not (= tv (- val2 1))) (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv))) (if (not (= rv val2)) (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (/ (+ (expt 2 i) 1) 2)) (val2 (expt 2 (- i 1))) (fv (floor val1)) (rv (round val1)) (cv (ceiling val1)) (tv (truncate val1))) (if (not (= fv val2)) (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv))) (if (not (= cv (+ val2 1))) (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv))) (if (not (= tv val2)) (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv))) (if (not (= rv val2)) (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (expt 2 i)) (val2 (- val1 1))) (if (= (floor val1) (floor val2)) (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2))) (if (= (ceiling val1) (ceiling val2)) (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2))) (if (= (truncate val1) (truncate val2)) (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2))) (if (= (round val1) (round val2)) (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (/ (- (expt 2 i) 1) 2)) (val2 (/ (- (expt 2 i) 3) 2))) (if (= (floor val1) (floor val2)) (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2))) (if (= (ceiling val1) (ceiling val2)) (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2))) (if (= (truncate val1) (truncate val2)) (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2))) (if (= (round val1) (round val2)) (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2)))))) (let ((happy #t) (off-by 1/3)) (do ((i 2 (+ i 1))) ((or (not happy) (>= i top-exp))) (let* ((val1 (/ (expt 2 i) 3)) (fv (floor val1)) (cv (ceiling val1)) (tv (truncate val1)) (rv (round val1))) (if (not (= fv (- val1 off-by))) (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv))) (if (not (= cv (+ val1 (- 1 off-by)))) (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv))) (if (not (= tv (- val1 off-by))) (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv))) (if (= off-by 1/3) (if (not (= rv (- val1 off-by))) (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))) (if (not (= rv (+ val1 (- 1 off-by)))) (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))) (if (= off-by 1/3) (set! off-by 2/3) (set! off-by 1/3))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (- (/ (- (expt 2 i) 1) 2))) (val2 (- (expt 2 (- i 1)))) (fv (floor val1)) (rv (round val1)) (cv (ceiling val1)) (tv (truncate val1))) (if (not (= fv val2)) (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv))) (if (not (= cv (+ val2 1))) (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv))) (if (not (= tv (+ val2 1))) (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv))) (if (not (= rv val2)) (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (- (/ (+ (expt 2 i) 1) 2))) (val2 (- (expt 2 (- i 1)))) (fv (floor val1)) (rv (round val1)) (cv (ceiling val1)) (tv (truncate val1))) (if (not (= fv (- val2 1))) (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv))) (if (not (= cv val2)) (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv))) (if (not (= tv val2)) (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv))) (if (not (= rv val2)) (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (- (expt 2 i))) (val2 (+ val1 1))) (if (= (floor val1) (floor val2)) (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2))) (if (= (ceiling val1) (ceiling val2)) (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2))) (if (= (truncate val1) (truncate val2)) (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2))) (if (= (round val1) (round val2)) (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (- (/ (- (expt 2 i) 1) 2))) (val2 (- (/ (- (expt 2 i) 3) 2)))) (if (= (floor val1) (floor val2)) (begin (set! happy #f) (format #t ";(floor ~S) = (floor ~S)?~%" val1 val2))) (if (= (ceiling val1) (ceiling val2)) (begin (set! happy #f) (format #t ";(ceiling ~S) = (ceiling ~S)?~%" val1 val2))) (if (= (truncate val1) (truncate val2)) (begin (set! happy #f) (format #t ";(truncate ~S) = (truncate ~S)?~%" val1 val2))) (if (= (round val1) (round val2)) (begin (set! happy #f) (format #t ";(round ~S) = (round ~S)?~%" val1 val2)))))) (let ((happy #t) (off-by 2/3)) (do ((i 2 (+ i 1))) ((or (not happy) (>= i top-exp))) (let* ((val1 (- (/ (expt 2 i) 3))) (fv (floor val1)) (cv (ceiling val1)) (tv (truncate val1)) (rv (round val1))) (if (not (= fv (- val1 off-by))) (begin (set! happy #f) (format #t ";(floor ~S) = ~S?~%" val1 fv))) (if (not (= cv (+ val1 (- 1 off-by)))) (begin (set! happy #f) (format #t ";(ceiling ~S) = ~S?~%" val1 cv))) (if (not (= tv (+ val1 (- 1 off-by)))) (begin (set! happy #f) (format #t ";(truncate ~S) = ~S?~%" val1 tv))) (if (= off-by 1/3) (if (not (= rv (- val1 off-by))) (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv))) (if (not (= rv (+ val1 (- 1 off-by)))) (begin (set! happy #f) (format #t ";(round ~S) = ~S?~%" val1 rv)))) (if (= off-by 1/3) (set! off-by 2/3) (set! off-by 1/3))))) ) ;;; -------------------------------------------------------------------------------- ;;; modulo ;;; -------------------------------------------------------------------------------- ;;; (modulo x 0) -> x? I seem to be getting errors instead; maxima returns x and refers to Section 3.4, of "Concrete Mathematics," by Graham, Knuth, and Patashnik ;;; (mod x 1.0) = sawtooth (test (modulo (/ (expt 2 61)) (/ (expt 3 10))) 1/2305843009213693952) (test (modulo (/ (expt 2 61)) (/ (expt 3 20))) 1/2305843009213693952) (test (modulo (/ (expt 2 61)) 1/512) 1/2305843009213693952) (test (modulo -0.5 -1) -0.5) (test (modulo -1 -1) 0) (test (modulo -1 -10) -1) (test (modulo -1 -1234) -1) (test (modulo -1 -2) -1) (test (modulo -1 -3) -1) (test (modulo -1 -500029) -1) (test (modulo -1 1) 0) (test (modulo -1 10) 9) (test (modulo -1 1234) 1233) (test (modulo -1 2) 1) (test (modulo -1 3) 2) (test (modulo -1 500029) 500028) (test (modulo -1.5 -2) -1.5) (test (modulo -1.5 2) 0.5) (test (modulo -1/2 -1) -1/2) (test (modulo -1/2 -1.0) -0.5) (test (modulo -1/2 2) 3/2) (test (modulo -1/9223372036854775807 -1/3) -1/9223372036854775807) (test (modulo -1234 -1) 0) (test (modulo -1234 -10) -4) (test (modulo -1234 -1234) 0) (test (modulo -1234 -2) 0) (test (modulo -1234 -3) -1) (test (modulo -1234 -500029) -1234) (test (modulo -1234 1) 0) (test (modulo -1234 10) 6) (test (modulo -1234 1234) 0) (test (modulo -1234 2) 0) (test (modulo -1234 3) 2) (test (modulo -1234 500029) 498795) (test (modulo -13 -4) -1) (test (modulo -13 4) 3) (test (modulo -2 -1) 0) (test (modulo -2 -10) -2) (test (modulo -2 -1234) -2) (test (modulo -2 -2) 0) (test (modulo -2 -3) -2) (test (modulo -2 -500029) -2) (test (modulo -2 1) 0) (test (modulo -2 10) 8) (test (modulo -2 1234) 1232) (test (modulo -2 2) 0) (test (modulo -2 3) 1) (test (modulo -2 500029) 500027) (test (modulo -2/9223372036854775807 -2/3) -2/9223372036854775807) (test (modulo -3 -1) 0) (test (modulo -3 -10) -3) (test (modulo -3 -1234) -3) (test (modulo -3 -2) -1) (test (modulo -3 -3) 0) (test (modulo -3 -500029) -3) (test (modulo -3 1) 0) (test (modulo -3 10) 7) (test (modulo -3 1234) 1231) (test (modulo -3 2) 1) (test (modulo -3 3) 0) (test (modulo -3 500029) 500026) (num-test (modulo -3.1 -2.0) -1.1) (num-test (modulo -3.1 2.0) 0.9) ; parallels (modulo -3 2) -> 1 (num-test (modulo -3.1 2.5) 1.9) (num-test (modulo -3.5 1.5) 1.0) (test (modulo -3/2 -2) -3/2) (test (modulo -3/2 2) 1/2) (test (modulo -500029 -1) 0) (test (modulo -500029 -10) -9) (test (modulo -500029 -1234) -259) (test (modulo -500029 -2) -1) (test (modulo -500029 -3) -1) (test (modulo -500029 -500029) 0) (test (modulo -500029 1) 0) (test (modulo -500029 10) 1) (test (modulo -500029 1234) 975) (test (modulo -500029 2) 1) (test (modulo -500029 3) 2) (test (modulo -500029 500029) 0) (test (modulo 0 -1) 0) (test (modulo 0 -10) 0) (test (modulo 0 -1234) 0) (test (modulo 0 -2) 0) (test (modulo 0 -3) 0) (test (modulo 0 -500029) 0) (test (modulo 0 1) 0) (test (modulo 0 10) 0) (test (modulo 0 1234) 0) (test (modulo 0 2) 0) (test (modulo 0 3) 0) (test (modulo 0 500029) 0) (test (modulo 0 86400) 0) (test (modulo 0.5 -2) -1.5) (test (modulo 0.5 -2.0) -1.5) (test (modulo 0.5 2.0) 0.5) (test (modulo 1 -1) 0) (test (modulo 1 -10) -9) (test (modulo 1 -1234) -1233) (test (modulo 1 -2) -1) (test (modulo 1 -3) -2) (test (modulo 1 -4) -3) (test (modulo 1 -500029) -500028) (test (modulo 1 1) 0) (test (modulo 1 10) 1) (test (modulo 1 1234) 1) (test (modulo 1 2) 1) (test (modulo 1 3) 1) (test (modulo 1 500029) 1) (num-test (modulo 1.5 1/3) 0.16666666666667) (num-test (modulo 1.5 1/4) 0.0) (test (modulo 1/2 -2) -3/2) (test (modulo 1/2 2) 1/2) (test (modulo 1/2305843009213693952 1/4) 1/2305843009213693952) (test (modulo 1/9223372036854775807 1/2) 1/9223372036854775807) (test (modulo 1/9223372036854775807 1/3) 1/9223372036854775807) (test (modulo 11/9223372036854775807 3/9223372036854775807) 2/9223372036854775807) (test (modulo 1234 -1) 0) (test (modulo 1234 -10) -6) (test (modulo 1234 -1234) 0) (test (modulo 1234 -2) 0) (test (modulo 1234 -3) -2) (test (modulo 1234 -500029) -498795) (test (modulo 1234 1) 0) (test (modulo 1234 10) 4) (test (modulo 1234 1234) 0) (test (modulo 1234 2) 0) (test (modulo 1234 3) 1) (test (modulo 1234 500029) 1234) (test (modulo 13 -4) -3) (test (modulo 13 4) 1) (num-test (modulo 19439282 4409.5) 2206.0) (test (modulo 2 -1) 0) (test (modulo 2 -10) -8) (test (modulo 2 -1234) -1232) (test (modulo 2 -2) 0) (test (modulo 2 -3) -1) (test (modulo 2 -500029) -500027) (test (modulo 2 1) 0) (test (modulo 2 10) 2) (test (modulo 2 1234) 2) (test (modulo 2 2) 0) (test (modulo 2 3) 2) (test (modulo 2 500029) 2) (test (modulo 2/9223372036854775807 2/3) 2/9223372036854775807) (test (modulo 3 -1) 0) (test (modulo 3 -10) -7) (test (modulo 3 -1234) -1231) (test (modulo 3 -2) -1) (test (modulo 3 -3) 0) (test (modulo 3 -500029) -500026) (test (modulo 3 1) 0) (test (modulo 3 10) 3) (test (modulo 3 1234) 3) (test (modulo 3 2) 1) (num-test (modulo 3 2.5) 0.5) (test (modulo 3 3) 0) (test (modulo 3 500029) 3) (num-test (modulo 3.1 -2.0) -0.9) (num-test (modulo 3.1 2) 1.1) (num-test (modulo 3.1 2.0) 1.1) (num-test (modulo 3.5 1.5) 0.5) (test (modulo 3/2 1/3) 1/6) (test (modulo 3/2 1/4) 0) (test (modulo 3/2 3/10) 0) (test (modulo 3/3037000501 2/3037000501) 1/3037000501) (test (modulo 3/9223372036854775807 2/9223372036854775807) 1/9223372036854775807) (test (modulo 500029 -1) 0) (test (modulo 500029 -10) -1) (test (modulo 500029 -1234) -975) (test (modulo 500029 -2) -1) (test (modulo 500029 -3) -2) (test (modulo 500029 -500029) 0) (test (modulo 500029 1) 0) (test (modulo 500029 10) 9) (test (modulo 500029 1234) 259) (test (modulo 500029 2) 1) (test (modulo 500029 3) 1) (test (modulo 500029 500029) 0) (test (modulo 922337203685477 1/3) 0) (test (modulo 9223372036854775 1/3) 0) (test (modulo 92233720368547758 1/3) 0) (test (modulo 92233720368547758/23 1/3) 1/69) (test (modulo 922337203685477580 1/3) 0) (test (modulo 2755 13) 12) (test (modulo 56 2) 0) (test (modulo 148665 2) 1) (test (modulo 71862 203) 0) (test (modulo 21568911 41) 0) (test (modulo 15295874 111) 74) (test (modulo 20430054 41) 0) (test (modulo 248255254 767) 364) (test (modulo 510104442 5453) 3557) (test (modulo 242162410 41) 10) (test (modulo 660070972 74) 0) (test (modulo 6542405452 117) 37) (test (modulo 629448534 2) 0) (test (modulo 163873565922 155) 62) (test (modulo 1563464979842 442) 272) (test (modulo 3712337724 576173) 55085) (test (modulo 4380921044390 5) 0) (test (modulo 4097970629150 86) 16) (test (modulo 2090198664 1118) 398) (test (modulo 5275411661289 31857) 10521) (test (modulo 38602581835881 19) 8) (test (modulo 82578867500655 319) 174) (test (modulo 363169800 20) 0) (test (modulo 2033404107084 23374) 16730) (test (modulo 7438317458260 31213) 22165) (test (modulo 390609000 11) 1) (test (modulo 406117800 57) 39) (test (modulo 1008217762344 4403) 3922) (test (modulo 136581511784536 67022) 19220) (test (modulo 43293168048 1344610) 759878) (test (modulo 608503422693864 47) 0) (test (modulo 6945109296864 779) 722) (test (modulo 1346702251365156 435) 261) (test (modulo 1388225063690465 644) 525) (test (modulo 1200780158492850 91686) 60534) (test (modulo 1551193257090906 2656731) 2347158) (test (modulo 386512944051107445 17) 0) (test (modulo 1111364125679340 6) 0) (test (modulo 15858537083857314 21793) 0) (test (modulo 44179338013272 280645) 48872) (test (modulo 64149298745840 43808357) 20657028) (test (modulo 4412914630225794 515823) 281358) (test (modulo 169216424701305960 17) 14) (test (modulo 178335507754891305 817) 0) (test (modulo -9223372036854775808 -9223372036854775808) 0) (when with-bignums (num-test (modulo 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -9.223372036854775807999999999999999888978E18)) (num-test (modulo 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 5.551115123125783999999999999999999999984E-17) (test (modulo 9223372036854775807 -9223372036854775808) -1) (test (modulo 9223372036854775807 9223372036854775807) 0) (test (modulo (+ (ash 1 54) 1) (ash 1 54)) 1) (test (modulo 8/3 3/2) 7/6) (test (modulo 37/8 17/12) 3/8) (test (modulo 12/19 41/29) 12/19) (test (modulo 389/84 99/70) 163/420) (test (modulo 1456/401 577/408) 65647/81804) (test (modulo 9097/1054 1393/985) 151213/1038190) (test (modulo 53963/20511 3363/2378) 59345521/48775158) (test (modulo 163963/24727 19601/13860) 83457868/85679055) (test (modulo 456564/125743 47321/33461) 3376518998/4207486523) (test (modulo 794525/301994 114243/80782) 7420654502/6098919827) (test (modulo 75261245/11350029 275807/195025) 2156154512513/2213539405725) (test (modulo 92819835/16483927 1607521/1136689) 26012508981414/18737098497703) (test (modulo 44957104/17087915 3880899/2744210) 11411052426451/9378565444430) (test (modulo 53715833/85137581 9369319/6625109) 53715833/85137581) (test (modulo 171928773/272500658 54608393/38613965) 171928773/272500658) (test (modulo 4178406761/630138897 131836323/93222358) 28610075152269757/29371516922929563) (test (modulo 1/9223372036 9223372036) 1/9223372036) (test (modulo 1/9223372036854775807 9223372036854775807) 1/9223372036854775807) (test (modulo 3/2 most-positive-fixnum) 3/2) (test (modulo most-negative-fixnum -1) 0) (test (modulo 100 -1/2) 0) ; was -1/2?? (test (modulo 100 1/2) 0) (num-test (modulo 100.0 -0.5) 0.0) (num-test (modulo 100.0 -1/2) 0.0) (num-test (modulo 100 -0.5) 0.0) (test (modulo 9223372036854775807 2) 1) (test (modulo 2 -9223372036854775808) -9223372036854775806) (when with-bignums (num-test (modulo 9223372036854775807 2.0) 1.0) ; depends on * and / handling (double)integer(x|y)! -- 0.0 in non-gmp case due to truncation error (test (/ 9223372036854775807 2.0) 4.6116860184273879035E18) (num-test (/ (bignum 9223372036854775807) 2.0) 4.6116860184273879035E18) (test (floor 4.6116860184273879035E18) 4611686018427387903) (num-test (* 2.0 4611686018427387903) 9.223372036854775806E18) (num-test (* 4611686018427387903 2.0) 9.223372036854775806E18) (num-test (modulo 9223372036854775807.0 2) 1.0) (num-test (modulo 9223372036854775807.0 2.0) 1.0) (num-test (modulo 10000000000000001 2.0) 1.0) ; even this is 0.0 in non-gmp case (num-test (modulo -9223372036854775808 0.6931471805599453) 3.263807524297868999704069770118053384067E-1) (num-test (modulo 2.0 -9223372036854775808) -9223372036854775806.0) (num-test (modulo -1 10000000000000000.0) 9.999999999999999E15) ; non-gmp: 1e16 (num-test (modulo -1 1.176926334185099927039499553745174043786E17) 1.176926334185099917039499553745174043786E17) ) (test (modulo -9223372036854775808 2) 0) (unless with-bignums (test (modulo 3/2 most-negative-fixnum) 'error)) (when with-bignums (num-test (= (modulo 2.0 (* 318281039/225058681 318281039/225058681)) 0.0) #f) (num-test (= (modulo (* 1855077841/1311738121 1855077841/1311738121) 2.0) 0.0) #f) (test (modulo 3/2 most-negative-fixnum) -18446744073709551613/2) (test (modulo (+ 2 (* 3 499127 495037 490459 468803)) (* 499127 495037 490459 468803)) 2) (num-test (modulo -9223372036854775808 5.551115123125783999999999999999999999984E-17) 3.258027528318940824192395666614174842834E-17) (test (modulo 12345678901234567890 12345678901234567) 890) (test (modulo 12345678901234567890 3123) 1071) (test (modulo 460683358924445799142 518) 0) (test (modulo 113021475230160 74635) 67850) (test (modulo 74228340534140364 363909) 357201) (test (modulo 69242022961311060 48305942) 17170072) (test (modulo 286967952870300 2273388) 2067312) (test (modulo 302822258393413362492399 29) 0) (test (modulo 10491072879382200 133) 0) (test (modulo 167206737423420464 609) 539) (test (modulo 72212583812867784 4888799) 1883149) (test (modulo 4170116471639397292390 1798025) 1078815) (test (modulo 83910330283522050 35224) 9282) (test (modulo 275373383775647594346 66884092) 19813626) (test (modulo 14656657495570695990 37) 7) (test (modulo 95470974177676509874110 1219) 0) (test (modulo 619506317623001424 5957) 3304) (test (modulo 11268171656665155960 9858) 372) (test (modulo 6172860073826160 5167394) 906830) (test (modulo 26457493095663264 1491412) 1103724) (test (modulo 8481384175941103284 313836405) 93136149) (test (modulo 60356595775749199080 176098815946) 156894620552) (test (modulo 611492274956002440 37) 0) (test (modulo 164614611843685080 1711) 177) (test (modulo 93177516542679418720 62197) 37333) (test (modulo 938959746797519770440 127558) 0) (test (modulo 137670522526899326250 200) 50) (test (modulo 852063402206742880 41643478) 23771242) (test (modulo 55947291202307909360 188546228) 125937196) (test (modulo 12877971214039423262680 9832253830) 8120608300) (test (modulo 192158415774146059920 53) 0) (test (modulo 902814024155808960 1829) 434) (test (modulo 1265864304573235487120 4921) 1295) (test (modulo 14172662463567665400 95817) 38076) (test (modulo 32171996211745702482324 2368555) 459984) (test (modulo 971324258606045826300 4576748) 342908) (test (modulo 2400649320046378377000 1704690) 165540) (test (modulo 953233796456393760 18342152493) 178603257) (test (modulo 28906333140964843080 236206740) 140736420) (test (modulo 775403093708557121609032 41) 0) (test (modulo 12587009808135760402860 2491) 1410) (test (modulo 510685807527370566909720 76) 44) (test (modulo 9842598153710524682146590 10089) 3363) (test (modulo 44936631038618189620242012 30740) 24592) (test (modulo 934589372977008750144 373650) 202194) (test (modulo 33027125273398900134069150 840577803) 0) (test (modulo 4428219127938822420288 1695783782) 1071746452) (test (modulo 29316428815807608915440 560764380) 415244720) (test (modulo 1364397376360544429904 19) 0) (test (modulo 4991450791697293128313385277 329) 133) (test (modulo 75448279792981695149550 3009) 2385) (test (modulo 181031604499464166188731133 3364) 1641) (test (modulo 405831142402606479845286 2746214) 1938504) (test (modulo 89170366469003867207160 25337230) 23157930) (test (modulo 13523725766340619200 1490114045) 621483730) (test (modulo 104705939487154940255412 192200052) 48253032) (test (modulo 7232591421499800642000 16584679460) 4668328860) (test (modulo 14043796716396386984750160 33382708236) 717907704) (test (modulo 13894638105872256412416 23) 0) (test (modulo 147611447155643499428400 118) 68) (test (modulo 13356594697070649024 4558) 1802) (test (modulo 15089731174706036171537760 90) 60) (test (modulo 307230141273924828960 1971507) 1430805) (test (modulo 2582563944548247741930009096 22873474) 3518996) (test (modulo 1074296602920111687342072 146235518) 73672588) (test (modulo 774058642832724262993980 407557010) 187324340) (test (modulo 291091930213008490369569480 13412544348) 10762778160) (test (modulo 2089068565149831833568 7302038455228) 470177842332) (test (modulo 1064437567441124038217970656 5) 1) (test (modulo 142557826750459447787460 1333) 527) (test (modulo 311779340580033594160200 23693) 0) (test (modulo 29314187023691666530559664 110143) 0) (test (modulo 222003853016244177637944900 857463) 0) (test (modulo 6247776111945111006243552 77976501) 12576855) (test (modulo 1140058514761397155259712 5530338) 502758) (test (modulo 580962736822969724865449808 55686036) 13545252) (test (modulo 4100502596989506786787500 45333475410) 13925822190) (test (modulo 1497378750311599979536944 262630276090) 236984817664) (test (modulo 105637634198318524045536 2633013240) 452166936) (test (modulo 11415822547029425161364106595632 7) 3) (test (modulo 198305933339312916107438448 177) 15) (test (modulo 3127415425979879537134790928 3335) 2668) (test (modulo 589703503861221139260034914750 13209) 4641) (test (modulo 3108579252052448504121792 14322) 12936) (test (modulo 636976201153021006473464400 66264077) 55801328) (test (modulo 9544425315508129998909285900 1488396) 850512) (test (modulo 458100280193857502802977376 260747103934) 17656078468) (test (modulo 114208186302155358124900650 22076867505) 6602131305) (test (modulo 90107067439719108194114160 28566806069714) 24735629596458) (test (modulo 2976572787365723002218245484 110104803958578) 49695655366500) (test (modulo 53453375725613238735360 17) 7) (test (modulo 888822833524306124874229800 106) 0) (test (modulo 21275338550698297089687698855820 3021) 0) (test (modulo 417525245705449941528380320750068 5828) 0) (test (modulo 1954871230146370370001829871352 22765249) 0) (test (modulo 903057827710908645847577520 648545995) 631903275) (test (modulo 6002846634833433581621040 28493572159) 8965596645) (test (modulo 26428903214964558277189300080 100428856) 20778384) (test (modulo 470486531607553676511206181180 28495896) 23264436) (test (modulo 483599554429365539310928369206620 5577334078910) 3472679709510) (test (modulo 134511400157705323668887400 1285071093558916) 114037248705380) (test (modulo 25897125642468049125349982599216 1183846707540) 999692775256) (test (modulo 1118034209930460291955200 3) 0) (test (modulo 16297594064835666104344589410644 413) 0) (test (modulo 536762539932642345554192060100 1378) 0) (test (modulo 933250179448203335817687635834340 58029) 55821) (test (modulo 65573457048202714607131200 486115) 32895) (test (modulo 85664559165674439863772868932 322014) 0) (test (modulo 7232817686074320060728552759760 11307940) 0) (test (modulo 78400098291720425971762131120 5646921093) 0) (test (modulo 345445746644065669842240 19727989065) 1869036660) (test (modulo 627854758484491743169777558200 750371721805653) 32673867918264) (test (modulo 788233263079483492974876830792850 7170146100) 1202847750) (test (modulo 18378856389802641496737518160 6247594493140) 1385698158460) (test (modulo 9620902642431357480148667659080 59) 0) (test (modulo 16008524600631853118144316000 629) 620) (test (modulo 4342138447708715023205684275423920 53041) 5133) (test (modulo 2431833161592653384508687244500 47541) 0) (test (modulo 39424620224103957589082132160 1671734) 0) (test (modulo 652830233576052788654372406432 552231327) 231166602) (test (modulo 6892963340916411083970414000 3662431431) 935088876) (test (modulo 29102758215190063506219566460000 10565720) 0) (test (modulo 21253900104556838003127171970777418412 1182797770) 1026303562) (test (modulo 3964268932242030284914943132662620 21244177854110) 13576270590290) (test (modulo 6070388091189460078138338240 40809131994181213) 6560348180153677) (test (modulo 9685989954133695108793384134000 964113514382876) 108668324726468) (test (modulo 56468122001858834917195045500 429400787158167902) 411466139739284938) (test (modulo 18843408973202596901221568364900 47) 0) (test (modulo 7800980538292163259967028613764250 6) 0) (test (modulo 270433907726619219545089642715200 3422) 3132) (test (modulo 45771666919597903071546708768 2342359) 1698374) (test (modulo 47198294949461301503537593835384892 314502) 130548) (test (modulo 3165335901519110207943908102359110 14953473) 10646010) (test (modulo 189219585097956261544520863361400 35605794) 0) (test (modulo 38532137569034426600955256933810890813 1341358608707) 100754920326) (test (modulo 1396277868664090735481380981225896 312520860) 187512516) (test (modulo 864038349500762576564773759109700 714136202724) 614489290716) (test (modulo 12514185871591242579049167322464 10706997440178) 749897068284) (test (modulo 1981802660405609330969478067056636 33312289752) 27681419124) (test (modulo 979313401024175219420658240 125278417383795) 92954907481995) (test (modulo 4074026154111369481048033354344 29) 0) (test (modulo 599666571180604695702511920885005100 129) 0) (test (modulo 5703263639326551702474610108800 1978) 0) (test (modulo 134137932950214683609064669163440 190619) 115401) (test (modulo 344735091370772631136645455600 1048985) 0) (test (modulo 6759508339299085316106145385400 4969610) 1763410) (test (modulo 700334422308861928135313594400 228529587) 194401350) (test (modulo 10277417891211405957191810814198480 2516552038) 1372664748) (test (modulo 490099971577877358878082782880 9282588354) 7843699422) (test (modulo 1954558750269048828645390249600 5575829490) 2295929790) (test (modulo 1360588454560018295496656378989200 7868178296420) 3049105010900) (test (modulo 4337552841738910859248770564912480 17722936528737830) 1203686858124400) (test (modulo 215913068853045803981566931862756 7009479781500) 1803638466756) (test (modulo 44890707654126305940250882318870941900 18329973480720) 7637488950300) (test (modulo 28579720891831355496720656680837200 3) 0) (test (modulo 29332703209780553199747293473184160 1711) 551) (test (modulo 3648979393315349438003046604440000 186) 0) (test (modulo 1159760236369472473822068077011807878780 25714) 0) (test (modulo 158186359726371025615685433600 31395) 17940) (test (modulo 331091450443070201468559735703944 28424) 0) (test (modulo 9734443639363161342241553023288200 1961348207) 1708271019) (test (modulo 701896612128009033011419603540080 51300) 47880) (test (modulo 86169288128517384618860929451245320 5032162527446) 925322642976) (test (modulo 64828800524794653881296183831741773624 4645294472) 311380888) (test (modulo 49068907706533938991402184550000 268183371225) 262983139650) (test (modulo 1708602980304476478496020543612288 4083128544) 131713824) (test (modulo 17608179287674151740172985536160 980399424528) 962337263616) (test (modulo 43194437079731225735521919644800 178119261126453036) 70796157206439912) (test (modulo 817555977437791699707628651571149344 59) 0) (test (modulo 19062946261334997559157066059536 533) 287) (test (modulo 6533849124840489114353090499099000 598) 130) (test (modulo 427663965127849896842400211428345149025 234) 117) (test (modulo 352395507261316174741530450071590608 154734) 26418) (test (modulo 391579493632653867660919800000 9221565) 1166160) (test (modulo 2618798923882923048581401148931738000 681876) 419616) (test (modulo 174712575449141140214591110997980800 233260339838) 37341839152) (test (modulo 88598141227372995032227898284800 1929763976) 1797148024) (test (modulo 210110141308655567793064872567302676320 720390430628) 523536832148) (test (modulo 668425085137718599277317523827419000 19898594339442) 17330916357006) (test (modulo 89533471731097208414073727453200 4173840860670546) 1611748174428756) (test (modulo 113987439157802480362236410675251462620 21548296273949445) 20414175417425790) (test (modulo 48129335993995093308894209644253760 1009442888504820) 947047755795120) (test (modulo 3497836376962291922989777163497680 138736290091634664) 23686683674181528) (test (modulo 11371924962562208722154622794880 3) 0) (test (modulo 9451631862008339290824315653784000 703) 171) (test (modulo 16869347753325980368094612370435598560 806) 0) (test (modulo 4701845646467068759127854100132739552 3198) 504) (test (modulo 1029865193584911347147121232800485280 1005771) 24531) (test (modulo 10657125216930337802109861408000 2415138) 2210802) (test (modulo 14382707743772734802155022983680 247913634) 7969170) (test (modulo 60134748581470366378101904574533857248 54828228) 9878960) (test (modulo 214830664120540781167218700750596000 505665810) 223433730) (test (modulo 48933004118344447687599112101802800 6263883444) 849340128) (test (modulo 5498670161558110606435630054129739400 262699548132) 255270333864) (test (modulo 35941673649029587182509620977230062500 25622409466332) 7911836749404) (test (modulo 1592802602494326390643157055239113248 736377633395508) 260180363298804) (test (modulo 4043816553144402557587143272522043028314 5011466158645380) 1781651263267134) (test (modulo 7171921165220830707276631005512550 1765284492289500) 1588756043060550) (test (modulo 2402189359210218692854826119405968750 23) 22) (test (modulo 26149068753160488131648964110990162400 1147) 868) (test (modulo 556184059176863945810376239306506311552 4089) 0) (test (modulo 67871323087036310486238021899264593800 13395) 0) (test (modulo 12750401179065252879838440979200 7177173) 0) (test (modulo 278110245000092733617125071646080 17748) 0) (test (modulo 13408203364935178481017292708752000 50619404) 13680920) (test (modulo 124271828931784534297423756437875067000 8839796595) 1143112215) (test (modulo 11893442806922081156953529319100769836176 972789007267) 210492262442) (test (modulo 352581052555284857902053030133344488264100 923561430099) 488944286523) (test (modulo 6108908012714804315575319947340956346976 31944833628092) 28158060036920) (test (modulo 67475643422116264959949054821520228800 22515435540) 8157766500) (test (modulo 470601888939348535946408832 5135943991060962937) 4475576385383445628) (test (modulo 110759232155568113345545635903016614000 30159198663300) 0) (test (modulo 146100914712024458707469587112300146320 26868173101560) 24880219882560) (test (modulo 12173192708601511002951184416658091200 466645866900785428350) 288583529752854077950) (test (modulo 5784684831478746253226687170890240 13) 0) (test (modulo 35042260655085685815432622412891903767500 667) 0) (test (modulo 2903871349270676921837488659419545120987500 530) 0) (test (modulo 630123969240840167098426767919876491188000 77691) 51794) (test (modulo 33192703032132982013024959634241667249800 4684718) 4051648) (test (modulo 4731525733734729472809717145544850000 90706055) 0) (test (modulo 214011009809686092216200126896120006823232 50400042) 45006552) (test (modulo 5854250735296111435541950856160000 24357777002) 2121729090) (test (modulo 35348208247612761916374738259136697649608 156806713508) 8948839908) (test (modulo 612558317420289618714916924536521515286100 2377007388) 375316956) (test (modulo 181857299802925368992522029882739454720 21606337755618) 0) (test (modulo 4731635341196946327443020710970699860000 58092526675092) 44387995860156) (test (modulo 22081740554432638182773611616166588288192 61419768950540) 49135815160432) (test (modulo 125627844706077784535328068665849312000 30482033400) 19356933400) (test (modulo 1225504716872819103560254268197955520 510813364186125) 233201076344145) (test (modulo 5209185280578468690281136425214396728400 2327880739319250103818) 518788605323339989776) (test (modulo 230425011604643097634961294406535254400 31) 0) (test (modulo 13222608481676137093434201748083744000 893) 0) (test (modulo 13348198818240350339028224064019716678960 651) 117) (test (modulo 7236172685650198160266777676385295337308176 23426) 14144) (test (modulo 756264162229440667711265021676693350760 28899) 0) (test (modulo 40915062421030872924283823601517905600 36345062) 0) (test (modulo 1174590526522170015825602834292923520 4991486258) 1554170940) (test (modulo 2891892862328155581145450075391651333218020 35138529818) 0) (test (modulo 1993335355070485984559797658834121810059400 535644500) 433741400) (test (modulo 6324295450641455215591954662726515160 367472693133) 134441229195) (test (modulo 6576388154814679090356195121505112000 15901952377630) 3827367890390) (test (modulo 117828556355409428513249595788296238400 565992666495795) 106570976318730) (test (modulo 592831716700236607285748949860604000 139641978135660) 133123065151440) (test (modulo 106766839071170184723986891291602032000 1584924526628112) 785519540106048) (test (modulo 21677148858122146832326483307664860804937400 247815827510760) 183567279637600) (test (modulo 14079549844487257384278196623697173813600 160967604100961853832) 160644118308938243512) (test (modulo 2696480372014145687016224877963234647656980 2219319031453896088860) 1749775073012430835800) (test (modulo 13545431257849875145060979241270859310160 29) 0) (test (modulo 137485634482479300158725199474868559498162500 329) 188) (test (modulo 529252417743761759027305009539254400 3243) 0) (test (modulo 133897419738958073238580385894509887148800 330455) 0) (test (modulo 3896215507210178905244623173635584334007288624 1005238) 0) (test (modulo 17654511984514518592175290794029073043800 1060530) 511980) (test (modulo 16470780256339082688310222474503880382858400 913836) 0) (test (modulo 57267105834722825210001789897760395576000 2958974018) 2329405078) (test (modulo 521977833444747522001426544601807810543216 1066521690) 625031316) (test (modulo 1699559962174727325529414216960251941390400 25883611479) 16915574049) (test (modulo 10654036597801063717295948399628964800 317449894126222) 116812646389120) (test (modulo 381902381115592200811990304316262139150724960 4640335440216) 0) (test (modulo 425968526187959807410151867411382902838703889232 1882826315615025) 1191718303295157) (test (modulo 174609167728518272531601927200939868792000 1712923655178450) 541648883945400) (test (modulo 3325168366561555458817274989681612518000 1699726139891780) 1568977975284720) (test (modulo 11429650426242566426919762928176000 7414967839104) 1771142792832) (test (modulo 2104794191230056678355480848036599377844400 16946684823025584) 9111120872594400) (test (modulo 11894522530167763519415142641640874994880 7) 0) (test (modulo 5906329981690378696996009087718418780000 185) 0) (test (modulo 3056294774178096513474941936265025440000 658) 0) (test (modulo 10491907660880423349353457742257185280 123369) 0) (test (modulo 673239479595593149777212259021965839229225628776 15470) 12376) (test (modulo 1506608574369860432616005754109397877696 1474070) 1179256) (test (modulo 4849814041048623250005708880379694793905000 2172220582) 0) (test (modulo 21154344928580705924176101470087564940000 5023204186) 0) (test (modulo 346448039376394135288065831861806112294000 776147372) 25037012) (test (modulo 2339009760844587560470606952218133142645504 194201967414) 78730527330) (test (modulo 2242982161480922111384667548175169152 21419749763490) 17054708275722) (test (modulo 4717315265246821759830981157482117120 45609714193992) 45557259088536) (test (modulo 16628111321698075419789804224660024289936 4643626415880804) 3203755070835528) (test (modulo 115557531507210992033160068979962880 88406536976058378) 13997397131802546) (test (modulo 21059511907771200155093927745003762840000 180298981648603620) 88715511648941760) (test (modulo 2124921015128697258800067298086064536000 2282525112298516782924) 1050493715522523120240) (test (modulo 16015671538624533047089928322348864000 49817926936366875) 31511531988217125) (test (modulo 166517667014186289390514558017250969134523800 43413708621878528404068) 4443969735426840626952) (test (modulo 2780796292789128359666429021610464935722000 47) 0) (test (modulo 21297913114430245153455383503409684916193317960 58) 0) (test (modulo 1516745257039775143654568869485529015398000 6293) 0) (test (modulo 8447692776411453120390905608381515479808 2030) 518) (test (modulo 958876033949638283967045624731391031146081240 9834415) 9667730) (test (modulo 4731349833403602529573388098680617532624192 14868) 0) (test (modulo 6375001358038970462026761077388061675464000 430513678) 0) (test (modulo 254088526608579040642428151389718385042344800 4799428101) 294233472) (test (modulo 21140490542258031885408065086507444825621023648 164778747198) 63851269926) (test (modulo 34214837305812460226811046733375808000 4312787868) 2681970660) (test (modulo 11450197571956515037245443769386989035470896800 75585518430279) 69771247781796) (test (modulo 1211397915863796187148880114197307052796506376580 538601201880) 128795939580) (test (modulo 5454139401260819402160859765169199667337088 30452838731872) 22996976784800) (test (modulo 744935981632690384026127091216926530879171660 1032747922358460) 630836297950320) (test (modulo 324574326062026951443376280715122947502400 103751223626207988025) 7552030128655111125) (test (modulo 15272163751269260921486082393684080908800 6484309049057400) 4436632507249800) (test (modulo 386527546655781220813671331401971490218262720 3481571963427119100) 243571263764902920) (test (modulo 3189682029126430413458911948222943640000 6724598925622907976570) 2607219061590696572250) (test (modulo 709403542855323660533377490060722241678400 7) 0) (test (modulo 139803787314578422635552652090095842837312147438904 123) 0) (test (modulo 171985399350431759069945935900956183322827030835560 18241) 0) (test (modulo 33090522521924986387051477884789600000 26187) 25578) (test (modulo 1733723010009930088165729903139785699319986530 372945) 23805) (test (modulo 56408303994570817306318494803635460247582000 5761730) 3307860) (test (modulo 25845509336769185412951159262424903513866295760 64371378271) 0) (test (modulo 624970361450506104794172455132584603069611058500 108222780) 0) (test (modulo 82823962548382643645255524843049561752323600 135325929794) 123023572540) (test (modulo 170620453449723034746079844571491973300000 9460614789626) 4845680745906) (test (modulo 125144597811313015929871740675462711600000 12764411911636) 5714078712188) (test (modulo 257193319319332344553297882967977761077115600 6510126541380) 1111485019260) (test (modulo 879624546681838385457288074812140664728758550 10045784120501316) 5303606126868522) (test (modulo 18300938860777100857669855248554588369659200 118088077425391892) 94617840861501464) (test (modulo 8394780474625841647581984803260010511075000 746584618179400) 91432008031000) (test (modulo 146802334713757872619395774222116859916800 718775571956687400) 62390745247132200) (test (modulo 240155883351717999820072393833707008014911556000 1350921510529331832) 1096988895768179232) (test (modulo 918942437243241528855354123800826649596480 74343962238703160850) 1608809218075839780) (test (modulo 1361069299753299783990135442290762165844800 8281085446358585640) 7375208194228544280) (test (modulo 1/9223372036854775807 -1/3) -9223372036854775804/27670116110564327421) (test (modulo -1/9223372036854775807 1/3) 9223372036854775804/27670116110564327421) (test (modulo 9223372036854775807 1/3) 0) (test (modulo (/ (expt 3 10)) (/ (expt 2 61))) 1991/136157723851059414171648) (test (modulo (/ (expt 3 20)) (/ (expt 2 61))) 487228559/2009994358920301836855410688) (test (modulo -2/9223372036854775807 2/3) 18446744073709551608/27670116110564327421) (test (modulo 2/9223372036854775807 -2/3) -18446744073709551608/27670116110564327421) (test (modulo 57473596068/6659027209 318281039/225058681) 218279130532125402/1498671880400651329) (test (modulo 25808688679/9809721694 1855077841/1311738121) 15656443452349049505/12867785902420496974) (test (modulo 17026679261/10439860591 4478554083/3166815962) 7164879387815321029/33061117160633553542) (test (modulo 480544481373/103768467013 10812186007/7645370045) 308048482161795610512/793348329316760825585) (test (modulo 137528045312/217976794617 63018038201/44560482149) 137528045312/217976794617) (test (modulo 1591258440050/975675645481 152139002499/107578520350) 22746909008980882960481/104961742282377144038350) (test (modulo 6721373040371/1193652440098 367296043199/259717522849) 430386901580727488556473/310012454884916918799202) (test (modulo 56850567176297/8573543875303 886731088897/627013566048) 1309091318011705591580273/1343932079730680866628136) (test (modulo 176638380405175/18340740190704 5168247530883/3654502875938) 38394278980353599950554679/33513143886879715286440176) (test (modulo 551230231989018/83130157078217 12477253282759/8822750406821) 714422652331325234782048966/733436627180932669467318157) (test (modulo 1360510821127147/517121682660006 30122754096401/21300003689580) 2233626037506212134611298309/1835782291436657618117489580) (test (modulo 5849200401628882/766512153894657 175568277047523/124145519261542) 53275930148683942294955132989/95159049365535186345899381094) (test (modulo 15914407453568626/6048967074079039 423859315570607/299713796309065) 2205856429990054302964180188017/1812958885520765991472282188535) (test (modulo 25997605614346611/9881527843552324 1023286908188737/723573111879672) 127934269420347558776141264953/105147174292423231311078293496) (test (modulo 1528546195606366451/177100989030047175 5964153172084899/4217293152016490) 10878285025401489444908608411504/74688678825176546867355107791575) (test (modulo 1991152086194052263/206745572560704147 14398739476117879/10181446324101389) 2411554265852820467970218680028029/2104968949772418231181062860760183) (test (modulo 1657796840421716313/630118245525664765 34761632124320657/24580185800219268) 18845015710796719738302110345968279/15488423551129023359673258461692020) (test (modulo 30769194397037159797/5464318637170278738 202605639573839043/143263821649299118) 271701765358086704077048080811413961/195709792667626007806640474599388271) (test (modulo 63477669249275110720/7354673373747273033 489133282872437279/345869461223138161) 370494072414302426447989361648602678/2543756917250129165517177396348512313) (test (modulo 275806591309589148297/36143248623210700400 1180872205318713601/835002744095575440) 9600268203288030825290513354903593/17147563511880433985428780967862600) (num-test (modulo 1e19 10) 0.0) (num-test (modulo .1e20 10) 0.0) (num-test (modulo 1e20 10) 0.0) (num-test (modulo 1e21 10) 0.0) (num-test (modulo 1e19 -1) 0.0) (num-test (modulo 1e19 1) 0.0) (num-test (modulo .1e20 1) 0.0) (num-test (modulo 1e20 1) 0.0) (test (modulo 10000000000000000000 1) 0) (test (modulo 100000000000000000000 1) 0) (test (modulo 10000000000000000000 10) 0) (test (modulo 100000000000000000000 10) 0) (test (modulo 1361069299753299783990135442290762165844800+i 8281085446358585640) 'error)) (test (modulo 123 123 123) 'error) (test (modulo 123) 'error) (test (modulo) 'error) (test (mod 2 0) 'error) (test (modulo 2.3 1.0+0.1i) 'error) (test (modulo 3.0+2.3i 3) 'error) ;(test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (modulo (cosh 128) 1.0)))) (define (hi) (func)) (hi)) 'error) (test (do ((i 0 (+ i __x__))) ((= i __x__)) (modulo (cosh 128) #x123.123)) 'error) (test (modulo 21010111 10) 1) ; from CL bboard (test (modulo 21010111 10.0) 1.0) (test (modulo 8101011121111 10) 1) (test (modulo 8101011121111 10.0) 1.0) (test (modulo 21010111211111 10) 1) (test (modulo 21010111211111 10.0) (if with-bignums 1.0 'error)) (for-each (lambda (arg) (test (modulo arg +nan.0) 'error) (test (modulo +nan.0 arg) 'error) (test (modulo arg +inf.0) 'error) (test (modulo +inf.0 arg) 'error) (test (modulo arg 2) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (arg) (test (modulo 2 arg) 'error) (test (modulo 1/2 arg) 'error) (test (modulo 2.0 arg) 'error) (test (modulo 2+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;; check an optimizer bug (test (let () (define (f x) (modulo x 12)) (f 3/4)) 3/4) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (modulo -inf.0 1234)))) (define (hi) (func)) (hi)) #t) ;;; -------------------------------------------------------------------------------- ;;; quotient ;;; -------------------------------------------------------------------------------- (test (quotient -0.5 -1) 0) (test (quotient -1 -1) 1) (test (quotient -1 -10) 0) (test (quotient -1 -1234) 0) (test (quotient -1 -2) 0) (test (quotient -1 -3) 0) (test (quotient -1 -500029) 0) (test (quotient -1 1) -1) (test (quotient -1 10) 0) (test (quotient -1 1234) 0) (test (quotient -1 2) 0) (test (quotient -1 3) 0) (test (quotient -1 500029) 0) (test (quotient -1.5 -2) 0) (test (quotient -1.5 2) 0) (test (quotient -1/2 -1) 0) (test (quotient -1/2 -1.0) 0) (test (quotient -1234 -1) 1234) (test (quotient -1234 -10) 123) (test (quotient -1234 -1234) 1) (test (quotient -1234 -2) 617) (test (quotient -1234 -3) 411) (test (quotient -1234 -500029) 0) (test (quotient -1234 1) -1234) (test (quotient -1234 10) -123) (test (quotient -1234 1234) -1) (test (quotient -1234 2) -617) (test (quotient -1234 3) -411) (test (quotient -1234 500029) 0) (test (quotient -2 -1) 2) (test (quotient -2 -10) 0) (test (quotient -2 -1234) 0) (test (quotient -2 -2) 1) (test (quotient -2 -3) 0) (test (quotient -2 -500029) 0) (test (quotient -2 1) -2) (test (quotient -2 10) 0) (test (quotient -2 1234) 0) (test (quotient -2 2) -1) (test (quotient -2 3) 0) (test (quotient -2 500029) 0) (test (quotient -35 -7) 5) (test (quotient -35 7) -5) (test (quotient -500029 -1) 500029) (test (quotient -500029 -10) 50002) (test (quotient -500029 -1234) 405) (test (quotient -500029 -2) 250014) (test (quotient -500029 -3) 166676) (test (quotient -500029 -500029) 1) (test (quotient -500029 1) -500029) (test (quotient -500029 10) -50002) (test (quotient -500029 1234) -405) (test (quotient -500029 2) -250014) (test (quotient -500029 3) -166676) (test (quotient -500029 500029) -1) (test (quotient 0 -1) 0) (test (quotient 0 -10) 0) (test (quotient 0 -1234) 0) (test (quotient 0 -2) 0) (test (quotient 0 -3) 0) (test (quotient 0 -500029) 0) (test (quotient 0 1) 0) (test (quotient 0 10) 0) (test (quotient 0 1234) 0) (test (quotient 0 2) 0) (test (quotient 0 3) 0) (test (quotient 0 500029) 0) (test (quotient 0.5 -2) 0) (test (quotient 0.5 -2.0) 0) (test (quotient 0.5 2.0) 0) (test (quotient 1 -1) -1) (test (quotient 1 -10) 0) (test (quotient 1 -1234) 0) (test (quotient 1 -2) 0) (test (quotient 1 -3) 0) (test (quotient 1 -4) 0) (test (quotient 1 -500029) 0) (test (quotient 1 1) 1) (test (quotient 1 10) 0) (test (quotient 1 1234) 0) (test (quotient 1 2) 0) (test (quotient 1 3) 0) (test (quotient 1 500029) 0) (test (quotient 1.5 1/3) 4) (test (quotient 1.5 1/4) 6) (test (quotient 1/2 -2) 0) (test (quotient 1/2 2) 0) (test (quotient 1/9223372036854775807 1/3) 0) (test (quotient 11/9223372036854775807 3/9223372036854775807) 3) (test (quotient 1234 -1) -1234) (test (quotient 1234 -10) -123) (test (quotient 1234 -1234) -1) (test (quotient 1234 -2) -617) (test (quotient 1234 -3) -411) (test (quotient 1234 -500029) 0) (test (quotient 1234 1) 1234) (test (quotient 1234 10) 123) (test (quotient 1234 1234) 1) (test (quotient 1234 2) 617) (test (quotient 1234 3) 411) (test (quotient 1234 500029) 0) (test (quotient 19439282 4409.5) 4408) (test (quotient 2 -1) -2) (test (quotient 2 -10) 0) (test (quotient 2 -1234) 0) (test (quotient 2 -2) -1) (test (quotient 2 -3) 0) (test (quotient 2 -500029) 0) (test (quotient 2 1) 2) (test (quotient 2 10) 0) (test (quotient 2 1234) 0) (test (quotient 2 2) 1) (test (quotient 2 3) 0) (test (quotient 2 500029) 0) (test (quotient 3/9223372036854775807 -2/9223372036854775807) -1) (test (quotient 3/9223372036854775807 1/9223372036854775807) 3) (test (quotient 35 -7) -5) (test (quotient 35 7) 5 ) (test (quotient 500029 -1) -500029) (test (quotient 500029 -10) -50002) (test (quotient 500029 -1234) -405) (test (quotient 500029 -2) -250014) (test (quotient 500029 -3) -166676) (test (quotient 500029 -500029) -1) (test (quotient 500029 1) 500029) (test (quotient 500029 10) 50002) (test (quotient 500029 1234) 405) (test (quotient 500029 2) 250014) (test (quotient 500029 3) 166676) (test (quotient 500029 500029) 1) (test (quotient 512/1350851717672992089 512/4052555153018976267) 3) (test (quotient 9223372036854775 1/3) 27670116110564325) (test (quotient 9223372036854775807/2 9223372036854775807/8) 4) (test (quotient 9223372036854775807/8 9223372036854775807/2) 0) (test (quotient -9223372036854775808 -9223372036854775808) 1) (test (quotient 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 0) (test (quotient 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 0) (test (quotient 9223372036854775807 -9223372036854775808) 0) (test (quotient 9223372036854775807 9223372036854775807) 1) (if (not with-bignums) (test (quotient most-negative-fixnum -1) 'error) (test (quotient most-negative-fixnum -1) 9223372036854775808)) (test (quotient 3 1.5) 2) (test (quotient 3 1.75) 1) (test (quotient pi 1) 3) (test (quotient pi 1.5) 2) (test (quotient pi 1.6) 1) (test (quotient pi 3.0) 1) (test (quotient pi 4.0) 0) (test (quotient 0.0 1) 0) (test (quotient 0.0 2) 0) (test (quotient 0.0 3) 0) (test (quotient 0.0 4) 0) (test (quotient 0.0 pi) 0) (test (quotient 0.0 2.5) 0) (test (quotient 0.0 4.0) 0) (test (quotient 0.0 1000.1) 0) (test (quotient pi 2) 1) (test (quotient pi 3) 1) (test (quotient pi pi) 1) (test (quotient pi 2.5) 1) (test (quotient pi 4.0) 0) (test (quotient pi 1000.1) 0) (test (quotient 1.5 1) 1) (test (quotient 1.5 2) 0) (test (quotient 1.5 3) 0) (test (quotient 1.5 4) 0) (test (quotient 1.5 pi) 0) (test (quotient 1.5 2.5) 0) (test (quotient 1.5 4.0) 0) (test (quotient 1.5 1000.1) 0) (test (quotient -1.5 1) -1) (test (quotient -1.5 2) 0) (test (quotient -1.5 3) 0) (test (quotient -1.5 4) 0) (test (quotient -1.5 pi) 0) (test (quotient -1.5 2.5) 0) (test (quotient -1.5 4.0) 0) (test (quotient -1.5 1000.1) 0) (test (quotient 3.0 1) 3) (test (quotient 3.0 2) 1) (test (quotient 3.0 3) 1) (test (quotient 3.0 4) 0) (test (quotient 3.0 pi) 0) (test (quotient 3.0 2.5) 1) (test (quotient 3.0 4.0) 0) (test (quotient 3.0 1000.1) 0) (test (quotient 110.123 1) 110) (test (quotient 110.123 2) 55) (test (quotient 110.123 3) 36) (test (quotient 110.123 4) 27) (test (quotient 110.123 pi) 35) (test (quotient 110.123 2.5) 44) (test (quotient 110.123 4.0) 27) (test (quotient 110.123 1000.1) 0) (test (quotient 100 1.0) 100) (test (quotient 100 1.5) 66) (test (quotient pi 1.5) 2) (if with-bignums (test (quotient 1e+18 8) 125000000000000000)) (test (quotient 1/9223372036854775807 -1/9223372036854775807) -1) (test (quotient -4611686018427387904 1/2) -9223372036854775808) (test (= (quotient (* 99/70 99/70) 2) (quotient (* 577/408 577/408) 2)) #t) (test (= (quotient 2.0 (* 99/70 99/70)) (quotient (* 577/408 577/408) 2.0)) #f) (test (= (quotient 99/70 577/408) (floor (/ 99/70 577/408))) #t) (test (= (quotient (* 577/408 577/408) 2) (quotient (* 1393/985 1393/985) 2)) #f) (test (= (quotient 2.0 (* 577/408 577/408)) (quotient (* 1393/985 1393/985) 2.0)) #t) (test (= (quotient 577/408 1393/985) (floor (/ 577/408 1393/985))) #t) (test (= (quotient (* 3363/2378 3363/2378) 2) (quotient (* 19601/13860 19601/13860) 2)) #t) (test (= (quotient 2.0 (* 3363/2378 3363/2378)) (quotient (* 19601/13860 19601/13860) 2.0)) #f) (test (= (quotient 3363/2378 19601/13860) (floor (/ 3363/2378 19601/13860))) #t) (test (= (quotient (* 47321/33461 47321/33461) 2) (quotient (* 114243/80782 114243/80782) 2)) #f) (test (= (quotient 2.0 (* 47321/33461 47321/33461)) (quotient (* 114243/80782 114243/80782) 2.0)) #t) (test (= (quotient 47321/33461 114243/80782) (floor (/ 47321/33461 114243/80782))) #t) (test (= (quotient (* 275807/195025 275807/195025) 2) (quotient (* 1607521/1136689 1607521/1136689) 2)) #t) (test (= (quotient 2.0 (* 275807/195025 275807/195025)) (quotient (* 1607521/1136689 1607521/1136689) 2.0)) #f) (test (= (quotient 275807/195025 1607521/1136689) (floor (/ 275807/195025 1607521/1136689))) #t) (test (= (quotient (* 3880899/2744210 3880899/2744210) 2) (quotient (* 9369319/6625109 9369319/6625109) 2)) #f) (test (= (quotient 2.0 (* 3880899/2744210 3880899/2744210)) (quotient (* 9369319/6625109 9369319/6625109) 2.0)) #t) (test (= (quotient 3880899/2744210 9369319/6625109) (floor (/ 3880899/2744210 9369319/6625109))) #t) (test (= (quotient (* 54608393/38613965 54608393/38613965) 2) (quotient (* 131836323/93222358 131836323/93222358) 2)) #f) (test (= (quotient 2.0 (* 54608393/38613965 54608393/38613965)) (quotient (* 131836323/93222358 131836323/93222358) 2.0)) #t) (test (= (quotient 54608393/38613965 131836323/93222358) (floor (/ 54608393/38613965 131836323/93222358))) #t) (test (= (quotient (* 131836323/93222358 131836323/93222358) 2) (quotient (* 318281039/225058681 318281039/225058681) 2)) #f) ;(if with-bignums (test (= (quotient 2.0 (* 131836323/93222358 131836323/93222358)) ; this should be 1 I think ; (quotient (* 318281039/225058681 318281039/225058681) 2.0)) #f)) (test (= (quotient 131836323/93222358 318281039/225058681) (floor (/ 131836323/93222358 318281039/225058681))) #t) (when with-bignums (test (= (quotient (* 318281039/225058681 318281039/225058681) 2) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2)) #t) ;; (exact->inexact (* 1855077841/1311738121 1855077841/1311738121)) ;; 1.999999999999999999418826611445214136431E0 ;; (exact->inexact (* 318281039/225058681 318281039/225058681)) ;; 1.999999999999999980257212936354560469555E0 (test (= (quotient 2.0 (* 318281039/225058681 318281039/225058681)) (quotient (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #f) ; see above (test (= (quotient 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #t) (test (= (quotient (* 1855077841/1311738121 1855077841/1311738121) 2) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2)) #f)) (if (provided? 'overflow-checks) (test (= (quotient 2.0 (* 1855077841/1311738121 1855077841/1311738121)) (quotient (* 4478554083/3166815962 4478554083/3166815962) 2.0)) #t)) (test (= (quotient 1855077842/1311738121 4478554083/3166815962) (floor (/ 1855077842/1311738121 4478554083/3166815962))) #t) (test (nan? (let () (define (func) (* (quotient (expt 2 32) +inf.0) 12)) (define (hi) (func)) (hi))) #t) ; g_mul_2_ix signature->optimizer confusion ;;; there's one really dumb problem here: ;;; (quotient 1e-12 1E-16) -> 9999 ;;; (quotient 1.0000000000000e-12 1E-16) -> 9999 but ;;; (quotient 1.00000000000000e-12 1E-16) -> 10000 ;;; for 1e-14 however, there is no number of zeros that will work, but you can set precision to 1024 ;;; or you can spell it out: (quotient 0.0000000000001 0.00000000000000001) -> 10000 ;;; (quotient 1e+18 3/4) -> 1333333333333333248 ;;; which should be 333 at the end of course ;;; (quotient 1e+15 3/4) -> 1333333333333333 (test (quotient 1e16 1e14) 100) (when with-bignums (test (quotient 1.00000000000000e-12 1E-16) 10000) (test (quotient 2.0 (* 318281039/225058681 318281039/225058681)) 1) (test (quotient (* 1855077841/1311738121 1855077841/1311738121) 2.0) 0) (test (quotient -1.797693134862315699999999999999999999998E308 -9223372036854775808) 19490628022799995908501125008172039088075481712089442747863503837260448050616338003410135413043522984719682345909025832711116783129727902847513862872544943321023332545672815506523677443663683097294005030046422806743414556504424564204282517830151319186021046775247332737488676655598816722944) (test (quotient -9223372036854775808 5.551115123125783999999999999999999999984E-17) -166153499473114445265356059994784304) (test (quotient 295147905149568077200 34359738366) 8589934591) (test (quotient 696898287454081973170944403677937368733396 1180591620717411303422) 590295810358705651711) (test (quotient 1e19 10) 1000000000000000000) (test (quotient .1e20 10) 1000000000000000000) (test (quotient 1e20 10) 10000000000000000000) (test (quotient 1e21 10) 100000000000000000000) (test (quotient 1e19 -1) -10000000000000000000) (test (quotient 1e19 1) 10000000000000000000) (test (quotient .1e20 1) 10000000000000000000) (test (quotient 1e20 1) 100000000000000000000) (test (quotient 10000000000000000000 1) 10000000000000000000) (test (quotient 100000000000000000000 1) 100000000000000000000) (test (quotient 10000000000000000000 10) 1000000000000000000) (test (quotient 100000000000000000000 10) 10000000000000000000) (test (quotient 1 1/9223372036854775807) 9223372036854775807) (test (quotient 9223372036854775807 2/3) 13835058055282163710) (test (quotient 1361069299753299783990135442290762165844800+i 8281085446358585640) 'error) (test (quotient 1231231231231231232123 0.0) 'error) (test (quotient 1231231231231231232123 0) 'error) ;; the tests that multiply by 2.0 may be on the edge of the 128 bit default precision (test (= (quotient (* 4478554083/3166815962 4478554083/3166815962) 2) (quotient (* 10812186007/7645370045 10812186007/7645370045) 2)) #f) (test (= (quotient 2.0 (* 4478554083/3166815962 4478554083/3166815962)) (quotient (* 10812186007/7645370045 10812186007/7645370045) 2.0)) #t) (test (= (quotient 4478554083/3166815962 10812186007/7645370045) (floor (/ 4478554083/3166815962 10812186007/7645370045))) #t) (test (= (quotient (* 63018038201/44560482149 63018038201/44560482149) 2) (quotient (* 152139002499/107578520350 152139002499/107578520350) 2)) #f) (test (= (quotient 2.0 (* 63018038201/44560482149 63018038201/44560482149)) (quotient (* 152139002499/107578520350 152139002499/107578520350) 2.0)) #t) (test (= (quotient 63018038201/44560482149 152139002499/107578520350) (floor (/ 63018038201/44560482149 152139002499/107578520350))) #t) (test (= (quotient (* 367296043199/259717522849 367296043199/259717522849) 2) (quotient (* 886731088897/627013566048 886731088897/627013566048) 2)) #f) (test (= (quotient 2.0 (* 367296043199/259717522849 367296043199/259717522849)) (quotient (* 886731088897/627013566048 886731088897/627013566048) 2.0)) #t) (test (= (quotient 367296043199/259717522849 886731088897/627013566048) (floor (/ 367296043199/259717522849 886731088897/627013566048))) #t) (test (= (quotient (* 5168247530883/3654502875938 5168247530883/3654502875938) 2) (quotient (* 12477253282759/8822750406821 12477253282759/8822750406821) 2)) #f) (test (= (quotient 2.0 (* 5168247530883/3654502875938 5168247530883/3654502875938)) (quotient (* 12477253282759/8822750406821 12477253282759/8822750406821) 2.0)) #t) (test (= (quotient 5168247530883/3654502875938 12477253282759/8822750406821) (floor (/ 5168247530883/3654502875938 12477253282759/8822750406821))) #t) (test (= (quotient (* 30122754096401/21300003689580 30122754096401/21300003689580) 2) (quotient (* 175568277047523/124145519261542 175568277047523/124145519261542) 2)) #t) (test (= (quotient 2.0 (* 30122754096401/21300003689580 30122754096401/21300003689580)) (quotient (* 175568277047523/124145519261542 175568277047523/124145519261542) 2.0)) #f) (test (= (quotient 30122754096401/21300003689580 175568277047523/124145519261542) (floor (/ 30122754096401/21300003689580 175568277047523/124145519261542))) #t) (test (= (quotient (* 423859315570607/299713796309065 423859315570607/299713796309065) 2) (quotient (* 1023286908188737/723573111879672 1023286908188737/723573111879672) 2)) #f) (test (= (quotient 423859315570607/299713796309065 1023286908188737/723573111879672) (floor (/ 423859315570607/299713796309065 1023286908188737/723573111879672))) #t) (test (= (quotient (* 1023286908188737/723573111879672 1023286908188737/723573111879672) 2) (quotient (* 5964153172084899/4217293152016490 5964153172084899/4217293152016490) 2)) #t) (test (= (quotient (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905) 2) (quotient (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701) 2)) #t) (test (= (quotient 3289910387877251662993/2326317944764069484905 19175002942688032928599/13558774610046711780701) (floor (/ 3289910387877251662993/2326317944764069484905 19175002942688032928599/13558774610046711780701))) #t) (test (= (quotient (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300) 2) (quotient (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301) 2)) #f) (test (= (quotient 46292552162781456490001/32733777552734744709300 111760107268250945908601/79026329715516201199301) (floor (/ 46292552162781456490001/32733777552734744709300 111760107268250945908601/79026329715516201199301))) #t) (test (= (quotient (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902) 2) (quotient (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112) 2)) #t) (test (= (quotient 269812766699283348307203/190786436983767147107902 1572584048032918633353217/1111984844349868137938112) (floor (/ 269812766699283348307203/190786436983767147107902 1572584048032918633353217/1111984844349868137938112))) #t) (test (= (quotient (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112) 2) (quotient (* 3796553736732654909229441/2684568892382786771291329 3796553736732654909229441/2684568892382786771291329) 2)) #f) (test (= (quotient 1572584048032918633353217/1111984844349868137938112 3796553736732654909229441/2684568892382786771291329) (floor (/ 1572584048032918633353217/1111984844349868137938112 3796553736732654909229441/2684568892382786771291329))) #t)) (test (quotient 123 123 123) 'error) (test (quotient 123) 'error) (test (quotient 3 0) 'error) (test (quotient) 'error) (test (quotient 3 1+i) 'error) (test (quotient 3 0.0) 'error) (for-each (lambda (arg) (test (quotient arg +nan.0) 'error) (test (quotient +nan.0 arg) 'error) (test (quotient arg +inf.0) 'error) (test (quotient +inf.0 arg) 'error) (test (quotient arg 2) 'error)) (list "hi" () (integer->char 65) #f #t 0+i '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (arg) (test (quotient 2 arg) 'error) (test (quotient 1/2 arg) 'error) (test (quotient 2.0 arg) 'error) (test (quotient 2+i arg) 'error)) (list "hi" () (integer->char 65) #f #t 0 0.0 0+i '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; remainder ;;; -------------------------------------------------------------------------------- (test (remainder -0.5 -1) -0.5) (test (remainder -1 -1) 0) (test (remainder -1 -10) -1) (test (remainder -1 -1234) -1) (test (remainder -1 -2) -1) (test (remainder -1 -3) -1) (test (remainder -1 -500029) -1) (test (remainder -1 1) 0) (test (remainder -1 10) -1) (test (remainder -1 1234) -1) (test (remainder -1 2) -1) (test (remainder -1 3) -1) (test (remainder -1 500029) -1) (test (remainder -1.5 -2) -1.5) (test (remainder -1.5 2) -1.5) (test (remainder -1/2 -1) -1/2) (test (remainder -1/2 -1.0) -0.5) (test (remainder -1234 -1) 0) (test (remainder -1234 -10) -4) (test (remainder -1234 -1234) 0) (test (remainder -1234 -2) 0) (test (remainder -1234 -3) -1) (test (remainder -1234 -500029) -1234) (test (remainder -1234 1) 0) (test (remainder -1234 10) -4) (test (remainder -1234 1234) 0) (test (remainder -1234 2) 0) (test (remainder -1234 3) -1) (test (remainder -1234 500029) -1234) (test (remainder -13 -4) -1) (test (remainder -13 4) -1) (test (remainder -2 -1) 0) (test (remainder -2 -10) -2) (test (remainder -2 -1234) -2) (test (remainder -2 -2) 0) (test (remainder -2 -3) -2) (test (remainder -2 -500029) -2) (test (remainder -2 1) 0) (test (remainder -2 10) -2) (test (remainder -2 1234) -2) (test (remainder -2 2) 0) (test (remainder -2 3) -2) (test (remainder -2 500029) -2) (test (remainder -500029 -1) 0) (test (remainder -500029 -10) -9) (test (remainder -500029 -1234) -259) (test (remainder -500029 -2) -1) (test (remainder -500029 -3) -1) (test (remainder -500029 -500029) 0) (test (remainder -500029 1) 0) (test (remainder -500029 10) -9) (test (remainder -500029 1234) -259) (test (remainder -500029 2) -1) (test (remainder -500029 3) -1) (test (remainder -500029 500029) 0) (test (remainder 0 -1) 0) (test (remainder 0 -10) 0) (test (remainder 0 -1234) 0) (test (remainder 0 -2) 0) (test (remainder 0 -3) 0) (test (remainder 0 -500029) 0) (test (remainder 0 1) 0) (test (remainder 0 10) 0) (test (remainder 0 1234) 0) (test (remainder 0 2) 0) (test (remainder 0 3) 0) (test (remainder 0 500029) 0) (test (remainder 0.5 -2) 0.5) (test (remainder 0.5 -2.0) 0.5) (test (remainder 0.5 2.0) 0.5) (test (remainder 1 -1) 0) (test (remainder 1 -10) 1) (test (remainder 1 -1234) 1) (test (remainder 1 -2) 1) (test (remainder 1 -3) 1) (test (remainder 1 -4) 1) (test (remainder 1 -500029) 1) (test (remainder 1 1) 0) (test (remainder 1 10) 1) (test (remainder 1 1234) 1) (test (remainder 1 2) 1) (test (remainder 1 3) 1) (test (remainder 1 500029) 1) (num-test (remainder 1.5 1/3) 0.16666666666667) (num-test (remainder 1.5 1/4) 0.0) (test (remainder 1/2 -2) 1/2) (test (remainder 1/2 2) 1/2) (test (remainder 1/9223372036854775807 1/3) 1/9223372036854775807) (test (remainder 11/9223372036854775807 3/9223372036854775807) 2/9223372036854775807) (test (remainder 1234 -1) 0) (test (remainder 1234 -10) 4) (test (remainder 1234 -1234) 0) (test (remainder 1234 -2) 0) (test (remainder 1234 -3) 1) (test (remainder 1234 -500029) 1234) (test (remainder 1234 1) 0) (test (remainder 1234 10) 4) (test (remainder 1234 1234) 0) (test (remainder 1234 2) 0) (test (remainder 1234 3) 1) (test (remainder 1234 500029) 1234) (test (remainder 13 -4) 1) (test (remainder 13 4) 1) (num-test (remainder 19439282 4409.5) 2206.0) (test (remainder 2 -1) 0) (test (remainder 2 -10) 2) (test (remainder 2 -1234) 2) (test (remainder 2 -2) 0) (test (remainder 2 -3) 2) (test (remainder 2 -500029) 2) (test (remainder 2 1) 0) (test (remainder 2 10) 2) (test (remainder 2 1234) 2) (test (remainder 2 2) 0) (test (remainder 2 3) 2) (test (remainder 500029 -1) 0) (test (remainder 500029 -10) 9) (test (remainder 500029 -1234) 259) (test (remainder 500029 -2) 1) (test (remainder 500029 -3) 1) (test (remainder 500029 -500029) 0) (test (remainder 500029 1) 0) (test (remainder 500029 10) 9) (test (remainder 500029 1234) 259) (test (remainder 500029 2) 1) (test (remainder 500029 3) 1) (test (remainder 500029 500029) 0) (test (remainder -9223372036854775808 -9223372036854775808) 0) (num-test (remainder 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 1.110223024625156799999999999999999999997E-16) (num-test (remainder 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 5.551115123125783999999999999999999999984E-17) (test (remainder 9223372036854775807 -9223372036854775808) 9223372036854775807) (test (remainder 9223372036854775807 9223372036854775807) 0) (num-test (remainder 0.0 1) 0.0) (num-test (remainder 0.0 2) 0.0) (num-test (remainder 0.0 3) 0.0) (num-test (remainder 0.0 4) 0.0) (num-test (remainder 0.0 pi) 0.0) (num-test (remainder 0.0 2.5) 0.0) (num-test (remainder 0.0 4.0) 0.0) (num-test (remainder 0.0 1000.1) 0.0) (num-test (remainder pi 1) 1.415926535897932384626433832795028841953E-1) (num-test (remainder pi 2) 1.141592653589793238462643383279502884195E0) (num-test (remainder pi 3) 1.415926535897932384626433832795028841953E-1) (num-test (remainder pi 4) pi) (num-test (remainder pi pi) 0.0) (num-test (remainder pi 2.5) 6.415926535897932384626433832795028841953E-1) (num-test (remainder pi 4.0) pi) (num-test (remainder pi 1000.1) pi) (num-test (remainder 1.5 1) 0.5) (num-test (remainder 1.5 2) 1.5) (num-test (remainder 1.5 3) 1.5) (num-test (remainder 1.5 4) 1.5) (num-test (remainder 1.5 pi) 1.500E0) (num-test (remainder 1.5 2.5) 1.5) (num-test (remainder 1.5 4.0) 1.5) (num-test (remainder 1.5 1000.1) 1.5) (num-test (remainder -1.5 1) -0.5) (num-test (remainder -1.5 3) -1.5) (num-test (remainder -1.5 4) -1.5) (num-test (remainder -1.5 pi) -1.50E0) (num-test (remainder -1.5 2.5) -1.5) (num-test (remainder -1.5 4.0) -1.5) (num-test (remainder -1.5 1000.1) -1.5) (num-test (remainder 3.0 1) 0.0) (num-test (remainder 3.0 2) 1.0) (num-test (remainder 3.0 3) 0.0) (num-test (remainder 3.0 4) 3.0) (num-test (remainder 3.0 pi) 3.000E0) (num-test (remainder 3.0 2.5) 0.5) (num-test (remainder 3.0 4.0) 3.0) (num-test (remainder 3.0 1000.1) 3.0) (num-test (remainder 110.123 1) 0.123) (num-test (remainder 110.123 2) 0.123) (num-test (remainder 110.123 3) 2.123) (num-test (remainder 110.123 4) 2.123) (num-test (remainder 110.123 pi) 1.672571243572413149678281714746183675874E-1) (num-test (remainder 110.123 2.5) 0.123) (num-test (remainder 110.123 4.0) 2.123) (num-test (remainder 110.123 1000.1) 110.123) (when (provided? 'overflow-checks) (test (remainder 3/2 most-negative-fixnum) 3/2) (test (remainder 3/2 most-positive-fixnum) 3/2) (test (remainder most-negative-fixnum -1) 0)) (test (= (remainder (* 577/408 577/408) 2) (remainder (* 1393/985 1393/985) 2)) #f) (num-test (= (remainder 2.0 (* 577/408 577/408)) (remainder (* 1393/985 1393/985) 2.0)) #f) (test (= (remainder 577/408 1393/985) (floor (/ 577/408 1393/985))) #f) (test (= (remainder (* 3363/2378 3363/2378) 2) (remainder (* 19601/13860 19601/13860) 2)) #f) (num-test (= (remainder 2.0 (* 47321/33461 47321/33461)) (remainder (* 114243/80782 114243/80782) 2.0)) #f) (test (= (remainder 47321/33461 114243/80782) (floor (/ 47321/33461 114243/80782))) #f) (test (= (remainder (* 275807/195025 275807/195025) 2) (remainder (* 1607521/1136689 1607521/1136689) 2)) #f) (num-test (= (remainder 2.0 (* 275807/195025 275807/195025)) (remainder (* 1607521/1136689 1607521/1136689) 2.0)) #f) (test (= (remainder 275807/195025 1607521/1136689) (floor (/ 275807/195025 1607521/1136689))) #f) (test (= (remainder (* 3880899/2744210 3880899/2744210) 2) (remainder (* 9369319/6625109 9369319/6625109) 2)) #f) (num-test (= (remainder 2.0 (* 3880899/2744210 3880899/2744210)) (remainder (* 9369319/6625109 9369319/6625109) 2.0)) #f) (test (= (remainder 3880899/2744210 9369319/6625109) (floor (/ 3880899/2744210 9369319/6625109))) #f) (when with-bignums (num-test (= (remainder 2.0 (* 318281039/225058681 318281039/225058681)) 0.0) #f) (num-test (= (remainder (* 1855077841/1311738121 1855077841/1311738121) 2.0) 0.0) #f) (num-test (= (remainder 2.0 (* 54608393/38613965 54608393/38613965)) (remainder (* 131836323/93222358 131836323/93222358) 2.0)) #f) ; was #t? (test (= (remainder 54608393/38613965 131836323/93222358) (floor (/ 54608393/38613965 131836323/93222358))) #f) (test (= (remainder (* 318281039/225058681 318281039/225058681) 2) (remainder (* 1855077841/1311738121 1855077841/1311738121) 2)) #f) (num-test (= (remainder 2.0 (* 318281039/225058681 318281039/225058681)) (remainder (* 1855077841/1311738121 1855077841/1311738121) 2.0)) #f) ; was #t?? 25-Apr-2020 (test (= (remainder 318281039/225058681 1855077841/1311738121) (floor (/ 318281039/225058681 1855077841/1311738121))) #f) (test (= (remainder (* 54608393/38613965 54608393/38613965) 2) (remainder (* 131836323/93222358 131836323/93222358) 2)) #f)) (test (+ (remainder 23/3 3/2) (* 3/2 (quotient 23/3 3/2))) 23/3) (test (+ (remainder 29/8 17/12) (* 17/12 (quotient 29/8 17/12))) 29/8) (test (+ (remainder 164/19 41/29) (* 41/29 (quotient 164/19 41/29))) 164/19) (test (+ (remainder 725/84 99/70) (* 99/70 (quotient 725/84 99/70))) 725/84) (num-test (+ (remainder 3862/401 577/408) (* 577/408 (quotient 3862/401 577/408))) 3862/401) (num-test (+ (remainder 4881/1054 1393/985) (* 1393/985 (quotient 4881/1054 1393/985))) 4881/1054) (num-test (+ (remainder 53963/20511 3363/2378) (* 3363/2378 (quotient 53963/20511 3363/2378))) 53963/20511) (num-test (+ (remainder 188690/24727 19601/13860) (* 19601/13860 (quotient 188690/24727 19601/13860))) 188690/24727) (num-test (+ (remainder 959536/125743 47321/33461) (* 47321/33461 (quotient 959536/125743 47321/33461))) 959536/125743) (num-test (+ (remainder 2606489/301994 114243/80782) (* 114243/80782 (quotient 2606489/301994 114243/80782))) 2606489/301994) (num-test (+ (remainder 97961303/11350029 275807/195025) (* 275807/195025 (quotient 97961303/11350029 275807/195025))) 97961303/11350029) (when (provided? 'overflow-checks) (num-test (+ (remainder 109303762/16483927 1607521/1136689) (* 1607521/1136689 (quotient 109303762/16483927 1607521/1136689))) 109303762/16483927) (num-test (+ (remainder 27869189/17087915 3880899/2744210) (* 3880899/2744210 (quotient 27869189/17087915 3880899/2744210))) 27869189/17087915) (num-test (+ (remainder 564541319/85137581 9369319/6625109) (* 9369319/6625109 (quotient 564541319/85137581 9369319/6625109))) 564541319/85137581) (num-test (+ (remainder 2351934037/272500658 54608393/38613965) (* 54608393/38613965 (quotient 2351934037/272500658 54608393/38613965))) 2351934037/272500658) (num-test (+ (remainder 1657851173/630138897 131836323/93222358) (* 131836323/93222358 (quotient 1657851173/630138897 131836323/93222358))) 1657851173/630138897)) (when with-bignums (num-test (remainder -9223372036854775808 5.551115123125783999999999999999999999984E-17) -2.295798100238055639010781305842101573944E-17) (num-test (remainder 295147905149568077200 34359738366) 21754858894) (num-test (remainder 696898287454081973170944403677937368733396 1180591620717411303422) 314390899110894278354) (num-test (remainder 1e19 10) 0.0) (num-test (remainder .1e20 10) 0.0) (num-test (remainder 1e20 10) 0.0) (num-test (remainder 1e21 10) 0.0) (num-test (remainder 1e19 -1) 0.0) (num-test (remainder 1e19 1) 0.0) (num-test (remainder .1e20 1) 0.0) (num-test (remainder 1e20 1) 0.0) (test (remainder 10000000000000000000 1) 0) (test (remainder 100000000000000000000 1) 0) (test (remainder 10000000000000000000 10) 0) (test (remainder 100000000000000000000 10) 0) (test (remainder 9223372036854775807 1/3) 0) (test (remainder 9223372036854775807 2/3) 1/3) (test (remainder 922337203685477580 1/3) 0) (test (remainder 1361069299753299783990135442290762165844800+i 8281085446358585640) 'error) (num-test (remainder 1231231231231231232123 0.0) 'error) (test (remainder 1231231231231231232123 0) 'error) (when with-bignums (num-test (remainder 9007199254740996.0 9007199254740995) 1.0)) ; 0.0 in 64-bit land (test (= (remainder (* 4478554083/3166815962 4478554083/3166815962) 2) (remainder (* 10812186007/7645370045 10812186007/7645370045) 2)) #f) (test (= (remainder 2.0 (* 4478554083/3166815962 4478554083/3166815962)) (remainder (* 10812186007/7645370045 10812186007/7645370045) 2.0)) #f) (test (= (remainder 367296043199/259717522849 886731088897/627013566048) (floor (/ 367296043199/259717522849 886731088897/627013566048))) #f) (test (= (remainder (* 5168247530883/3654502875938 5168247530883/3654502875938) 2) (remainder (* 12477253282759/8822750406821 12477253282759/8822750406821) 2)) #f) (test (= (remainder 2.0 (* 423859315570607/299713796309065 423859315570607/299713796309065)) (remainder (* 1023286908188737/723573111879672 1023286908188737/723573111879672) 2.0)) #f) (test (= (remainder 2.0 (* 34761632124320657/24580185800219268 34761632124320657/24580185800219268)) (remainder (* 202605639573839043/143263821649299118 202605639573839043/143263821649299118) 2.0)) #f) (test (= (remainder 34761632124320657/24580185800219268 202605639573839043/143263821649299118) (floor (/ 34761632124320657/24580185800219268 202605639573839043/143263821649299118))) #f) (test (= (remainder (* 489133282872437279/345869461223138161 489133282872437279/345869461223138161) 2) (remainder (* 1180872205318713601/835002744095575440 1180872205318713601/835002744095575440) 2)) #f) (test (= (remainder (* 2850877693509864481/2015874949414289041 2850877693509864481/2015874949414289041) 2) (remainder (* 16616132878186749607/11749380235262596085 16616132878186749607/11749380235262596085) 2)) #f) (test (= (remainder (* 564459384575477049359/399133058537705128729 564459384575477049359/399133058537705128729) 2) (remainder (* 1362725501650887306817/963592443113182178088 1362725501650887306817/963592443113182178088) 2)) #f) (test (= (remainder 564459384575477049359/399133058537705128729 1362725501650887306817/963592443113182178088) (floor (/ 564459384575477049359/399133058537705128729 1362725501650887306817/963592443113182178088))) #f) (test (= (remainder (* 3289910387877251662993/2326317944764069484905 3289910387877251662993/2326317944764069484905) 2) (remainder (* 19175002942688032928599/13558774610046711780701 19175002942688032928599/13558774610046711780701) 2)) #f) (test (= (remainder (* 46292552162781456490001/32733777552734744709300 46292552162781456490001/32733777552734744709300) 2) (remainder (* 111760107268250945908601/79026329715516201199301 111760107268250945908601/79026329715516201199301) 2)) #f) (test (= (remainder 46292552162781456490001/32733777552734744709300 111760107268250945908601/79026329715516201199301) (floor (/ 46292552162781456490001/32733777552734744709300 111760107268250945908601/79026329715516201199301))) #f) (test (= (remainder (* 269812766699283348307203/190786436983767147107902 269812766699283348307203/190786436983767147107902) 2) (remainder (* 1572584048032918633353217/1111984844349868137938112 1572584048032918633353217/1111984844349868137938112) 2)) #f) (test (= (remainder 269812766699283348307203/190786436983767147107902 1572584048032918633353217/1111984844349868137938112) (floor (/ 269812766699283348307203/190786436983767147107902 1572584048032918633353217/1111984844349868137938112))) #f) (test (+ (remainder 37496514441/6659027209 318281039/225058681) (* 318281039/225058681 (quotient 37496514441/6659027209 318281039/225058681))) 37496514441/6659027209) (test (+ (remainder 74857297149/9809721694 1855077841/1311738121) (* 1855077841/1311738121 (quotient 74857297149/9809721694 1855077841/1311738121))) 74857297149/9809721694) (test (+ (remainder 48346261034/10439860591 4478554083/3166815962) (* 4478554083/3166815962 (quotient 48346261034/10439860591 4478554083/3166815962))) 48346261034/10439860591) (test (+ (remainder 584312948386/103768467013 10812186007/7645370045) (* 10812186007/7645370045 (quotient 584312948386/103768467013 10812186007/7645370045))) 584312948386/103768467013) (test (+ (remainder 1663365607631/217976794617 63018038201/44560482149) (* 63018038201/44560482149 (quotient 1663365607631/217976794617 63018038201/44560482149))) 1663365607631/217976794617) (test (+ (remainder 4518285376493/975675645481 152139002499/107578520350) (* 152139002499/107578520350 (quotient 4518285376493/975675645481 152139002499/107578520350))) 4518285376493/975675645481) (test (+ (remainder 10302330360665/1193652440098 367296043199/259717522849) (* 367296043199/259717522849 (quotient 10302330360665/1193652440098 367296043199/259717522849))) 10302330360665/1193652440098) (test (+ (remainder 73997654926903/8573543875303 886731088897/627013566048) (* 886731088897/627013566048 (quotient 73997654926903/8573543875303 886731088897/627013566048))) 73997654926903/8573543875303) (test (+ (remainder 176638380405175/18340740190704 5168247530883/3654502875938) (* 5168247530883/3654502875938 (quotient 176638380405175/18340740190704 5168247530883/3654502875938))) 176638380405175/18340740190704) (test (+ (remainder 468100074910801/83130157078217 12477253282759/8822750406821) (* 12477253282759/8822750406821 (quotient 468100074910801/83130157078217 12477253282759/8822750406821))) 468100074910801/83130157078217) (test (+ (remainder 843389138467141/517121682660006 30122754096401/21300003689580) (* 30122754096401/21300003689580 (quotient 843389138467141/517121682660006 30122754096401/21300003689580))) 843389138467141/517121682660006) (test (+ (remainder 1250127478260940/766512153894657 175568277047523/124145519261542) (* 175568277047523/124145519261542 (quotient 1250127478260940/766512153894657 175568277047523/124145519261542))) 1250127478260940/766512153894657) (test (+ (remainder 21963374527647665/6048967074079039 423859315570607/299713796309065) (* 423859315570607/299713796309065 (quotient 21963374527647665/6048967074079039 423859315570607/299713796309065))) 21963374527647665/6048967074079039) (test (+ (remainder 45760661301451259/9881527843552324 1023286908188737/723573111879672) (* 1023286908188737/723573111879672 (quotient 45760661301451259/9881527843552324 1023286908188737/723573111879672))) 45760661301451259/9881527843552324) (test (+ (remainder 1528546195606366451/177100989030047175 5964153172084899/4217293152016490) (* 5964153172084899/4217293152016490 (quotient 1528546195606366451/177100989030047175 5964153172084899/4217293152016490))) 1528546195606366451/177100989030047175) (test (+ (remainder 543933078269123234/206745572560704147 14398739476117879/10181446324101389) (* 14398739476117879/10181446324101389 (quotient 543933078269123234/206745572560704147 14398739476117879/10181446324101389))) 543933078269123234/206745572560704147) (test (+ (remainder 4808388068050040138/630118245525664765 34761632124320657/24580185800219268) (* 34761632124320657/24580185800219268 (quotient 4808388068050040138/630118245525664765 34761632124320657/24580185800219268))) 4808388068050040138/630118245525664765)) (test (remainder 123 123 123) 'error) (test (remainder 123) 'error) (test (remainder 3 0) 'error) (test (remainder) 'error) (test (remainder 2.3 1.0+0.1i) 'error) (test (remainder 3.0+2.3i 3) 'error) (test (remainder 3 0.0) 'error) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (remainder -inf.0 1855077841/1311738121)))) (define (hi) (func)) (hi)) #t) (for-each (lambda (arg) (test (remainder arg +nan.0) 'error) (test (remainder +nan.0 arg) 'error) (test (remainder arg +inf.0) 'error) (test (remainder +inf.0 arg) 'error) (test (remainder arg 2) 'error)) (list "hi" () (integer->char 65) 0+i #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (arg) (test (remainder 2 arg) 'error) (test (remainder 2.0 arg) 'error) (test (remainder 1/2 arg) 'error) (test (remainder 2+i arg) 'error)) (list "hi" () (integer->char 65) #f #t 0 0+i '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (remainder -nan.0 0) 'error) (test (remainder -nan.0 0.0) 'error) (when with-bignums (let ((top-exp 60)) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (inexact->exact (expt 2 i))) (val2 (+ val1 1)) (mv (modulo val2 2)) (qv (quotient val2 2)) (rv (remainder val2 2))) (if (not (= mv 1)) (begin (set! happy #f) (display "(modulo ") (display val2) (display " 2) = ") (display mv) (display "?") (newline))) (if (not (= qv (/ val1 2))) (begin (set! happy #f) (display "(quotient ") (display val2) (display " 2) = ") (display qv) (display "?") (newline))) (if (not (= rv 1)) (begin (set! happy #f) (display "(remainder ") (display val2) (display " 2) = ") (display rv) (display "?") (newline)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (inexact->exact (expt 2 i))) (val2 (/ (+ val1 1) 2)) (mv (modulo val2 2)) (qv (quotient val2 2)) (rv (remainder val2 2))) (if (not (= mv 1/2)) (begin (set! happy #f) (display "(modulo ") (display val2) (display " 2) = ") (display mv) (display "?") (newline))) (if (not (= qv (/ val1 4))) (begin (set! happy #f) (display "(quotient ") (display val2) (display " 2) = ") (display qv) (display "?") (newline))) (if (not (= rv 1/2)) (begin (set! happy #f) (display "(remainder ") (display val2) (display " 2) = ") (display rv) (display "?") (newline)))))))) (unless with-bignums (test (remainder 1e20 10) 'error) (test (quotient 1e20 10) 'error)) ;;; -------------------------------------------------------------------------------- ;;; gcd ;;; -------------------------------------------------------------------------------- (test (gcd (* 512 500057) (* 128 500057) (* 2048 500057)) 64007296) (test (gcd (- (expt 2 11) 1) (- (expt 2 19) 1)) (- (expt 2 (gcd 11 19)) 1)) (test (gcd (- (expt 2 11) 1) (- (expt 2 22) 1)) (- (expt 2 (gcd 11 22)) 1)) (test (gcd (- (expt 2 12) 1) (- (expt 2 18) 1)) (- (expt 2 (gcd 12 18)) 1)) (test (gcd (- (expt 2 52) 1) (- (expt 2 39) 1)) (- (expt 2 (gcd 52 39)) 1)) (test (gcd (numerator 7/9) (denominator 7/9)) 1) (test (gcd -1 -1) 1) (test (gcd -1 -10) 1) (test (gcd -1 -1234) 1) (test (gcd -1 -2) 1) (test (gcd -1 -3) 1) (test (gcd -1 -500029) 1) (test (gcd -1 0) 1) (test (gcd -1 1) 1) (test (gcd -1 10) 1) (test (gcd -1 1234) 1) (test (gcd -1 2) 1) (test (gcd -1 3) 1) (test (gcd -1 500029) 1) (test (gcd -1) 1) (test (gcd -1234 -1) 1) (test (gcd -1234 -10) 2) (test (gcd -1234 -1234) 1234) (test (gcd -1234 -2) 2) (test (gcd -1234 -3) 1) (test (gcd -1234 -500029) 1) (test (gcd -1234 0) 1234) (test (gcd -1234 1) 1) (test (gcd -1234 10) 2) (test (gcd -1234 1234) 1234) (test (gcd -1234 2) 2) (test (gcd -1234 3) 1) (test (gcd -1234 500029) 1) (test (gcd -1234) 1234) (test (gcd -2 -1) 1) (test (gcd -2 -10) 2) (test (gcd -2 -1234) 2) (test (gcd -2 -2) 2) (test (gcd -2 -3) 1) (test (gcd -2 -500029) 1) (test (gcd -2 0) 2) (test (gcd -2 1) 1) (test (gcd -2 10) 2) (test (gcd -2 1234) 2) (test (gcd -2 2) 2) (test (gcd -2 3) 1) (test (gcd -2 500029) 1) (test (gcd -2) 2) (test (gcd -4 0) 4 ) (test (gcd -500029 -1) 1) (test (gcd -500029 -10) 1) (test (gcd -500029 -1234) 1) (test (gcd -500029 -2) 1) (test (gcd -500029 -3) 1) (test (gcd -500029 -500029) 500029) (test (gcd -500029 0) 500029) (test (gcd -500029 1) 1) (test (gcd -500029 10) 1) (test (gcd -500029 1234) 1) (test (gcd -500029 2) 1) (test (gcd -500029 3) 1) (test (gcd -500029 500029) 500029) (test (gcd -500029) 500029) (test (gcd 0 -1) 1) (test (gcd 0 -10) 10) (test (gcd 0 -1234) 1234) (test (gcd 0 -2) 2) (test (gcd 0 -3) 3) (test (gcd 0 -500029) 500029) (test (gcd 0 0 0 10) 10) (test (gcd 0 0) 0) (test (gcd 0 1) 1) (test (gcd 0 10 10 1234) 2) (test (gcd 0 10) 10) (test (gcd 0 1234 -1234 10) 2) (test (gcd 0 1234) 1234) (test (gcd 0 2 2 -500029) 1) (test (gcd 0 2) 2) (test (gcd 0 3) 3) (test (gcd 0 4) 4 ) (test (gcd 0 500029 -500029 -2) 1) (test (gcd 0 500029) 500029) (test (gcd 0) 0) (test (gcd 1 -1) 1) (test (gcd 1 -10) 1) (test (gcd 1 -1234) 1) (test (gcd 1 -2) 1) (test (gcd 1 -3) 1) (test (gcd 1 -500029) 1) (test (gcd 1 0 -1 1) 1) (test (gcd 1 0) 1) (test (gcd 1 1 2 -10) 1) (test (gcd 1 1) 1) (test (gcd 1 10) 1) (test (gcd 1 1234) 1) (test (gcd 1 2) 1) (test (gcd 1 3 10 500029) 1) (test (gcd 1 3) 1) (test (gcd 1 500029) 1) (test (gcd 1) 1) (test (gcd 1/10 1/1000000000) 1/1000000000) (test (gcd 1/1024 1/9765625) 1/10000000000) (test (gcd 1/131072 1/762939453125) 1/100000000000000000) (test (gcd 1/2 1/3) 1/6) (test (gcd 1/2 2) 1/2) (test (gcd 1/262144 1/3814697265625) 1/1000000000000000000) (test (gcd 1/3 1/6 5/12 2) 1/12) (test (gcd 1/3 1/6 5/12) 1/12) (test (gcd 1/3 2/3) 1/3) (test (gcd 1/3 3/4 5/8) 1/24) (test (gcd 1/3 3/4) 1/12) (test (gcd 1008217762344 4403) 37) (test (gcd 1111364125679340 6) 6) (test (gcd 1200780158492850 91686) 354) (test (gcd 1234 -1) 1) (test (gcd 1234 -10) 2) (test (gcd 1234 -1234) 1234) (test (gcd 1234 -2) 2) (test (gcd 1234 -3) 1) (test (gcd 1234 -500029) 1) (test (gcd 1234 0 -1234 1234) 1234) (test (gcd 1234 0) 1234) (test (gcd 1234 1) 1) (test (gcd 1234 10 0 1) 1) (test (gcd 1234 10) 2) (test (gcd 1234 1234 1 -10) 1) (test (gcd 1234 1234) 1234) (test (gcd 1234 2 -500029 -3) 1) (test (gcd 1234 2) 2) (test (gcd 1234 3) 1) (test (gcd 1234 500029 3 500029) 1) (test (gcd 1234 500029) 1) (test (gcd 1234) 1234) (test (gcd 1346702251365156 435) 87) (test (gcd 136581511784536 67022) 62) (test (gcd 1388225063690465 644) 7) (test (gcd 15295874 111) 37) (test (gcd 1551193257090906 2656731) 1749) (test (gcd 1563464979842 442) 34) (test (gcd 15858537083857314 21793) 21793) (test (gcd 163873565922 155) 31) (test (gcd 178335507754891305 817) 817) (test (gcd 2 -1) 1) (test (gcd 2 -10) 2) (test (gcd 2 -1234) 2) (test (gcd 2 -2) 2) (test (gcd 2 -3) 1) (test (gcd 2 -500029) 1) (test (gcd 2 0 2 -2) 2) (test (gcd 2 0) 2) (test (gcd 2 1 -3 -1) 1) (test (gcd 2 1) 1) (test (gcd 2 10) 2) (test (gcd 2 1234) 2) (test (gcd 2 2 10 10) 2) (test (gcd 2 2) 2) (test (gcd 2 3) 1) (test (gcd 2 3/4) 1/4) (test (gcd 2 500029 0 10) 1) (test (gcd 2 500029) 1) (test (gcd 2) 2) (test (gcd 2033404107084 23374) 2) (test (gcd 20430054 41) 41) (test (gcd 2090198664 1118) 2) (test (gcd 21568911 41) 41) (test (gcd 248255254 767) 13) (test (gcd 2755 13) 1) (test (gcd 3 500029 1 -1234) 1) (test (gcd 3 500029) 1) (test (gcd 3) 3) (test (gcd 3/4 2) 1/4) (test (gcd 32 -36) 4 ) (test (gcd 323 28747 27113) 19) (test (gcd 3333 -33 1002001) 11) (test (gcd 3333 -33 101) 1) (test (gcd 363169800 20) 20) (test (gcd 3712337724 576173) 23) (test (gcd 386512944051107445 17) 17) (test (gcd 406117800 57) 3) (test (gcd 4097970629150 86) 2) (test (gcd 4294967298 3) 3) (test (gcd 43293168048 1344610) 2) (test (gcd 4380921044390 5) 5) (test (gcd 4412914630225794 515823) 46893) (test (gcd 44179338013272 280645) 41) (test (gcd 500029 -1) 1) (test (gcd 500029 -10) 1) (test (gcd 500029 -1234) 1) (test (gcd 500029 -2) 1) (test (gcd 500029 -3) 1) (test (gcd 500029 -500029) 500029) (test (gcd 500029 0 -500029 -500029) 500029) (test (gcd 500029 0) 500029) (test (gcd 500029 1) 1) (test (gcd 500029 10 -2 -3) 1) (test (gcd 500029 10) 1) (test (gcd 500029 1234 3 2) 1) (test (gcd 500029 1234) 1) (test (gcd 500029 2 0 1234) 1) (test (gcd 500029 2) 1) (test (gcd 500029 3 1 -10) 1) (test (gcd 500029 3) 1) (test (gcd 500029 500029 1234 -10) 1) (test (gcd 500029 500029) 500029) (test (gcd 500029) 500029) (test (gcd 510104442 5453) 1) (test (gcd 524288/5 19073486328125/2) 1/10) (test (gcd 5275411661289 31857) 21) (test (gcd 56 2) 2) (test (gcd 60 42) 6) (test (gcd 608503422693864 47) 47) (test (gcd 629448534 2) 2) (test (gcd 63 -42 35) 7) (test (gcd 64149298745840 43808357) 35131) (test (gcd 660070972 74) 74) (test (gcd 6945109296864 779) 19) (test (gcd 71862 203) 203) (test (gcd 7438317458260 31213) 13) (test (gcd 77874422 32223899) 1) (test (gcd 82578867500655 319) 29) (test (gcd 91 -49) 7) (test (gcd) 0) (test (gcd 9223372036854775807 -9223372036854775808) (if with-bignums 1 'error)) (test (gcd 10400200/16483927 1607521/1136689) 1/18737098497703) (test (gcd 10781274/17087915 3880899/2744210) 3/9378565444430) (test (gcd 12/19 41/29) 1/551) (test (gcd 12941/20511 3363/2378) 1/48775158) (test (gcd 15601/24727 19601/13860) 1/342716220) (test (gcd 171928773/272500658 54608393/38613965) 1/10522330870488970) (test (gcd 190537/301994 114243/80782) 1/12197839654) (test (gcd 2/3 3/2) 1/6) (test (gcd 253/401 577/408) 1/163608) (test (gcd 397573379/630138897 131836323/93222358) 1/58743033845859126) (test (gcd 4201378396/6659027209 318281039/225058681) 1/1498671880400651329) (test (gcd 5/8 17/12) 1/24) (test (gcd 53/84 99/70) 1/420) (test (gcd 53715833/85137581 9369319/6625109) 1/564045754121329) (test (gcd 665/1054 1393/985) 7/1038190) (test (gcd 7161071/11350029 275807/195025) 1/2213539405725) (test (gcd 79335/125743 47321/33461) 1/4207486523) (test (gcd -2305843009213693952/4611686018427387903) 2305843009213693952/4611686018427387903) (test (gcd 1/92233720368547758 1/3005) (if with-bignums 1/277162329707486012790 'error)) (test (gcd -9223372036854775808) (if with-bignums 9223372036854775808 'error)) (test (gcd -9223372036854775808 -9223372036854775808) (if with-bignums 9223372036854775808 'error)) (test (gcd 0 "hi") 'error) (test (gcd 1 "hi") 'error) (test (gcd 3 5 #\a) 'error) (test (gcd 1.4 2.3) 'error) (test (gcd 1.0) 'error) (test (gcd 0/0) 'error) (test (gcd 2 1.0+0.5i) 'error) (for-each (lambda (arg) (test (gcd arg +nan.0) 'error) (test (gcd +nan.0 arg) 'error) (test (gcd arg +inf.0) 'error) (test (gcd +inf.0 arg) 'error) (test (gcd arg 2) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (arg) (test (gcd 2 arg) 'error) (test (gcd 1/2 arg) 'error) (test (gcd 2.0 arg) 'error) (test (gcd 2+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (when with-bignums (test (gcd (* 2 (ash 1 63)) 72) 8) (test (gcd 72 (* 2 (ash 1 63))) 8) (test (bignum? (gcd (* 2 (ash 1 63)) 72)) #f) (test (bignum? (gcd 72 (* 2 (ash 1 63)))) #f) (test (gcd -9223372036854775808 -9223372036854775808) 9223372036854775808) (test (gcd -9223372036854775808 9223372036854775807 -9223372036854775808) 1) (test (gcd 12345678901234567890 12345) 15) (test (gcd 2155967190204955525121 -12850565775361 93458656690177) 557057) (test (gcd 2155967190204955525121 0) 2155967190204955525121) (test (gcd 2155967190204955525121 12850565775361 93458656690177) 557057) (test (gcd 2346026393680644703525505657 17293822570713318399) 11) (test (gcd 974507656412513757857315037382926980395082974811562770185617915360 -1539496810360685510909469177732386446833404488164283) 1) (test (gcd 460683358924445799142 518) 518) (test (gcd 113021475230160 74635) 6785) (test (gcd 74228340534140364 363909) 1677) (test (gcd 69242022961311060 48305942) 60458) (test (gcd -286967952870300 2273388) 156) (test (gcd 302822258393413362492399 29) 29) (test (gcd 10491072879382200 133) 133) (test (gcd 167206737423420464 609) 7) (test (gcd 72212583812867784 4888799) 47) (test (gcd 4170116471639397292390 1798025) 359605) (test (gcd 83910330283522050 35224) 238) (test (gcd 275373383775647594346 66884092) 104834) (test (gcd 14656657495570695990 37) 1) (test (gcd 95470974177676509874110 1219) 1219) (test (gcd 619506317623001424 -5957) 7) (test (gcd 11268171656665155960 9858) 186) (test (gcd 6172860073826160 5167394) 3074) (test (gcd 26457493095663264 1491412) 3956) (test (gcd -8481384175941103284 313836405) 51) (test (gcd 60356595775749199080 -176098815946) 1716346) (test (gcd 611492274956002440 37) 37) (test (gcd 164614611843685080 1711) 59) (test (gcd 93177516542679418720 62197) 37) (test (gcd 938959746797519770440 127558) 127558) (test (gcd 137670522526899326250 200) 50) (test (gcd 852063402206742880 41643478) 58406) (test (gcd 55947291202307909360 188546228) 6364) (test (gcd 12877971214039423262680 9832253830) 121730) (test (gcd 192158415774146059920 53) 53) (test (gcd 902814024155808960 1829) 31) (test (gcd 1265864304573235487120 4921) 259) (test (gcd -14172662463567665400 95817) 57) (test (gcd 32171996211745702482324 2368555) 259) (test (gcd 971324258606045826300 4576748) 236) (test (gcd 2400649320046378377000 1704690) 930) (test (gcd 953233796456393760 18342152493) 574287) (test (gcd 28906333140964843080 236206740) 823020) (test (gcd 775403093708557121609032 41) 41) (test (gcd 12587009808135760402860 2491) 47) (test (gcd 510685807527370566909720 76) 4) (test (gcd 9842598153710524682146590 10089) 3363) (test (gcd 44936631038618189620242012 30740) 6148) (test (gcd 934589372977008750144 373650) 282) (test (gcd 33027125273398900134069150 840577803) 840577803) (test (gcd 4428219127938822420288 1695783782) 12502) (test (gcd 29316428815807608915440 560764380) 153340) (test (gcd 1364397376360544429904 19) 19) (test (gcd 4991450791697293128313385277 329) 7) (test (gcd 75448279792981695149550 3009) 3) (test (gcd 181031604499464166188731133 3364) 1) (test (gcd 405831142402606479845286 2746214) 161542) (test (gcd 89170366469003867207160 25337230) 11470) (test (gcd 13523725766340619200 1490114045) 28595) (test (gcd 104705939487154940255412 192200052) 26196) (test (gcd 7232591421499800642000 16584679460) 7820) (test (gcd 14043796716396386984750160 -33382708236) 358953852) (test (gcd 13894638105872256412416 23) 23) (test (gcd 147611447155643499428400 118) 2) (test (gcd 13356594697070649024 4558) 106) (test (gcd 15089731174706036171537760 90) 30) (test (gcd 307230141273924828960 1971507) 1581) (test (gcd 2582563944548247741930009096 22873474) 1759498) (test (gcd 1074296602920111687342072 146235518) 21758) (test (gcd 774058642832724262993980 -407557010) 2531410) (test (gcd 291091930213008490369569480 13412544348) 26508) (test (gcd 2089068565149831833568 7302038455228) 68171356) (test (gcd 1064437567441124038217970656 5) 1) (test (gcd 142557826750459447787460 1333) 31) (test (gcd 311779340580033594160200 23693) 23693) (test (gcd 29314187023691666530559664 110143) 110143) (test (gcd 222003853016244177637944900 857463) 857463) (test (gcd 6247776111945111006243552 77976501) 2515371) (test (gcd 1140058514761397155259712 5530338) 502758) (test (gcd 580962736822969724865449808 55686036) 1505028) (test (gcd 4100502596989506786787500 45333475410) 563730) (test (gcd 1497378750311599979536944 262630276090) 361046) (test (gcd 105637634198318524045536 2633013240) 150072) (test (gcd 11415822547029425161364106595632 7) 1) (test (gcd 198305933339312916107438448 177) 3) (test (gcd 3127415425979879537134790928 3335) 667) (test (gcd 589703503861221139260034914750 13209) 357) (test (gcd 3108579252052448504121792 14322) 462) (test (gcd 636976201153021006473464400 66264077) 3487583) (test (gcd 9544425315508129998909285900 1488396) 212628) (test (gcd 458100280193857502802977376 260747103934) 6212554) (test (gcd 114208186302155358124900650 22076867505) 6342105) (test (gcd 90107067439719108194114160 28566806069714) 3408519994) (test (gcd 2976572787365723002218245484 -110104803958578) 2966904798) (test (gcd 53453375725613238735360 17) 1) (test (gcd 888822833524306124874229800 106) 106) (test (gcd 21275338550698297089687698855820 3021) 3021) (test (gcd 417525245705449941528380320750068 5828) 5828) (test (gcd 1954871230146370370001829871352 22765249) 22765249) (test (gcd 903057827710908645847577520 648545995) 520085) (test (gcd 6002846634833433581621040 28493572159) 27869) (test (gcd 26428903214964558277189300080 100428856) 3463064) (test (gcd 470486531607553676511206181180 28495896) 2964) (test (gcd 483599554429365539310928369206620 5577334078910) 105232718470) (test (gcd 134511400157705323668887400 -1285071093558916) 340069628) (test (gcd -25897125642468049125349982599216 1183846707540) 26307704612) (test (gcd 1118034209930460291955200 3) 3) (test (gcd 16297594064835666104344589410644 413) 413) (test (gcd 536762539932642345554192060100 1378) 1378) (test (gcd 933250179448203335817687635834340 58029) 69) (test (gcd 65573457048202714607131200 486115) 3655) (test (gcd 85664559165674439863772868932 322014) 322014) (test (gcd 7232817686074320060728552759760 11307940) 11307940) (test (gcd 78400098291720425971762131120 5646921093) 5646921093) (test (gcd 345445746644065669842240 19727989065) 2193705) (test (gcd 627854758484491743169777558200 -750371721805653) 156322329) (test (gcd 788233263079483492974876830792850 7170146100) 5867550) (test (gcd 18378856389802641496737518160 6247594493140) 824329660) (test (gcd 9620902642431357480148667659080 59) 59) (test (gcd 16008524600631853118144316000 629) 1) (test (gcd 4342138447708715023205684275423920 53041) 1711) (test (gcd 2431833161592653384508687244500 47541) 47541) (test (gcd 39424620224103957589082132160 1671734) 1671734) (test (gcd 652830233576052788654372406432 552231327) 12842589) (test (gcd 6892963340916411083970414000 3662431431) 77924073) (test (gcd 29102758215190063506219566460000 10565720) 10565720) (test (gcd 21253900104556838003127171970777418412 1182797770) 62698) (test (gcd 3964268932242030284914943132662620 21244177854110) 18521515130) (test (gcd 6070388091189460078138338240 40809131994181213) 274113073169) (test (gcd 9685989954133695108793384134000 964113514382876) 169529367748) (test (gcd 56468122001858834917195045500 -429400787158167902) 2090772606538) (test (gcd 18843408973202596901221568364900 47) 47) (test (gcd 7800980538292163259967028613764250 6) 6) (test (gcd 270433907726619219545089642715200 3422) 58) (test (gcd 45771666919597903071546708768 2342359) 2183) (test (gcd 47198294949461301503537593835384892 314502) 5934) (test (gcd 3165335901519110207943908102359110 14953473) 207) (test (gcd 189219585097956261544520863361400 35605794) 35605794) (test (gcd -38532137569034426600955256933810890813 -1341358608707) 6436369) (test (gcd 1396277868664090735481380981225896 312520860) 62504172) (test (gcd -864038349500762576564773759109700 714136202724) 16607818668) (test (gcd 12514185871591242579049167322464 10706997440178) 200614518) (test (gcd 1981802660405609330969478067056636 33312289752) 14779188) (test (gcd 979313401024175219420658240 125278417383795) 1551032145) (test (gcd 4074026154111369481048033354344 29) 29) (test (gcd 599666571180604695702511920885005100 129) 129) (test (gcd 5703263639326551702474610108800 1978) 1978) (test (gcd 134137932950214683609064669163440 190619) 143) (test (gcd 344735091370772631136645455600 1048985) 1048985) (test (gcd 6759508339299085316106145385400 4969610) 160310) (test (gcd 700334422308861928135313594400 228529587) 432003) (test (gcd 10277417891211405957191810814198480 2516552038) 228777458) (test (gcd 490099971577877358878082782880 9282588354) 17547426) (test (gcd 1954558750269048828645390249600 5575829490) 327989970) (test (gcd 1360588454560018295496656378989200 7868178296420) 14873682980) (test (gcd 4337552841738910859248770564912480 17722936528737830) 338114285990) (test (gcd 215913068853045803981566931862756 7009479781500) 2930844) (test (gcd 44890707654126305940250882318870941900 18329973480720) 1527497790060) (test (gcd 28579720891831355496720656680837200 3) 3) (test (gcd 29332703209780553199747293473184160 1711) 29) (test (gcd 3648979393315349438003046604440000 186) 186) (test (gcd 1159760236369472473822068077011807878780 25714) 25714) (test (gcd 158186359726371025615685433600 31395) 4485) (test (gcd 331091450443070201468559735703944 28424) 28424) (test (gcd 9734443639363161342241553023288200 1961348207) 63269297) (test (gcd 701896612128009033011419603540080 51300) 3420) (test (gcd 86169288128517384618860929451245320 5032162527446) 180164066) (test (gcd 64828800524794653881296183831741773624 4645294472) 6354712) (test (gcd 49068907706533938991402184550000 268183371225) 742890225) (test (gcd 1708602980304476478496020543612288 4083128544) 131713824) (test (gcd 17608179287674151740172985536160 980399424528) 91686096) (test (gcd 43194437079731225735521919644800 -178119261126453036) 80633436453804) (test (gcd 817555977437791699707628651571149344 59) 59) (test (gcd 19062946261334997559157066059536 533) 41) (test (gcd 6533849124840489114353090499099000 598) 26) (test (gcd 427663965127849896842400211428345149025 234) 117) (test (gcd 352395507261316174741530450071590608 154734) 3774) (test (gcd 391579493632653867660919800000 9221565) 645) (test (gcd 2618798923882923048581401148931738000 681876) 52452) (test (gcd 174712575449141140214591110997980800 233260339838) 126154862) (test (gcd 88598141227372995032227898284800 1929763976) 155288) (test (gcd 210110141308655567793064872567302676320 720390430628) 468699044) (test (gcd 668425085137718599277317523827419000 19898594339442) 58711254) (test (gcd 89533471731097208414073727453200 4173840860670546) 2257350384354) (test (gcd 113987439157802480362236410675251462620 21548296273949445) 1134120856523655) (test (gcd 48129335993995093308894209644253760 1009442888504820) 84891337020) (test (gcd -3497836376962291922989777163497680 138736290091634664) 3383811953454504) (test (gcd 11371924962562208722154622794880 3) 3) (test (gcd 9451631862008339290824315653784000 703) 19) (test (gcd 16869347753325980368094612370435598560 806) 806) (test (gcd 4701845646467068759127854100132739552 3198) 6) (test (gcd 1029865193584911347147121232800485280 1005771) 24531) (test (gcd 10657125216930337802109861408000 2415138) 2838) (test (gcd 14382707743772734802155022983680 247913634) 144894) (test (gcd 60134748581470366378101904574533857248 54828228) 493948) (test (gcd 214830664120540781167218700750596000 505665810) 11759670) (test (gcd 48933004118344447687599112101802800 6263883444) 106167516) (test (gcd 5498670161558110606435630054129739400 262699548132) 1346604) (test (gcd 35941673649029587182509620977230062500 25622409466332) 525598668) (test (gcd 1592802602494326390643157055239113248 736377633395508) 960075141324) (test (gcd 4043816553144402557587143272522043028314 5011466158645380) 366067652202) (test (gcd 7171921165220830707276631005512550 1765284492289500) 176528449228950) (test (gcd 2402189359210218692854826119405968750 23) 1) (test (gcd 26149068753160488131648964110990162400 1147) 31) (test (gcd 556184059176863945810376239306506311552 4089) 4089) (test (gcd 67871323087036310486238021899264593800 13395) 13395) (test (gcd 12750401179065252879838440979200 -7177173) 7177173) (test (gcd 278110245000092733617125071646080 17748) 17748) (test (gcd 13408203364935178481017292708752000 50619404) 1368092) (test (gcd 124271828931784534297423756437875067000 -8839796595) 4068015) (test (gcd 11893442806922081156953529319100769836176 972789007267) 983608703) (test (gcd 352581052555284857902053030133344488264100 923561430099) 54327142947) (test (gcd 6108908012714804315575319947340956346976 31944833628092) 97096758748) (test (gcd 67475643422116264959949054821520228800 22515435540) 326310660) (test (gcd 470601888939348535946408832 5135943991060962937) 36905011) (test (gcd -110759232155568113345545635903016614000 30159198663300) 30159198663300) (test (gcd 146100914712024458707469587112300146320 26868173101560) 10304280) (test (gcd 12173192708601511002951184416658091200 466645866900785428350) 1496624001041650) (test (gcd 5784684831478746253226687170890240 13) 13) (test (gcd 35042260655085685815432622412891903767500 667) 667) (test (gcd 2903871349270676921837488659419545120987500 530) 530) (test (gcd 630123969240840167098426767919876491188000 77691) 25897) (test (gcd 33192703032132982013024959634241667249800 4684718) 126614) (test (gcd 4731525733734729472809717145544850000 90706055) 90706055) (test (gcd 214011009809686092216200126896120006823232 50400042) 258) (test (gcd 5854250735296111435541950856160000 24357777002) 817622) (test (gcd 35348208247612761916374738259136697649608 156806713508) 8596388) (test (gcd 612558317420289618714916924536521515286100 2377007388) 125105652) (test (gcd 181857299802925368992522029882739454720 21606337755618) 21606337755618) (test (gcd 4731635341196946327443020710970699860000 58092526675092) 776108892) (test (gcd 22081740554432638182773611616166588288192 61419768950540) 12283953790108) (test (gcd 125627844706077784535328068665849312000 30482033400) 32200) (test (gcd 1225504716872819103560254268197955520 510813364186125) 168863922045) (test (gcd 5209185280578468690281136425214396728400 2327880739319250103818) 829166238) (test (gcd 230425011604643097634961294406535254400 31) 31) (test (gcd 13222608481676137093434201748083744000 893) 893) (test (gcd 13348198818240350339028224064019716678960 651) 3) (test (gcd 7236172685650198160266777676385295337308176 23426) 442) (test (gcd 756264162229440667711265021676693350760 28899) 28899) (test (gcd 40915062421030872924283823601517905600 36345062) 36345062) (test (gcd 1174590526522170015825602834292923520 4991486258) 145114) (test (gcd 2891892862328155581145450075391651333218020 35138529818) 35138529818) (test (gcd 1993335355070485984559797658834121810059400 535644500) 2612900) (test (gcd 6324295450641455215591954662726515160 367472693133) 8962748613) (test (gcd 6576388154814679090356195121505112000 15901952377630) 969690370) (test (gcd 117828556355409428513249595788296238400 565992666495795) 33126555) (test (gcd 592831716700236607285748949860604000 139641978135660) 343100683380) (test (gcd 106766839071170184723986891291602032000 1584924526628112) 1983635202288) (test (gcd 21677148858122146832326483307664860804937400 247815827510760) 9178363981880) (test (gcd 14079549844487257384278196623697173813600 160967604100961853832) 42959600534344) (test (gcd 2696480372014145687016224877963234647656980 -2219319031453896088860) 1258830987778727220) (test (gcd 13545431257849875145060979241270859310160 29) 29) (test (gcd 137485634482479300158725199474868559498162500 329) 47) (test (gcd 529252417743761759027305009539254400 3243) 3243) (test (gcd 133897419738958073238580385894509887148800 330455) 330455) (test (gcd 3896215507210178905244623173635584334007288624 1005238) 1005238) (test (gcd 17654511984514518592175290794029073043800 1060530) 36570) (test (gcd 16470780256339082688310222474503880382858400 913836) 913836) (test (gcd 57267105834722825210001789897760395576000 2958974018) 62956894) (test (gcd 521977833444747522001426544601807810543216 1066521690) 4960566) (test (gcd 1699559962174727325529414216960251941390400 25883611479) 30924267) (test (gcd 10654036597801063717295948399628964800 317449894126222) 19212606314) (test (gcd 381902381115592200811990304316262139150724960 4640335440216) 4640335440216) (test (gcd 425968526187959807410151867411382902838703889232 1882826315615025) 4430179566153) (test (gcd 174609167728518272531601927200939868792000 1712923655178450) 6189150) (test (gcd 3325168366561555458817274989681612518000 1699726139891780) 130748164607060) (test (gcd 11429650426242566426919762928176000 7414967839104) 5416338816) (test (gcd 2104794191230056678355480848036599377844400 -16946684823025584) 182222417451888) (test (gcd 11894522530167763519415142641640874994880 7) 7) (test (gcd 5906329981690378696996009087718418780000 185) 185) (test (gcd 3056294774178096513474941936265025440000 658) 658) (test (gcd 10491907660880423349353457742257185280 123369) 123369) (test (gcd 673239479595593149777212259021965839229225628776 15470) 3094) (test (gcd 1506608574369860432616005754109397877696 1474070) 294814) (test (gcd 4849814041048623250005708880379694793905000 2172220582) 2172220582) (test (gcd 21154344928580705924176101470087564940000 5023204186) 5023204186) (test (gcd 346448039376394135288065831861806112294000 776147372) 25037012) (test (gcd 2339009760844587560470606952218133142645504 194201967414) 5248701822) (test (gcd 2242982161480922111384667548175169152 21419749763490) 2316901002) (test (gcd 4717315265246821759830981157482117120 45609714193992) 26227552728) (test (gcd 16628111321698075419789804224660024289936 4643626415880804) 1653124391556) (test (gcd 115557531507210992033160068979962880 88406536976058378) 36546728803662) (test (gcd 21059511907771200155093927745003762840000 180298981648603620) 191197223381340) (test (gcd 2124921015128697258800067298086064536000 2282525112298516782924) 15103625661372) (test (gcd 16015671538624533047089928322348864000 49817926936366875) 69075001125) (test (gcd 166517667014186289390514558017250969134523800 -43413708621878528404068) 1188862957578074004) (test (gcd -2780796292789128359666429021610464935722000 47) 47) (test (gcd 21297913114430245153455383503409684916193317960 58) 58) (test (gcd 1516745257039775143654568869485529015398000 6293) 6293) (test (gcd 8447692776411453120390905608381515479808 2030) 14) (test (gcd 958876033949638283967045624731391031146081240 9834415) 166685) (test (gcd 4731349833403602529573388098680617532624192 14868) 14868) (test (gcd 6375001358038970462026761077388061675464000 430513678) 430513678) (test (gcd 254088526608579040642428151389718385042344800 4799428101) 255411) (test (gcd 21140490542258031885408065086507444825621023648 164778747198) 13189686) (test (gcd 34214837305812460226811046733375808000 4312787868) 746028) (test (gcd 11450197571956515037245443769386989035470896800 75585518430279) 5814270648483) (test (gcd 1211397915863796187148880114197307052796506376580 538601201880) 11708721780) (test (gcd 5454139401260819402160859765169199667337088 30452838731872) 48414687968) (test (gcd 744935981632690384026127091216926530879171660 1032747922358460) 60868033380) (test (gcd 324574326062026951443376280715122947502400 103751223626207988025) 3334229637375325) (test (gcd 15272163751269260921486082393684080908800 6484309049057400) 341279423634600) (test (gcd 386527546655781220813671331401971490218262720 3481571963427119100) 1915440648660) (test (gcd 3189682029126430413458911948222943640000 -6724598925622907976570) 829921474949490) (test (gcd -709403542855323660533377490060722241678400 7) 7) (test (gcd 139803787314578422635552652090095842837312147438904 123) 123) (test (gcd 171985399350431759069945935900956183322827030835560 18241) 18241) (test (gcd 33090522521924986387051477884789600000 26187) 609) (test (gcd 1733723010009930088165729903139785699319986530 372945) 7935) (test (gcd 56408303994570817306318494803635460247582000 5761730) 10810) (test (gcd 25845509336769185412951159262424903513866295760 64371378271) 64371378271) (test (gcd 624970361450506104794172455132584603069611058500 108222780) 108222780) (test (gcd 82823962548382643645255524843049561752323600 135325929794) 12302357254) (test (gcd 170620453449723034746079844571491973300000 9460614789626) 230746702186) (test (gcd 125144597811313015929871740675462711600000 12764411911636) 12726233212) (test (gcd 257193319319332344553297882967977761077115600 6510126541380) 158783574180) (test (gcd 879624546681838385457288074812140664728758550 10045784120501316) 80757786714) (test (gcd 18300938860777100857669855248554588369659200 118088077425391892) 1433647093268) (test (gcd 8394780474625841647581984803260010511075000 746584618179400) 11198041400) (test (gcd 146802334713757872619395774222116859916800 718775571956687400) 854667743111400) (test (gcd 240155883351717999820072393833707008014911556000 -1350921510529331832) 10157304590446104) (test (gcd -918942437243241528855354123800826649596480 -74343962238703160850) 3476056267530) (test (gcd 1361069299753299783990135442290762165844800 8281085446358585640) 8546011812547560) (test (gcd 111738283365989051/177100989030047175 5964153172084899/4217293152016490) 1/149377357650353093734710215583150) (test (gcd 11571718688839/18340740190704 5168247530883/3654502875938) 1/33513143886879715286440176) (test (gcd 130441933147714940/206745572560704147 14398739476117879/10181446324101389) 1/2104968949772418231181062860760183) (test (gcd 137528045312/217976794617 63018038201/44560482149) 1/9713151065427067791933) (test (gcd 205632218873398596256/325919355854421968365 16616132878186749607/11749380235262596085) 1/5590292610168557896833020882635974965) (test (gcd 22803850947114245497/36143248623210700400 1180872205318713601/835002744095575440) 1/34295127023760867970857561935725200) (test (gcd 326267455807135/517121682660006 30122754096401/21300003689580) 1/1835782291436657618117489580) (test (gcd 3447601211185766107/5464318637170278738 202605639573839043/143263821649299118) 1/391419585335252015613280949198776542) (test (gcd 3816473305410548/6048967074079039 423859315570607/299713796309065) 313/1812958885520765991472282188535) (test (gcd 397560349370386783/630118245525664765 34761632124320657/24580185800219268) 17/15488423551129023359673258461692020) (test (gcd 4640282259296926456/7354673373747273033 489133282872437279/345869461223138161) 1/2543756917250129165517177396348512313) (test (gcd 483615324366283/766512153894657 175568277047523/124145519261542) 1/95159049365535186345899381094) (test (gcd 50247984153525417450/79641170620168673833 2850877693509864481/2015874949414289041) 1/160546640795227287934843564657515364153) (test (gcd 5409303924479/8573543875303 886731088897/627013566048) 1/5375728318922723466512544) (test (gcd 5680010011095224105765/9002602871306688466954 40114893348711941777/28365513113449345692) 1/127681724900613301985499022520606932131084) (test (gcd 615582794569/975675645481 152139002499/107578520350) 19/104961742282377144038350) (test (gcd 6189245291/9809721694 1855077841/1311738121) 1/12867785902420496974) (test (gcd 6234549927241963/9881527843552324 1023286908188737/723573111879672) 1/105147174292423231311078293496) (test (gcd 65470613321/103768467013 10812186007/7645370045) 1/793348329316760825585) (test (gcd 6586818670/10439860591 4478554083/3166815962) 1/33061117160633553542) (test (gcd 7530699980955811472069/11935877073996486182239 96845919575610633161/68480406462161287469) 1/817373713509671731923053344199644801063091) (test (gcd 753110839881/1193652440098 367296043199/259717522849) 1/310012454884916918799202)) ;;; -------------------------------------------------------------------------------- ;;; lcm ;;; -------------------------------------------------------------------------------- (test (lcm (* 512 500057) (* 128 500057) (* 2048 500057)) 1024116736) (test (lcm (/ (expt 2 10)) (/ (expt 3 10))) 1) (test (lcm (/ (expt 2 57) 3) (/ 63 11)) 9079256848778919936) (test (lcm (/ 3 (expt 2 10)) (/ 2 (expt 3 10))) 6) (test (lcm (/ 3 (expt 2 40)) (/ 2 (expt 3 10))) 6) (test (lcm (/ 3 (expt 2 60)) (/ 2 (expt 2 30))) 3/536870912) (test (lcm (/ 3 (expt 2 60)) (/ 2 (expt 3 30))) 6) (test (lcm -1 -1) 1) (test (lcm -1 -10) 10) (test (lcm -1 -1234) 1234) (test (lcm -1 -2) 2) (test (lcm -1 -3) 3) (test (lcm -1 -500029) 500029) (test (lcm -1 0) 0) (test (lcm -1 1) 1) (test (lcm -1 10) 10) (test (lcm -1 1234) 1234) (test (lcm -1 2) 2) (test (lcm -1 3) 3) (test (lcm -1 500029) 500029) (test (lcm -1) 1) (test (lcm -1/2 -2) 2) (test (lcm -1234 -1) 1234) (test (lcm -1234 -10) 6170) (test (lcm -1234 -1234) 1234) (test (lcm -1234 -2) 1234) (test (lcm -1234 -3) 3702) (test (lcm -1234 -500029) 617035786) (test (lcm -1234 0) 0) (test (lcm -1234 1) 1234) (test (lcm -1234 10) 6170) (test (lcm -1234 1234) 1234) (test (lcm -1234 2) 1234) (test (lcm -1234 3) 3702) (test (lcm -1234 500029) 617035786) (test (lcm -1234) 1234) (test (lcm -2 -1) 2) (test (lcm -2 -10) 10) (test (lcm -2 -1234) 1234) (test (lcm -2 -2) 2) (test (lcm -2 -3) 6) (test (lcm -2 -500029) 1000058) (test (lcm -2 0) 0) (test (lcm -2 1) 2) (test (lcm -2 10) 10) (test (lcm -2 1234) 1234) (test (lcm -2 2) 2) (test (lcm -2 3) 6) (test (lcm -2 500029) 1000058) (test (lcm -2) 2) (test (lcm -500029 -1) 500029) (test (lcm -500029 -10) 5000290) (test (lcm -500029 -1234) 617035786) (test (lcm -500029 -2) 1000058) (test (lcm -500029 -3) 1500087) (test (lcm -500029 -500029) 500029) (test (lcm -500029 0) 0) (test (lcm -500029 1) 500029) (test (lcm -500029 10) 5000290) (test (lcm -500029 1234) 617035786) (test (lcm -500029 2) 1000058) (test (lcm -500029 3) 1500087) (test (lcm -500029 500029) 500029) (test (lcm -500029) 500029) (test (lcm 0 -1) 0) (test (lcm 0 -10) 0) (test (lcm 0 -1234) 0) (test (lcm 0 -2) 0) (test (lcm 0 -3) 0) (test (lcm 0 -500029) 0) (test (lcm 0 0 0 10) 0) (test (lcm 0 0) 0) (test (lcm 0 1) 0) (test (lcm 0 10 10 1234) 0) (test (lcm 0 10) 0) (test (lcm 0 1234 -1234 10) 0) (test (lcm 0 1234) 0) (test (lcm 0 2) 0) (test (lcm 0 3) 0) (test (lcm 0 500029) 0) (test (lcm 0) 0) (test (lcm 1 -1) 1) (test (lcm 1 -10) 10) (test (lcm 1 -1234) 1234) (test (lcm 1 -2) 2) (test (lcm 1 -3) 3) (test (lcm 1 -500029) 500029) (test (lcm 1 0 -1 1) 0) (test (lcm 1 0) 0) (test (lcm 1 1 2 -10) 10) (test (lcm 1 1) 1) (test (lcm 1 10) 10) (test (lcm 1 1234) 1234) (test (lcm 1 2) 2) (test (lcm 1 3) 3) (test (lcm 1 500029) 500029) (test (lcm 1) 1) (test (lcm 1/2 -2) 2) (test (lcm 1/2 2) 2) (test (lcm 1/21 1/33) 1/3) (test (lcm 1/3 1/6 5/12 2) 10) (test (lcm 1/3 1/6 5/12) 5/3) (test (lcm 1/3 2/3) 2/3) (test (lcm 1/3 3/4 5/8) 15) (test (lcm 1/3 3/4) 3) (test (lcm 1024 9765625) 10000000000) (test (lcm 1234 -1) 1234) (test (lcm 1234 -10) 6170) (test (lcm 1234 -1234) 1234) (test (lcm 1234 -2) 1234) (test (lcm 1234 -3) 3702) (test (lcm 1234 -500029) 617035786) (test (lcm 1234 0 -1234 1234) 0) (test (lcm 1234 0) 0) (test (lcm 1234 1) 1234) (test (lcm 1234 10 0 1) 0) (test (lcm 1234 10) 6170) (test (lcm 1234 1234 1 -10) 6170) (test (lcm 1234 1234) 1234) (test (lcm 1234 2) 1234) (test (lcm 1234 3) 3702) (test (lcm 1234 500029) 617035786) (test (lcm 1234) 1234) (test (lcm 131072 762939453125) 100000000000000000) (test (lcm 14 35) 70) (test (lcm 1741 2063 3137 3797 3251 3 19) 7927658615618708709) (test (lcm 2 -1) 2) (test (lcm 2 -10) 10) (test (lcm 2 -1234) 1234) (test (lcm 2 -2) 2) (test (lcm 2 -3) 6) (test (lcm 2 -500029) 1000058) (test (lcm 2 0 2 -2) 0) (test (lcm 2 0) 0) (test (lcm 2 1 -3 -1) 6) (test (lcm 2 1) 2) (test (lcm 2 10) 10) (test (lcm 2 1234) 1234) (test (lcm 2 2 10 10) 10) (test (lcm 2 2) 2) (test (lcm 2 3) 6) (test (lcm 2 3/4) 6) (test (lcm 2 500029) 1000058) (test (lcm 2) 2) (test (lcm 262144 3814697265625) 1000000000000000000) (test (lcm 3 500029) 1500087) (test (lcm 3) 3) (test (lcm 3/4 2) 6) (test (lcm 32 -36) 288 ) (test (lcm 323 28747 27113) 41021969) (test (lcm 4242884/3 1907348632815/7) 8092658996592638460) (test (lcm 500029 -1) 500029) (test (lcm 500029 -10) 5000290) (test (lcm 500029 -1234) 617035786) (test (lcm 500029 -2) 1000058) (test (lcm 500029 -3) 1500087) (test (lcm 500029 -500029) 500029) (test (lcm 500029 0) 0) (test (lcm 500029 1) 500029) (test (lcm 500029 10) 5000290) (test (lcm 500029 1234) 617035786) (test (lcm 500029 2) 1000058) (test (lcm 500029 3) 1500087) (test (lcm 500029 500029) 500029) (test (lcm 500029) 500029) (test (lcm 524288 -17500000000001) 9175040000000524288) (test (lcm 524288 17500000000001) 9175040000000524288) (test (lcm 524288/3 1907348632815/7) 1000000000001310720) (test (lcm) 1 ) (test (lcm) 1) (test (lcm 2755 13) 35815) (test (lcm 56 2) 56) (test (lcm 148665 2) 297330) (test (lcm 71862 203) 71862) (test (lcm 21568911 41) 21568911) (test (lcm 15295874 111) 45887622) (test (lcm 20430054 41) 20430054) (test (lcm 248255254 767) 14647059986) (test (lcm 510104442 5453) 2781599522226) (test (lcm 242162410 41) 9928658810) (test (lcm 660070972 74) 660070972) (test (lcm 6542405452 117) 765461437884) (test (lcm 629448534 2) 629448534) (test (lcm 163873565922 155) 819367829610) (test (lcm 1563464979842 442) 20325044737946) (test (lcm 3712337724 576173) 92997772323924) (test (lcm 4380921044390 5) 4380921044390) (test (lcm 4097970629150 86) 176212737053450) (test (lcm 2090198664 1118) 1168421053176) (test (lcm 5275411661289 31857) 8002799490175413) (test (lcm 38602581835881 19) 733449054881739) (test (lcm 82578867500655 319) 908367542507205) (test (lcm 363169800 20) 363169800) (test (lcm 2033404107084 23374) 23764393799490708) (test (lcm 7438317458260 31213) 17859400217282260) (test (lcm 390609000 11) 4296699000) (test (lcm 406117800 57) 7716238200) (test (lcm 1008217762344 4403) 119977913718936) (test (lcm 136581511784536 67022) 147644614239083416) (test (lcm 43293168048 1344610) 29106213344510640) (test (lcm 608503422693864 47) 608503422693864) (test (lcm 6945109296864 779) 284749481171424) (test (lcm 1346702251365156 435) 6733511256825780) (test (lcm 1388225063690465 644) 127716705859522780) (test (lcm 1200780158492850 91686) 311002061049648150) (test (lcm 1551193257090906 2656731) 2356262557521086214) (test (lcm 386512944051107445 17) 386512944051107445) (test (lcm 1111364125679340 6) 1111364125679340) (test (lcm 15858537083857314 21793) 15858537083857314) (test (lcm 44179338013272 280645) 302407568700846840) (test (lcm 64149298745840 43808357) 79994175536062480) (test (lcm 4412914630225794 515823) 48542060932483734) (test (lcm 169216424701305960 17) 2876679219922201320) (test (lcm 178335507754891305 817) 178335507754891305) (when (provided? 'overflow-checks) (num-test (lcm 10781274/17087915 3880899/2744210) (/ (* 10781274/17087915 3880899/2744210) (gcd 10781274/17087915 3880899/2744210))) (num-test (lcm 190537/301994 114243/80782) (/ (* 190537/301994 114243/80782) (gcd 190537/301994 114243/80782))) (num-test (lcm 397573379/630138897 131836323/93222358) (/ (* 397573379/630138897 131836323/93222358) (gcd 397573379/630138897 131836323/93222358)))) (num-test (lcm 10400200/16483927 1607521/1136689) (/ (* 10400200/16483927 1607521/1136689) (gcd 10400200/16483927 1607521/1136689))) (num-test (lcm 12/19 41/29) (/ (* 12/19 41/29) (gcd 12/19 41/29))) (num-test (lcm 12941/20511 3363/2378) (/ (* 12941/20511 3363/2378) (gcd 12941/20511 3363/2378))) (num-test (lcm 15601/24727 19601/13860) (/ (* 15601/24727 19601/13860) (gcd 15601/24727 19601/13860))) (num-test (lcm 171928773/272500658 54608393/38613965) (/ (* 171928773/272500658 54608393/38613965) (gcd 171928773/272500658 54608393/38613965))) (num-test (lcm 2/3 3/2) (/ (* 2/3 3/2) (gcd 2/3 3/2))) (num-test (lcm 253/401 577/408) (/ (* 253/401 577/408) (gcd 253/401 577/408))) (num-test (lcm 4201378396/6659027209 318281039/225058681) (/ (* 4201378396/6659027209 318281039/225058681) (gcd 4201378396/6659027209 318281039/225058681))) (num-test (lcm 5/8 17/12) (/ (* 5/8 17/12) (gcd 5/8 17/12))) (num-test (lcm 53/84 99/70) (/ (* 53/84 99/70) (gcd 53/84 99/70))) (num-test (lcm 53715833/85137581 9369319/6625109) (/ (* 53715833/85137581 9369319/6625109) (gcd 53715833/85137581 9369319/6625109))) (num-test (lcm 665/1054 1393/985) (/ (* 665/1054 1393/985) (gcd 665/1054 1393/985))) (num-test (lcm 7161071/11350029 275807/195025) (/ (* 7161071/11350029 275807/195025) (gcd 7161071/11350029 275807/195025))) (num-test (lcm 79335/125743 47321/33461) (/ (* 79335/125743 47321/33461) (gcd 79335/125743 47321/33461))) (num-test (lcm -2305843009213693951/4611686018427387903) 2305843009213693951/4611686018427387903) (let () (define (flcm n) (if (<= n 1) 1 (lcm n (flcm (- n 1))))) (test (flcm 9) 2520) (test (flcm 40) 5342931457063200) (if with-bignums (test (flcm 100) 69720375229712477164533808935312303556800))) (when with-bignums (num-test (let ((n 1)) (do ((i 2 (+ i 1))) ((= i 100)) (set! n (lcm n i))) n) 69720375229712477164533808935312303556800) (num-test (lcm -9223372036854775808 -9223372036854775808) 9223372036854775808) (num-test (lcm -9223372036854775808 9223372036854775807 -9223372036854775808) 85070591730234615856620279821087277056) (num-test (lcm 1/21 1/2432902008176640001) 1) (num-test (lcm 132120577 33292289 260046847) 1143841133453061178785791) (num-test (lcm 132120577 33292289) 4398596432330753) (num-test (lcm 132120577/12 33292289/6 260046847/4) 1143841133453061178785791/2) (num-test (lcm 2/132120577 3/33292289 4/260046847) 12) (num-test (lcm 21 2432902008176640001) 51090942171709440021) (num-test (lcm 2353913150770005286438421033702874906038383291674012942337 9641628265553941653251772554046975615133217962696757011808257) 22695555569123220026272727097682721551725929819788097280747860983024240452040931523149698041303750665450606153441476609) (num-test (lcm 2432902008176640001 21) 51090942171709440021) (num-test (lcm 2432902008176640001/21 21/2432902008176640001) 51090942171709440021) (num-test (lcm 557057 23068673 167772161) 2155967190204955525121) (num-test (lcm 9223372036854775807 -9223372036854775808) 85070591730234615856620279821087277056) (num-test (lcm 524288 19073486328125) 10000000000000000000) (num-test (lcm 2147483648 4656612873077392578125) 10000000000000000000000000000000) (num-test (lcm (/ (expt 2 57) 3) (/ 65 11)) 9367487224930631680) (num-test (lcm 460683358924445799142 518) 460683358924445799142) (num-test (lcm 113021475230160 74635) 1243236227531760) (num-test (lcm 74228340534140364 363909) 16107549895908458988) (num-test (lcm 69242022961311060 48305942) 55324376346087536940) (num-test (lcm 286967952870300 2273388) 4181983977178881900) (num-test (lcm 302822258393413362492399 29) 302822258393413362492399) (num-test (lcm 10491072879382200 133) 10491072879382200) (num-test (lcm 167206737423420464 609) 14546986155837580368) (num-test (lcm 72212583812867784 4888799) 7511336330463068288328) (num-test (lcm 4170116471639397292390 1798025) 20850582358196986461950) (num-test (lcm 83910330283522050 35224) 12418728881961263400) (num-test (lcm 275373383775647594346 66884092) 175688218848863165192748) (num-test (lcm 14656657495570695990 37) 542296327336115751630) (num-test (lcm 95470974177676509874110 1219) 95470974177676509874110) (num-test (lcm 619506317623001424 5957) 527199876297174211824) (num-test (lcm 11268171656665155960 9858) 597213097803253265880) (num-test (lcm 6172860073826160 5167394) 10376577784101774960) (num-test (lcm 26457493095663264 1491412) 9974474897065050528) (num-test (lcm 8481384175941103284 313836405) 52191512141200849929103020) (num-test (lcm 60356595775749199080 176098815946) 6192647083187643574807080) (num-test (lcm 611492274956002440 37) 611492274956002440) (num-test (lcm 164614611843685080 1711) 4773823743466867320) (num-test (lcm 93177516542679418720 62197) 156631405308244102868320) (num-test (lcm 938959746797519770440 127558) 938959746797519770440) (num-test (lcm 137670522526899326250 200) 550682090107597305000) (num-test (lcm 852063402206742880 41643478) 607521205773407673440) (num-test (lcm 55947291202307909360 188546228) 1657550396450776430608720) (num-test (lcm 12877971214039423262680 9832253830) 1040166612929178256349926280) (num-test (lcm 192158415774146059920 53) 192158415774146059920) (num-test (lcm 902814024155808960 1829) 53266027425192728640) (num-test (lcm 1265864304573235487120 4921) 24051421786891474255280) (num-test (lcm 14172662463567665400 95817) 23824245601257245537400) (num-test (lcm 32171996211745702482324 2368555) 294212905356414449200852980) (num-test (lcm 971324258606045826300 4576748) 18836891347147046709435900) (num-test (lcm 2400649320046378377000 1704690) 4400390203645011565041000) (num-test (lcm 953233796456393760 18342152493) 30445334225020760300640) (num-test (lcm 28906333140964843080 236206740) 8296117611456909963960) (num-test (lcm 775403093708557121609032 41) 775403093708557121609032) (num-test (lcm 12587009808135760402860 2491) 667111519831195301351580) (num-test (lcm 510685807527370566909720 76) 9703030343020040771284680) (num-test (lcm 9842598153710524682146590 10089) 29527794461131574046439770) (num-test (lcm 44936631038618189620242012 30740) 224683155193090948101210060) (num-test (lcm 934589372977008750144 373650) 1238330919194536593940800) (num-test (lcm 33027125273398900134069150 840577803) 33027125273398900134069150) (num-test (lcm 4428219127938822420288 1695783782) 600648070732749811910284608) (num-test (lcm 29316428815807608915440 560764380) 107210180179408425803764080) (num-test (lcm 1364397376360544429904 19) 1364397376360544429904) (num-test (lcm 4991450791697293128313385277 329) 234598187209772777030729108019) (num-test (lcm 75448279792981695149550 3009) 75674624632360640234998650) (num-test (lcm 181031604499464166188731133 3364) 608990317536197455058891531412) (num-test (lcm 405831142402606479845286 2746214) 6899129420844310157369862) (num-test (lcm 89170366469003867207160 25337230) 196977339530029542660616440) (num-test (lcm 13523725766340619200 1490114045) 704734873409776007131200) (num-test (lcm 104705939487154940255412 192200052) 768227478017255796653957844) (num-test (lcm 7232591421499800642000 16584679460) 15338901584491041700955526000) (num-test (lcm 14043796716396386984750160 33382708236) 1306073094624863989581764880) (num-test (lcm 13894638105872256412416 23) 13894638105872256412416) (num-test (lcm 147611447155643499428400 118) 8709075382182966466275600) (num-test (lcm 13356594697070649024 4558) 574333571974037908032) (num-test (lcm 15089731174706036171537760 90) 45269193524118108514613280) (num-test (lcm 307230141273924828960 1971507) 383115986168584261713120) (num-test (lcm 2582563944548247741930009096 22873474) 33573331279127220645090118248) (num-test (lcm 1074296602920111687342072 146235518) 7220347468226070650626065912) (num-test (lcm 774058642832724262993980 407557010) 124623441496068606342030780) (num-test (lcm 291091930213008490369569480 13412544348) 147286985941108248965685135059880) (num-test (lcm 2089068565149831833568 7302038455228) 223766401218893937188969184) (num-test (lcm 1064437567441124038217970656 5) 5322187837205620191089853280) (num-test (lcm 142557826750459447787460 1333) 6129986550269756254860780) (num-test (lcm 311779340580033594160200 23693) 311779340580033594160200) (num-test (lcm 29314187023691666530559664 110143) 29314187023691666530559664) (num-test (lcm 222003853016244177637944900 857463) 222003853016244177637944900) (num-test (lcm 6247776111945111006243552 77976501) 193681059470298441193550112) (num-test (lcm 1140058514761397155259712 5530338) 12540643662375368707856832) (num-test (lcm 580962736822969724865449808 55686036) 21495621262449879820021642896) (num-test (lcm 4100502596989506786787500 45333475410) 329750117342105167273090387500) (num-test (lcm 1497378750311599979536944 262630276090) 1089215763657912499114866119760) (num-test (lcm 105637634198318524045536 2633013240) 1853412292009498504378929120) (num-test (lcm 11415822547029425161364106595632 7) 79910757829205976129548746169424) (num-test (lcm 198305933339312916107438448 177) 11700050067019462050338868432) (num-test (lcm 3127415425979879537134790928 3335) 15637077129899397685673954640) (num-test (lcm 589703503861221139260034914750 13209) 21819029642865182152621291845750) (num-test (lcm 3108579252052448504121792 14322) 96365956813625903627775552) (num-test (lcm 636976201153021006473464400 66264077) 12102547821907399122995823600) (num-test (lcm 9544425315508129998909285900 1488396) 66810977208556909992365001300) (num-test (lcm 458100280193857502802977376 260747103934) 19226926860016393250143763448096) (num-test (lcm 114208186302155358124900650 22076867505) 397558696517802801632779162650) (num-test (lcm 90107067439719108194114160 28566806069714) 755187332212285845774870774960) (num-test (lcm 2976572787365723002218245484 110104803958578) 110463592711929346335321308156724) (num-test (lcm 53453375725613238735360 17) 908707387335425058501120) (num-test (lcm 888822833524306124874229800 106) 888822833524306124874229800) (num-test (lcm 21275338550698297089687698855820 3021) 21275338550698297089687698855820) (num-test (lcm 417525245705449941528380320750068 5828) 417525245705449941528380320750068) (num-test (lcm 1954871230146370370001829871352 22765249) 1954871230146370370001829871352) (num-test (lcm 903057827710908645847577520 648545995) 1126113111155503081371929167440) (num-test (lcm 6002846634833433581621040 28493572159) 6137376430766685661618749127440) (num-test (lcm 26428903214964558277189300080 100428856) 766438193233972190038489702320) (num-test (lcm 470486531607553676511206181180 28495896) 4523257514875021045978736225864520) (num-test (lcm 483599554429365539310928369206620 5577334078910) 25630776384756373583479203567950860) (num-test (lcm 134511400157705323668887400 1285071093558916) 508298000951744289230204144827800) (num-test (lcm 25897125642468049125349982599216 1183846707540) 1165370653911062210640749216964720) (num-test (lcm 1118034209930460291955200 3) 1118034209930460291955200) (num-test (lcm 16297594064835666104344589410644 413) 16297594064835666104344589410644) (num-test (lcm 536762539932642345554192060100 1378) 536762539932642345554192060100) (num-test (lcm 933250179448203335817687635834340 58029) 784863400915939005422675301736679940) (num-test (lcm 65573457048202714607131200 486115) 8721269787410961042748449600) (num-test (lcm 85664559165674439863772868932 322014) 85664559165674439863772868932) (num-test (lcm 7232817686074320060728552759760 11307940) 7232817686074320060728552759760) (num-test (lcm 78400098291720425971762131120 5646921093) 78400098291720425971762131120) (num-test (lcm 345445746644065669842240 19727989065) 3106593599570082568891264320) (num-test (lcm 627854758484491743169777558200 750371721805653) 3013801413922642432418609934436637400) (num-test (lcm 788233263079483492974876830792850 7170146100) 963221047483128828415299487228862700) (num-test (lcm 18378856389802641496737518160 6247594493140) 139293352578314219903773650134640) (num-test (lcm 9620902642431357480148667659080 59) 9620902642431357480148667659080) (num-test (lcm 16008524600631853118144316000 629) 10069361973797435611312774764000) (num-test (lcm 4342138447708715023205684275423920 53041) 134606291878970165719376212538141520) (num-test (lcm 2431833161592653384508687244500 47541) 2431833161592653384508687244500) (num-test (lcm 39424620224103957589082132160 1671734) 39424620224103957589082132160) (num-test (lcm 652830233576052788654372406432 552231327) 28071700043770269912138013476576) (num-test (lcm 6892963340916411083970414000 3662431431) 323969277023071320946609458000) (num-test (lcm 29102758215190063506219566460000 10565720) 29102758215190063506219566460000) (num-test (lcm 21253900104556838003127171970777418412 1182797770) 400954825472464748928994099228715998342380) (num-test (lcm 3964268932242030284914943132662620 21244177854110) 4547016465281608736797439773164025140) (num-test (lcm 6070388091189460078138338240 40809131994181213) 903741167852013248053001382156480) (num-test (lcm 9685989954133695108793384134000 964113514382876) 55084224869158324083707975570058000) (num-test (lcm 56468122001858834917195045500 429400787158167902) 11597366428619765656458601249744500) (num-test (lcm 18843408973202596901221568364900 47) 18843408973202596901221568364900) (num-test (lcm 7800980538292163259967028613764250 6) 7800980538292163259967028613764250) (num-test (lcm 270433907726619219545089642715200 3422) 15955600555870533953160288920196800) (num-test (lcm 45771666919597903071546708768 2342359) 49112998604728549995769618508064) (num-test (lcm 47198294949461301503537593835384892 314502) 2501509632321448979687492473275399276) (num-test (lcm 3165335901519110207943908102359110 14953473) 228660700189839002311659977406319747290) (num-test (lcm 189219585097956261544520863361400 35605794) 189219585097956261544520863361400) (num-test (lcm 38532137569034426600955256933810890813 1341358608707) 8030213065799481606918878410776991078101639) (num-test (lcm 1396277868664090735481380981225896 312520860) 6981389343320453677406904906129480) (num-test (lcm 864038349500762576564773759109700 714136202724) 37153649028532790792285271641717100) (num-test (lcm 12514185871591242579049167322464 10706997440178) 667894614152696207686433109167226144) (num-test (lcm 1981802660405609330969478067056636 33312289752) 4466983196554243432005203563145657544) (num-test (lcm 979313401024175219420658240 125278417383795) 79100122714123656647825986703040) (num-test (lcm 4074026154111369481048033354344 29) 4074026154111369481048033354344) (num-test (lcm 599666571180604695702511920885005100 129) 599666571180604695702511920885005100) (num-test (lcm 5703263639326551702474610108800 1978) 5703263639326551702474610108800) (num-test (lcm 134137932950214683609064669163440 190619) 178805864622636173250883203994865520) (num-test (lcm 344735091370772631136645455600 1048985) 344735091370772631136645455600) (num-test (lcm 6759508339299085316106145385400 4969610) 209544758518271644799290506947400) (num-test (lcm 700334422308861928135313594400 228529587) 370476909401387959983580891437600) (num-test (lcm 10277417891211405957191810814198480 2516552038) 113051596803325465529109918956183280) (num-test (lcm 490099971577877358878082782880 9282588354) 259262884964697122846505792143520) (num-test (lcm 1954558750269048828645390249600 5575829490) 33227498754573830086971634243200) (num-test (lcm 1360588454560018295496656378989200 7868178296420) 719751292462249678317731224485286800) (num-test (lcm 4337552841738910859248770564912480 17722936528737830) 227361507305428490509242806701017464160) (num-test (lcm 215913068853045803981566931862756 7009479781500) 516383093295665670947415013416263818500) (num-test (lcm 44890707654126305940250882318870941900 18329973480720) 538688491849515671283010587826451302800) (num-test (lcm 28579720891831355496720656680837200 3) 28579720891831355496720656680837200) (num-test (lcm 29332703209780553199747293473184160 1711) 1730629489377052638785090314917865440) (num-test (lcm 3648979393315349438003046604440000 186) 3648979393315349438003046604440000) (num-test (lcm 1159760236369472473822068077011807878780 25714) 1159760236369472473822068077011807878780) (num-test (lcm 158186359726371025615685433600 31395) 1107304518084597179309798035200) (num-test (lcm 331091450443070201468559735703944 28424) 331091450443070201468559735703944) (num-test (lcm 9734443639363161342241553023288200 1961348207) 301767752820258001609488143721934200) (num-test (lcm 701896612128009033011419603540080 51300) 10528449181920135495171294053101200) (num-test (lcm 86169288128517384618860929451245320 5032162527446) 2406794386717619069789404620502733032920) (num-test (lcm 64828800524794653881296183831741773624 4645294472) 47389853183624891987227510381003236519144) (num-test (lcm 49068907706533938991402184550000 268183371225) 17713875682058751975896188622550000) (num-test (lcm 1708602980304476478496020543612288 4083128544) 52966692389438770833376636851980928) (num-test (lcm 17608179287674151740172985536160 980399424528) 188284261123099704557669734338158880) (num-test (lcm 43194437079731225735521919644800 178119261126453036) 95416511509126277649767920495363200) (num-test (lcm 817555977437791699707628651571149344 59) 817555977437791699707628651571149344) (num-test (lcm 19062946261334997559157066059536 533) 247818301397354968269041858773968) (num-test (lcm 6533849124840489114353090499099000 598) 150278529871331249630121081479277000) (num-test (lcm 427663965127849896842400211428345149025 234) 855327930255699793684800422856690298050) (num-test (lcm 352395507261316174741530450071590608 154734) 14448215797713963164402748452935214928) (num-test (lcm 391579493632653867660919800000 9221565) 5598412020466052345948170380600000) (num-test (lcm 2618798923882923048581401148931738000 681876) 34044386010477999631558214936112594000) (num-test (lcm 174712575449141140214591110997980800 233260339838) 323043552005461968256778964235266499200) (num-test (lcm 88598141227372995032227898284800 1929763976) 1101009101032564209265496091985209600) (num-test (lcm 210110141308655567793064872567302676320 720390430628) 322939287191403607697940709135944213503840) (num-test (lcm 668425085137718599277317523827419000 19898594339442) 226544635130131000822866287128160329737000) (num-test (lcm 89533471731097208414073727453200 4173840860670546) 165547389230798738357622322060966800) (num-test (lcm 113987439157802480362236410675251462620 21548296273949445) 2165761343998247126882491802829777789780) (num-test (lcm 48129335993995093308894209644253760 1009442888504820) 572305934304595654536061046879821460160) (num-test (lcm 3497836376962291922989777163497680 138736290091634664) 143411291455453968842580863703404880) (num-test (lcm 11371924962562208722154622794880 3) 11371924962562208722154622794880) (num-test (lcm 9451631862008339290824315653784000 703) 349710378894308553760499679190008000) (num-test (lcm 16869347753325980368094612370435598560 806) 16869347753325980368094612370435598560) (num-test (lcm 4701845646467068759127854100132739552 3198) 2506083729566947648615146235370750181216) (num-test (lcm 1029865193584911347147121232800485280 1005771) 42224472936981365233031970544819896480) (num-test (lcm 10657125216930337802109861408000 2415138) 9069213559607717469595492058208000) (num-test (lcm 14382707743772734802155022983680 247913634) 24608812949595149246487244325076480) (num-test (lcm 60134748581470366378101904574533857248 54828228) 6674957092543210667969311407773258154528) (num-test (lcm 214830664120540781167218700750596000 505665810) 9237718557183253590190404132275628000) (num-test (lcm 48933004118344447687599112101802800 6263883444) 2887047242982322413568347614006365200) (num-test (lcm 5498670161558110606435630054129739400 262699548132) 1072697071127240891435282017849791951370200) (num-test (lcm 35941673649029587182509620977230062500 25622409466332) 1752120648716543345560161513018988316812500) (num-test (lcm 1592802602494326390643157055239113248 736377633395508) 1221679596113148341623301461368399861216) (num-test (lcm 4043816553144402557587143272522043028314 5011466158645380) 55359848612546871013367991400826769057618660) (num-test (lcm 7171921165220830707276631005512550 1765284492289500) 71719211652208307072766310055125500) (num-test (lcm 2402189359210218692854826119405968750 23) 55250355261835029935661000746337281250) (num-test (lcm 26149068753160488131648964110990162400 1147) 967515543866938060871011672106636008800) (num-test (lcm 556184059176863945810376239306506311552 4089) 556184059176863945810376239306506311552) (num-test (lcm 67871323087036310486238021899264593800 13395) 67871323087036310486238021899264593800) (num-test (lcm 12750401179065252879838440979200 7177173) 12750401179065252879838440979200) (num-test (lcm 278110245000092733617125071646080 17748) 278110245000092733617125071646080) (num-test (lcm 13408203364935178481017292708752000 50619404) 496103524502601603797639830223824000) (num-test (lcm 124271828931784534297423756437875067000 8839796595) 270042684268767793028301822739502520591000) (num-test (lcm 11893442806922081156953529319100769836176 972789007267) 11762614936045938264227040496590661367978064) (num-test (lcm 352581052555284857902053030133344488264100 923561430099) 5993877893439842584334901512266856300489700) (num-test (lcm 6108908012714804315575319947340956346976 31944833628092) 2009830736183170619824280262675174638155104) (num-test (lcm 67475643422116264959949054821520228800 22515435540) 4655819396126022282236484782684895787200) (num-test (lcm 470601888939348535946408832 5135943991060962937) 65492053197870222825732159796881558144) (num-test (lcm 110759232155568113345545635903016614000 30159198663300) 110759232155568113345545635903016614000) (num-test (lcm 146100914712024458707469587112300146320 26868173101560) 380954774790565399517176676594819048626034640) (num-test (lcm 12173192708601511002951184416658091200 466645866900785428350) 3795589313349242529209176349929576178068800) (num-test (lcm 5784684831478746253226687170890240 13) 5784684831478746253226687170890240) (num-test (lcm 35042260655085685815432622412891903767500 667) 35042260655085685815432622412891903767500) (num-test (lcm 2903871349270676921837488659419545120987500 530) 2903871349270676921837488659419545120987500) (num-test (lcm 630123969240840167098426767919876491188000 77691) 1890371907722520501295280303759629473564000) (num-test (lcm 33192703032132982013024959634241667249800 4684718) 1228130012188920334481923506466941688242600) (num-test (lcm 4731525733734729472809717145544850000 90706055) 4731525733734729472809717145544850000) (num-test (lcm 214011009809686092216200126896120006823232 50400042) 41806836755312368428342478589030147212911547968) (num-test (lcm 5854250735296111435541950856160000 24357777002) 174403983655206455776230257955862560000) (num-test (lcm 35348208247612761916374738259136697649608 156806713508) 644786666644704390116591600584912501826499528) (num-test (lcm 612558317420289618714916924536521515286100 2377007388) 11638608030985502755583421566193908790435900) (num-test (lcm 181857299802925368992522029882739454720 21606337755618) 181857299802925368992522029882739454720) (num-test (lcm 4731635341196946327443020710970699860000 58092526675092) 354167636923932629555437543236867855220860000) (num-test (lcm 22081740554432638182773611616166588288192 61419768950540) 110408702772163190913868058080832941440960) (num-test (lcm 125627844706077784535328068665849312000 30482033400) 118925222307474416497014710218320253656864000) (num-test (lcm 1225504716872819103560254268197955520 510813364186125) 3707151768540277788269769161298815448000) (num-test (lcm 5209185280578468690281136425214396728400 2327880739319250103818) 14624765850878700374498228867533344237423825059372400) (num-test (lcm 230425011604643097634961294406535254400 31) 230425011604643097634961294406535254400) (num-test (lcm 13222608481676137093434201748083744000 893) 13222608481676137093434201748083744000) (num-test (lcm 13348198818240350339028224064019716678960 651) 2896559143558156023569124621892278519334320) (num-test (lcm 7236172685650198160266777676385295337308176 23426) 383517152339460502494139216848420652877333328) (num-test (lcm 756264162229440667711265021676693350760 28899) 756264162229440667711265021676693350760) (num-test (lcm 40915062421030872924283823601517905600 36345062) 40915062421030872924283823601517905600) (num-test (lcm 1174590526522170015825602834292923520 4991486258) 40402390340783082034353260691173690317440) (num-test (lcm 2891892862328155581145450075391651333218020 35138529818) 2891892862328155581145450075391651333218020) (num-test (lcm 1993335355070485984559797658834121810059400 535644500) 408633747789449626834758520060994971062177000) (num-test (lcm 6324295450641455215591954662726515160 367472693133) 259296113476299663839270141171787121560) (num-test (lcm 6576388154814679090356195121505112000 15901952377630) 107846189350805922402751243797562331688000) (num-test (lcm 117828556355409428513249595788296238400 565992666495795) 2013191495492007395999396032982202432871329600) (num-test (lcm 592831716700236607285748949860604000 139641978135660) 241282508696996299165299822593265828000) (num-test (lcm 106766839071170184723986891291602032000 1584924526628112) 85306704417864977594465526141990023568000) (num-test (lcm 21677148858122146832326483307664860804937400 247815827510760) 585283019169297964472815049306951241733309800) (num-test (lcm 14079549844487257384278196623697173813600 160967604100961853832) 52755411528451062517793341673751996512389960800) (num-test (lcm 2696480372014145687016224877963234647656980 2219319031453896088860) 4753894895860938846209604459849182683819255740) (num-test (lcm 13545431257849875145060979241270859310160 29) 13545431257849875145060979241270859310160) (num-test (lcm 137485634482479300158725199474868559498162500 329) 962399441377355101111076396324079916487137500) (num-test (lcm 529252417743761759027305009539254400 3243) 529252417743761759027305009539254400) (num-test (lcm 133897419738958073238580385894509887148800 330455) 133897419738958073238580385894509887148800) (num-test (lcm 3896215507210178905244623173635584334007288624 1005238) 3896215507210178905244623173635584334007288624) (num-test (lcm 17654511984514518592175290794029073043800 1060530) 511980847550921039173083433026843118270200) (num-test (lcm 16470780256339082688310222474503880382858400 913836) 16470780256339082688310222474503880382858400) (num-test (lcm 57267105834722825210001789897760395576000 2958974018) 2691553974231972784870084125194738592072000) (num-test (lcm 521977833444747522001426544601807810543216 1066521690) 112225234190620717230306707089388679266791440) (num-test (lcm 1699559962174727325529414216960251941390400 25883611479) 1422531688340246771468119699595730874943764800) (num-test (lcm 10654036597801063717295948399628964800 317449894126222) 176036646705466975800880955407069385390400) (num-test (lcm 381902381115592200811990304316262139150724960 4640335440216) 381902381115592200811990304316262139150724960) (num-test (lcm 425968526187959807410151867411382902838703889232 1882826315615025) 181036623629882918149314543649837733706449152923600) (num-test (lcm 174609167728518272531601927200939868792000 1712923655178450) 48325242369824705024158690915447549888986499656000) (num-test (lcm 3325168366561555458817274989681612518000 1699726139891780) 43227188765300220964624574865860962734000) (num-test (lcm 11429650426242566426919762928176000 7414967839104) 15647191433526073438453155448672944000) (num-test (lcm 2104794191230056678355480848036599377844400 16946684823025584) 195745859784395271087059718867403742139529200) (num-test (lcm 11894522530167763519415142641640874994880 7) 11894522530167763519415142641640874994880) (num-test (lcm 5906329981690378696996009087718418780000 185) 5906329981690378696996009087718418780000) (num-test (lcm 3056294774178096513474941936265025440000 658) 3056294774178096513474941936265025440000) (num-test (lcm 10491907660880423349353457742257185280 123369) 10491907660880423349353457742257185280) (num-test (lcm 673239479595593149777212259021965839229225628776 15470) 3366197397977965748886061295109829196146128143880) (num-test (lcm 1506608574369860432616005754109397877696 1474070) 7533042871849302163080028770546989388480) (num-test (lcm 4849814041048623250005708880379694793905000 2172220582) 4849814041048623250005708880379694793905000) (num-test (lcm 21154344928580705924176101470087564940000 5023204186) 21154344928580705924176101470087564940000) (num-test (lcm 346448039376394135288065831861806112294000 776147372) 10739889220668218193930040787715989481114000) (num-test (lcm 2339009760844587560470606952218133142645504 194201967414) 86543361151249739737412457232070926277883648) (num-test (lcm 2242982161480922111384667548175169152 21419749763490) 20736370082891124919751251482879438810240) (num-test (lcm 4717315265246821759830981157482117120 45609714193992) 8203411246264223040346076232861401671680) (num-test (lcm 16628111321698075419789804224660024289936 4643626415880804) 46708364702649893854189560067070008230430224) (num-test (lcm 115557531507210992033160068979962880 88406536976058378) 279533668715943389728214206862530206720) (num-test (lcm 21059511907771200155093927745003762840000 180298981648603620) 19859119729028241746253573863538548358120000) (num-test (lcm 2124921015128697258800067298086064536000 2282525112298516782924) 321127237090271040335932409977291910220921912000) (num-test (lcm 16015671538624533047089928322348864000 49817926936366875) 11550742548729092601556962655002835949760000) (num-test (lcm 166517667014186289390514558017250969134523800 43413708621878528404068) 6080725646357040729673420115115953639885405604600) (num-test (lcm 2780796292789128359666429021610464935722000 47) 2780796292789128359666429021610464935722000) (num-test (lcm 21297913114430245153455383503409684916193317960 58) 21297913114430245153455383503409684916193317960) (num-test (lcm 1516745257039775143654568869485529015398000 6293) 1516745257039775143654568869485529015398000) (num-test (lcm 8447692776411453120390905608381515479808 2030) 1224915452579660702456681313215319744572160) (num-test (lcm 958876033949638283967045624731391031146081240 9834415) 56573686003028658754055691859152070837618793160) (num-test (lcm 4731349833403602529573388098680617532624192 14868) 4731349833403602529573388098680617532624192) (num-test (lcm 6375001358038970462026761077388061675464000 430513678) 6375001358038970462026761077388061675464000) (num-test (lcm 254088526608579040642428151389718385042344800 4799428101) 4774577503501808752711867392764198173330701136800) (num-test (lcm 21140490542258031885408065086507444825621023648 164778747198) 264108148344429592344402957125737508206483448434464) (num-test (lcm 34214837305812460226811046733375808000 4312787868) 197795974464901832571194661165645546048000) (num-test (lcm 11450197571956515037245443769386989035470896800 75585518430279) 148852568435434695484190769002030857461121658400) (num-test (lcm 1211397915863796187148880114197307052796506376580 538601201880) 55724304129734624608848485253076124428639293322680) (num-test (lcm 5454139401260819402160859765169199667337088 30452838731872) 3430653683393055403959180792291426590755028352) (num-test (lcm 744935981632690384026127091216926530879171660 1032747922358460) 12639328800361857745771298356677592449426905555220) (num-test (lcm 324574326062026951443376280715122947502400 103751223626207988025) 10099779304072092648063539727012480757432180800) (num-test (lcm 15272163751269260921486082393684080908800 6484309049057400) 290171111274115957508235565479997537267200) (num-test (lcm 386527546655781220813671331401971490218262720 3481571963427119100) 702565997265680899293657490452822449622871959067200) (num-test (lcm 3189682029126430413458911948222943640000 6724598925622907976570) 25845014249628523826120631630482407871222520000) (num-test (lcm 709403542855323660533377490060722241678400 7) 709403542855323660533377490060722241678400) (num-test (lcm 139803787314578422635552652090095842837312147438904 123) 139803787314578422635552652090095842837312147438904) (num-test (lcm 171985399350431759069945935900956183322827030835560 18241) 171985399350431759069945935900956183322827030835560) (num-test (lcm 33090522521924986387051477884789600000 26187) 1422892468442774414643213549045952800000) (num-test (lcm 1733723010009930088165729903139785699319986530 372945) 81484981470466714143789305447569927868039366910) (num-test (lcm 56408303994570817306318494803635460247582000 5761730) 30065626029106245624267757730337700311961206000) (num-test (lcm 25845509336769185412951159262424903513866295760 64371378271) 25845509336769185412951159262424903513866295760) (num-test (lcm 624970361450506104794172455132584603069611058500 108222780) 624970361450506104794172455132584603069611058500) (num-test (lcm 82823962548382643645255524843049561752323600 135325929794) 911063588032209080097810773273545179275559600) (num-test (lcm 170620453449723034746079844571491973300000 9460614789626) 6995438591438644424589273627431170905300000) (num-test (lcm 125144597811313015929871740675462711600000 12764411911636) 125520031604746954977661355897489099734800000) (num-test (lcm 257193319319332344553297882967977761077115600 6510126541380) 10544926092092626126685213201687088204161739600) (num-test (lcm 879624546681838385457288074812140664728758550 10045784120501316) 109420015859940604120573892778181425848269191068700) (num-test (lcm 18300938860777100857669855248554588369659200 118088077425391892) 1507430033023349020545408306968192889420458644800) (num-test (lcm 8394780474625841647581984803260010511075000 746584618179400) 559688409023779488485938508818148160783881325000) (num-test (lcm 146802334713757872619395774222116859916800 718775571956687400) 123460763494270370872911846120800279190028800) (num-test (lcm 240155883351717999820072393833707008014911556000 1350921510529331832) 31940732485778493976069628379883032065983236948000) (num-test (lcm 918942437243241528855354123800826649596480 74343962238703160850) 19653830834705779820109799278313370922778988193600) (num-test (lcm 1361069299753299783990135442290762165844800 8281085446358585640) 1318876151460947490686441243579748538703611200) (num-test (lcm 111738283365989051/177100989030047175 5964153172084899/4217293152016490) (/ (* 111738283365989051/177100989030047175 5964153172084899/4217293152016490) (gcd 111738283365989051/177100989030047175 5964153172084899/4217293152016490))) (num-test (lcm 11571718688839/18340740190704 5168247530883/3654502875938) (/ (* 11571718688839/18340740190704 5168247530883/3654502875938) (gcd 11571718688839/18340740190704 5168247530883/3654502875938))) (num-test (lcm 130441933147714940/206745572560704147 14398739476117879/10181446324101389) (/ (* 130441933147714940/206745572560704147 14398739476117879/10181446324101389) (gcd 130441933147714940/206745572560704147 14398739476117879/10181446324101389))) (num-test (lcm 137528045312/217976794617 63018038201/44560482149) (/ (* 137528045312/217976794617 63018038201/44560482149) (gcd 137528045312/217976794617 63018038201/44560482149))) (num-test (lcm 326267455807135/517121682660006 30122754096401/21300003689580) (/ (* 326267455807135/517121682660006 30122754096401/21300003689580) (gcd 326267455807135/517121682660006 30122754096401/21300003689580))) (num-test (lcm 3816473305410548/6048967074079039 423859315570607/299713796309065) (/ (* 3816473305410548/6048967074079039 423859315570607/299713796309065) (gcd 3816473305410548/6048967074079039 423859315570607/299713796309065))) (num-test (lcm 397560349370386783/630118245525664765 34761632124320657/24580185800219268) (/ (* 397560349370386783/630118245525664765 34761632124320657/24580185800219268) (gcd 397560349370386783/630118245525664765 34761632124320657/24580185800219268))) (num-test (lcm 483615324366283/766512153894657 175568277047523/124145519261542) (/ (* 483615324366283/766512153894657 175568277047523/124145519261542) (gcd 483615324366283/766512153894657 175568277047523/124145519261542))) (num-test (lcm 52449289519716/83130157078217 12477253282759/8822750406821) (/ (* 52449289519716/83130157078217 12477253282759/8822750406821) (gcd 52449289519716/83130157078217 12477253282759/8822750406821))) (num-test (lcm 5409303924479/8573543875303 886731088897/627013566048) (/ (* 5409303924479/8573543875303 886731088897/627013566048) (gcd 5409303924479/8573543875303 886731088897/627013566048))) (num-test (lcm 615582794569/975675645481 152139002499/107578520350) (/ (* 615582794569/975675645481 152139002499/107578520350) (gcd 615582794569/975675645481 152139002499/107578520350))) (num-test (lcm 6189245291/9809721694 1855077841/1311738121) (/ (* 6189245291/9809721694 1855077841/1311738121) (gcd 6189245291/9809721694 1855077841/1311738121))) (num-test (lcm 65470613321/103768467013 10812186007/7645370045) (/ (* 65470613321/103768467013 10812186007/7645370045) (gcd 65470613321/103768467013 10812186007/7645370045))) (num-test (lcm 6586818670/10439860591 4478554083/3166815962) (/ (* 6586818670/10439860591 4478554083/3166815962) (gcd 6586818670/10439860591 4478554083/3166815962))) (num-test (lcm 7530699980955811472069/11935877073996486182239 96845919575610633161/68480406462161287469) (/ (* 7530699980955811472069/11935877073996486182239 96845919575610633161/68480406462161287469) (gcd 7530699980955811472069/11935877073996486182239 96845919575610633161/68480406462161287469))) (num-test (lcm 753110839881/1193652440098 367296043199/259717522849) (/ (* 753110839881/1193652440098 367296043199/259717522849) (gcd 753110839881/1193652440098 367296043199/259717522849)))) (test (lcm 0 "hi") 'error) (test (lcm 0 1 "hi") 'error) (test (lcm 1.4 2.3) 'error) (test (lcm 2 1.0+0.5i) 'error) (test (lcm 92233720368547758/3 3005/2) (if with-bignums 92387443235828670930 'error)) (test (lcm 92233720368547758/3 30005/2) (if with-bignums 922490926552758492930 'error)) (test (lcm 92233720368547758/13 3005/17) (if with-bignums 21320179208268154830 'error)) (when with-bignums (test (lcm (bignum 92233720368547758/3) (bignum 3005/2)) 92387443235828670930) (test (lcm (bignum 92233720368547758/3) (bignum 30005/2)) 922490926552758492930) (test (lcm (bignum 92233720368547758/13) (bignum 3005/17)) 21320179208268154830)) ;; the "reason": (test (lcm 3/2 1) 3) ; = 3/2 2/2 -> 6/2 -> 3 (test (lcm 3/2 5/2) 15/2) (test (lcm 92233720368547758/13 30005/17) (if with-bignums 12522501265422060990 'error)) (test (lcm 1152921504606846976/17 3486784401/13) (if with-bignums 4019988717840603673710821376 'error)) (test (lcm 1152921504606846976/17 59049/13) (if with-bignums 68078861925529707085824 'error)) (test (lcm 1152921504606846976/17 3486784401/17) (if with-bignums 4019988717840603673710821376/17 'error)) (test (lcm -9223372036854775808 1) (if with-bignums 9223372036854775808 'error)) (test (lcm 9223372036854775806 2) 9223372036854775806) (test (lcm -9223372036854775808/3 1/3) (if with-bignums 9223372036854775808/3 'error)) (test (lcm -9223372036854775808) (if with-bignums 9223372036854775808 'error)) (for-each (lambda (arg) (test (lcm arg +nan.0) 'error) (test (lcm +nan.0 arg) 'error) (test (lcm arg +inf.0) 'error) (test (lcm +inf.0 arg) 'error) (test (lcm 2 arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (arg) (test (lcm arg 2) 'error) (test (lcm arg 1/2) 'error) (test (lcm arg 2.0) 'error) (test (lcm arg 2+i) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; rationalize ;;; -------------------------------------------------------------------------------- (test (rationalize 0.0 1.0001) 0) (test (rationalize -0.0 1.0001) 0) (test (rationalize 0.0 0.50000000000000) 0) (test (rationalize -0.0 0.50000000000000) 0) (test (rationalize 0.0 0.1) 0) (test (rationalize -0.0 0.1) 0) (test (rationalize 0.0 0.001) 0) (test (rationalize -0.0 0.001) 0) (test (rationalize 0.00000001 0.000000011) 0) (test (rationalize -0.00000001 0.000000011) 0) (test (rationalize 0.00000001 1.0) 0) (test (rationalize -0.00000001 1.0) 0) (test (rationalize 0.00000001 0.50000000000000) 0) (test (rationalize -0.00000001 0.50000000000000) 0) (test (rationalize 0.00000001 0.1) 0) (test (rationalize -0.00000001 0.1) 0) (test (rationalize 0.00000001 0.001) 0) (test (rationalize -0.00000001 0.001) 0) (test (rationalize 1.0 1.0001) 0) (test (rationalize -1.0 1.0001) 0) (test (rationalize 1.0 0.999) 1) (test (rationalize -1.0 0.999) -1) (test (rationalize 1.0 0.50000000000000) 1) (test (rationalize -1.0 0.50000000000000) -1) (test (rationalize 1.0 0.1) 1) (test (rationalize -1.0 0.1) -1) (test (rationalize 1.0 0.001) 1) (test (rationalize -1.0 0.001) -1) (test (rationalize 1.0 0.00300000000000) 1) (test (rationalize -1.0 0.00300000000000) -1) (test (rationalize 1.0 0.00002000000000) 1) (test (rationalize -1.0 0.00002000000000) -1) (test (rationalize 1.0 0.00000001) 1) (test (rationalize -1.0 0.00000001) -1) (test (rationalize 3.14159265358979 1.0) 3) (test (rationalize -3.14159265358979 1.0) -3) (test (rationalize 3.14159265358979 0.50000000000000) 3) (test (rationalize -3.14159265358979 0.50000000000000) -3) (test (rationalize 3.14159265358979 0.1) 16/5) (test (rationalize -3.14159265358979 0.1) -16/5) (test (rationalize 3.14159265358979 0.001) 201/64) (test (rationalize -3.14159265358979 0.001) -201/64) (test (rationalize 3.14159265358979 0.00300000000000) 22/7) (test (rationalize -3.14159265358979 0.00300000000000) -22/7) (test (rationalize 3.14159265358979 0.00002000000000) 355/113) (test (rationalize -3.14159265358979 0.00002000000000) -355/113) (test (rationalize 3.14159265358979 0.00000001) 100798/32085) (test (rationalize -3.14159265358979 0.00000001) -100798/32085) (test (rationalize -2.71828182845905 0.1) -8/3) (test (rationalize 2.71828182845905 0.001) 87/32) (test (rationalize -2.71828182845905 0.001) -87/32) (test (rationalize 2.71828182845905 0.00300000000000) 68/25) (test (rationalize -2.71828182845905 0.00300000000000) -68/25) (test (rationalize 2.71828182845905 0.00002000000000) 878/323) (test (rationalize -2.71828182845905 0.00002000000000) -878/323) (test (rationalize 2.71828182845905 0.00000001) 23225/8544) (test (rationalize -2.71828182845905 0.00000001) -23225/8544) (test (rationalize 1234.12339999999995 1.0) 1234) (test (rationalize -1234.12339999999995 1.0) -1234) (test (rationalize 1234.12339999999995 0.50000000000000) 1234) (test (rationalize -1234.12339999999995 0.50000000000000) -1234) (test (rationalize 1234.12339999999995 0.1) 6171/5) (test (rationalize -1234.12339999999995 0.1) -6171/5) (test (rationalize 1234.12339999999995 0.001) 60472/49) (test (rationalize -1234.12339999999995 0.001) -60472/49) (test (rationalize 1234.12339999999995 0.00300000000000) 9873/8) (test (rationalize -1234.12339999999995 0.00300000000000) -9873/8) (test (rationalize 1234.12339999999995 0.00002000000000) 290019/235) (test (rationalize -1234.12339999999995 0.00002000000000) -290019/235) (test (rationalize 1234.12339999999995 0.00000001) 6170617/5000) (test (rationalize -1234.12339999999995 0.00000001) -6170617/5000) (test (rationalize 0.33 1.0) 0) (test (rationalize -0.33 1.0) 0) (test (rationalize 0.33 0.50000000000000) 0) (test (rationalize -0.33 0.50000000000000) 0) (test (rationalize 0.33 0.1) 1/3) (test (rationalize -0.33 0.1) -1/3) (test (rationalize 0.33 0.001) 26/79) (test (rationalize -0.33 0.001) -26/79) (test (rationalize 0.33 0.00300000000000) 18/55) (test (rationalize -0.33 0.00300000000000) -18/55) (test (rationalize 0.33 0.00002000000000) 33/100) (test (rationalize -0.33 0.00002000000000) -33/100) (test (rationalize 0.33 0.00000001) 33/100) (test (rationalize -0.33 0.00000001) -33/100) (test (rationalize 0.99990 1.0) 0) (test (rationalize -0.99990 1.0) 0) (test (rationalize 0.99990 0.50000000000000) 1) (test (rationalize -0.99990 0.50000000000000) -1) (test (rationalize 0.99990 0.1) 1) (test (rationalize -0.99990 0.1) -1) (test (rationalize 0.99990 0.001) 1) (test (rationalize -0.99990 0.001) -1) (test (rationalize 0.99990 0.00300000000000) 1) (test (rationalize -0.99990 0.00300000000000) -1) (test (rationalize 0.99990 0.00002000000000) 8333/8334) (test (rationalize -0.99990 0.00002000000000) -8333/8334) (test (rationalize 0.99990 0.00000001) 9999/10000) (test (rationalize -0.99990 0.00000001) -9999/10000) (test (rationalize 0.5010 1.0) 0) (test (rationalize -0.5010 1.0) 0) (test (rationalize 0.5010 0.50000000000000) 1) (test (rationalize -0.5010 0.50000000000000) -1) (test (rationalize 0.5010 0.1) 1/2) (test (rationalize -0.5010 0.1) -1/2) (test (rationalize 0.5010 0.00099) 127/253) (test (rationalize -0.5010 0.00099) -127/253) (test (rationalize 0.5010 0.00300000000000) 1/2) (test (rationalize -0.5010 0.00300000000000) -1/2) (test (rationalize 0.5010 0.00002000000000) 246/491) (test (rationalize -0.5010 0.00002000000000) -246/491) (test (rationalize 0.5010 0.00000001) 501/1000) (test (rationalize -0.5010 0.00000001) -501/1000) (test (rationalize 0.499 1.0) 0) (test (rationalize -0.499 1.0) 0) (test (rationalize 0.499 0.50000000000000) 0) (test (rationalize -0.499 0.50000000000000) 0) (test (rationalize 0.499 0.1) 1/2) (test (rationalize -0.499 0.1) -1/2) (test (rationalize 0.499 0.00099) 126/253) (test (rationalize -0.499 0.00099) -126/253) (test (rationalize 0.499 0.00300000000000) 1/2) (test (rationalize -0.499 0.00300000000000) -1/2) (test (rationalize 0.499 0.00002000000000) 245/491) (test (rationalize -0.499 0.00002000000000) -245/491) (test (rationalize 0.499 0.00000001) 499/1000) (test (rationalize -0.499 0.00000001) -499/1000) (test (rationalize 1.501 1.0) 1) (test (rationalize -1.501 1.0) -1) (test (rationalize 1.501 0.50000000000000) 2) (test (rationalize -1.501 0.50000000000000) -2) (test (rationalize 1.501 0.1) 3/2) (test (rationalize -1.501 0.1) -3/2) (test (rationalize 1.501 0.01) 3/2) (test (rationalize -1.501 0.01) -3/2) (test (rationalize 1.501 0.00300000000000) 3/2) (test (rationalize -1.501 0.00300000000000) -3/2) (test (rationalize 1.501 0.00002000000000) 737/491) (test (rationalize -1.501 0.00002000000000) -737/491) (test (rationalize 1.501 0.00000001) 1501/1000) (test (rationalize -1.501 0.00000001) -1501/1000) (test (rationalize 1.499 1.0) 1) (test (rationalize -1.499 1.0) -1) (test (rationalize 1.499 0.50000000000000) 1) (test (rationalize -1.499 0.50000000000000) -1) (test (rationalize 1.499 0.1) 3/2) (test (rationalize -1.499 0.1) -3/2) (test (rationalize 1.499 0.001) 3/2) (test (rationalize -1.499 0.001) -3/2) (test (rationalize 1.499 0.00300000000000) 3/2) (test (rationalize -1.499 0.00300000000000) -3/2) (test (rationalize 1.499 0.00002000000000) 736/491) (test (rationalize -1.499 0.00002000000000) -736/491) (test (rationalize 1.499 0.00000001) 1499/1000) (test (rationalize -1.499 0.00000001) -1499/1000) (test (rationalize 1.16 .2) 1) (test (rationalize 1.16 .1) 5/4) (test (rationalize 1.16 .041) 6/5) (test (rationalize 1.16 .039) 7/6) (test (rationalize 1.16 .007) 7/6) (test (rationalize 1.16 .006) 22/19) (test (rationalize 1.16 .0022) 22/19) (test (rationalize 1.16 .002) 29/25) (test (rationalize 1.16 .0000001) 29/25) (test (rationalize .1 .1) 0) (test (rationalize .1 .0999) 1/6) (test (rationalize .1 .065) 1/7) (test (rationalize .1 .067) 1/6) (test (rationalize .1 .04) 1/8) (test (rationalize .1 .02) 1/9) (test (rationalize .1 .01) 1/10) (test (rationalize 23.1 22.0) 2) (test (rationalize 23.1 22) 2) (test (rationalize 23.1 .5) 23) (test (rationalize 23.1 1/2) 23) (test (rationalize 1/2 3/4) 0) (test (rationalize 1/2 1/4) 1/2) (test (rationalize 1 3) 0) (test (rationalize 11/10 1/5) 1) (test (rationalize 3/4 1/2) 1) (test (rationalize 1/4 1/3) 0) (test (rationalize 1/4 1/6) 1/3) (test (rationalize 2/3 1/4) 1/2) (test (rationalize 1/3 1/3) 0) (test (rationalize 1/3 1/4) 1/2) (test (rationalize 3/10 1/10) 1/3) (test (rationalize 1/4 1/11) 1/3) (test (rationalize 1/4 1/12) 1/4) (test (rationalize pi 1/10) 16/5) (test (rationalize pi 1/100) 22/7) (test (rationalize pi 1/10000) 333/106) ;; currently (rationalize pi 0) -> 245850922/78256779, but should it return the actual (float-style) ratio? (test (rationalize 1 .1) 1) (test (rationalize 1 1) 0) (test (rationalize 1 1/2) 1) (test (rationalize 1 0) 1) (test (rationalize 0 -.1) 0) (test (rationalize 0 1) 0) (test (rationalize 0 0) 0) (test (rationalize -1 .1) -1) (test (rationalize -1 -1) 0) (test (rationalize (exact->inexact 1/2) 3/4) 0) (test (rationalize (exact->inexact 1/2) 1/4) 1/2) (test (rationalize (exact->inexact 1) 3) 0) (test (rationalize (exact->inexact 11/10) 1/5) 1) (test (rationalize (exact->inexact 3/4) 1/2) 1) (test (rationalize (exact->inexact 1/4) 1/3) 0) (test (rationalize (exact->inexact 1/4) 1/6) 1/3) (test (rationalize (exact->inexact 2/3) 1/4) 1/2) (test (rationalize (exact->inexact 1/3) 1/4) 1/2) (test (rationalize (exact->inexact 3/10) 1/10) 1/3) (test (rationalize 1/2 (exact->inexact 3/4)) 0) (test (rationalize 1/2 (exact->inexact 1/4)) 1/2) (test (rationalize 1 (exact->inexact 3)) 0) (test (rationalize 11/10 (exact->inexact 1/5)) 1) (test (rationalize 3/4 (exact->inexact 1/2)) 1) (test (rationalize 1/4 (exact->inexact 1/3)) 0) (test (rationalize 1/4 (exact->inexact 1/6)) 1/3) (test (rationalize 2/3 (exact->inexact 1/4)) 1/2) (test (rationalize 1/3 (exact->inexact 1/4)) 1/2) (test (rationalize 3/10 (exact->inexact 1/10)) 1/3) (test (rationalize (exact->inexact 1/2) (exact->inexact 3/4)) 0) (test (rationalize (exact->inexact 1/2) (exact->inexact 1/4)) 1/2) (test (rationalize (exact->inexact 1) (exact->inexact 3)) 0) (test (rationalize (exact->inexact 11/10) (exact->inexact 1/5)) 1) (test (rationalize (exact->inexact 3/4) (exact->inexact 1/2)) 1) (test (rationalize (exact->inexact 1/4) (exact->inexact 1/3)) 0) (test (rationalize (exact->inexact 1/4) (exact->inexact 1/6)) 1/3) (test (rationalize (exact->inexact 2/3) (exact->inexact 1/4)) 1/2) (test (rationalize (exact->inexact 1/3) (exact->inexact 1/4)) 1/2) (test (rationalize (exact->inexact 3/10) (exact->inexact 1/10)) 1/3) (test (rationalize -1/2 3/4) 0) (test (rationalize -1/2 1/4) -1/2) (test (rationalize -1 3) 0) (test (rationalize -11/10 1/5) -1) (test (rationalize -3/4 1/2) -1) (test (rationalize -1/4 1/3) 0) (test (rationalize -1/4 1/6) -1/3) (test (rationalize -2/3 1/4) -1/2) (test (rationalize -1/3 1/4) -1/2) (test (rationalize -1/3 1/3) 0) (test (rationalize -3/10 1/10) -1/3) (test (rationalize .0999 .1) 0) (test (rationalize -.0999 .1) 0) (test (rationalize 1.0999 .1) 1) (test (rationalize -1.0999 .1) -1) (test (rationalize .239 .0005) 11/46) ;baseball of course... the average .001 is the hardest to get: 1/667 (test (rationalize .001 .0005) 1/667) (test (rationalize .334 .0005) 96/287) (test (rationalize 1.0000001 0.00000001) 9090911/9090910) (test (rationalize 0.000000015 0.0000000009999999) 1/62500001) (test (rationalize 0.00000001 1e-16) 1/100000000) ;(test (rationalize 0.1 0) (if with-bignums 3602879701896397/36028797018963968 1/10)) ; ?? sometimes in gmp this is 1/10 (test (rationalize 0.1 .00000000000000001) 1/10) (test (/ 0.(rationalize .1)) 0.0) (unless with-bignums (test (rationalize .1 0) 1/10) ;; but (rationalize 0.1 0) -> 1526457681181556/15264576811815559? independent of precision ;; and (rationalize 0.1000000000000000 0) -> 1/10 so once again it's either the idiotic reader or the bignum promotion process ;; (rationalize 0.00000001 0) 3022314549036573/302231454903657293676544? (test (rationalize 1e-3 0) 1/1000) (unless (provided? '32-bit) (test (rationalize 1e-12 0) 1/1000000000000) (test (rationalize 1e-15 0) 1/1000000000000000)) (test (rationalize (+ 1e2 1e-2) 0) 10001/100)) (test (rationalize -1 -1) 0) ;; spec says "differs by no more than", but that seems to imply a comparison ;; on either side, so a negative error doesn't change the result?? (test (rationalize 1/4 -1/6) 1/3) (test (rationalize -3/10 -1/10) -1/3) (test (rationalize (exact->inexact 1/3) (exact->inexact -1/4)) 1/2) (test (rationalize 0.5 0.02) 1/2) (test (rationalize 1073741824 1) 1073741823) ; perverse (test (rationalize -2.225073858507201399999999999999999999996E-308) 0) (test (rationalize -9223372036854775808) -9223372036854775808) (test (rationalize 1.110223024625156799999999999999999999997E-16) 0) (test (rationalize 9223372036854775807) 9223372036854775807) (test (rationalize -3037000503.0 -3037000500.0) -3) (test (rationalize 33309123021416.7508179322803e-25 1e-20) 1/300218050279) (test (rationalize 33309123021416.7508179322803e-25 1e-12) 1/230898233499) (test (rationalize 33309123021416.7508179322803e-25 1e-23) 1/300218051179) (test (rationalize 9223372036854775807 0) 9223372036854775807) (test (rationalize 9223372036854775807 -1) 9223372036854775806) (test (rationalize 9223372036854775807 -1/2) 9223372036854775807) (test (rationalize 9223372036854775807 1/2) 9223372036854775807) (test (rationalize 9223372036854775807 3/2) 9223372036854775806) (test (rationalize 9223372036854775807 -3/2) 9223372036854775806) (test (rationalize 9223372036854775807 1) 9223372036854775806) (test (rationalize 9223372036854775807 +inf.0) 0) (test (rationalize (/ pi) 1e-8) 24288/76303) (test (rationalize (/ pi) 1e-10) 33102/103993) (test (rationalize 1e8 1e9) 0) (test (rationalize 1e16 most-positive-fixnum) 0) (test (rationalize most-positive-fixnum 1e20) 0) (test (rationalize most-positive-fixnum most-positive-fixnum) 0) (test (rationalize (/ 1 most-positive-fixnum) 0) (/ 1 most-positive-fixnum)) (test (rationalize 1e20 -1e21) 0) (test (rationalize -1e20 1e21) 0) (test (rationalize 1e20 +inf.0) 0) (test (rationalize (/ (expt 2 60) (expt 3 20)) .01) 2314582608/7) (test (rationalize (/ (expt 2 60) (expt 3 20)) .001) 8266366457/25) (test (rationalize 11/30 .1) 1/3) (test (rationalize 11/30 .2) 1/2) (test (rationalize 11/30 .365) 1/2) (test (rationalize 11/30 .367) 0) ;; these differ from the ratify result (test (rationalize 0.02 .01) 1/34) (test (rationalize 0.05 .01) 1/17) (test (rationalize 0.06 .01) 1/15) (test (rationalize 0.07 .01) 1/13) (test (rationalize 0.32 .01) 5/16) (test (rationalize 0.35 .01) 5/14) (test (rationalize 0.39 .01) 2/5) (test (rationalize 0.47 .01) 6/13) (test (rationalize 0.48 .01) 8/17) (test (rationalize 0.52 .01) 9/17) (test (rationalize 0.53 .01) 7/13) (test (rationalize 0.61 .01) 3/5) (test (rationalize 0.65 .01) 9/14) (test (rationalize 0.68 .01) 11/16) (test (rationalize 0.93 .01) 12/13) (test (rationalize 0.94 .01) 14/15) (test (rationalize 0.95 .01) 16/17) (test (rationalize 0.96 .01) 19/20) (test (rationalize 0.97 .01) 24/25) (test (rationalize 0.98 .01) 33/34) (test (rationalize 0.01 .001) 1/91) (test (rationalize 0.02 .001) 1/48) (test (rationalize 0.06 .001) 2/33) (test (rationalize 0.11 .001) 6/55) (test (rationalize 0.14 .001) 6/43) (test (rationalize 0.17 .001) 7/41) (test (rationalize 0.18 .001) 7/39) (test (rationalize 0.33 .001) 26/79) (test (rationalize 0.34 .001) 15/44) (test (rationalize 0.43 .001) 28/65) (test (rationalize 0.46 .001) 17/37) (test (rationalize 0.49 .001) 23/47) (test (rationalize 0.51 .001) 24/47) (test (rationalize 0.57 .001) 37/65) (test (rationalize 0.58 .001) 18/31) (test (rationalize 0.66 .001) 29/44) (test (rationalize 0.67 .001) 53/79) (test (rationalize 0.83 .001) 34/41) (test (rationalize 0.86 .001) 37/43) (test (rationalize 0.89 .001) 49/55) (test (rationalize 0.94 .001) 31/33) (test (rationalize 0.98 .001) 47/48) (test (rationalize 0.99 .001) 90/91) (test (rationalize 0.1001 .1) 1/5) (test (rationalize 0.101 .1) 1/5) (test (rationalize 0.451 .0010001) 9/20) (test (rationalize 0.9876 .0001) 80/81) (test (rationalize (expt 2 1/3) (expt 10 -10)) 96389/76504) (test (rationalize (expt 2 1/3) (expt 10 -15)) 15240955/12096754) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'rationalize num (rationalize num) val))) (vector (list 0 0) (list 1 1) (list 2 2) (list 3 3) (list -1 -1) (list -2 -2) (list -3 -3) (list 9223372036854775807 9223372036854775807) (list -9223372036854775808 -9223372036854775808) (list 1/2 1/2) (list 1/3 1/3) (list -1/2 -1/2) (list -1/3 -1/3) (list 1/9223372036854775807 0) (list 0.0 0) (list 1.0 1) (list 2.0 2) (list -2.0 -2) (list 1.000000000000000000000000000000000000002E-309 0))) (if (not with-bignums) (begin (test (< (abs (- (rationalize (/ pi) 1e-17) (/ pi))) 1e-10) #t) ; make sure we don't hang! (test (< (abs (- (rationalize (/ pi) 1e-18) (/ pi))) 1e-10) #t) (test (< (abs (- (rationalize (/ pi) 1e-20) (/ pi))) 1e-10) #t) (test (rationalize 1e-19 1e-21) 0) (test (rationalize 1e-19 1e-30) 0) (test (rationalize 1e-19 1e-50) 0) (test (rationalize 1e-19 0.0) 0) (test (rationalize 1e-19 1e-19) 0) (test (rationalize 1e-30 0.0) 0) (test (rationalize (+ .1 1e-18) 1e-17) 1/10) (test (rationalize (- .1 1e-18) 1e-17) 1/10) ) (begin (test (rationalize (/ pi) 1e-17) 78256779/245850922) (test (rationalize (/ pi) 1e-18) 340262731/1068966896) (test (rationalize (/ pi) 1e-20) 1963319607/6167950454) (test (rationalize (/ pi) 1e-30) 136308121570117/428224593349304) (test (rationalize (/ 1 most-negative-fixnum) 0) (/ 1 most-negative-fixnum)) (test (rationalize 1e-19 1e-21) 1/9900990099009900991) (test (rationalize 1e-19 1e-30) 1/9999999999900000001) (test (rationalize 1e-30 0.0) 1/1000000000000000000000000000000) (test (rationalize (+ .1 1e-18) 0) 1894333982346309985/18943339823463098609) (test (rationalize (+ .1 1e-18) 1e-20) 1524131159466061/15241311594660609) (test (rationalize (- .1 1e-18) 1e-20) 2192446305355891/21924463053558909) (test (rationalize 1e18 1e19) 0) (test (rationalize 1180591620717411303424) 1180591620717411303424) (test (rationalize 1180591620717411303424 .9) 1180591620717411303424) (test (rationalize -1180591620717411303424 1.9) -1180591620717411303423) (test (rationalize -1180591620717411303424 +nan.0) 'error) (test (rationalize -1180591620717411303424 +inf.0) 0) (test (rationalize most-negative-fixnum 1) (+ most-negative-fixnum 1)) (test (rationalize (/ 3.0 most-positive-fixnum) 1e-50) 3/9223372036854775807) (test (rationalize (/ 3.0 most-positive-fixnum) 1e-38) 3/9223372036854775807) (test (rationalize (expt 2 1/3) (expt 10 -20)) 11952836413/9486972548) (test (rationalize (expt 2 1/3) (expt 10 -30)) 2566462403285413/2037002559406049) (test (< (abs (- (expt (rationalize (expt 2 1/3) (expt 10 -30)) 3.0) 2)) 1e-29) #t) (test (rationalize 3796553736732654909229441/2684568892382786771291329) 1607521/1136689) ; default error? (test (< (abs (- (rationalize 3796553736732654909229441/2684568892382786771291329) 3796553736732654909229441/2684568892382786771291329)) 1e-12) #t) (test (rationalize 3796553736732654909229441/2684568892382786771291329 1) 1) (test (let () (define (func) (let ((x 8796093022208)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (rationalize x))))) (define (hi) (func)) (hi)) #t) #| (let-temporarily (((*s7* 'bignum-precision) 1024)) (test (rationalize (expt 2 1/3) 1e-40) 77270484057362988877/61329623839374997455) ;; or 38599114766834832265/30636137692957437662 ? (test (rationalize 3796553736732654909229441/2684568892382786771291329 0) 3796553736732654909229441/2684568892382786771291329)) ;; or 16616132878186749607/11749380235262596085 ? |# )) (let () (define (check-rationalize val n) (call-with-exit (lambda (return) (let* ((diffs (make-vector n 0.0)) (ratios (make-vector n 0))) (do ((i 0 (+ i 1))) ((= i n)) (let* ((err (expt 2 (- (+ i 1)))) (rat (rationalize val err)) (diff (abs (- rat val)))) (vector-set! ratios i rat) (vector-set! diffs i diff) (if (> diff err) (begin (format #t "|~A - ~A| = ~A > ~A (2^~A -> 2^~A)?~%" val rat diff err (log diff 2) (log err 2)) (return #f))))) (and (apply >= (vector->list diffs)) (apply <= (map denominator ratios))))))) (for-each (lambda (val) (test (check-rationalize val 40) #t)) (list pi (/ pi) (- pi) (- (/ pi)) (* 10 pi) (* -1000 pi) (exp 1.0) (exp -1.0) (exp 4.0) (exp -4.0))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (- (random 2.0) 1.0))) (let ((rat (check-rationalize val 40))) (if (not rat) (format #t "rationalize trouble with ~A~%" val))))) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 4096)) (test (*s7* 'bignum-precision) 4096) (test (check-rationalize pi 100) #t) (test (check-rationalize (/ pi) 100) #t) (for-each (lambda (arg) (test (set! (*s7* 'bignum-precision) arg) 'error)) (list "hi" #\a 'a-symbol #(1 2 3) -1 0 1 3.14 3/4 1.0+1.0i #t abs # # (lambda () 1))) (test (bignum-precision 213) 'error) (test (set! (bignum-precision 213) 123) 'error) (set! (*s7* 'bignum-precision) 2) (test (*s7* 'bignum-precision) 2) (test (object->string pi) "3.0E0")))) (test (rationalize) 'error) (test (rationalize 1.23+1.0i 1.23+1.0i) 'error) (test (rationalize 1.23 1.23 1.23) 'error) (test (rationalize 0 +nan.0) 'error) ; ?? (test (rationalize 1 +nan.0) 'error) (test (rationalize (expt 2 60) -) 'error) (for-each (lambda (arg) (test (rationalize arg 0.1) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) #| ;; this is only the tip of the iceberg -- need much more stringent tests (let () (define (func) (call-with-output-string (lambda (p) (do ((i 0 (+ i 1))) ((= i 1) (get-output-string p)) (display (rationalize most-positive-fixnum) p))))) (test (func) "9223372036854775807")) |# (for-each (lambda (arg) (test (rationalize arg +nan.0) 'error) (test (rationalize +nan.0 arg) 'error) (test (rationalize arg +inf.0) 'error) (test (rationalize +inf.0 arg) 'error) (test (rationalize 0.1 arg) 'error) (test (rationalize 1 arg) 'error) (test (rationalize 1/2 arg) 'error) (test (rationalize 0+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (if with-bignums (begin (test (rationalize .1e20) 10000000000000000000) (test (rationalize 1e19) 10000000000000000000) (test (rationalize 1e20) 100000000000000000000)) (begin (test (rationalize .1e20) 'error) (test (rationalize 1e20) 'error))) (call-with-exit (lambda (done) (do ((k -6 (- k 1))) ((= k -17)) (call-with-exit (lambda (ok) (let ((fraction (rationalize (expt 10.0 k) 1e-18))) (do ((i 0 (+ i 1))) ((= i 100)) (if (not (zero? (random fraction))) (ok)))) (format #t ";random of small ratios is always 0 below ca. ~A~%" (expt 10.0 k)) (done)))))) (let-temporarily (((*s7* 'default-rationalize-error) 1e-11)) (test (rationalize 1.000000056443638e-12) 0) (set! (*s7* 'default-rationalize-error) 1e-12) (test (rationalize 1.000000056443638e-12) (if with-bignums 1/499999985890 0))) ;;; Bill Gosper's farint: (let () (define* (farint x (err 1/1000000)) ; this err term is not the same as the s7 rationalize error term (define (farint-1 x nhi dhi ln ld hn hd) (if (> (+ ln hn) (* (+ ld hd) x)) (let* ((m (min (if (= 0 ln) nhi (floor (/ (- nhi hn) ln))) (floor (/ (- dhi hd) ld)))) (d (- (* x ld) ln)) (k (if (= 0 d) m (ceiling (/ (- hn (* x hd)) d))))) (if (< k m) (let ((hn1 (+ (* k ln) hn)) (hd1 (+ (* k ld) hd))) (farint-1 x nhi dhi hn1 hd1 (- hn1 ln) (- hd1 ld))) (let* ((n (+ (* m ln) hn)) (d (+ (* m ld) hd))) (if (< (* 2 d ld x) (+ (* ld n) (* ln d))) (/ ln ld) (/ n d))))) (let* ((m (min (floor (/ (- nhi ln) hn)) (if (= 0 hd) dhi (floor (/ (- dhi ld) hd))))) (d (- hn (* x hd))) (k (if (= 0 d) m (ceiling (/ (- (* x ld) ln) d))))) (if (< k m) (let ((ln1 (+ (* k hn) ln)) (ld1 (+ (* k hd) ld))) (farint-1 x nhi dhi (- ln1 hn) (- ld1 hd) ln1 ld1)) (let* ((n (+ (* m hn) ln)) (d (+ (* m hd) ld))) (if (< (* 2 d hd x) (+ (* hd n) (* hn d))) (/ n d) (/ hn hd))))))) (farint-1 x (/ err) (/ err) 0 1 1 0)) (test (farint .1) 1/10)) ;; scheme version of rationalize (define* (cdr-ratify ux (err 0.0000001)) ;; translated from CL code in Canny, Donald, Ressler, "A Rational Rotation Method for Robust Geometric Algorithms" (let ((x0 (- ux err)) (x1 (+ ux err))) (let ((i (ceiling x0)) (i0 (floor x0)) (i1 (ceiling x1)) (r 0)) (if (>= x1 i) i (do ((p0 i0 (+ p1 (* r p0))) (q0 1 (+ q1 (* r q0))) (p1 i1 p0) (q1 1 q0) (e0 (- i1 x0) e1p) (e1 (- x0 i0) (- e0p (* r e1p))) (e0p (- i1 x1) e1) (e1p (- x1 i0) (- e0 (* r e1)))) ((<= x0 (/ p0 q0) x1) (/ p0 q0)) (set! r (min (floor (/ e0 e1)) (ceiling (/ e0p e1p))))))))) (test (cdr-ratify .75) 3/4) ;;; -------------------------------------------------------------------------------- ;;; min ;;; -------------------------------------------------------------------------------- (num-test (min -0.0) 0.0) (num-test (min -1 -1/2) -1) (num-test (min -1/2 0) -1/2) (num-test (min 0 -1/2) -1/2) (num-test (min -1 1/2) -1) (num-test (min -1.0) -1.0) (num-test (min -1.797693134862315699999999999999999999998E308 -9223372036854775808) -1.797693134862315699999999999999999999998E308) (num-test (min -1/2 -1) -1) (num-test (min -1/2 1) -1/2) (num-test (min -10) -10) (num-test (min -10/3) -10/3) (num-test (min -2 3 0 7) -2) (num-test (min -2) -2) (num-test (min -2/2) -2/2) (num-test (min -3/2 -1/2) -3/2) (num-test (min -3/2 -6/5) -3/2) (num-test (min -3/2 1/2) -3/2) (num-test (min -3/2 6/5) -3/2) (num-test (min -6 -12) -12) (num-test (min -9223372036854775808 -9223372036854775808) -9223372036854775808) (num-test (min -9223372036854775808 5.551115123125783999999999999999999999984E-17) -9.223372036854775808E18) (num-test (min -9223372036854775808 9223372036854775807 -9223372036854775808) -9223372036854775808) (num-test (min 0 1 1) 0) (num-test (min 0 1 1.0) 0.0) (num-test (min 0 1 1/1) 0) (num-test (min 0 1 123.4) 0.0) (num-test (min 0 1 1234) 0) (num-test (min 0 1 1234/11) 0) (num-test (min 0 1) 0) (num-test (min 0 1.0 1) 0.0) (num-test (min 0 1.0 1.0) 0.0) (num-test (min 0 1.0 1/1) 0.0) (num-test (min 0 1.0 123.4) 0.0) (num-test (min 0 1.0 1234) 0.0) (num-test (min 0 1.0 1234/11) 0.0) (num-test (min 0 1.0) 0.0) (num-test (min 0 1/1) 0) (num-test (min 0 123.4 1) 0.0) (num-test (min 0 123.4 1.0) 0.0) (num-test (min 0 123.4 1/1) 0.0) (num-test (min 0 123.4 123.4) 0.0) (num-test (min 0 123.4 1234) 0.0) (num-test (min 0 123.4 1234/11) 0.0) (num-test (min 0 123.4) 0.0) (num-test (min 0 1234 1) 0) (num-test (min 0 1234 1.0) 0.0) (num-test (min 0 1234 1/1) 0) (num-test (min 0 1234 123.4) 0.0) (num-test (min 0 1234 1234) 0) (num-test (min 0 1234 1234/11) 0) (num-test (min 0 1234) 0) (num-test (min 0 1234/11 1) 0) (num-test (min 0 1234/11 1.0) 0.0) (num-test (min 0 1234/11 1/1) 0) (num-test (min 0 1234/11 123.4) 0.0) (num-test (min 0 1234/11 1234) 0) (num-test (min 0 1234/11 1234/11) 0) (num-test (min 0 1234/11) 0) (num-test (min 0) 0) (num-test (min 0.0 1 1) 0.0) (num-test (min 0.0 1 1.0) 0.0) (num-test (min 0.0 1 1/1) 0.0) (num-test (min 0.0 1 123.4) 0.0) (num-test (min 0.0 1 1234) 0.0) (num-test (min 0.0 1 1234/11) 0.0) (num-test (min 0.0 1) 0.0) (num-test (min 0.0 1.0 1) 0.0) (num-test (min 0.0 1.0 1.0) 0.0) (num-test (min 0.0 1.0 1/1) 0.0) (num-test (min 0.0 1.0 123.4) 0.0) (num-test (min 0.0 1.0 1234) 0.0) (num-test (min 0.0 1.0 1234/11) 0.0) (num-test (min 0.0 1.0) 0.0) (num-test (min 0.0 1/1) 0.0) (num-test (min 0.0 123.4 1) 0.0) (num-test (min 0.0 123.4 1.0) 0.0) (num-test (min 0.0 123.4 1/1) 0.0) (num-test (min 0.0 123.4 123.4) 0.0) (num-test (min 0.0 123.4 1234) 0.0) (num-test (min 0.0 123.4 1234/11) 0.0) (num-test (min 0.0 123.4) 0.0) (num-test (min 0.0 1234 1) 0.0) (num-test (min 0.0 1234 1.0) 0.0) (num-test (min 0.0 1234 1/1) 0.0) (num-test (min 0.0 1234 123.4) 0.0) (num-test (min 0.0 1234 1234) 0.0) (num-test (min 0.0 1234 1234/11) 0.0) (num-test (min 0.0 1234) 0.0) (num-test (min 0.0 1234/11 1) 0.0) (num-test (min 0.0 1234/11 1.0) 0.0) (num-test (min 0.0 1234/11 1/1) 0.0) (num-test (min 0.0 1234/11 123.4) 0.0) (num-test (min 0.0 1234/11 1234) 0.0) (num-test (min 0.0 1234/11 1234/11) 0.0) (num-test (min 0.0 1234/11) 0.0) (num-test (min 0.0) 0.0) (num-test (min 0/1) 0/1) (num-test (min 1 -1/2) -1/2) (num-test (min 1 1 1) 1) (num-test (min 1 1 1.0) 1.0) (num-test (min 1 1 1/1) 1) (num-test (min 1 1 123.4) 1.0) (num-test (min 1 1 1234) 1) (num-test (min 1 1 1234/11) 1) (num-test (min 1 1) 1) (num-test (min 1 1.0 1) 1.0) (num-test (min 1 1.0 1.0) 1.0) (num-test (min 1 1.0 1/1) 1.0) (num-test (min 1 1.0 123.4) 1.0) (num-test (min 1 1.0 1234) 1.0) (num-test (min 1 1.0 1234/11) 1.0) (num-test (min 1 1.0) 1.0) (num-test (min 1 1/1) 1) (num-test (min 1 1/2) 1/2) (num-test (min 1 123.4 1) 1.0) (num-test (min 1 123.4 1.0) 1.0) (num-test (min 1 123.4 1/1) 1.0) (num-test (min 1 123.4 123.4) 1.0) (num-test (min 1 123.4 1234) 1.0) (num-test (min 1 123.4 1234/11) 1.0) (num-test (min 1 123.4) 1.0) (num-test (min 1 1234 1) 1) (num-test (min 1 1234 1.0) 1.0) (num-test (min 1 1234 1/1) 1) (num-test (min 1 1234 123.4) 1.0) (num-test (min 1 1234 1234) 1) (num-test (min 1 1234 1234/11) 1) (num-test (min 1 1234) 1) (num-test (min 1 1234/11 1) 1) (num-test (min 1 1234/11 1.0) 1.0) (num-test (min 1 1234/11 1/1) 1) (num-test (min 1 1234/11 123.4) 1.0) (num-test (min 1 1234/11 1234) 1) (num-test (min 1 1234/11 1234/11) 1) (num-test (min 1 1234/11) 1) (num-test (min 1 3 2 -7) -7) (num-test (min 1.0 1 1) 1.0) (num-test (min 1.0 1 1.0) 1.0) (num-test (min 1.0 1 1/1) 1.0) (num-test (min 1.0 1 123.4) 1.0) (num-test (min 1.0 1 1234) 1.0) (num-test (min 1.0 1 1234/11) 1.0) (num-test (min 1.0 1) 1.0) (num-test (min 1.0 1.0 1) 1.0) (num-test (min 1.0 1.0 1.0) 1.0) (num-test (min 1.0 1.0 1/1) 1.0) (num-test (min 1.0 1.0 123.4) 1.0) (num-test (min 1.0 1.0 1234) 1.0) (num-test (min 1.0 1.0 1234/11) 1.0) (num-test (min 1.0 1.0) 1.0) (num-test (min 1.0 1/1) 1.0) (num-test (min 1.0 123.4 1) 1.0) (num-test (min 1.0 123.4 1.0) 1.0) (num-test (min 1.0 123.4 1/1) 1.0) (num-test (min 1.0 123.4 123.4) 1.0) (num-test (min 1.0 123.4 1234) 1.0) (num-test (min 1.0 123.4 1234/11) 1.0) (num-test (min 1.0 123.4) 1.0) (num-test (min 1.0 1234 1) 1.0) (num-test (min 1.0 1234 1.0) 1.0) (num-test (min 1.0 1234 1/1) 1.0) (num-test (min 1.0 1234 123.4) 1.0) (num-test (min 1.0 1234 1234) 1.0) (num-test (min 1.0 1234 1234/11) 1.0) (num-test (min 1.0 1234) 1.0) (num-test (min 1.0 1234/11 1) 1.0) (num-test (min 1.0 1234/11 1.0) 1.0) (num-test (min 1.0 1234/11 1/1) 1.0) (num-test (min 1.0 1234/11 123.4) 1.0) (num-test (min 1.0 1234/11 1234) 1.0) (num-test (min 1.0 1234/11 1234/11) 1.0) (num-test (min 1.0 1234/11) 1.0) (num-test (min 1.0) 1.0) (num-test (min 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -9.223372036854775808E18) (num-test (min 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 5.42101086242752217060000000000000000001E-20) (num-test (min 1/2 -1) -1) (num-test (min 1/2 1) 1/2) (num-test (min 1/46116860184273883 1/46116860184273879) 1/46116860184273883) (num-test (min 1/9223372036854775807 1/9223372036854775300) 1/9223372036854775807) (num-test (min 1/9223372036854775807 2/9223372036854775807) 1/9223372036854775807) (num-test (min 10) 10) (num-test (min 10/3) 10/3) (num-test (min 1010-0.i) 1010.0) (num-test (min 123.4 1 1) 1.0) (num-test (min 123.4 1 1.0) 1.0) (num-test (min 123.4 1 1/1) 1.0) (num-test (min 123.4 1 123.4) 1.0) (num-test (min 123.4 1 1234) 1.0) (num-test (min 123.4 1 1234/11) 1.0) (num-test (min 123.4 1) 1.0) (num-test (min 123.4 1.0 1) 1.0) (num-test (min 123.4 1.0 1.0) 1.0) (num-test (min 123.4 1.0 1/1) 1.0) (num-test (min 123.4 1.0 123.4) 1.0) (num-test (min 123.4 1.0 1234) 1.0) (num-test (min 123.4 1.0 1234/11) 1.0) (num-test (min 123.4 1.0) 1.0) (num-test (min 123.4 1/1) 1.0) (num-test (min 123.4 123.4 1) 1.0) (num-test (min 123.4 123.4 1.0) 1.0) (num-test (min 123.4 123.4 1/1) 1.0) (num-test (min 123.4 123.4 123.4) 123.4) (num-test (min 123.4 123.4 1234) 123.4) (num-test (min 123.4 123.4 1234/11) 112.18181818181819) (num-test (min 123.4 123.4) 123.4) (num-test (min 123.4 1234 1) 1.0) (num-test (min 123.4 1234 1.0) 1.0) (num-test (min 123.4 1234 1/1) 1.0) (num-test (min 123.4 1234 123.4) 123.4) (num-test (min 123.4 1234 1234) 123.4) (num-test (min 123.4 1234 1234/11) 112.18181818181819) (num-test (min 123.4 1234) 123.4) (num-test (min 123.4 1234/11 1) 1.0) (num-test (min 123.4 1234/11 1.0) 1.0) (num-test (min 123.4 1234/11 1/1) 1.0) (num-test (min 123.4 1234/11 123.4) 112.18181818181819) (num-test (min 123.4 1234/11 1234) 112.18181818181819) (num-test (min 123.4 1234/11 1234/11) 112.18181818181819) (num-test (min 123.4 1234/11) 112.18181818181819) (num-test (min 1234 1 1) 1) (num-test (min 1234 1 1.0) 1.0) (num-test (min 1234 1 1/1) 1) (num-test (min 1234 1 123.4) 1.0) (num-test (min 1234 1 1234) 1) (num-test (min 1234 1 1234/11) 1) (num-test (min 1234 1) 1) (num-test (min 1234 1.0 1) 1.0) (num-test (min 1234 1.0 1.0) 1.0) (num-test (min 1234 1.0 1/1) 1.0) (num-test (min 1234 1.0 123.4) 1.0) (num-test (min 1234 1.0 1234) 1.0) (num-test (min 1234 1.0 1234/11) 1.0) (num-test (min 1234 1.0) 1.0) (num-test (min 1234 1/1) 1) (num-test (min 1234 123.4 1) 1.0) (num-test (min 1234 123.4 1.0) 1.0) (num-test (min 1234 123.4 1/1) 1.0) (num-test (min 1234 123.4 123.4) 123.4) (num-test (min 1234 123.4 1234) 123.4) (num-test (min 1234 123.4 1234/11) 112.18181818181819) (num-test (min 1234 123.4) 123.4) (num-test (min 1234 1234 1) 1) (num-test (min 1234 1234 1.0) 1.0) (num-test (min 1234 1234 1/1) 1) (num-test (min 1234 1234 123.4) 123.4) (num-test (min 1234 1234 1234) 1234) (num-test (min 1234 1234 1234/11) 1234/11) (num-test (min 1234 1234) 1234) (num-test (min 1234 1234/11 1) 1) (num-test (min 1234 1234/11 1.0) 1.0) (num-test (min 1234 1234/11 1/1) 1) (num-test (min 1234 1234/11 123.4) 112.18181818181819) (num-test (min 1234 1234/11 1234) 1234/11) (num-test (min 1234 1234/11 1234/11) 1234/11) (num-test (min 1234 1234/11) 1234/11) (num-test (min 1234/11 1 1) 1) (num-test (min 1234/11 1 1.0) 1.0) (num-test (min 1234/11 1 1/1) 1) (num-test (min 1234/11 1 123.4) 1.0) (num-test (min 1234/11 1 1234) 1) (num-test (min 1234/11 1 1234/11) 1) (num-test (min 1234/11 1) 1) (num-test (min 1234/11 1.0 1) 1.0) (num-test (min 1234/11 1.0 1.0) 1.0) (num-test (min 1234/11 1.0 1/1) 1.0) (num-test (min 1234/11 1.0 123.4) 1.0) (num-test (min 1234/11 1.0 1234) 1.0) (num-test (min 1234/11 1.0 1234/11) 1.0) (num-test (min 1234/11 1.0) 1.0) (num-test (min 1234/11 1/1) 1) (num-test (min 1234/11 123.4 1) 1.0) (num-test (min 1234/11 123.4 1.0) 1.0) (num-test (min 1234/11 123.4 1/1) 1.0) (num-test (min 1234/11 123.4 123.4) 112.18181818181819) (num-test (min 1234/11 123.4 1234) 112.18181818181819) (num-test (min 1234/11 123.4 1234/11) 112.18181818181819) (num-test (min 1234/11 123.4) 112.18181818181819) (num-test (min 1234/11 1234 1) 1) (num-test (min 1234/11 1234 1.0) 1.0) (num-test (min 1234/11 1234 1/1) 1) (num-test (min 1234/11 1234 123.4) 112.18181818181819) (num-test (min 1234/11 1234 1234) 1234/11) (num-test (min 1234/11 1234 1234/11) 1234/11) (num-test (min 1234/11 1234) 1234/11) (num-test (min 1234/11 1234/11 1) 1) (num-test (min 1234/11 1234/11 1.0) 1.0) (num-test (min 1234/11 1234/11 1/1) 1) (num-test (min 1234/11 1234/11 123.4) 112.18181818181819) (num-test (min 1234/11 1234/11 1234) 1234/11) (num-test (min 1234/11 1234/11 1234/11) 1234/11) (num-test (min 1234/11 1234/11) 1234/11) (num-test (min 2 1+0i) 1.0) (num-test (min 2) 2) (num-test (min 2/2) 2/2) (num-test (min 2/9223372036854775807 1/9223372036854775807) 1/9223372036854775807) (num-test (min 3 5 5 330 4 -24) -24 ) (num-test (min 3) 3) (num-test (min 3.0 7 1) 1.0) (num-test (min 3/2 -1/2) -1/2) (num-test (min 3/2 -6/5) -6/5) (num-test (min 3/2 1/2) 1/2) (num-test (min 3/2 6/5) 6/5) (num-test (min 5.0 2) 2.0) ; why not 2? (num-test (min 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 5.551115123125783999999999999999999999984E-17) (num-test (min 6 12) 6) (num-test (min 92233720368547758/9223372036854775807 92233720368547757/9223372036854775807) 92233720368547757/9223372036854775807) (num-test (min 9223372036854775807 -9223372036854775808) -9223372036854775808) (when with-bignums (num-test (min 12345678901234567890 12345678901234567891) 12345678901234567890) (num-test (min 2.168404344971008681816600431489558149231E-17 2.168404344971008869895696563055543437233E-17) 2.168404344971008681816600431489558149231E-17) (num-test (min 2.168404344971008869895696563055543437233E-17 2.168404344971008681816600431489558149231E-17 ) 2.168404344971008681816600431489558149231E-17) (num-test (min 2.168404344971008681816600431489558149231E-17 1/46116860184273879) 2.168404344971008681816600431489558149231E-17) (num-test (min 1/46116860184273883 2.168404344971008869895696563055543437233E-17) 2.168404344971008681816600431489558149231E-17) (num-test (let ((n (list 2.0 (bignum "3")))) (eval `(let () (define (f1) (min ,@n)) (f1)))) 2.0) (num-test (let ((n (list 2.0 (bignum "0")))) (eval `(let () (define (f1) (min ,@n)) (f1)))) 0) (num-test (let ((n (list 2.0 (bignum "3")))) (eval `(let () (define (f1) (max ,@n)) (f1)))) 3) (num-test (let ((n (list 2.0 (bignum "0")))) (eval `(let () (define (f1) (max ,@n)) (f1)))) 2.0)) (test (min 92233720368547758/5 18446744073709552.0) 92233720368547758/5) (test (max 92233720368547758/5 18446744073709552.0) 18446744073709552.0) (test (min 92233720368547758/5 18446744073709551) 18446744073709551) (test (max 92233720368547758/5 18446744073709551) 92233720368547758/5) (test (min 1.23+1.0i) 'error) (test (min) 'error) (test (min 1.0+1.0i) 'error) (test (min 0.0+0.00000001i) 'error) (test (min -0.0+0.00000001i) 'error) (test (min -1.0+1.0i) 'error) (test (min +nan.0 1+i) 'error) (test (min +nan.0 1 1+i) 'error) (test (min 1 +nan.0 2 1+i) 'error) (test (min +inf.0 1+i) 'error) (test (min +inf.0 +nan.0 0-i 1) 'error) (test (min 3441313796169221281/1720656898084610641 2.0) 3441313796169221281/1720656898084610641) (test (max 3441313796169221281/1720656898084610641 2.0) 2.0) (test (nan? (min 3/4 1/0)) #t) (test (nan? (min 3/4 +nan.0)) #t) (test (min 3/4 +nan.0 #\a) 'error) (num-test (min 1 +nan.0) +nan.0) (num-test (min +nan.0 1) +nan.0) (num-test (min 1.0 +nan.0) +nan.0) (num-test (min +nan.0 1.0) +nan.0) (num-test (min 1 1.0) 1) ; (eqv? (min 1 1.0) 1): #t etc (for-each (lambda (arg) (test (min arg +nan.0) 'error) (test (min +nan.0 arg) 'error) (test (min arg +inf.0) 'error) (test (min +inf.0 arg) 'error) (test (min 0 arg) 'error) (test (min 0.0 arg) 'error) (test (min 1/2 arg) 'error) (test (min 1+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (catch #t (lambda () (min 1 +nan.0 #f)) (lambda (type info) (apply format #f info))) "min second argument, #f, is boolean but should be a real") ;;; -------------------------------------------------------------------------------- ;;; max ;;; -------------------------------------------------------------------------------- (num-test (max -0.0) 0.0) (num-test (max -1 -1/2) -1/2) (num-test (max -1/2 0) 0) (num-test (max -1/2 -1) -1/2) (num-test (max 0 -1/2) 0) (num-test (max -1 1/2) 1/2) (num-test (max -1.0) -1.0) (num-test (max -1.797693134862315699999999999999999999998E308 -9223372036854775808) -9.223372036854775808E18) (num-test (max -1/2 1) 1) (num-test (max -10) -10) (num-test (max -10/3) -10/3) (num-test (max -2 3 0 7) 7) (num-test (max -2) -2) (num-test (max -2/2) -2/2) (num-test (max -3/2 -1/2) -1/2) (num-test (max -3/2 -6/5) -6/5) (num-test (max -3/2 1/2) 1/2) (num-test (max -3/2 6/5) 6/5) (num-test (max -6 -12) -6) (num-test (max -9223372036854775808 -9223372036854775808) -9223372036854775808) (num-test (max -9223372036854775808 5.551115123125783999999999999999999999984E-17) 5.551115123125783999999999999999999999984E-17) (num-test (max -9223372036854775808 9223372036854775807 -9223372036854775808) 9223372036854775807) (num-test (max 0 1 1) 1) (num-test (max 0 1 1.0) 1.0) (num-test (max 0 1 1/1) 1) (num-test (max 0 1 123.4) 123.4) (num-test (max 0 1 1234) 1234) (num-test (max 0 1 1234/11) 1234/11) (num-test (max 0 1) 1) (num-test (max 0 1.0 1) 1.0) (num-test (max 0 1.0 1.0) 1.0) (num-test (max 0 1.0 1/1) 1.0) (num-test (max 0 1.0 123.4) 123.4) (num-test (max 0 1.0 1234) 1234.0) (num-test (max 0 1.0 1234/11) 112.18181818181819) (num-test (max 0 1.0) 1.0) (num-test (max 0 1/1) 1) (num-test (max 0 123.4 1) 123.4) (num-test (max 0 123.4 1.0) 123.4) (num-test (max 0 123.4 1/1) 123.4) (num-test (max 0 123.4 123.4) 123.4) (num-test (max 0 123.4 1234) 1234.0) (num-test (max 0 123.4 1234/11) 123.4) (num-test (max 0 123.4) 123.4) (num-test (max 0 1234 1) 1234) (num-test (max 0 1234 1.0) 1234.0) (num-test (max 0 1234 1/1) 1234) (num-test (max 0 1234 123.4) 1234.0) (num-test (max 0 1234 1234) 1234) (num-test (max 0 1234 1234/11) 1234) (num-test (max 0 1234) 1234) (num-test (max 0 1234/11 1) 1234/11) (num-test (max 0 1234/11 1.0) 112.18181818181819) (num-test (max 0 1234/11 1/1) 1234/11) (num-test (max 0 1234/11 123.4) 123.4) (num-test (max 0 1234/11 1234) 1234) (num-test (max 0 1234/11 1234/11) 1234/11) (num-test (max 0 1234/11) 1234/11) (num-test (max 0) 0) (num-test (max 0.0 1 1) 1.0) (num-test (max 0.0 1 1.0) 1.0) (num-test (max 0.0 1 1/1) 1.0) (num-test (max 0.0 1 123.4) 123.4) (num-test (max 0.0 1 1234) 1234.0) (num-test (max 0.0 1 1234/11) 112.18181818181819) (num-test (max 0.0 1) 1.0) (num-test (max 0.0 1.0 1) 1.0) (num-test (max 0.0 1.0 1.0) 1.0) (num-test (max 0.0 1.0 1/1) 1.0) (num-test (max 0.0 1.0 123.4) 123.4) (num-test (max 0.0 1.0 1234) 1234.0) (num-test (max 0.0 1.0 1234/11) 112.18181818181819) (num-test (max 0.0 1.0) 1.0) (num-test (max 0.0 1/1) 1.0) (num-test (max 0.0 123.4 1) 123.4) (num-test (max 0.0 123.4 1.0) 123.4) (num-test (max 0.0 123.4 1/1) 123.4) (num-test (max 0.0 123.4 123.4) 123.4) (num-test (max 0.0 123.4 1234) 1234.0) (num-test (max 0.0 123.4 1234/11) 123.4) (num-test (max 0.0 123.4) 123.4) (num-test (max 0.0 1234 1) 1234.0) (num-test (max 0.0 1234 1.0) 1234.0) (num-test (max 0.0 1234 1/1) 1234.0) (num-test (max 0.0 1234 123.4) 1234.0) (num-test (max 0.0 1234 1234) 1234.0) (num-test (max 0.0 1234 1234/11) 1234.0) (num-test (max 0.0 1234) 1234.0) (num-test (max 0.0 1234/11 1) 112.18181818181819) (num-test (max 0.0 1234/11 1.0) 112.18181818181819) (num-test (max 0.0 1234/11 1/1) 112.18181818181819) (num-test (max 0.0 1234/11 123.4) 123.4) (num-test (max 0.0 1234/11 1234) 1234.0) (num-test (max 0.0 1234/11 1234/11) 112.18181818181819) (num-test (max 0.0 1234/11) 112.18181818181819) (num-test (max 0.0) 0.0) (num-test (max 0/1) 0/1) (num-test (max 1 -1/2) 1) (num-test (max 1 1 1) 1) (num-test (max 1 1 1.0) 1.0) (num-test (max 1 1 1/1) 1) (num-test (max 1 1 123.4) 123.4) (num-test (max 1 1 1234) 1234) (num-test (max 1 1 1234/11) 1234/11) (num-test (max 1 1) 1) (num-test (max 1 1.0 1) 1.0) (num-test (max 1 1.0 1.0) 1.0) (num-test (max 1 1.0 1/1) 1.0) (num-test (max 1 1.0 123.4) 123.4) (num-test (max 1 1.0 1234) 1234.0) (num-test (max 1 1.0 1234/11) 112.18181818181819) (num-test (max 1 1.0) 1.0) (num-test (max 1 1/1) 1) (num-test (max 1 1/2) 1) (num-test (max 1 123.4 1) 123.4) (num-test (max 1 123.4 1.0) 123.4) (num-test (max 1 123.4 1/1) 123.4) (num-test (max 1 123.4 123.4) 123.4) (num-test (max 1 123.4 1234) 1234.0) (num-test (max 1 123.4 1234/11) 123.4) (num-test (max 1 123.4) 123.4) (num-test (max 1 1234 1) 1234) (num-test (max 1 1234 1.0) 1234.0) (num-test (max 1 1234 1/1) 1234) (num-test (max 1 1234 123.4) 1234.0) (num-test (max 1 1234 1234) 1234) (num-test (max 1 1234 1234/11) 1234) (num-test (max 1 1234) 1234) (num-test (max 1 1234/11 1) 1234/11) (num-test (max 1 1234/11 1.0) 112.18181818181819) (num-test (max 1 1234/11 1/1) 1234/11) (num-test (max 1 1234/11 123.4) 123.4) (num-test (max 1 1234/11 1234) 1234) (num-test (max 1 1234/11 1234/11) 1234/11) (num-test (max 1 1234/11) 1234/11) (num-test (max 1 3 2 -7) 3) (num-test (max 1.0 1 1) 1.0) (num-test (max 1.0 1 1.0) 1.0) (num-test (max 1.0 1 1/1) 1.0) (num-test (max 1.0 1 123.4) 123.4) (num-test (max 1.0 1 1234) 1234.0) (num-test (max 1.0 1 1234/11) 112.18181818181819) (num-test (max 1.0 1) 1.0) (num-test (max 1.0 1.0 1) 1.0) (num-test (max 1.0 1.0 1.0) 1.0) (num-test (max 1.0 1.0 1/1) 1.0) (num-test (max 1.0 1.0 123.4) 123.4) (num-test (max 1.0 1.0 1234) 1234.0) (num-test (max 1.0 1.0 1234/11) 112.18181818181819) (num-test (max 1.0 1.0) 1.0) (num-test (max 1.0 1/1) 1.0) (num-test (max 1.0 123.4 1) 123.4) (num-test (max 1.0 123.4 1.0) 123.4) (num-test (max 1.0 123.4 1/1) 123.4) (num-test (max 1.0 123.4 123.4) 123.4) (num-test (max 1.0 123.4 1234) 1234.0) (num-test (max 1.0 123.4 1234/11) 123.4) (num-test (max 1.0 123.4) 123.4) (num-test (max 1.0 1234 1) 1234.0) (num-test (max 1.0 1234 1.0) 1234.0) (num-test (max 1.0 1234 1/1) 1234.0) (num-test (max 1.0 1234 123.4) 1234.0) (num-test (max 1.0 1234 1234) 1234.0) (num-test (max 1.0 1234 1234/11) 1234.0) (num-test (max 1.0 1234) 1234.0) (num-test (max 1.0 1234/11 1) 112.18181818181819) (num-test (max 1.0 1234/11 1.0) 112.18181818181819) (num-test (max 1.0 1234/11 1/1) 112.18181818181819) (num-test (max 1.0 1234/11 123.4) 123.4) (num-test (max 1.0 1234/11 1234) 1234.0) (num-test (max 1.0 1234/11 1234/11) 112.18181818181819) (num-test (max 1.0 1234/11) 112.18181818181819) (num-test (max 1.0) 1.0) (num-test (max 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 1.110223024625156799999999999999999999997E-16) (num-test (max 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 1.110223024625156799999999999999999999997E-16) (num-test (max 1/2 -1) 1/2) (num-test (max 1/2 1) 1) (unless (provided? 'tcc) (num-test (max 1/461168601842738841 1/461168601842738790) 1/461168601842738790) (num-test (max 1/4611686018427388416 1/4611686018427387904) 1/4611686018427387904) (num-test (max 1/461168601842738848 1/461168601842738790) 1/461168601842738790) (num-test (max 1/9223372036854775300 1/9223372036854775807) 1/9223372036854775300) (num-test (max 1/9223372036854775807 1/9223372036854775300) 1/9223372036854775300) (num-test (max 1/9223372036854775807 1/9223372036854775806) 1/9223372036854775806) (num-test (max 1/9223372036854775807 2/9223372036854775807) 2/9223372036854775807)) (num-test (max 10) 10) (num-test (max 10/3) 10/3) (num-test (max 123.4 1 1) 123.4) (num-test (max 123.4 1 1.0) 123.4) (num-test (max 123.4 1 1/1) 123.4) (num-test (max 123.4 1 123.4) 123.4) (num-test (max 123.4 1 1234) 1234.0) (num-test (max 123.4 1 1234/11) 123.4) (num-test (max 123.4 1) 123.4) (num-test (max 123.4 1.0 1) 123.4) (num-test (max 123.4 1.0 1.0) 123.4) (num-test (max 123.4 1.0 1/1) 123.4) (num-test (max 123.4 1.0 123.4) 123.4) (num-test (max 123.4 1.0 1234) 1234.0) (num-test (max 123.4 1.0 1234/11) 123.4) (num-test (max 123.4 1.0) 123.4) (num-test (max 123.4 1/1) 123.4) (num-test (max 123.4 123.4 1) 123.4) (num-test (max 123.4 123.4 1.0) 123.4) (num-test (max 123.4 123.4 1/1) 123.4) (num-test (max 123.4 123.4 123.4) 123.4) (num-test (max 123.4 123.4 1234) 1234.0) (num-test (max 123.4 123.4 1234/11) 123.4) (num-test (max 123.4 123.4) 123.4) (num-test (max 123.4 1234 1) 1234.0) (num-test (max 123.4 1234 1.0) 1234.0) (num-test (max 123.4 1234 1/1) 1234.0) (num-test (max 123.4 1234 123.4) 1234.0) (num-test (max 123.4 1234 1234) 1234.0) (num-test (max 123.4 1234 1234/11) 1234.0) (num-test (max 123.4 1234) 1234.0) (num-test (max 123.4 1234/11 1) 123.4) (num-test (max 123.4 1234/11 1.0) 123.4) (num-test (max 123.4 1234/11 1/1) 123.4) (num-test (max 123.4 1234/11 123.4) 123.4) (num-test (max 123.4 1234/11 1234) 1234.0) (num-test (max 123.4 1234/11 1234/11) 123.4) (num-test (max 123.4 1234/11) 123.4) (num-test (max 1234 1 1) 1234) (num-test (max 1234 1 1.0) 1234.0) (num-test (max 1234 1 1/1) 1234) (num-test (max 1234 1 123.4) 1234.0) (num-test (max 1234 1 1234) 1234) (num-test (max 1234 1 1234/11) 1234) (num-test (max 1234 1) 1234) (num-test (max 1234 1.0 1) 1234.0) (num-test (max 1234 1.0 1.0) 1234.0) (num-test (max 1234 1.0 1/1) 1234.0) (num-test (max 1234 1.0 123.4) 1234.0) (num-test (max 1234 1.0 1234) 1234.0) (num-test (max 1234 1.0 1234/11) 1234.0) (num-test (max 1234 1.0) 1234.0) (num-test (max 1234 1/1) 1234) (num-test (max 1234 123.4 1) 1234.0) (num-test (max 1234 123.4 1.0) 1234.0) (num-test (max 1234 123.4 1/1) 1234.0) (num-test (max 1234 123.4 123.4) 1234.0) (num-test (max 1234 123.4 1234) 1234.0) (num-test (max 1234 123.4 1234/11) 1234.0) (num-test (max 1234 123.4) 1234.0) (num-test (max 1234 1234 1) 1234) (num-test (max 1234 1234 1.0) 1234.0) (num-test (max 1234 1234 1/1) 1234) (num-test (max 1234 1234 123.4) 1234.0) (num-test (max 1234 1234 1234) 1234) (num-test (max 1234 1234 1234/11) 1234) (num-test (max 1234 1234) 1234) (num-test (max 1234 1234/11 1) 1234) (num-test (max 1234 1234/11 1.0) 1234.0) (num-test (max 1234 1234/11 1/1) 1234) (num-test (max 1234 1234/11 123.4) 1234.0) (num-test (max 1234 1234/11 1234) 1234) (num-test (max 1234 1234/11 1234/11) 1234) (num-test (max 1234 1234/11) 1234) (num-test (max 1234/11 1 1) 1234/11) (num-test (max 1234/11 1 1.0) 112.18181818181819) (num-test (max 1234/11 1 1/1) 1234/11) (num-test (max 1234/11 1 123.4) 123.4) (num-test (max 1234/11 1 1234) 1234) (num-test (max 1234/11 1 1234/11) 1234/11) (num-test (max 1234/11 1) 1234/11) (num-test (max 1234/11 1.0 1) 112.18181818181819) (num-test (max 1234/11 1.0 1.0) 112.18181818181819) (num-test (max 1234/11 1.0 1/1) 112.18181818181819) (num-test (max 1234/11 1.0 123.4) 123.4) (num-test (max 1234/11 1.0 1234) 1234.0) (num-test (max 1234/11 1.0 1234/11) 112.18181818181819) (num-test (max 1234/11 1.0) 112.18181818181819) (num-test (max 1234/11 1/1) 1234/11) (num-test (max 1234/11 123.4 1) 123.4) (num-test (max 1234/11 123.4 1.0) 123.4) (num-test (max 1234/11 123.4 1/1) 123.4) (num-test (max 1234/11 123.4 123.4) 123.4) (num-test (max 1234/11 123.4 1234) 1234.0) (num-test (max 1234/11 123.4 1234/11) 123.4) (num-test (max 1234/11 123.4) 123.4) (num-test (max 1234/11 1234 1) 1234) (num-test (max 1234/11 1234 1.0) 1234.0) (num-test (max 1234/11 1234 1/1) 1234) (num-test (max 1234/11 1234 123.4) 1234.0) (num-test (max 1234/11 1234 1234) 1234) (num-test (max 1234/11 1234 1234/11) 1234) (num-test (max 1234/11 1234) 1234) (num-test (max 1234/11 1234/11 1) 1234/11) (num-test (max 1234/11 1234/11 1.0) 112.18181818181819) (num-test (max 1234/11 1234/11 1/1) 1234/11) (num-test (max 1234/11 1234/11 123.4) 123.4) (num-test (max 1234/11 1234/11 1234) 1234) (num-test (max 1234/11 1234/11 1234/11) 1234/11) (num-test (max 1234/11 1234/11) 1234/11) (num-test (max 1e+16 9223372036854775807 1e+17) 9223372036854775807) (num-test (max 2 1+0i) 2) (num-test (max 2) 2) (num-test (max 2/2) 2/2) (num-test (max 2/9223372036854775807 1/9223372036854775807) 2/9223372036854775807) (num-test (max 3) 3) (num-test (max 3.0 7 1) 7.0) (num-test (max 3/2 -1/2) 3/2) (num-test (max 3/2 -6/5) 3/2) (num-test (max 3/2 1/2) 3/2) (num-test (max 3/2 6/5) 3/2) (num-test (max 34 5 7 38 6) 38 ) (num-test (max 5.0 2) 5.0) (num-test (max 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999999999997E-16) (num-test (max 6 12) 12) (num-test (max 92233720368547758/9223372036854775807 92233720368547757/9223372036854775807) 13176245766935394/1317624576693539401) (num-test (max 9223372036854775805/9223372036854775807 9223372036854775806/9223372036854775807) 9223372036854775806/9223372036854775807) (num-test (max 9223372036854775806/9223372036854775807 9223372036854775805/9223372036854775807) 9223372036854775806/9223372036854775807) (num-test (max 9223372036854775807 -9223372036854775808) 9223372036854775807) (num-test (max 92233720368547757/9223372036854775807 92233720368547758/9223372036854775807) 13176245766935394/1317624576693539401) ;; after reduction this is 13176245766935394/1317624576693539401 and 92233720368547757/9223372036854775807 -> ;; 9.999999999999999992410584792601468961145E-3 ;; 9.999999999999999883990367544051025548645E-3 ;; but in doubles-land, they're exactly the same, so we have to hope long doubles work in the non-gmp case (num-test (max 9223372036854776/9223372036854775807 9223372036854775/9223372036854775807) 9223372036854776/9223372036854775807) (num-test (max 9223372036854776/9223372036854775807 9223372036854775/922337203685477500) 1/100) (num-test (max 9223372036854775/922337203685477500 9223372036854776/9223372036854775807) 1/100) (num-test (max 9223372036854776/9223372036854775807 9223372036854775/9223372036854774806) 9223372036854775/9223372036854774806) (num-test (max 9223372036854775/9223372036854774806 9223372036854776/9223372036854775807) 9223372036854775/9223372036854774806) (num-test (max 9223372036854776/9223372036854775807 9223372036854775/9223372036854775000) 9223372036854776/9223372036854775807) ;; mpfr says the first fraction is 1.000000000000000020925101928970235578612E-3 (num-test (max 1e18 most-positive-fixnum) most-positive-fixnum) ; in bignum case there's type confusion here I think (hence num-test) (let () (define (f) ; opt_d_7dd_ff and opt_d_dd_ff (let ((sum 0.0)) (do ((i 0 (+ i 1))) ((= i 3) sum) (set! sum (/ (+ sum 2.0) (max (* 2.0 sum) (+ sum 1.0))))))) (num-test (f) 1.5)) (test (max) 'error) (test (max 1.23+1.0i) 'error) (test (max -0.0+0.00000001i) 'error) (test (max -1.0+1.0i) 'error) (test (max 0.0+0.00000001i) 'error) (test (max 1.0+1.0i) 'error) (test (max +nan.0 1+i) 'error) (test (max +nan.0 1 1+i) 'error) (test (max 1 +nan.0 2 1+i) 'error) (test (max +inf.0 1+i) 'error) (test (max +inf.0 +nan.0 0-i 1) 'error) (test (nan? (max 3/4 1/0)) #t) (test (nan? (max 3/4 +nan.0)) #t) (test (max 3/4 +nan.0 #\a) 'error) ;; s7 and Guile say (max -nan.0 -nan.0) -> +nan.0 (num-test (max 1 +nan.0) +nan.0) (num-test (max +nan.0 1) +nan.0) (num-test (max 1.0 +nan.0) +nan.0) (num-test (max +nan.0 1.0) +nan.0) (num-test (max 1 1.0) 1) (for-each (lambda (arg) (test (max arg +nan.0) 'error) (test (max +nan.0 arg) 'error) (test (max arg +inf.0) 'error) (test (max +inf.0 arg) 'error) (test (max 0 arg) 'error) (test (max 0.0 arg) 'error) (test (max 1/2 arg) 'error) (test (max 0+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (let ((top-exp 60)) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (+ 2 (expt 2 i))) (val2 (- val1 1))) (if (not (= val1 (max val1 val2))) (begin (set! happy #f) (display "(max ") (display val1) (display " ") (display val2) (display ") -> ") (display (max val1 val2)) (display "?") (newline))) (if (not (= val2 (min val1 val2))) (begin (set! happy #f) (display "(min ") (display val1) (display " ") (display val2) (display ") -> ") (display (min val1 val2)) (display "?") (newline)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (/ (expt 2 i) 3)) (val2 (/ (+ 1 (expt 2 i)) 3))) (if (not (= val2 (max val1 val2))) (begin (set! happy #f) (display "(max ") (display val1) (display " ") (display val2) (display ") -> ") (display (max val1 val2)) (display "?") (newline))) (if (not (= val2 (max val2 val1))) (begin (set! happy #f) (display "(max ") (display val1) (display " ") (display val2) (display ") -> ") (display (max val2 val1)) (display "?") (newline))) (if (not (= val1 (min val1 val2))) (begin (set! happy #f) (display "(min ") (display val1) (display " ") (display val2) (display ") -> ") (display (min val1 val2)) (display "?") (newline))) (if (not (= val1 (min val2 val1))) (begin (set! happy #f) (display "(min ") (display val1) (display " ") (display val2) (display ") -> ") (display (min val2 val1)) (display "?") (newline))) )))) (let () (define (tmin . args) (let ((val (apply min args))) (if (number? val) (for-each (lambda (arg) (if (< arg val) (format *stderr* "(min ~{~^~A ~}) -> ~A~%" args val))) args)) val)) (define (tmax . args) (let ((val (apply max args))) (if (number? val) (for-each (lambda (arg) (if (> arg val) (format *stderr* "(max ~{~^~A ~}) -> ~A~%" args val))) args)) val)) (do ((i 0 (+ i 1))) ((= i 10)) (tmin (- (random 10) 5) (- (random 99/100) 49/100)) (tmax (- (random 10) 5) (- (random 99/100) 49/100)) (tmin (- (random 99/100) 49/100) (- (random 10) 5)) (tmax (- (random 99/100) 49/100) (- (random 10) 5)) (tmin (- (random 10) 5) 0) (tmax (- (random 10) 5) 0) (tmin (- (random 99/100) 49/100) 0) (tmax (- (random 99/100) 49/100) 0) (tmin 0 (- (random 10) 5)) (tmax 0 (- (random 10) 5)) (tmin 0 (- (random 99/100) 49/100)) (tmax 0 (- (random 99/100) 49/100)) (tmin (- (random 10) 5) 1) (tmax (- (random 10) 5) 1) (tmin (- (random 99/100) 49/100) 1) (tmax (- (random 99/100) 49/100) 1) (tmin 1 (- (random 10) 5)) (tmax 1 (- (random 10) 5)) (tmin 1 (- (random 99/100) 49/100)) (tmax 1 (- (random 99/100) 49/100)) (tmin (- (random 10) 5) -1/4) (tmax (- (random 10) 5) -1/4) (tmin (- (random 99/100) 49/100) -1/4) (tmax (- (random 99/100) 49/100) -1/4) (tmin -3/4 (- (random 10) 5)) (tmax -3/4 (- (random 10) 5)) (tmin -3/4 (- (random 99/100) 49/100)) (tmax -3/4 (- (random 99/100) 49/100)) (tmin (- (random 299/100) 149/100) (- (random 199/100) 1)) (tmax (- (random 299/100) 149/100) (- (random 199/100) 1)) (tmin 0 (- (random 10) 5) (- (random 99/100) 49/100)) (tmax 0 (- (random 10) 5) (- (random 99/100) 49/100)) (tmin 0 (- (random 99/100) 49/100) (- (random 10) 5)) (tmax 0 (- (random 99/100) 49/100) (- (random 10) 5)) (tmin (- (random 10) 5) -1/2) (tmax (- (random 10) 5) -1/2) (tmin (- (random 99/100) 49/100) -1/2) (tmax (- (random 99/100) 49/100) -1/2) (tmin -1/2 (- (random 10) 5)) (tmax -1/2 (- (random 10) 5)) (tmin -1/2 (- (random 99/100) 49/100)) (tmax -1/2 (- (random 99/100) 49/100)))) ;;; -------------------------------------------------------------------------------- ;;; < ;;; -------------------------------------------------------------------------------- (test (< 0 1 1) #f) (test (< 0 1 1.0) #f) (test (< 0 1 1/1) #f) (test (< 0 1 123.4) #t) (test (< 0 1 1234) #t) (test (< 0 1 1234/11) #t) (test (< 0 1) #t) (test (< 0 1.0 1) #f) (test (< 0 1.0 1.0) #f) (test (< 0 1.0 1/1) #f) (test (< 0 1.0 123.4) #t) (test (< 0 1.0 1234) #t) (test (< 0 1.0 1234/11) #t) (test (< 0 1.0) #t) (test (< 0 123.4) #t) (test (< 0 1234) #t) (test (< 0 1234/11) #t) (test (< 0.0 1 1.0) #f) (test (< 0.0 1 1/1) #f) (test (< 0.0 1 123.4) #t) (test (< 0.0 1 1234) #t) (test (< 0.0 1 1234/11) #t) (test (< 0.0 1) #t) (test (< 0.0 1.0 1) #f) (test (< 0.0 1.0 1.0) #f) (test (< 0.0 1.0 1/1) #f) (test (< 0.0 1.0 123.4) #t) (test (< 0.0 1.0 1234) #t) (test (< 0.0 1.0 1234/11) #t) (test (< 0.0 1.0) #t) (test (< 0.0 123.4 1) #f) (test (< 0.0 123.4 1.0) #f) (test (< 0.0 123.4 1/1) #f) (test (< 0.0 123.4 123.4) #f) (test (< 0.0 123.4 1234) #t) (test (< 0.0 123.4 1234/11) #f) (test (< 0.0 123.4) #t) (test (< 0.0 1234 1) #f) (test (< 0.0 1234 1.0) #f) (test (< 0.0 1234 1/1) #f) (test (< 0.0 1234 123.4) #f) (test (< 0.0 1234 1234) #f) (test (< 0.0 1234 1234/11) #f) (test (< 0.0 1234) #t) (test (< 0.0 1234/11 1) #f) (test (< 0.0 1234/11 1.0) #f) (test (< 0.0 1234/11 1/1) #f) (test (< 0.0 1234/11 123.4) #t) (test (< 0.0 1234/11 1234) #t) (test (< 0.0 1234/11 1234/11) #f) (test (< 0.0 1234/11) #t) (test (< 1 1 1) #f) (test (< 1 1 1.0) #f) (test (< 1 1 1/1) #f) (test (< 1 1 123.4) #f) (test (< 1 1 1234) #f) (test (< 1 1 1234/11) #f) (test (< 1 1) #f) (test (< 1 1.0 1) #f) (test (< 1 1.0 1.0) #f) (test (< 1 1.0 1/1) #f) (test (< 1 1.0 123.4) #f) (test (< 1 1.0 1234) #f) (test (< 1 1.0 1234/11) #f) (test (< 1 1.0) #f) (test (< 1 1/1) #f) (test (< 1 123.4) #t) (test (< 1 1234) #t) (test (< 1 1234/11) #t) (test (< 1.0 1 1) #f) (test (< 1.0 1 1.0) #f) (test (< 1.0 1 1/1) #f) (test (< 1.0 1 123.4) #f) (test (< 1.0 1 1234) #f) (test (< 1.0 1 1234/11) #f) (test (< 1.0 1) #f) (test (< 1.0 1.0 1) #f) (test (< 1.0 1.0 1.0) #f) (test (< 1.0 1.0 1/1) #f) (test (< 1.0 1.0 123.4) #f) (test (< 1.0 1.0 1234) #f) (test (< 1.0 1.0 1234/11) #f) (test (< 1.0 1.0) #f) (test (< 1.0 123.4 1) #f) (test (< 1.0 123.4 1.0) #f) (test (< 1.0 123.4 1/1) #f) (test (< 1.0 123.4 123.4) #f) (test (< 1.0 123.4 1234) #t) (test (< 1.0 123.4 1234/11) #f) (test (< 1.0 123.4) #t) (test (< 1.0 1234 1) #f) (test (< 1.0 1234 1.0) #f) (test (< 1.0 1234 1/1) #f) (test (< 1.0 1234 123.4) #f) (test (< 1.0 1234 1234) #f) (test (< 1.0 1234 1234/11) #f) (test (< 1.0 1234) #t) (test (< 1.0 1234/11 1) #f) (test (< 1.0 1234/11 1.0) #f) (test (< 1.0 1234/11 1/1) #f) (test (< 1.0 1234/11 123.4) #t) (test (< 1.0 1234/11 1234) #t) (test (< 1.0 1234/11 1234/11) #f) (test (< 1.0 1234/11) #t) (test (< 123.4 1 1) #f) (test (< 123.4 1 1.0) #f) (test (< 123.4 1 1/1) #f) (test (< 123.4 1 123.4) #f) (test (< 123.4 1 1234) #f) (test (< 123.4 1 1234/11) #f) (test (< 123.4 1) #f) (test (< 123.4 1.0 1) #f) (test (< 123.4 1.0 1.0) #f) (test (< 123.4 1.0 1/1) #f) (test (< 123.4 1.0 123.4) #f) (test (< 123.4 1.0 1234) #f) (test (< 123.4 1.0 1234/11) #f) (test (< 123.4 1.0) #f) (test (< 123.4 123.4 1) #f) (test (< 123.4 123.4 1.0) #f) (test (< 123.4 123.4 1/1) #f) (test (< 123.4 123.4 123.4) #f) (test (< 123.4 123.4 1234) #f) (test (< 123.4 123.4 1234/11) #f) (test (< 123.4 123.4) #f) (test (< 123.4 1234 1) #f) (test (< 123.4 1234 1.0) #f) (test (< 123.4 1234 1/1) #f) (test (< 123.4 1234 123.4) #f) (test (< 123.4 1234 1234) #f) (test (< 123.4 1234 1234/11) #f) (test (< 123.4 1234) #t) (test (< 123.4 1234/11 1) #f) (test (< 123.4 1234/11 1.0) #f) (test (< 123.4 1234/11 1/1) #f) (test (< 123.4 1234/11 123.4) #f) (test (< 123.4 1234/11 1234) #f) (test (< 123.4 1234/11 1234/11) #f) (test (< 123.4 1234/11) #f) (test (< 1234 1) #f) (test (< 1234 1.0) #f) (test (< 1234 1/1) #f) (test (< 1234 123.4) #f) (test (< 1234 1234) #f) (test (< 1234 1234/11) #f) (test (< 1234/11 1) #f) (test (< 1234/11 1.0) #f) (test (< 1234/11 1/1) #f) (test (< 1234/11 123.4) #t) (test (< 1234/11 1234) #t) (test (< 1234/11 1234/11) #f) (test (< -0 0) #f) (test (< -0.0 0.0) #f) (test (< -1 2 3 4 4 5 6 7) #f) (test (< -1 2 3 4 5 6 7 8) #t) (test (< 0 -0) #f) (test (< 0.0 -0.0) #f) (test (< 1 0+i) 'error) (test (< 1 0-i) 'error) (test (< 1 1 2) #f) (test (< 1 3 2) #f) (test (< 1+i 0+i) 'error) (test (< 1+i 0-i) 'error) (test (< 2 1 #\a) 'error) (test (< +nan.0 1+i) 'error) (test (< +nan.0 1 1+i) 'error) (test (< 1 +nan.0 1+i) 'error) (test (< +inf.0 1+i) 'error) (test (< +inf.0 +nan.0 0-i 1) 'error) (test (< 2 1+0/2i) #f) (test (< 2 1+0i) #f) (test (< 2 1-0i) #f) (test (< -nan.0 0.0) #f) (test (> +nan.0 0.0) #f) ; NaN should be NaN or maybe nan, not these idiotic names (test (< -5 -4 -2 0 4 5) #t) (test (< 0 3 4 4 6) #f) (test (< 0 3 4 6 7) #t) (test (< 0) 'error) (test (<) 'error) (test (< 0.0) 'error) (test (< 0.0+0.00000001i) 'error) (test (< 0/1) 'error) (test (< 1.0) 'error) (test (< 1.0+1.0i) 'error) (test (< 10/3) 'error) (test (< 2 1 1.0+1.0i) 'error) (test (< 2) 'error) (test (< 3 -5) #f) (test (< 3 3) #f) (test (< 3 3.0 3 3.0+1.0i) 'error) (test (< 3 5) #t) (test (< 3.0 3) #f) (for-each (lambda (arg) (test (< arg +nan.0) 'error) (test (< +nan.0 arg) 'error) (test (< arg +inf.0) 'error) (test (< +inf.0 arg) 'error) (test (< 1 0 arg) 'error) (test (< 1 arg) 'error) (test (< 1.0 arg) 'error) (test (< 1/2 arg) 'error) (test (< arg 1) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (< -1/9223372036854775807 -1/9223372036854775806) #f) (test (< -10/3147483647 -40/12345678901) #f) (test (< -101/3147483647 40/12345678901) #t) (test (< -1047483646/11111111111111 -1234567890213/12345678901123123) #f) (test (< -1047483646/11111111111111 1234567890213/12345678901123123) #t) (test (< -11/3147483647 -40/12345678901) #t) (test (< -1282469252763/12824692526603504 -1234567890213/12345678901123123) #f) (test (< -1282469252763/12824692526603504 1234567890213/12345678901123123) #t) (test (< -1282469252765/12824692526603504 -1234567890213/12345678901123123) #t) (test (< -1282469252765/12824692526603504 1234567890213/12345678901123123) #t) (test (< -2/3 -3147483547123/4) #f) (test (< -2/3 3147483547123/4) #t) (test (< -2/3147483547 -3147483547/3) #f) (test (< -2/3147483547 3147483547/3) #t) (test (< -2147483646/11111111111111 -1234567890213/12345678901123123) #t) (test (< -2147483646/11111111111111 1234567890213/12345678901123123) #t) (test (< -3147483547/2 -3/3147483547) #t) (test (< -3147483547/2 -3147483547/3) #t) (test (< -3147483547/2 3/3147483547) #t) (test (< -3147483547/2 3147483547/3) #t) (test (< -3147483646/11 -12345678901/40) #f) (test (< -3147483646/11 -1234567890213/12345678901123123) #t) (test (< -3147483646/11 -40/12345678901) #t) (test (< -3147483646/11 12345678901/40) #t) (test (< -3147483646/11 1234567890213/12345678901123123) #t) (test (< -3147483646/11 40/12345678901) #t) (test (< -3147483646/11111111111111 -1234567890213/12345678901123123) #t) (test (< -3147483646/11111111111111 1234567890213/12345678901123123) #t) (test (< -3147483646/111111111111111 -1234567890213/12345678901123123) #f) (test (< -3147483646/111111111111111 1234567890213/12345678901123123) #t) (test (< 1/9223372036854775807 1/9223372036854775806) #t) (test (< 10/3147483647 40/12345678901) #t) (test (< 100000000000000.0 100000000000001.0) #t) (test (< 100000000000000/3 100000000000001/3) #t) (test (< 1000000000000000000/3 1000000000000000001/3) #t) (test (< 1047483646/11111111111111 -1234567890213/12345678901123123) #f) (test (< 1047483646/11111111111111 1234567890213/12345678901123123) #t) (test (< 11/3147483647 40/12345678901) #f) (test (< 1282469252763/12824692526603504 -1234567890213/12345678901123123) #f) (test (< 1282469252763/12824692526603504 1234567890213/12345678901123123) #t) (test (< 1282469252765/12824692526603504 -1234567890213/12345678901123123) #f) (test (< 1282469252765/12824692526603504 1234567890213/12345678901123123) #f) (test (< 2/3 -3147483547123/4) #f) (test (< 2/3 3147483547123/4) #t) (test (< 2/3147483547 -3147483547/3) #f) (test (< 2/3147483547 3147483547/3) #t) (test (< 2147483646/11111111111111 -1234567890213/12345678901123123) #f) (test (< 2147483646/11111111111111 1234567890213/12345678901123123) #f) (test (< 3/147483647 40/3) #t) (test (< 3/3147483647 -40/12345678901) #f) (test (< 3/3147483647 40/12345678901) #t) (test (< 3/3147483647 40/3) #t) (test (< 3147483547/2 -3/3147483547) #f) (test (< 3147483547/2 -3147483547/3) #f) (test (< 3147483547/2 3/3147483547) #f) (test (< 3147483547/2 3147483547/3) #f) (test (< 3147483646/11 -12345678901/40) #f) (test (< 3147483646/11 -1234567890213/12345678901123123) #f) (test (< 3147483646/11 -40/12345678901) #f) (test (< 3147483646/11 12345678901/40) #t) (test (< 3147483646/11 1234567890213/12345678901123123) #f) (test (< 3147483646/11 40/12345678901) #f) (test (< 3147483646/11111111111111 -1234567890213/12345678901123123) #f) (test (< 3147483646/11111111111111 1234567890213/12345678901123123) #f) (test (< 3147483646/111111111111111 -1234567890213/12345678901123123) #f) (test (< 3147483646/111111111111111 1234567890213/12345678901123123) #t) (test (< -1.797693134862315699999999999999999999998E308 -9223372036854775808) #t) (test (< -9223372036854775808 -9223372036854775808) #f) (test (< -9223372036854775808 5.551115123125783999999999999999999999984E-17) #t) (test (< -9223372036854775808 9223372036854775807 -9223372036854775808) #f) (test (< 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #f) (test (< 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #f) (test (< 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #t) (test (< 9223372036854775807 -9223372036854775808) #f) (test (< 9223372036854775807 9223372036854775807) #f) (when with-bignums (test (< (- 1237940039285380274899124223 1237940039285380000000000000) (- 1.2379400392853803e+27 1237940039285380000000000000) (- 1237940039285380274899124225 1237940039285380000000000000)) #f) (test (< 1237940039285380274899124223 1.2379400392853803e+27 1237940039285380274899124225) #f)) (test (< 0 most-negative-fixnum) #f) (test (< 0 most-positive-fixnum) #t) (test (< 1 3 . 2) 'error) (test (< 274899124223 3.0E11 274899124225) #f) (test (< most-negative-fixnum (real-part (log 0.0))) #f) (test (< most-negative-fixnum 0) #t) (test (< most-negative-fixnum most-positive-fixnum) #t) (test (< most-positive-fixnum (- (real-part (log 0.0)))) #t) (test (< most-positive-fixnum 0) #f) (test (< most-positive-fixnum most-negative-fixnum) #f) (test (< -1 1/9223372036854775807 9223372036854775807) #t) (test (< -9223372036854775807 -1/9223372036854775807 1) #t) (test (< -9223372036854775807 -1/9223372036854775807) #t) (test (< 1 9223372036 1/9223372036 1.0) #f) (test (< 1 9223372036 1/9223372036) #f) (test (< 1 922337203685 1/922337203685 1.0) #f) (test (< 1 922337203685 1/922337203685) #f) (test (< 1.0 9223372036 1/9223372036 1) #f) (test (< 1.0 9223372036 1/9223372036) #f) (test (< 1.0 922337203685 1/922337203685 1) #f) (test (< 1.0 922337203685 1/922337203685) #f) (test (< 1/9223372036 9223372036) #t) (test (< 1/922337203685 922337203685) #t) (test (< 1/9223372036854775807 9223372036854775807) #t) (test (< 9223372036 1/9223372036 1) #f) (test (< 9223372036 1/9223372036 1.0) #f) (test (< 9223372036 1/9223372036) #f) (test (< 922337203685 1/922337203685 1) #f) (test (< 922337203685 1/922337203685 1.0) #f) (test (< 922337203685 1/922337203685) #f) (test (< 1.0 9223372036854775807/9223372036854775806) #t) (test (< 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #t) (test (< 9223372036854775806/9223372036854775807 1.0) #t) ;;; there are cases that look innocuous that the non-gmp version can't get right: ;;; (< 21053343141/6701487259 3587785776203/1142027682075) ;;; I'll put a few of these in the bignum section (test (< (* 10400200/16483927 1.0) (* 10781274/17087915 1.0)) #f) (test (< (* 10400200/16483927 1.0) 10781274/17087915) #f) (test (< (* 10781274/17087915 1.0) (* 53715833/85137581 1.0)) #t) (test (< (* 10781274/17087915 1.0) 53715833/85137581) #t) (test (< (* 12/19 1.0) (* 53/84 1.0)) #f) (test (< (* 12/19 1.0) 53/84) #f) (test (< (* 12941/20511 1.0) (* 15601/24727 1.0)) #t) (test (< (* 12941/20511 1.0) 15601/24727) #t) (test (< (* 15601/24727 1.0) (* 79335/125743 1.0)) #t) (test (< (* 15601/24727 1.0) 79335/125743) #t) ;;; (if with-bignums (test (< (* 171928773/272500658 1.0) (* 397573379/630138897 1.0)) #t)) ;;; this requires more precision than 128 bits (test (negative? (- 171928773/272500658 397573379/630138897)) #t) ; so the first is less ;; clisp, sbcl, guile, non-gmp s7 all say #f for the < comparison of reals (test (< 171928773/272500658 397573379/630138897) #t) ;;; (= (* 171928773/272500658 1.0D0) (* 397573379/630138897 1.0D0)) -- clisp, sbcl, non-gmp s7, and guile say true (test (< (* 171928773/272500658 1.0) 397573379/630138897) #t) (test (< (* 190537/301994 1.0) (* 7161071/11350029 1.0)) #t) (test (< (* 190537/301994 1.0) 7161071/11350029) #t) (test (< (* 2/3 1.0) (* 5/8 1.0)) #f) (test (< (* 2/3 1.0) 5/8) #f) (test (< (* 253/401 1.0) (* 665/1054 1.0)) #t) (test (< (* 253/401 1.0) 665/1054) #t) (if with-bignums (test (< (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #t)) ;;; fraction -> double troubles -- this is ok if s7_double is long double in s7.h (test (< (* 397573379/630138897 1.0) 4201378396/6659027209) #t) (test (< (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #f) (if with-bignums (test (< (* 4201378396/6659027209 1.0) 6189245291/9809721694) #f)) (test (< (* 5/8 1.0) (* 12/19 1.0)) #t) (test (< (* 5/8 1.0) 12/19) #t) (test (< (* 53/84 1.0) (* 253/401 1.0)) #f) (test (< (* 53/84 1.0) 253/401) #f) (test (< (* 53715833/85137581 1.0) (* 171928773/272500658 1.0)) #f) ;;; (if with-bignums (test (< (* 53715833/85137581 1.0) 171928773/272500658) #f)) -- needs more than 128 bits (test (< 53715833/85137581 171928773/272500658) #f) (test (< (* 665/1054 1.0) (* 12941/20511 1.0)) #f) (test (< (* 665/1054 1.0) 12941/20511) #f) (test (< (* 7161071/11350029 1.0) (* 10400200/16483927 1.0)) #f) (test (< (* 7161071/11350029 1.0) 10400200/16483927) #f) (test (< (* 79335/125743 1.0) (* 190537/301994 1.0)) #t) (test (< (* 79335/125743 1.0) 190537/301994) #t) (test (< 10400200/16483927 10781274/17087915) #f) (test (< 10781274/17087915 53715833/85137581) #t) (test (< 12/19 53/84) #f) (test (< 12941/20511 15601/24727) #t) (test (< 15601/24727 79335/125743) #t) (test (< 190537/301994 7161071/11350029) #t) (test (< 2/3 5/8) #f) (test (< 253/401 665/1054) #t) (test (< 397573379/630138897 4201378396/6659027209) #t) (test (< 4201378396/6659027209 6189245291/9809721694) #f) (test (< 5/8 12/19) #t) (test (< 53/84 253/401) #f) (test (< 665/1054 12941/20511) #f) (test (< 7161071/11350029 10400200/16483927) #f) (test (< 79335/125743 190537/301994) #t) (test (< 131836323/93222358 110442295/78088974 125383891/88652904 61328902/43362679 138113653/97653429 254989762/180290825 393920845/278522218 100728653/71220318 175072959/123785551 278215191/196712393 ) #t) (test (< 10812186007/7645370045 18338419250/12967220607 13343405959/9435212837 11079453630/7834356793 6071445385/4293160203 14707776949/10399968816 22357396263/15809066506 77901127500/55084415513 2284381030/1615301317 10340752226/7312016021 ) #t) (test (< 886731088897/627013566048 1534756075495/1085236428449 244625906708/172976637487 1462171251759/1033911207374 1743861030874/1233095960377 954593412651/674999475361 ) #t) (test (< 10651773591371/984771132841 1.081649758092772603273242802490196379734E1 22691355773217/2095909383391 1.082649668092772603273242802490196379733E1 11269199657045/1040794570824 1.08274965909277260327324280249019637973E1 ) #t) (test (< 11320859/1046629 1.081649758092772603273242802490196379734E1 10021556/926421 1.081749668092772603273242802490196379733E1 12893515/1191902 1.08175965909277260327324280249019637973E1 ) #t) (test (< 11320859/1046629 1.081649659092772603273242802490196379732E1 6398591/591558 1.081650658192772603273242802490196379729E1 14562686/1346339 1.081650758102772603273242802490196379731E1 ) #t) (test (< 11320859/1046629 1.081649658102772603273242802490196379729E1 8517115/787419 1.081649668093772603273242802490196379735E1 9667298/893755 1.081649669092872603273242802490196379734E1 ) #t) (test (< 1109328651/102558961 1.08164965809278260327324280249019637973E1 1412995811/130633408 1.081649658102773603273242802490196379729E1 753823853/69692053 1.081649658103772703273242802490196379731E1 ) #t) (when with-bignums (test (< 12345678901234567890 12345678901234567891) #t) (test (< -9223372036854775808 -9223372036854775809) #f) (test (< -9223372036854775809 -9223372036854775808) #t) (test (< 9223372036854775808 9223372036854775807) #f) (test (< 9223372036854775808 1e19) #t) (test (< 9223372036854775807 85070591730234615865843651857942052865/9223372036854775807) #t) (test (< 1.000e19 1267650600228229401496703205376 1e20) #f) (test (< 4272943/1360120 21053343141/6701487259 3587785776203/1142027682075 2646693125139304345/842468587426513207) #t) (test (< 4272943/1360120 21053343141/6701487259 3587785776203/1142027682075) #t) (test (< 4272943/1360120 21053343141/6701487259 3587785776203/1142027682075 355/113) #t) (test (< 21053343141/6701487259 3587785776203/1142027682075 355/113) #t) (test (< 21053343141/6701487259 3587785776203/1142027682075) #t) (test (< 886731088897/627013566048 1534756075495/1085236428449 244625906708/172976637487 1462171251759/1033911207374 1743861030874/1233095960377 954593412651/674999475361 902779846866/638361751637 2968095823096/2098760683721 1684058273173/1190809024873 2947786590277/2084399887474 ) #t) (test (< 1023286908188737/723573111879672 1763020673688684/1246643873737343 1430528867885681/1011536663165079 2711447141769903/1917282660774379 575142878279173/406687429382352 935610884438753/661576800938585 2339755998541282/1654457332890441 1443730843578617/1020871869702614 478219565475493/338152297643805 2026075188260327/1432651504812687 ) #t) (test (< 1267650600228229401496703205376) 'error) (test (< 1.0 1267650600228229401496703205376+i) 'error)) ;; need 2 globals here, fx_lt_gsg (define _lt_test_1 2) (define _lt_test_2 1+i) (let ((mid 1)) (define (func) (list (< _lt_test_1 mid _lt_test_2))) (test (func) 'error)) (when with-bignums (test (let ((big (bignum 3.0))) (define (func) (< pi big pi)) (define (hi) (func)) (hi)) #f)) ;;; gad -- accidental pointer< rather than integer< in fx_lt_gsg! (define __fx_lt_1__ 1) (define __fx_lt_2__ 2) (define __fx_lt_3__ 8192) ; not a small int! (test (let () (define (func) (let ((i 2)) (cond (else (< __fx_lt_1__ __fx_lt_2__ __fx_lt_3__))))) (func) (func)) #t) ;;; -------------------------------------------------------------------------------- ;;; <= ;;; -------------------------------------------------------------------------------- (test (<= 0 1 1) #t) (test (<= 0 1 1.0) #t) (test (<= 0 1 1/1) #t) (test (<= 0 1 123.4) #t) (test (<= 0 1 1234) #t) (test (<= 0 1 1234/11) #t) (test (<= 0 1) #t) (test (<= 0 1.0 1) #t) (test (<= 0 1.0 1.0) #t) (test (<= 0 1.0 1/1) #t) (test (<= 0 1.0 123.4) #t) (test (<= 0 1.0 1234) #t) (test (<= 0 1.0 1234/11) #t) (test (<= 0 1.0) #t) (test (<= 0 123.4) #t) (test (<= 0 1234) #t) (test (<= 0 1234/11) #t) (test (<= 0.0 1 1.0) #t) (test (<= 0.0 1 1/1) #t) (test (<= 0.0 1 123.4) #t) (test (<= 0.0 1 1234) #t) (test (<= 0.0 1 1234/11) #t) (test (<= 0.0 1) #t) (test (<= 0.0 1.0 1) #t) (test (<= 0.0 1.0 1.0) #t) (test (<= 0.0 1.0 1/1) #t) (test (<= 0.0 1.0 123.4) #t) (test (<= 0.0 1.0 1234) #t) (test (<= 0.0 1.0 1234/11) #t) (test (<= 0.0 1.0) #t) (test (<= 0.0 123.4 1) #f) (test (<= 0.0 123.4 1.0) #f) (test (<= 0.0 123.4 1/1) #f) (test (<= 0.0 123.4 123.4) #t) (test (<= 0.0 123.4 1234) #t) (test (<= 0.0 123.4 1234/11) #f) (test (<= 0.0 123.4) #t) (test (<= 0.0 1234 1) #f) (test (<= 0.0 1234 1.0) #f) (test (<= 0.0 1234 1/1) #f) (test (<= 0.0 1234 123.4) #f) (test (<= 0.0 1234 1234) #t) (test (<= 0.0 1234 1234/11) #f) (test (<= 0.0 1234) #t) (test (<= 0.0 1234/11 1) #f) (test (<= 0.0 1234/11 1.0) #f) (test (<= 0.0 1234/11 1/1) #f) (test (<= 0.0 1234/11 123.4) #t) (test (<= 0.0 1234/11 1234) #t) (test (<= 0.0 1234/11 1234/11) #t) (test (<= 0.0 1234/11) #t) (test (<= 1 1 1) #t) (test (<= 1 1 1.0) #t) (test (<= 1 1 1/1) #t) (test (<= 1 1 123.4) #t) (test (<= 1 1 1234) #t) (test (<= 1 1 1234/11) #t) (test (<= 1 1) #t) (test (<= 1 1.0 1) #t) (test (<= 1 1.0 1.0) #t) (test (<= 1 1.0 1/1) #t) (test (<= 1 1.0 123.4) #t) (test (<= 1 1.0 1234) #t) (test (<= 1 1.0 1234/11) #t) (test (<= 1 1.0) #t) (test (<= 1 123.4) #t) (test (<= 1 1234) #t) (test (<= 1 1234/11) #t) (test (<= 1.0 1 1) #t) (test (<= 1.0 1 1.0) #t) (test (<= 1.0 1 1/1) #t) (test (<= 1.0 1 123.4) #t) (test (<= 1.0 1 1234) #t) (test (<= 1.0 1 1234/11) #t) (test (<= 1.0 1) #t) (test (<= 1.0 1.0 1) #t) (test (<= 1.0 1.0 1.0) #t) (test (<= 1.0 1.0 1/1) #t) (test (<= 1.0 1.0 123.4) #t) (test (<= 1.0 1.0 1234) #t) (test (<= 1.0 1.0 1234/11) #t) (test (<= 1.0 1.0) #t) (test (<= 1.0 123.4 1) #f) (test (<= 1.0 123.4 1.0) #f) (test (<= 1.0 123.4 1/1) #f) (test (<= 1.0 123.4 123.4) #t) (test (<= 1.0 123.4 1234) #t) (test (<= 1.0 123.4 1234/11) #f) (test (<= 1.0 123.4) #t) (test (<= 1.0 1234 1) #f) (test (<= 1.0 1234 1.0) #f) (test (<= 1.0 1234 1/1) #f) (test (<= 1.0 1234 123.4) #f) (test (<= 1.0 1234 1234) #t) (test (<= 1.0 1234 1234/11) #f) (test (<= 1.0 1234) #t) (test (<= 1.0 1234/11 1) #f) (test (<= 1.0 1234/11 1.0) #f) (test (<= 1.0 1234/11 1/1) #f) (test (<= 1.0 1234/11 123.4) #t) (test (<= 1.0 1234/11 1234) #t) (test (<= 1.0 1234/11 1234/11) #t) (test (<= 1.0 1234/11) #t) (test (<= 123.4 1 1) #f) (test (<= 123.4 1 1.0) #f) (test (<= 123.4 1 1/1) #f) (test (<= 123.4 1 123.4) #f) (test (<= 123.4 1 1234) #f) (test (<= 123.4 1 1234/11) #f) (test (<= 123.4 1) #f) (test (<= 123.4 1.0 1) #f) (test (<= 123.4 1.0 1.0) #f) (test (<= 123.4 1.0 1/1) #f) (test (<= 123.4 1.0 123.4) #f) (test (<= 123.4 1.0 1234) #f) (test (<= 123.4 1.0 1234/11) #f) (test (<= 123.4 1.0) #f) (test (<= 123.4 123.4 1) #f) (test (<= 123.4 123.4 1.0) #f) (test (<= 123.4 123.4 1/1) #f) (test (<= 123.4 123.4 123.4) #t) (test (<= 123.4 123.4 1234) #t) (test (<= 123.4 123.4 1234/11) #f) (test (<= 123.4 123.4) #t) (test (<= 123.4 1234 1) #f) (test (<= 123.4 1234 1.0) #f) (test (<= 123.4 1234 1/1) #f) (test (<= 123.4 1234 123.4) #f) (test (<= 123.4 1234 1234) #t) (test (<= 123.4 1234 1234/11) #f) (test (<= 123.4 1234) #t) (test (<= 123.4 1234/11 1) #f) (test (<= 123.4 1234/11 1.0) #f) (test (<= 123.4 1234/11 1/1) #f) (test (<= 123.4 1234/11 123.4) #f) (test (<= 123.4 1234/11 1234) #f) (test (<= 123.4 1234/11 1234/11) #f) (test (<= 123.4 1234/11) #f) (test (<= 1234 1) #f) (test (<= 1234 1.0) #f) (test (<= 1234 1/1) #f) (test (<= 1234 123.4) #f) (test (<= 1234 1234) #t) (test (<= 1234 1234/11) #f) (test (<= 1234/11 1) #f) (test (<= 1234/11 1.0) #f) (test (<= 1234/11 1/1) #f) (test (<= 1234/11 123.4) #t) (test (<= 1234/11 1234) #t) (test (<= 1234/11 1234/11) #t) (test (<= -1 2 3 4 4 5 6 7) #t) (test (<= -1 2 3 4 5 6 7 8) #t) (test (<= 1 0+i) 'error) (test (<= 1 0-i) 'error) (test (<= 1+i 0+i) 'error) (test (<= 1+i 0-i) 'error) (test (<= 2 1 #\a) 'error) (test (<= 2 1+0/2i) #f) (test (<= 2 1+0i) #f) (test (<= 2 1-0i) #f) (test (<= 2 2 1) #f) (test (<= 0 3 4 4 6) #t) (test (<= 0 3 4 6 7) #t) (test (<= 0) 'error) (test (<=) 'error) (test (<= 0.0) 'error) (test (<= 0.0+0.00000001i) 'error) (test (<= 0/1) 'error) (test (<= 1 3 3 2 5) #f) (test (<= 1.0) 'error) (test (<= 1.0+1.0i) 'error) (test (<= +nan.0 1+i) 'error) (test (<= +nan.0 1 1+i) 'error) (test (<= 1 +nan.0 1+i) 'error) (test (<= +inf.0 1+i) 'error) (test (<= +inf.0 +nan.0 0-i 1) 'error) (test (<= 10/3) 'error) (test (<= 2 1 1.0+1.0i) 'error) (test (<= 2) 'error) (test (<= 3 -5) #f) (test (<= 3 3) #t) (test (<= 3 5) #t) (test (<= 3.0 3) #t) (test (<= 5/2 2.5) #t) (test (<= -1.797693134862315699999999999999999999998E308 -9223372036854775808) #t) (test (<= -9223372036854775808 -9223372036854775808) #t) (test (<= -9223372036854775808 5.551115123125783999999999999999999999984E-17) #t) (test (<= -9223372036854775808 9223372036854775807 -9223372036854775808) #f) (test (<= 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #f) (test (<= 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #f) (test (<= 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #t) (test (<= 9223372036854775807 -9223372036854775808) #f) (test (<= 9223372036854775807 9223372036854775807) #t) (test (<= -1 -1/9223372036854775807 -9223372036854775807 1) #f) (test (<= -1 -1/9223372036854775807 -9223372036854775807) #f) (test (<= -1 1 9223372036854775807 1/9223372036854775807) #f) (test (<= -1 9223372036854775807 1/9223372036854775807 1) #f) (test (<= -1 9223372036854775807 1/9223372036854775807) #f) (test (<= -1/9223372036854775807 -9223372036854775807 -1 1) #f) (test (<= -1/9223372036854775807 -9223372036854775807 -1) #f) (test (<= -1/9223372036854775807 -9223372036854775807 1) #f) (test (<= -1/9223372036854775807 -9223372036854775807) #f) (test (<= 1 1.0 9223372036 1/9223372036) #f) (test (<= 1 1.0 922337203685 1/922337203685) #f) (test (<= 1 9223372036 1/9223372036 1.0) #f) (test (<= 1 9223372036 1/9223372036) #f) (test (<= 1 922337203685 1/922337203685 1.0) #f) (test (<= 1 922337203685 1/922337203685) #f) (test (<= 1 9223372036854775807 1/9223372036854775807) #f) (test (<= 1.0 1 9223372036 1/9223372036) #f) (test (<= 1.0 1 922337203685 1/922337203685) #f) (test (<= 1.0 9223372036 1/9223372036 1) #f) (test (<= 1.0 9223372036 1/9223372036) #f) (test (<= 1.0 922337203685 1/922337203685 1) #f) (test (<= 1.0 922337203685 1/922337203685) #f) (test (<= 1/9223372036 9223372036) #t) (test (<= 1/922337203685 922337203685) #t) (test (<= 9223372036 1/9223372036 1 1.0) #f) (test (<= 9223372036 1/9223372036 1) #f) (test (<= 9223372036 1/9223372036 1.0 1) #f) (test (<= 9223372036 1/9223372036 1.0) #f) (test (<= 9223372036 1/9223372036) #f) (test (<= 922337203685 1/922337203685 1 1.0) #f) (test (<= 922337203685 1/922337203685 1) #f) (test (<= 922337203685 1/922337203685 1.0 1) #f) (test (<= 922337203685 1/922337203685 1.0) #f) (test (<= 922337203685 1/922337203685) #f) (test (<= 9223372036854775807 1/9223372036854775807 1) #f) (test (<= 9223372036854775807 1/9223372036854775807) #f) (test (<= 1 1.0 9223372036854775806/9223372036854775807 9223372036854775807/9223372036854775806) #f) (test (<= 1 1.0 9223372036854775806/9223372036854775807) #f) (test (<= 1 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #f) (test (<= 1 9223372036854775807/9223372036854775806 1.0) #f) (test (<= 1.0 9223372036854775806/9223372036854775807 1 9223372036854775807/9223372036854775806) #f) (test (<= 1.0 9223372036854775806/9223372036854775807 1) #f) (test (<= 1.0 9223372036854775806/9223372036854775807 9223372036854775807/9223372036854775806) #f) (test (<= 1.0 9223372036854775806/9223372036854775807) #f) (test (<= 9223372036854775806/9223372036854775807 1 9223372036854775807/9223372036854775806 1.0) #f) (test (<= 9223372036854775806/9223372036854775807 9223372036854775807/9223372036854775806 1.0 1) #f) (test (<= 9223372036854775806/9223372036854775807 9223372036854775807/9223372036854775806 1.0) #f) (test (<= 9223372036854775807/9223372036854775806 1.0 1) #f) (test (<= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807 1) #f) (test (<= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #f) (test (<= 9223372036854775807/9223372036854775806 1.0) #f) (when with-bignums (test (<= 12345678901234567890 12345678901234567891) #t) ;(test (let () (define (func) (<= (bignum +nan.0) 10001)) (define (hi) (func)) (hi)) #f) (test (let () (define (func) (<= (bignum +nan.0) 0+i)) (define (hi) (func)) (hi)) 'error) (test (<= 4272943/1360120 21053343141/6701487259 2646693125139304345/842468587426513207 3587785776203/1142027682075) #f) (test (<= 4272943/1360120 3587785776203/1142027682075 21053343141/6701487259 2646693125139304345/842468587426513207) #f) (test (<= 4272943/1360120 3587785776203/1142027682075 21053343141/6701487259) #f) (test (<= 4272943/1360120 2646693125139304345/842468587426513207 3587785776203/1142027682075) #f) (test (<= 21053343141/6701487259 2646693125139304345/842468587426513207 3587785776203/1142027682075) #f) (test (<= 3587785776203/1142027682075 21053343141/6701487259 2646693125139304345/842468587426513207) #f) (test (<= 3587785776203/1142027682075 21053343141/6701487259) #f) (test (<= 2646693125139304345/842468587426513207 21053343141/6701487259) #f) (test (<= 4272943/1360120 3587785776203/1142027682075 21053343141/6701487259 355/113) #f) (test (<= 3587785776203/1142027682075 21053343141/6701487259 355/113) #f) (test (<= 1267650600228229401496703205376) 'error)) (for-each (lambda (arg) (test (<= arg +nan.0) 'error) (test (<= +nan.0 arg) 'error) (test (<= arg +inf.0) 'error) (test (<= +inf.0 arg) 'error) (test (<= 1 0 arg) 'error) (test (<= 1 arg) 'error) (test (<= 1.0 arg) 'error) (test (<= 1/2 arg) 'error) (test (<= arg 1) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (<= +nan.0 2.0) #f) (test (<= +nan.0 (bignum 2.0)) #f) (test (<= (bignum +nan.0) 2.0) #f) (test (<= (bignum +nan.0) (bignum 2.0)) #f) (test (< +nan.0 2.0) #f) (test (< +nan.0 (bignum 2.0)) #f) (test (< (bignum +nan.0) 2.0) #f) (test (< (bignum +nan.0) (bignum 2.0)) #f) (test (>= +nan.0 2.0) #f) (test (>= +nan.0 (bignum 2.0)) #f) (test (>= (bignum +nan.0) 2.0) #f) (test (>= (bignum +nan.0) (bignum 2.0)) #f) (test (> +nan.0 2.0) #f) (test (> +nan.0 (bignum 2.0)) #f) (test (> (bignum +nan.0) 2.0) #f) (test (> (bignum +nan.0) (bignum 2.0)) #f) (test (= +nan.0 2.0) #f) (test (= +nan.0 (bignum 2.0)) #f) (test (= (bignum +nan.0) 2.0) #f) (test (= (bignum +nan.0) (bignum 2.0)) #f) ;;; -------------------------------------------------------------------------------- ;;; = ;;; -------------------------------------------------------------------------------- (test (= -1.0+1.0i -1.0+1.0i) #t) (test (= -1.0+1.0i 0.0+1.0i) #f) (test (= -1.0+1.0i 1) #f) (test (= -1.0+1.0i 1.0) #f) (test (= -1.0+1.0i 1.0+1.0i) #f) (test (= -1.0+1.0i 1/1) #f) (test (= -1.0+1.0i 123.4) #f) (test (= -1.0+1.0i 1234) #f) (test (= -1.0+1.0i 1234/11) #f) (test (= 0 -1.0+1.0i) #f) (test (= 0 0.0+1.0i) #f) (test (= 0 1 -1.0+1.0i) #f) (test (= 0 1 0.0+1.0i) #f) (test (= 0 1 1) #f) (test (= 0 1 1.0) #f) (test (= 0 1 1.0+1.0i) #f) (test (= 0 1 1/1) #f) (test (= 0 1 123.4) #f) (test (= 0 1 1234) #f) (test (= 0 1 1234/11) #f) (test (= 0 1) #f) (test (= 0 -0) #t) (test (= 0 1.0 -1.0+1.0i) #f) (test (= 0 1.0 0.0+1.0i) #f) (test (= 0 1.0 1) #f) (test (= 0 1.0 1.0) #f) (test (= 0 1.0 1.0+1.0i) #f) (test (= 0 1.0 1/1) #f) (test (= 0 1.0 123.4) #f) (test (= 0 1.0 1234) #f) (test (= 0 1.0 1234/11) #f) (test (= 0 1.0) #f) (test (= 0 1.0+1.0i -1.0+1.0i) #f) (test (= 0 1.0+1.0i 0.0+1.0i) #f) (test (= 0 1.0+1.0i 1) #f) (test (= 0 1.0+1.0i 1.0) #f) (test (= 0 1.0+1.0i 1.0+1.0i) #f) (test (= 0 1.0+1.0i 1/1) #f) (test (= 0 1.0+1.0i 123.4) #f) (test (= 0 1.0+1.0i 1234) #f) (test (= 0 1.0+1.0i 1234/11) #f) (test (= 0 1.0+1.0i) #f) (test (= 0 123.4) #f) (test (= 0 1234) #f) (test (= 0 1234/11) #f) (test (= 0.0 -1.0+1.0i -1.0+1.0i) #f) (test (= 0.0 -1.0+1.0i 0.0+1.0i) #f) (test (= 0.0 -1.0+1.0i 1) #f) (test (= 0.0 -1.0+1.0i 1.0) #f) (test (= 0.0 -1.0+1.0i 1.0+1.0i) #f) (test (= 0.0 -1.0+1.0i 1/1) #f) (test (= 0.0 -1.0+1.0i 123.4) #f) (test (= 0.0 -1.0+1.0i 1234) #f) (test (= 0.0 -1.0+1.0i 1234/11) #f) (test (= 0.0 -1.0+1.0i) #f) (test (= 0.0 0.0+1.0i -1.0+1.0i) #f) (test (= 0.0 0.0+1.0i 0.0+1.0i) #f) (test (= 0.0 0.0+1.0i 1) #f) (test (= 0.0 0.0+1.0i 1.0) #f) (test (= 0.0 0.0+1.0i 1.0+1.0i) #f) (test (= 0.0 0.0+1.0i 1/1) #f) (test (= 0.0 0.0+1.0i 123.4) #f) (test (= 0.0 0.0+1.0i 1234) #f) (test (= 0.0 0.0+1.0i 1234/11) #f) (test (= 0.0 0.0+1.0i) #f) (test (= 0.0 1 -1.0+1.0i) #f) (test (= 0.0 1 0.0+1.0i) #f) (test (= 0.0 1 1.0) #f) (test (= 0.0 1 1.0+1.0i) #f) (test (= 0.0 1 1/1) #f) (test (= 0.0 1 123.4) #f) (test (= 0.0 1 1234) #f) (test (= 0.0 1 1234/11) #f) (test (= 0.0 1) #f) (test (= 0.0 1.0 -1.0+1.0i) #f) (test (= 0.0 1.0 0.0+1.0i) #f) (test (= 0.0 1.0 1) #f) (test (= 0.0 1.0 1.0) #f) (test (= 0.0 1.0 1.0+1.0i) #f) (test (= 0.0 1.0 1/1) #f) (test (= 0.0 1.0 123.4) #f) (test (= 0.0 1.0 1234) #f) (test (= 0.0 1.0 1234/11) #f) (test (= 0.0 1.0) #f) (test (= 0.0 1.0+1.0i -1.0+1.0i) #f) (test (= 0.0 1.0+1.0i 0.0+1.0i) #f) (test (= 0.0 1.0+1.0i 1) #f) (test (= 0.0 1.0+1.0i 1.0) #f) (test (= 0.0 1.0+1.0i 1.0+1.0i) #f) (test (= 0.0 1.0+1.0i 1/1) #f) (test (= 0.0 1.0+1.0i 123.4) #f) (test (= 0.0 1.0+1.0i 1234) #f) (test (= 0.0 1.0+1.0i 1234/11) #f) (test (= 0.0 1.0+1.0i) #f) (test (= 0.0 123.4 -1.0+1.0i) #f) (test (= 0.0 123.4 0.0+1.0i) #f) (test (= 0.0 123.4 1) #f) (test (= 0.0 123.4 1.0) #f) (test (= 0.0 123.4 1.0+1.0i) #f) (test (= 0.0 123.4 1/1) #f) (test (= 0.0 123.4 123.4) #f) (test (= 0.0 123.4 1234) #f) (test (= 0.0 123.4 1234/11) #f) (test (= 0.0 123.4) #f) (test (= 0.0 1234 -1.0+1.0i) #f) (test (= 0.0 1234 0.0+1.0i) #f) (test (= 0.0 1234 1) #f) (test (= 0.0 1234 1.0) #f) (test (= 0.0 1234 1.0+1.0i) #f) (test (= 0.0 1234 1/1) #f) (test (= 0.0 1234 123.4) #f) (test (= 0.0 1234 1234) #f) (test (= 0.0 1234 1234/11) #f) (test (= 0.0 1234) #f) (test (= 0.0 1234/11 -1.0+1.0i) #f) (test (= 0.0 1234/11 0.0+1.0i) #f) (test (= 0.0 1234/11 1) #f) (test (= 0.0 1234/11 1.0) #f) (test (= 0.0 1234/11 1.0+1.0i) #f) (test (= 0.0 1234/11 1/1) #f) (test (= 0.0 1234/11 123.4) #f) (test (= 0.0 1234/11 1234) #f) (test (= 0.0 1234/11 1234/11) #f) (test (= 0.0 1234/11) #f) (test (= 0.0+1.0i -1.0+1.0i) #f) (test (= 0.0+1.0i 0.0+1.0i) #t) (test (= 0.0+1.0i 1) #f) (test (= 0.0+1.0i 1.0) #f) (test (= 0.0+1.0i 1.0+1.0i) #f) (test (= 0.0+1.0i 1/1) #f) (test (= 0.0+1.0i 123.4) #f) (test (= 0.0+1.0i 1234) #f) (test (= 0.0+1.0i 1234/11) #f) (test (= 1 -1) #f) (test (= 1 -1.0+1.0i) #f) (test (= 1 -2) #f) (test (= 1 0.0+1.0i) #f) (test (= 1 1 -1.0+1.0i) #f) (test (= 1 1 0.0+1.0i) #f) (test (= 1 1 1) #t) (test (= 1 1 1.0) #t) (test (= 1 1 1.0+1.0i) #f) (test (= 1 1 1/1) #t) (test (= 1 1 123.4) #f) (test (= 1 1 1234) #f) (test (= 1 1 1234/11) #f) (test (= 1 1) #t) (test (= 1 1.0 -1.0+1.0i) #f) (test (= 1 1.0 0.0+1.0i) #f) (test (= 1 1.0 1) #t) (test (= 1 1.0 1.0) #t) (test (= 1 1.0 1.0+1.0i) #f) (test (= 1 1.0 1/1) #t) (test (= 1 1.0 123.4) #f) (test (= 1 1.0 1234) #f) (test (= 1 1.0 1234/11) #f) (test (= 1 1.0) #t) (test (= 1 1.0+1.0i -1.0+1.0i) #f) (test (= 1 1.0+1.0i 0.0+1.0i) #f) (test (= 1 1.0+1.0i 1) #f) (test (= 1 1.0+1.0i 1.0) #f) (test (= 1 1.0+1.0i 1.0+1.0i) #f) (test (= 1 1.0+1.0i 1/1) #f) (test (= 1 1.0+1.0i 123.4) #f) (test (= 1 1.0+1.0i 1234) #f) (test (= 1 1.0+1.0i 1234/11) #f) (test (= 1 1.0+1.0i) #f) (test (= 1 123.4) #f) (test (= 1 1234) #f) (test (= 1 1234/11) #f) (test (= 1.0 -1.0) #f) (test (= 1.0 -1.0+1.0i -1.0+1.0i) #f) (test (= 1.0 -1.0+1.0i 0.0+1.0i) #f) (test (= 1.0 -1.0+1.0i 1) #f) (test (= 1.0 -1.0+1.0i 1.0) #f) (test (= 1.0 -1.0+1.0i 1.0+1.0i) #f) (test (= 1.0 -1.0+1.0i 1/1) #f) (test (= 1.0 -1.0+1.0i 123.4) #f) (test (= 1.0 -1.0+1.0i 1234) #f) (test (= 1.0 -1.0+1.0i 1234/11) #f) (test (= 1.0 -1.0+1.0i) #f) (test (= 1.0 0.0+1.0i -1.0+1.0i) #f) (test (= 1.0 0.0+1.0i 0.0+1.0i) #f) (test (= 1.0 0.0+1.0i 1) #f) (test (= 1.0 0.0+1.0i 1.0) #f) (test (= 1.0 0.0+1.0i 1.0+1.0i) #f) (test (= 1.0 0.0+1.0i 1/1) #f) (test (= 1.0 0.0+1.0i 123.4) #f) (test (= 1.0 0.0+1.0i 1234) #f) (test (= 1.0 0.0+1.0i 1234/11) #f) (test (= 1.0 0.0+1.0i) #f) (test (= 1.0 1 -1.0+1.0i) #f) (test (= 1.0 1 0.0+1.0i) #f) (test (= 1.0 1 1) #t) (test (= 1.0 1 1.0) #t) (test (= 1.0 1 1.0+1.0i) #f) (test (= 1.0 1 1/1) #t) (test (= 1.0 1 123.4) #f) (test (= 1.0 1 1234) #f) (test (= 1.0 1 1234/11) #f) (test (= 1.0 1) #t) (test (= 1.0 1.0 -1.0+1.0i) #f) (test (= 1.0 1.0 0.0+1.0i) #f) (test (= 1.0 1.0 1) #t) (test (= 1.0 1.0 1.0) #t) (test (= 1.0 1.0 1.0+1.0i) #f) (test (= 1.0 1.0 1/1) #t) (test (= 1.0 1.0 123.4) #f) (test (= 1.0 1.0 1234) #f) (test (= 1.0 1.0 1234/11) #f) (test (= 1.0 1.0) #t) (test (= 1.0 1.0+1.0i -1.0+1.0i) #f) (test (= 1.0 1.0+1.0i 0.0+1.0i) #f) (test (= 1.0 1.0+1.0i 1) #f) (test (= 1.0 1.0+1.0i 1.0) #f) (test (= 1.0 1.0+1.0i 1.0+1.0i) #f) (test (= 1.0 1.0+1.0i 1/1) #f) (test (= 1.0 1.0+1.0i 123.4) #f) (test (= 1.0 1.0+1.0i 1234) #f) (test (= 1.0 1.0+1.0i 1234/11) #f) (test (= 1.0 1.0+1.0i) #f) (test (= 1.0 123.4 -1.0+1.0i) #f) (test (= 1.0 123.4 0.0+1.0i) #f) (test (= 1.0 123.4 1) #f) (test (= 1.0 123.4 1.0) #f) (test (= 1.0 123.4 1.0+1.0i) #f) (test (= 1.0 123.4 1/1) #f) (test (= 1.0 123.4 123.4) #f) (test (= 1.0 123.4 1234) #f) (test (= 1.0 123.4 1234/11) #f) (test (= 1.0 123.4) #f) (test (= 1.0 1234 -1.0+1.0i) #f) (test (= 1.0 1234 0.0+1.0i) #f) (test (= 1.0 1234 1) #f) (test (= 1.0 1234 1.0) #f) (test (= 1.0 1234 1.0+1.0i) #f) (test (= 1.0 1234 1/1) #f) (test (= 1.0 1234 123.4) #f) (test (= 1.0 1234 1234) #f) (test (= 1.0 1234 1234/11) #f) (test (= 1.0 1234) #f) (test (= 1.0 1234/11 -1.0+1.0i) #f) (test (= 1.0 1234/11 0.0+1.0i) #f) (test (= 1.0 1234/11 1) #f) (test (= 1.0 1234/11 1.0) #f) (test (= 1.0 1234/11 1.0+1.0i) #f) (test (= 1.0 1234/11 1/1) #f) (test (= 1.0 1234/11 123.4) #f) (test (= 1.0 1234/11 1234) #f) (test (= 1.0 1234/11 1234/11) #f) (test (= 1.0 1234/11) #f) (test (= 1.0+1.0i -1.0+1.0i -1.0+1.0i) #f) (test (= 1.0+1.0i -1.0+1.0i 0.0+1.0i) #f) (test (= 1.0+1.0i -1.0+1.0i 1) #f) (test (= 1.0+1.0i -1.0+1.0i 1.0) #f) (test (= 1.0+1.0i -1.0+1.0i 1.0+1.0i) #f) (test (= 1.0+1.0i -1.0+1.0i 1/1) #f) (test (= 1.0+1.0i -1.0+1.0i 123.4) #f) (test (= 1.0+1.0i -1.0+1.0i 1234) #f) (test (= 1.0+1.0i -1.0+1.0i 1234/11) #f) (test (= 1.0+1.0i -1.0+1.0i) #f) (test (= 1.0+1.0i 0.0+1.0i -1.0+1.0i) #f) (test (= 1.0+1.0i 0.0+1.0i 0.0+1.0i) #f) (test (= 1.0+1.0i 0.0+1.0i 1) #f) (test (= 1.0+1.0i 0.0+1.0i 1.0) #f) (test (= 1.0+1.0i 0.0+1.0i 1.0+1.0i) #f) (test (= 1.0+1.0i 0.0+1.0i 1/1) #f) (test (= 1.0+1.0i 0.0+1.0i 123.4) #f) (test (= 1.0+1.0i 0.0+1.0i 1234) #f) (test (= 1.0+1.0i 0.0+1.0i 1234/11) #f) (test (= 1.0+1.0i 0.0+1.0i) #f) (test (= 1.0+1.0i 1 -1.0+1.0i) #f) (test (= 1.0+1.0i 1 0.0+1.0i) #f) (test (= 1.0+1.0i 1 1) #f) (test (= 1.0+1.0i 1 1.0) #f) (test (= 1.0+1.0i 1 1.0+1.0i) #f) (test (= 1.0+1.0i 1 1/1) #f) (test (= 1.0+1.0i 1 123.4) #f) (test (= 1.0+1.0i 1 1234) #f) (test (= 1.0+1.0i 1 1234/11) #f) (test (= 1.0+1.0i 1) #f) (test (= 1.0+1.0i 1.0 -1.0+1.0i) #f) (test (= 1.0+1.0i 1.0 0.0+1.0i) #f) (test (= 1.0+1.0i 1.0 1) #f) (test (= 1.0+1.0i 1.0 1.0) #f) (test (= 1.0+1.0i 1.0 1.0+1.0i) #f) (test (= 1.0+1.0i 1.0 1/1) #f) (test (= 1.0+1.0i 1.0 123.4) #f) (test (= 1.0+1.0i 1.0 1234) #f) (test (= 1.0+1.0i 1.0 1234/11) #f) (test (= 1.0+1.0i 1.0) #f) (test (= 1.0+1.0i 1.0+1.0i -1.0+1.0i) #f) (test (= 1.0+1.0i 1.0+1.0i 0.0+1.0i) #f) (test (= 1.0+1.0i 1.0+1.0i 1) #f) (test (= 1.0+1.0i 1.0+1.0i 1.0) #f) (test (= 1.0+1.0i 1.0+1.0i 1.0+1.0i) #t) (test (= 1.0+1.0i 1.0+1.0i 1/1) #f) (test (= 1.0+1.0i 1.0+1.0i 123.4) #f) (test (= 1.0+1.0i 1.0+1.0i 1234) #f) (test (= 1.0+1.0i 1.0+1.0i 1234/11) #f) (test (= 1.0+1.0i 1.0+1.0i) #t) (test (= 1.0+1.0i 123.4 -1.0+1.0i) #f) (test (= 1.0+1.0i 123.4 0.0+1.0i) #f) (test (= 1.0+1.0i 123.4 1) #f) (test (= 1.0+1.0i 123.4 1.0) #f) (test (= 1.0+1.0i 123.4 1.0+1.0i) #f) (test (= 1.0+1.0i 123.4 1/1) #f) (test (= 1.0+1.0i 123.4 123.4) #f) (test (= 1.0+1.0i 123.4 1234) #f) (test (= 1.0+1.0i 123.4 1234/11) #f) (test (= 1.0+1.0i 123.4) #f) (test (= 1.0+1.0i 1234 -1.0+1.0i) #f) (test (= 1.0+1.0i 1234 0.0+1.0i) #f) (test (= 1.0+1.0i 1234 1) #f) (test (= 1.0+1.0i 1234 1.0) #f) (test (= 1.0+1.0i 1234 1.0+1.0i) #f) (test (= 1.0+1.0i 1234 1/1) #f) (test (= 1.0+1.0i 1234 123.4) #f) (test (= 1.0+1.0i 1234 1234) #f) (test (= 1.0+1.0i 1234 1234/11) #f) (test (= 1.0+1.0i 1234) #f) (test (= 1.0+1.0i 1234/11 -1.0+1.0i) #f) (test (= 1.0+1.0i 1234/11 0.0+1.0i) #f) (test (= 1.0+1.0i 1234/11 1) #f) (test (= 1.0+1.0i 1234/11 1.0) #f) (test (= 1.0+1.0i 1234/11 1.0+1.0i) #f) (test (= 1.0+1.0i 1234/11 1/1) #f) (test (= 1.0+1.0i 1234/11 123.4) #f) (test (= 1.0+1.0i 1234/11 1234) #f) (test (= 1.0+1.0i 1234/11 1234/11) #f) (test (= 1.0+1.0i 1234/11) #f) (test (= 123.4 -1.0+1.0i -1.0+1.0i) #f) (test (= 123.4 -1.0+1.0i 0.0+1.0i) #f) (test (= 123.4 -1.0+1.0i 1) #f) (test (= 123.4 -1.0+1.0i 1.0) #f) (test (= 123.4 -1.0+1.0i 1.0+1.0i) #f) (test (= 123.4 -1.0+1.0i 1/1) #f) (test (= 123.4 -1.0+1.0i 123.4) #f) (test (= 123.4 -1.0+1.0i 1234) #f) (test (= 123.4 -1.0+1.0i 1234/11) #f) (test (= 123.4 -1.0+1.0i) #f) (test (= 123.4 0.0+1.0i -1.0+1.0i) #f) (test (= 123.4 0.0+1.0i 0.0+1.0i) #f) (test (= 123.4 0.0+1.0i 1) #f) (test (= 123.4 0.0+1.0i 1.0) #f) (test (= 123.4 0.0+1.0i 1.0+1.0i) #f) (test (= 123.4 0.0+1.0i 1/1) #f) (test (= 123.4 0.0+1.0i 123.4) #f) (test (= 123.4 0.0+1.0i 1234) #f) (test (= 123.4 0.0+1.0i 1234/11) #f) (test (= 123.4 0.0+1.0i) #f) (test (= 123.4 1 -1.0+1.0i) #f) (test (= 123.4 1 0.0+1.0i) #f) (test (= 123.4 1 1) #f) (test (= 123.4 1 1.0) #f) (test (= 123.4 1 1.0+1.0i) #f) (test (= 123.4 1 1/1) #f) (test (= 123.4 1 123.4) #f) (test (= 123.4 1 1234) #f) (test (= 123.4 1 1234/11) #f) (test (= 123.4 1) #f) (test (= 123.4 1.0 -1.0+1.0i) #f) (test (= 123.4 1.0 0.0+1.0i) #f) (test (= 123.4 1.0 1) #f) (test (= 123.4 1.0 1.0) #f) (test (= 123.4 1.0 1.0+1.0i) #f) (test (= 123.4 1.0 1/1) #f) (test (= 123.4 1.0 123.4) #f) (test (= 123.4 1.0 1234) #f) (test (= 123.4 1.0 1234/11) #f) (test (= 123.4 1.0) #f) (test (= 123.4 1.0+1.0i -1.0+1.0i) #f) (test (= 123.4 1.0+1.0i 0.0+1.0i) #f) (test (= 123.4 1.0+1.0i 1) #f) (test (= 123.4 1.0+1.0i 1.0) #f) (test (= 123.4 1.0+1.0i 1.0+1.0i) #f) (test (= 123.4 1.0+1.0i 1/1) #f) (test (= 123.4 1.0+1.0i 123.4) #f) (test (= 123.4 1.0+1.0i 1234) #f) (test (= 123.4 1.0+1.0i 1234/11) #f) (test (= 123.4 1.0+1.0i) #f) (test (= 123.4 123.4 -1.0+1.0i) #f) (test (= 123.4 123.4 0.0+1.0i) #f) (test (= 123.4 123.4 1) #f) (test (= 123.4 123.4 1.0) #f) (test (= 123.4 123.4 1.0+1.0i) #f) (test (= 123.4 123.4 1/1) #f) (test (= 123.4 123.4 123.4) #t) (test (= 123.4 123.4 1234) #f) (test (= 123.4 123.4 1234/11) #f) (test (= 123.4 123.4) #t) (test (= 123.4 1234 -1.0+1.0i) #f) (test (= 123.4 1234 0.0+1.0i) #f) (test (= 123.4 1234 1) #f) (test (= 123.4 1234 1.0) #f) (test (= 123.4 1234 1.0+1.0i) #f) (test (= 123.4 1234 1/1) #f) (test (= 123.4 1234 123.4) #f) (test (= 123.4 1234 1234) #f) (test (= 123.4 1234 1234/11) #f) (test (= 123.4 1234) #f) (test (= 123.4 1234/11 -1.0+1.0i) #f) (test (= 123.4 1234/11 0.0+1.0i) #f) (test (= 123.4 1234/11 1) #f) (test (= 123.4 1234/11 1.0) #f) (test (= 123.4 1234/11 1.0+1.0i) #f) (test (= 123.4 1234/11 1/1) #f) (test (= 123.4 1234/11 123.4) #f) (test (= 123.4 1234/11 1234) #f) (test (= 123.4 1234/11 1234/11) #f) (test (= 123.4 1234/11) #f) (test (= 1234 -1.0+1.0i) #f) (test (= 1234 0.0+1.0i) #f) (test (= 1234 1) #f) (test (= 1234 1.0) #f) (test (= 1234 1.0+1.0i) #f) (test (= 1234 1/1) #f) (test (= 1234 123.4) #f) (test (= 1234 1234) #t) (test (= 1234 1234/11) #f) (test (= 1234/11 -1.0+1.0i) #f) (test (= 1234/11 0.0+1.0i) #f) (test (= 1234/11 1) #f) (test (= 1234/11 1.0) #f) (test (= 1234/11 1.0+1.0i) #f) (test (= 1234/11 1/1) #f) (test (= 1234/11 123.4) #f) (test (= 1234/11 1234) #f) (test (= 1234/11 1234/11) #t) (test (= 2 -1) #f) (test (= 2 -2) #f) (test (= -0 0) #t) (test (= -0-0i 0.0) #t) (test (= -0.0 0.0) #t) (test (= -0.0-0.0i 0.0) #t) (test (= .6 .6) #t) (test (= 0.11 0.11) #t) (test (= 0.18 0.18) #t) (test (= 0.3 0.3) #t) (test (= 0.333 0.333) #t) (test (= 0.60 0.60) #t) (test (= 0.999 0.999) #t) (test (= 1 2 #\a) 'error) (test (= 1+0i 1-0i) #t) (test (= 1+i 0+i) #f) (test (= 1+i 0-i) #f) (test (= 1/2 1/2+0i) #t) ; gmp reads 1/2+0i as 1.0 (test (= 100.000 100.000) #t) (test (= 1e10 1e10) #t) (test (= 22 22 22) #t) (test (= 22 22) #t) (test (= 34 34 35) #f) (test (= 34 35) #f) (test (= 60e-2 60e-2) #t) ;; should these be an error if not bignums? or if safety>n? (test (= 9007199254740992 9007199254740992.0) #t) (when with-bignums (test (= 9007199254740992 (+ 9007199254740992 1.0)) #f) (test (= 9007199254740992 (+ 9007199254740992 1.0e-1)) #f) (test (= 9007199254740992 (+ 9007199254740992 1.0e-10)) #f)) (test (= 92233720368547758/19 (exact->inexact 92233720368547758/19)) #f) ; repeating decimal 4.854406335186724105263157894736842105267E15) (test (= 9007199254740992.0 9007199254740992) #t) (when with-bignums (test (= (+ 9007199254740992 1.0) 9007199254740992) #f) (test (= (+ 9007199254740992 1.0e-1) 9007199254740992) #f) (test (= (+ 9007199254740992 1.0e-10) 9007199254740992) #f)) (test (= (exact->inexact 92233720368547758/19) 92233720368547758/19) #f) (test (= 9007199254740993 (+ 9007199254740992 1)) #t) (test (= 9007199254740993.0 (+ 9007199254740992 1)) #t) (test (= 9007199254740993.0 (+ 9007199254740992 1.0)) #t) (test (= 9007199254740991 (- 9007199254740992 1)) #t) (test (= 9007199254740991.0 (- 9007199254740992 1)) #t) (test (= 9007199254740991.0 (- 9007199254740992 1.0)) #t) (test (let () (define (f) (= 9007199254740993.0 (+ 9007199254740992 1))) (f)) #t) (when with-bignums (test (let () (define (f) (= 9007199254740992 (+ 9007199254740992 1.0))) (f)) #f)) (test (= 0 0.0) #t) (test (= 0 1 "hi") 'error) (test (= 0) 'error) (test (=) 'error) (test (= 0.0 0.0) #t) (test (= 0.0 1.0 "hi") 'error) (test (= 0.0) 'error) (test (= 0.0+0.00000001i) 'error) (test (= 0/1) 'error) (test (= 1.0) 'error) (test (= 1.0+1.0i) 'error) (test (= 1 lambda) 'error) (test (= 10/3) 'error) (test (= 2) 'error) (test (= 2.5 5/2) #t) (test (= 2.5+0.0i 5/2) #t) (test (= 2.5+1.0i 5/2) #f) (test (= pi '(1)) 'error) ; for gmp (test (= 3 2 3) #f) (test (= 3 3 3 3) #t) (test (= 3 3 5 3) #f) (test (= 3 3) #t) (test (= 3 3.0) #t) (test (= 3 5) #f) (test (= 3 6 5 2) #f) (test (= 3.0 3.0+0.0i) #t) (test (= 5/2 2.5) #t) (test (= 5/2 2.5+0.0i) #t) (test (= 5/2 2.5+1.0i) #f) (for-each (lambda (arg) (test (= arg +nan.0) 'error) (test (= +nan.0 arg) 'error) (test (= arg +inf.0) 'error) (test (= +inf.0 arg) 'error) (test (= 1 0 arg) 'error) (test (= 1 arg) 'error) (test (= 1.0 arg) 'error) (test (= 1/2 arg) 'error) (test (= 1+i arg) 'error) (test (= arg 1) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (= +0 -0 0/100 00 -0/9223372036854775807) #t) (test (= +1/2 1/2) #t) (test (= 0 0) #t) (test (= 0.0 0.0+0.0i +0.0 -0.0 +.0 -.0 +0. -0. 0. .0 0.e1 0e1 0e+1 +0.0e+1+0.0e+1i 0-0i) #t) (test (= 1.0 1.0+0.0i +1.0 1. 1e0 1-0i) #t) (test (= 0.0+0.0i 0.0+0.0i) #t) (test (= 1+1i 1+1i) #t) (test (= 1.0+1i 1.0+1.0i) #t) (test (= 100000000000000.0 100000000000001.0) #f) (test (= -1.797693134862315699999999999999999999998E308 -9223372036854775808) #f) (test (= -9223372036854775808 -9223372036854775808) #t) (test (= -9223372036854775808 5.551115123125783999999999999999999999984E-17) #f) (test (= -9223372036854775808 9223372036854775807 -9223372036854775808) #f) (test (= 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #f) (when with-bignums (test (= 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #f) (test (= 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #f)) (test (= 9223372036854775807 -9223372036854775808) #f) (test (= 9223372036854775807 9223372036854775807) #t) (test (= (* most-negative-fixnum 1) (- (* -1 most-positive-fixnum) 1)) #t) (test (= (* most-positive-fixnum -1) (+ most-negative-fixnum 1)) #t) (test (= (+ most-negative-fixnum 1) (- most-positive-fixnum)) #t) (test (= (+ most-negative-fixnum most-positive-fixnum) -1) #t) (test (= (- most-negative-fixnum (- most-positive-fixnum)) -1) #t) (test (= 0 1/0 0/0) #f) (test (= 0/1 -0/1) #t) (test (= 1/0 (log 0)) #f) (test (= 1/0 -1/0) #f) (test (= 1e100 1e+100) #t) (test (= most-negative-fixnum (/ (log 0) (log 0))) #f) (test (= most-negative-fixnum 0/0) #f) (test (= most-negative-fixnum 0/0+0/0i) #f) (test (= most-negative-fixnum 1/0) #f) (test (= most-positive-fixnum (/ (log 0) (log 0))) #f) (test (= most-positive-fixnum 0/0) #f) (test (= most-positive-fixnum 0/0+0/0i) #f) (test (= most-positive-fixnum 1/0) #f) (test (= most-positive-fixnum most-negative-fixnum) #f) (test (= most-positive-fixnum most-positive-fixnum) #t) (test (= 1+i 1+nan.0i) #f) ; mpc_cmp can't handle NaNs, so we have to check that case by hand (test (= (bignum 1+i) 1+nan.0i) #f) (test (= 1+i (bignum 1+nan.0i)) #f) (test (= (bignum 1+i) (bignum 1+nan.0i)) #f) (test (= 1+nan.0i 1+i) #f) (test (= (bignum 1+nan.0i) 1+i) #f) (test (= 1+nan.0i (bignum 1+i)) #f) (test (= (bignum 1+nan.0i) (bignum 1+i)) #f) (test (eqv? 1+i 1+nan.0i) #f) (test (eqv? (bignum 1+i) 1+nan.0i) #f) (test (eqv? 1+i (bignum 1+nan.0i)) #f) (test (eqv? (bignum 1+i) (bignum 1+nan.0i)) #f) (test (eqv? 1+nan.0i 1+i) #f) (test (eqv? (bignum 1+nan.0i) 1+i) #f) (test (eqv? 1+nan.0i (bignum 1+i)) #f) (test (eqv? (bignum 1+nan.0i) (bignum 1+i)) #f) (test (equal? 1+i 1+nan.0i) #f) (test (equal? (bignum 1+i) 1+nan.0i) #f) (test (equal? 1+i (bignum 1+nan.0i)) #f) (test (equal? (bignum 1+i) (bignum 1+nan.0i)) #f) (test (equal? 1+nan.0i 1+i) #f) (test (equal? (bignum 1+nan.0i) 1+i) #f) (test (equal? 1+nan.0i (bignum 1+i)) #f) (test (equal? (bignum 1+nan.0i) (bignum 1+i)) #f) (test (equivalent? 1+i 1+nan.0i) #f) (test (equivalent? (bignum 1+i) 1+nan.0i) #f) (test (equivalent? 1+i (bignum 1+nan.0i)) #f) (test (equivalent? (bignum 1+i) (bignum 1+nan.0i)) #f) (test (equivalent? 1+nan.0i 1+i) #f) (test (equivalent? (bignum 1+nan.0i) 1+i) #f) (test (equivalent? 1+nan.0i (bignum 1+i)) #f) (test (equivalent? (bignum 1+nan.0i) (bignum 1+i)) #f) (test (> (bignum 3/4) +nan.0) #f) (test (>= (bignum 3/4) +nan.0) #f) (test (< (bignum 3/4) +nan.0) #f) (test (<= (bignum 3/4) +nan.0) #f) (test (> +nan.0 (bignum 3/4)) #f) (test (>= +nan.0 (bignum 3/4)) #f) (test (< +nan.0 (bignum 3/4)) #f) (test (<= +nan.0 (bignum 3/4)) #f) (test (<= (bignum +nan.0) (bignum 23)) #f) (when with-bignums (test (= (bignum +nan.0) "asdf") 'error) (test (let () (define (func) (= (bignum +nan.0) 10001)) (define (hi) (func)) (hi)) #f) (for-each ; just do them all! (lambda (op) (if (op +nan.0 +nan.0) (format *stderr* "~A bignum case 1~%" op)) (if (op +nan.0 (bignum +nan.0)) (format *stderr* "~A bignum case 2~%" op)) (if (op +nan.0 1) (format *stderr* "~A bignum case 3~%" op)) (if (op +nan.0 1/2) (format *stderr* "~A bignum case 4~%" op)) (if (op +nan.0 1.0) (format *stderr* "~A bignum case 5~%" op)) (if (op +nan.0 (bignum 1)) (format *stderr* "~A bignum case 6~%" op)) (if (op +nan.0 (bignum 1/2)) (format *stderr* "~A bignum case 7~%" op)) (if (op +nan.0 (bignum 1.0)) (format *stderr* "~A bignum case 8~%" op)) (if (op (bignum +nan.0) +nan.0) (format *stderr* "~A bignum case 11~%" op)) (if (op (bignum +nan.0) (bignum +nan.0)) (format *stderr* "~A bignum case 12~%" op)) (if (op (bignum +nan.0) 1) (format *stderr* "~A bignum case 13~%" op)) (if (op (bignum +nan.0) 1/2) (format *stderr* "~A bignum case 14~%" op)) (if (op (bignum +nan.0) 1.0) (format *stderr* "~A bignum case 15~%" op)) (if (op (bignum +nan.0) (bignum 1)) (format *stderr* "~A bignum case 16~%" op)) (if (op (bignum +nan.0) (bignum 1/2)) (format *stderr* "~A bignum case 17~%" op)) (if (op (bignum +nan.0) (bignum 1.0)) (format *stderr* "~A bignum case 18~%" op)) (if (op 1 +nan.0) (format *stderr* "~A bignum case 23~%" op)) (if (op 1/2 +nan.0) (format *stderr* "~A bignum case 24~%" op)) (if (op 1.0 +nan.0) (format *stderr* "~A bignum case 25~%" op)) (if (op (bignum 1) +nan.0) (format *stderr* "~A bignum case 26~%" op)) (if (op (bignum 1/2) +nan.0) (format *stderr* "~A bignum case 27~%" op)) (if (op (bignum 1.0) +nan.0) (format *stderr* "~A bignum case 28~%" op)) (if (op 1 (bignum +nan.0)) (format *stderr* "~A bignum case 43~%" op)) (if (op 1/2 (bignum +nan.0)) (format *stderr* "~A bignum case 44~%" op)) (if (op 1.0 (bignum +nan.0)) (format *stderr* "~A bignum case 45~%" op)) (if (op (bignum 1) (bignum +nan.0)) (format *stderr* "~A bignum case 46~%" op)) (if (op (bignum 1/2) (bignum +nan.0)) (format *stderr* "~A bignum case 47~%" op)) (if (op (bignum 1.0) (bignum +nan.0)) (format *stderr* "~A bignum case 48~%" op))) (list = >= <= < >))) ;; these are a mess -- they depend on optimizer choices, etc (when with-bignums (test (= 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #f) (test (= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #f) (test (= 1 1.0 9223372036854775806/9223372036854775807) #f) (test (= 9223372036854775806/9223372036854775807 1.0 1) #f) (test (= 9223372036854775806/9223372036854775807 1.0) #f) (test (= 1.0 9223372036854775806/9223372036854775807) #f) (test (= 1 1.0 9223372036854775807/9223372036854775806) #f) (test (= 9223372036854775807/9223372036854775806 1.0 1) #f) (test (= 9223372036854775807/9223372036854775806 1.0) #f) (test (= 1.0 9223372036854775807/9223372036854775806) #f) (test (= 1.0 9223372036854775807/9223372036854775806) (= 9223372036854775807/9223372036854775806 1.0)) (test (= (* 397573379/630138897 1.0) 4201378396/6659027209) (= 4201378396/6659027209 (* 397573379/630138897 1.0)))) (test (= (* 10400200/16483927 1.0) (* 10781274/17087915 1.0)) #f) (test (= (* 10400200/16483927 1.0) 10781274/17087915) #f) (unless with-bignums ; equivalent? used here (test (= (* 10781274/17087915 1.0) (* 53715833/85137581 1.0)) #f) (test (= (* 10781274/17087915 1.0) 53715833/85137581) #f)) (test (= (* 12/19 1.0) (* 53/84 1.0)) #f) (test (= (* 12/19 1.0) 53/84) #f) (test (= (* 12941/20511 1.0) (* 15601/24727 1.0)) #f) (test (= (* 12941/20511 1.0) 15601/24727) #f) (test (= (* 15601/24727 1.0) (* 79335/125743 1.0)) #f) (test (= (* 15601/24727 1.0) 79335/125743) #f) (when with-bignums (test (positive? 9223372036854775808) #t)) (test (rational? -9223372036854775808/3) #t) (test (positive? (abs -9223372036854775808/3)) #t) ;;; (if with-bignums (test (= (* 171928773/272500658 1.0) (* 397573379/630138897 1.0)) #t)) -- needs more bits ;;; (test (= (* 171928773/272500658 1.0) 397573379/630138897) #f) (test (= (* 190537/301994 1.0) (* 7161071/11350029 1.0)) #f) (test (= (* 190537/301994 1.0) 7161071/11350029) #f) (test (= (* 2/3 1.0) (* 5/8 1.0)) #f) (test (= (* 2/3 1.0) 5/8) #f) (test (= (* 253/401 1.0) (* 665/1054 1.0)) #f) (test (= (* 253/401 1.0) 665/1054) #f) (when with-bignums (test (= (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #f) ;; first is not bignum currently (test (= (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #f) (test (= (* 397573379/630138897 1.0) 4201378396/6659027209) #f) (test (= (* 4201378396/6659027209 1.0) 6189245291/9809721694) #f)) (test (= (* 5/8 1.0) (* 12/19 1.0)) #f) (test (= (* 5/8 1.0) 12/19) #f) (test (= (* 53/84 1.0) (* 253/401 1.0)) #f) (test (= (* 53/84 1.0) 253/401) #f) ;;; (if with-bignums (test (= (* 53715833/85137581 1.0) (* 171928773/272500658 1.0)) #f)) -- more bits ;;; (if with-bignums (test (= (* 53715833/85137581 1.0) 171928773/272500658) #f)) (test (= (* 665/1054 1.0) (* 12941/20511 1.0)) #f) (test (= (* 665/1054 1.0) 12941/20511) #f) (test (= (* 7161071/11350029 1.0) (* 10400200/16483927 1.0)) #f) (test (= (* 7161071/11350029 1.0) 10400200/16483927) #f) (test (= (* 79335/125743 1.0) (* 190537/301994 1.0)) #f) (test (= (* 79335/125743 1.0) 190537/301994) #f) (test (= 10400200/16483927 10781274/17087915) #f) (test (= 10781274/17087915 53715833/85137581) #f) (test (= 12/19 53/84) #f) (test (= 12941/20511 15601/24727) #f) (test (= 15601/24727 79335/125743) #f) (test (= 171928773/272500658 397573379/630138897) #f) (test (= 190537/301994 7161071/11350029) #f) (test (= 2/3 5/8) #f) (test (= 253/401 665/1054) #f) (test (= 397573379/630138897 4201378396/6659027209) #f) (test (= 4201378396/6659027209 6189245291/9809721694) #f) (test (= 5/8 12/19) #f) (test (= 53/84 253/401) #f) (test (= 53715833/85137581 171928773/272500658) #f) (test (= 665/1054 12941/20511) #f) (test (= 7161071/11350029 10400200/16483927) #f) (test (= 79335/125743 190537/301994) #f) (unless with-bignums (test (= 10.000000000 10.000000000000001) #f)) (when with-bignums (test (= 8388608.9999999995 8388609) #f) (test (= (* 1.0 16743730547042864/1996007985) 8388609) #f) (test (= (* 1.0 13981015002796202/1666666667) 8388609) #f) (test (= (bignum "3") 1/0) #f) (test (= 12345678901234567890 12345678901234567891) #f) (test (= most-positive-fixnum (- (/ most-negative-fixnum -1) 1)) #t) (test (= 1267650600228229401496703205376) 'error)) ;;; non-gmp strangeness: ;;; (zero? (- (sqrt 2) 5964153172084899/4217293152016490)) -> #t, but ;;; (= (sqrt 2) 5964153172084899/4217293152016490) -> #f (test (= 0 '(1 . 2) . 3) 'error) (test (append 0 '(1 . 2) . 3) 'error) (test (= 0 ''0 . 0) 'error) (test (= . 0) 'error) (test (= 0 . (0)) #t) ;;; -------------------------------------------------------------------------------- ;;; > ;;; -------------------------------------------------------------------------------- (test (> 0 1 1) #f) (test (> 0 1 1.0) #f) (test (> 0 1 1/1) #f) (test (> 0 1 123.4) #f) (test (> 0 1 1234) #f) (test (> 0 1 1234/11) #f) (test (> 0 1) #f) (test (> 0 1.0 1) #f) (test (> 0 1.0 1.0) #f) (test (> 0 1.0 1/1) #f) (test (> 0 1.0 123.4) #f) (test (> 0 1.0 1234) #f) (test (> 0 1.0 1234/11) #f) (test (> 0 1.0) #f) (test (> 0 123.4) #f) (test (> 0 1234) #f) (test (> 0 1234/11) #f) (test (> 0.0 1 1.0) #f) (test (> 0.0 1 1/1) #f) (test (> 0.0 1 123.4) #f) (test (> 0.0 1 1234) #f) (test (> 0.0 1 1234/11) #f) (test (> 0.0 1) #f) (test (> 0.0 1.0 1) #f) (test (> 0.0 1.0 1.0) #f) (test (> 0.0 1.0 1/1) #f) (test (> 0.0 1.0 123.4) #f) (test (> 0.0 1.0 1234) #f) (test (> 0.0 1.0 1234/11) #f) (test (> 0.0 1.0) #f) (test (> 0.0 123.4 1) #f) (test (> 0.0 123.4 1.0) #f) (test (> 0.0 123.4 1/1) #f) (test (> 0.0 123.4 123.4) #f) (test (> 0.0 123.4 1234) #f) (test (> 0.0 123.4 1234/11) #f) (test (> 0.0 123.4) #f) (test (> 0.0 1234 1) #f) (test (> 0.0 1234 1.0) #f) (test (> 0.0 1234 1/1) #f) (test (> 0.0 1234 123.4) #f) (test (> 0.0 1234 1234) #f) (test (> 0.0 1234 1234/11) #f) (test (> 0.0 1234) #f) (test (> 0.0 1234/11 1) #f) (test (> 0.0 1234/11 1.0) #f) (test (> 0.0 1234/11 1/1) #f) (test (> 0.0 1234/11 123.4) #f) (test (> 0.0 1234/11 1234) #f) (test (> 0.0 1234/11 1234/11) #f) (test (> 0.0 1234/11) #f) (test (> 1 1 1) #f) (test (> 1 1 1.0) #f) (test (> 1 1 1/1) #f) (test (> 1 1 123.4) #f) (test (> 1 1 1234) #f) (test (> 1 1 1234/11) #f) (test (> 1 1) #f) (test (> 1 1.0 1) #f) (test (> 1 1.0 1.0) #f) (test (> 1 1.0 1/1) #f) (test (> 1 1.0 123.4) #f) (test (> 1 1.0 1234) #f) (test (> 1 1.0 1234/11) #f) (test (> 1 1.0) #f) (test (> 1 123.4) #f) (test (> 1 1234) #f) (test (> 1 1234/11) #f) (test (> 1.0 1 1) #f) (test (> 1.0 1 1.0) #f) (test (> 1.0 1 1/1) #f) (test (> 1.0 1 123.4) #f) (test (> 1.0 1 1234) #f) (test (> 1.0 1 1234/11) #f) (test (> 1.0 1) #f) (test (> 1.0 1.0 1) #f) (test (> 1.0 1.0 1.0) #f) (test (> 1.0 1.0 1/1) #f) (test (> 1.0 1.0 123.4) #f) (test (> 1.0 1.0 1234) #f) (test (> 1.0 1.0 1234/11) #f) (test (> 1.0 1.0) #f) (test (> 1.0 123.4 1) #f) (test (> 1.0 123.4 1.0) #f) (test (> 1.0 123.4 1/1) #f) (test (> 1.0 123.4 123.4) #f) (test (> 1.0 123.4 1234) #f) (test (> 1.0 123.4 1234/11) #f) (test (> 1.0 123.4) #f) (test (> 1.0 1234 1) #f) (test (> 1.0 1234 1.0) #f) (test (> 1.0 1234 1/1) #f) (test (> 1.0 1234 123.4) #f) (test (> 1.0 1234 1234) #f) (test (> 1.0 1234 1234/11) #f) (test (> 1.0 1234) #f) (test (> 1.0 1234/11 1) #f) (test (> 1.0 1234/11 1.0) #f) (test (> 1.0 1234/11 1/1) #f) (test (> 1.0 1234/11 123.4) #f) (test (> 1.0 1234/11 1234) #f) (test (> 1.0 1234/11 1234/11) #f) (test (> 1.0 1234/11) #f) (test (> 123.4 1 1) #f) (test (> 123.4 1 1.0) #f) (test (> 123.4 1 1/1) #f) (test (> 123.4 1 123.4) #f) (test (> 123.4 1 1234) #f) (test (> 123.4 1 1234/11) #f) (test (> 123.4 1) #t) (test (> 123.4 1.0 1) #f) (test (> 123.4 1.0 1.0) #f) (test (> 123.4 1.0 1/1) #f) (test (> 123.4 1.0 123.4) #f) (test (> 123.4 1.0 1234) #f) (test (> 123.4 1.0 1234/11) #f) (test (> 123.4 1.0) #t) (test (> 123.4 123.4 1) #f) (test (> 123.4 123.4 1.0) #f) (test (> 123.4 123.4 1/1) #f) (test (> 123.4 123.4 123.4) #f) (test (> 123.4 123.4 1234) #f) (test (> 123.4 123.4 1234/11) #f) (test (> 123.4 123.4) #f) (test (> 123.4 1234 1) #f) (test (> 123.4 1234 1.0) #f) (test (> 123.4 1234 1/1) #f) (test (> 123.4 1234 123.4) #f) (test (> 123.4 1234 1234) #f) (test (> 123.4 1234 1234/11) #f) (test (> 123.4 1234) #f) (test (> 123.4 1234/11 1) #t) (test (> 123.4 1234/11 1.0) #t) (test (> 123.4 1234/11 1/1) #t) (test (> 123.4 1234/11 123.4) #f) (test (> 123.4 1234/11 1234) #f) (test (> 123.4 1234/11 1234/11) #f) (test (> 123.4 1234/11) #t) (test (> 1234 1) #t) (test (> 1234 1.0) #t) (test (> 1234 1/1) #t) (test (> 1234 123.4) #t) (test (> 1234 1234) #f) (test (> 1234 1234/11) #t) (test (> 1234/11 1) #t) (test (> 1234/11 1.0) #t) (test (> 1234/11 1/1) #t) (test (> 1234/11 123.4) #f) (test (> 1234/11 1234) #f) (test (> 1234/11 1234/11) #f) (test (> +nan.0 1) #f) (test (> +nan.0 1.0) #f) (test (> +nan.0 1/2) #f) (test (> 1 +nan.0) #f) (test (> 1.0 +nan.0) #f) (test (> 1/2 +nan.0) #f) (test (> 1 0+i) 'error) (test (> 1 0-i) 'error) (test (> 1 2 #\a) 'error) (test (> 1+i 0+i) 'error) (test (> 1+i 0-i) 'error) (test (> +nan.0 1+i) 'error) (test (> +nan.0 1 1+i) 'error) (test (> 1 +nan.0 1+i) 'error) (test (> +inf.0 1+i) 'error) (test (> +inf.0 +nan.0 0-i 1) 'error) (test (> 2 1+0/2i) #t) (test (> 2 1+0i) #t) (test (> 2 1-0i) #t) (test (> 2 2 1) #f) (test (> 3 -6246) #t) (test (> 9 9 -2424) #f) (test (> quote if) 'error) (test (> 0) 'error) (test (> 0.0 0.0) #f) (test (> 0.0) 'error) (test (>) 'error) (test (> 0.0+0.00000001i) 'error) (test (> 0/1) 'error) (test (> 1 2 1.0+1.0i) 'error) (test (> 1.0) 'error) (test (> 1.0+1.0i) 'error) (test (> 10/3) 'error) (test (> 2) 'error) (test (> 3 3.0 3 3.0+1.0i) 'error) (test (> 4 3 1 2 0) #f) (test (> 4 3 2 1 0) #t) (test (> 4 3 3 2 0) #f) (test (> 4 3) #t) (test (> 8 7 6 5 4) #t) (test (> -10/3147483647 -40/12345678901) #t) (test (> -101/3147483647 40/12345678901) #f) (test (> -11/3147483647 -40/12345678901) #f) (test (> 1/9223372036854775807 1/9223372036854775806) #f) (test (> 10/3147483647 40/12345678901) #f) (test (> 1047483646/11111111111111 1234567890213/12345678901123123) #f) (test (> 11/3147483647 40/12345678901) #t) (test (> 1282469252763/12824692526603504 1234567890213/12345678901123123) #f) (test (> 1282469252765/12824692526603504 1234567890213/12345678901123123) #t) (test (> 2/3 3147483547123/4) #f) (test (> 2/3147483547 3147483547/3) #f) (test (> 2147483646/11111111111111 1234567890213/12345678901123123) #t) (test (> 3/147483647 40/3) #f) (test (> 3/3147483647 -40/12345678901) #t) (test (> 3/3147483647 40/12345678901) #f) (test (> 3/3147483647 40/3) #f) (test (> 3147483547/2 3/3147483547) #t) (test (> 3147483547/2 3147483547/3) #t) (test (> 3147483646/11 12345678901/40) #f) (test (> 3147483646/11 1234567890213/12345678901123123) #t) (test (> 3147483646/11 40/12345678901) #t) (test (> 3147483646/11111111111111 1234567890213/12345678901123123) #t) (test (> 3147483646/111111111111111 1234567890213/12345678901123123) #f) (test (> -1.797693134862315699999999999999999999998E308 -9223372036854775808) #f) (test (> -9223372036854775808 -9223372036854775808) #f) (test (> -9223372036854775808 5.551115123125783999999999999999999999984E-17) #f) (test (> -9223372036854775808 9223372036854775807 -9223372036854775808) #f) (test (> 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #t) (test (> 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #t) (test (> 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #f) (test (> 9223372036854775807 -9223372036854775808) #t) (test (> 9223372036854775807 9223372036854775807) #f) (test (> 0 most-negative-fixnum) #t) (test (> 0 most-positive-fixnum) #f) (test (> 1e18 most-positive-fixnum) #f) (test (> 9007199254740992.0 9007199254740991.0) #t) (test (> most-negative-fixnum (real-part (log 0.0))) #t) (test (> most-negative-fixnum 0) #f) (test (> most-negative-fixnum most-positive-fixnum) #f) (test (> most-positive-fixnum (- (real-part (log 0.0)))) #f) (test (> most-positive-fixnum 0) #t) (test (> most-positive-fixnum most-negative-fixnum) #t) (test (> 1/123400000000 .000000000001) #t) ; these can go either way I guess -- 1/0 might be NaN? ;(test (< most-positive-fixnum 1/0) #t) ;(test (> most-positive-fixnum 1/0) #f) (test (> 10.000000000 9.99999999999999) #t) (test (> -1/9223372036854775807 -9223372036854775807) #t) (test (> 1 -1/9223372036854775807 -9223372036854775807) #t) (test (> 1 1/9223372036 9223372036 1.0) #f) (test (> 1 1/9223372036 9223372036) #f) (test (> 1 1/922337203685 922337203685 1.0) #f) (test (> 1 1/922337203685 922337203685) #f) (test (> 1.0 1/9223372036 9223372036 1) #f) (test (> 1.0 1/9223372036 9223372036) #f) (test (> 1.0 1/922337203685 922337203685 1) #f) (test (> 1.0 1/922337203685 922337203685) #f) (test (> 1/9223372036 9223372036 1) #f) (test (> 1/9223372036 9223372036 1.0) #f) (test (> 1/9223372036 9223372036) #f) (test (> 1/922337203685 922337203685 1) #f) (test (> 1/922337203685 922337203685 1.0) #f) (test (> 1/922337203685 922337203685) #f) (test (> 9223372036 1/9223372036) #t) (test (> 922337203685 1/922337203685) #t) (test (> 9223372036854775807 1/9223372036854775807 -1) #t) (test (> 9223372036854775807 1/9223372036854775807) #t) (test (> 1.0 9223372036854775806/9223372036854775807) #t) (test (> 9223372036854775807/9223372036854775806 1.0 9223372036854775806/9223372036854775807) #t) (test (> 9223372036854775807/9223372036854775806 1.0) #t) (num-test (/ 9007199254740992 9007199254740993) 9007199254740992/9007199254740993) (num-test (/ 9007199254740992 9007199254740993 1.0) 1.0) (test (< (/ 9007199254740992 9007199254740993) 1.0) #t) (test (< 1.0 (/ 9007199254740992 9007199254740993)) #f) (test (= 9007199254740992 9007199254740993) #f) (test (= 9007199254740992 9007199254740993 (exact->inexact 9007199254740992)) #f) (test (> (* 10400200/16483927 1.0) (* 10781274/17087915 1.0)) #t) (test (> (* 10400200/16483927 1.0) 10781274/17087915) #t) (test (> (* 10781274/17087915 1.0) (* 53715833/85137581 1.0)) #f) (test (> (* 10781274/17087915 1.0) 53715833/85137581) #f) (test (> (* 12/19 1.0) (* 53/84 1.0)) #t) (test (> (* 12/19 1.0) 53/84) #t) (test (> (* 12941/20511 1.0) (* 15601/24727 1.0)) #f) (test (> (* 12941/20511 1.0) 15601/24727) #f) (test (> (* 15601/24727 1.0) (* 79335/125743 1.0)) #f) (test (> (* 15601/24727 1.0) 79335/125743) #f) (test (> (* 171928773/272500658 1.0) (* 397573379/630138897 1.0)) #f) (test (> (* 171928773/272500658 1.0) 397573379/630138897) #f) (test (> (* 190537/301994 1.0) (* 7161071/11350029 1.0)) #f) (test (> (* 190537/301994 1.0) 7161071/11350029) #f) (test (> (* 2/3 1.0) (* 5/8 1.0)) #t) (test (> (* 2/3 1.0) 5/8) #t) (test (> (* 253/401 1.0) (* 665/1054 1.0)) #f) (test (> (* 253/401 1.0) 665/1054) #f) (test (> (* 397573379/630138897 1.0) (* 4201378396/6659027209 1.0)) #f) (test (> (* 397573379/630138897 1.0) 4201378396/6659027209) #f) (test (> (* 5/8 1.0) (* 12/19 1.0)) #f) (test (> (* 5/8 1.0) 12/19) #f) (test (> (* 53/84 1.0) (* 253/401 1.0)) #t) (test (> (* 53/84 1.0) 253/401) #t) (test (> (abs (- .1 .2)) .3) #f) (test (> (abs (- .1 .2)) .03) #t) ;;; (if with-bignums (test (> (* 53715833/85137581 1.0) (* 171928773/272500658 1.0)) #t)) -- more bits ;;; (if with-bignums (test (> (* 53715833/85137581 1.0) 171928773/272500658) #t)) (test (> 53715833/85137581 171928773/272500658) #t) (test (> (* 665/1054 1.0) (* 12941/20511 1.0)) #t) (test (> (* 665/1054 1.0) 12941/20511) #t) (test (> (* 7161071/11350029 1.0) (* 10400200/16483927 1.0)) #t) (test (> (* 7161071/11350029 1.0) 10400200/16483927) #t) (test (> (* 79335/125743 1.0) (* 190537/301994 1.0)) #f) (test (> (* 79335/125743 1.0) 190537/301994) #f) (test (> 10400200/16483927 10781274/17087915) #t) (test (> 10781274/17087915 53715833/85137581) #f) (test (> 12/19 53/84) #t) (test (> 12941/20511 15601/24727) #f) (test (> 15601/24727 79335/125743) #f) (test (> 171928773/272500658 397573379/630138897) #f) (test (> 190537/301994 7161071/11350029) #f) (test (> 2/3 5/8) #t) (test (> 253/401 665/1054) #f) (test (> 397573379/630138897 4201378396/6659027209) #f) (test (> 4201378396/6659027209 6189245291/9809721694) #t) (test (> 5/8 12/19) #f) (test (> 53/84 253/401) #t) (test (> 665/1054 12941/20511) #t) (test (> 7161071/11350029 10400200/16483927) #t) (test (> 79335/125743 190537/301994) #f) (when with-bignums (test (> (* 4201378396/6659027209 1.0) (* 6189245291/9809721694 1.0)) #t) (test (> (* 4201378396/6659027209 1.0) 6189245291/9809721694) #t) (test (> 10.000000000 9.999999999999999) #t) (test (> 12345678901234567890 12345678901234567891) #f) (test (> 9007199254740993.0 9007199254740992.0) #t) (test (> 1267650600228229401496703205376) 'error) (test (> 355/113 3587785776203/1142027682075 21053343141/6701487259) #t) (test (> 3587785776203/1142027682075 21053343141/6701487259 4272943/1360120) #t) (test (> 22/7 2646693125139304345/842468587426513207 21053343141/6701487259) #t) (test (> 2646693125139304345/842468587426513207 21053343141/6701487259 4272943/1360120) #t) (test (> 2646693125139304345/842468587426513207 3587785776203/1142027682075 21053343141/6701487259 4272943/1360120) #t) (test (> 2646693125139304345/842468587426513207 3587785776203/1142027682075 21053343141/6701487259) #t) (test (> 3587785776203/1142027682075 21053343141/6701487259) #t) (test (> 2646693125139304345/842468587426513207 21053343141/6701487259) #t)) (for-each (lambda (arg) (test (> arg +nan.0) 'error) (test (> +nan.0 arg) 'error) (test (> arg +inf.0) 'error) (test (> +inf.0 arg) 'error) (test (> 0 1 arg) 'error) (test (> 1 arg) 'error) (test (> 1/2 arg) 'error) (test (> 1.0 arg) 'error) (test (> 1+i arg) 'error) (test (> arg 1) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; >= ;;; -------------------------------------------------------------------------------- (test (>= 0 1 1) #f) (test (>= 0 1 1.0) #f) (test (>= 0 1 1/1) #f) (test (>= 0 1 123.4) #f) (test (>= 0 1 1234) #f) (test (>= 0 1 1234/11) #f) (test (>= 0 1) #f) (test (>= 0 1.0 1) #f) (test (>= 0 1.0 1.0) #f) (test (>= 0 1.0 1/1) #f) (test (>= 0 1.0 123.4) #f) (test (>= 0 1.0 1234) #f) (test (>= 0 1.0 1234/11) #f) (test (>= 0 1.0) #f) (test (>= 0 123.4) #f) (test (>= 0 1234) #f) (test (>= 0 1234/11) #f) (test (>= 0.0 1 1) #f) (test (>= 0.0 1 1.0) #f) (test (>= 0.0 1 1/1) #f) (test (>= 0.0 1 123.4) #f) (test (>= 0.0 1 1234) #f) (test (>= 0.0 1 1234/11) #f) (test (>= 0.0 1) #f) (test (>= 0.0 1.0 1) #f) (test (>= 0.0 1.0 1.0) #f) (test (>= 0.0 1.0 1/1) #f) (test (>= 0.0 1.0 123.4) #f) (test (>= 0.0 1.0 1234) #f) (test (>= 0.0 1.0 1234/11) #f) (test (>= 0.0 1.0) #f) (test (>= 0.0 123.4 1) #f) (test (>= 0.0 123.4 1.0) #f) (test (>= 0.0 123.4 1/1) #f) (test (>= 0.0 123.4 123.4) #f) (test (>= 0.0 123.4 1234) #f) (test (>= 0.0 123.4 1234/11) #f) (test (>= 0.0 123.4) #f) (test (>= 0.0 1234 1) #f) (test (>= 0.0 1234 1.0) #f) (test (>= 0.0 1234 1/1) #f) (test (>= 0.0 1234 123.4) #f) (test (>= 0.0 1234 1234) #f) (test (>= 0.0 1234 1234/11) #f) (test (>= 0.0 1234) #f) (test (>= 0.0 1234/11 1) #f) (test (>= 0.0 1234/11 1.0) #f) (test (>= 0.0 1234/11 1/1) #f) (test (>= 0.0 1234/11 123.4) #f) (test (>= 0.0 1234/11 1234) #f) (test (>= 0.0 1234/11 1234/11) #f) (test (>= 0.0 1234/11) #f) (test (>= 1 1 1) #t) (test (>= 1 1 1.0) #t) (test (>= 1 1 1/1) #t) (test (>= 1 1 123.4) #f) (test (>= 1 1 1234) #f) (test (>= 1 1 1234/11) #f) (test (>= 1 1) #t) (test (>= 1 1.0 1) #t) (test (>= 1 1.0 1.0) #t) (test (>= 1 1.0 1/1) #t) (test (>= 1 1.0 123.4) #f) (test (>= 1 1.0 1234) #f) (test (>= 1 1.0 1234/11) #f) (test (>= 1 1.0) #t) (test (>= 1 123.4) #f) (test (>= 1 1234) #f) (test (>= 1 1234/11) #f) (test (>= 1.0 1 1) #t) (test (>= 1.0 1 1.0) #t) (test (>= 1.0 1 1/1) #t) (test (>= 1.0 1 123.4) #f) (test (>= 1.0 1 1234) #f) (test (>= 1.0 1 1234/11) #f) (test (>= 1.0 1) #t) (test (>= 1.0 1.0 1) #t) (test (>= 1.0 1.0 1.0) #t) (test (>= 1.0 1.0 1/1) #t) (test (>= 1.0 1.0 123.4) #f) (test (>= 1.0 1.0 1234) #f) (test (>= 1.0 1.0 1234/11) #f) (test (>= 1.0 1.0) #t) (test (>= 1.0 1/1 1) #t) (test (>= 1.0 123.4 1) #f) (test (>= 1.0 123.4 1.0) #f) (test (>= 1.0 123.4 1/1) #f) (test (>= 1.0 123.4 123.4) #f) (test (>= 1.0 123.4 1234) #f) (test (>= 1.0 123.4 1234/11) #f) (test (>= 1.0 123.4) #f) (test (>= 1.0 1234 1) #f) (test (>= 1.0 1234 1.0) #f) (test (>= 1.0 1234 1/1) #f) (test (>= 1.0 1234 123.4) #f) (test (>= 1.0 1234 1234) #f) (test (>= 1.0 1234 1234/11) #f) (test (>= 1.0 1234) #f) (test (>= 1.0 1234/11 1) #f) (test (>= 1.0 1234/11 1.0) #f) (test (>= 1.0 1234/11 1/1) #f) (test (>= 1.0 1234/11 123.4) #f) (test (>= 1.0 1234/11 1234) #f) (test (>= 1.0 1234/11 1234/11) #f) (test (>= 1.0 1234/11) #f) (test (>= 123.4 1 1) #t) (test (>= 123.4 1 1.0) #t) (test (>= 123.4 1 1/1) #t) (test (>= 123.4 1 123.4) #f) (test (>= 123.4 1 1234) #f) (test (>= 123.4 1 1234/11) #f) (test (>= 123.4 1) #t) (test (>= 123.4 1.0 1) #t) (test (>= 123.4 1.0 1.0) #t) (test (>= 123.4 1.0 1/1) #t) (test (>= 123.4 1.0 123.4) #f) (test (>= 123.4 1.0 1234) #f) (test (>= 123.4 1.0 1234/11) #f) (test (>= 123.4 1.0) #t) (test (>= 123.4 123.4 1) #t) (test (>= 123.4 123.4 1.0) #t) (test (>= 123.4 123.4 1/1) #t) (test (>= 123.4 123.4 123.4) #t) (test (>= 123.4 123.4 1234) #f) (test (>= 123.4 123.4 1234/11) #t) (test (>= 123.4 123.4) #t) (test (>= 123.4 1234 1) #f) (test (>= 123.4 1234 1.0) #f) (test (>= 123.4 1234 1/1) #f) (test (>= 123.4 1234 123.4) #f) (test (>= 123.4 1234 1234) #f) (test (>= 123.4 1234 1234/11) #f) (test (>= 123.4 1234) #f) (test (>= 123.4 1234/11 1) #t) (test (>= 123.4 1234/11 1.0) #t) (test (>= 123.4 1234/11 1/1) #t) (test (>= 123.4 1234/11 123.4) #f) (test (>= 123.4 1234/11 1234) #f) (test (>= 123.4 1234/11 1234/11) #t) (test (>= 123.4 1234/11) #t) (test (>= 1234 1) #t) (test (>= 1234 1.0) #t) (test (>= 1234 1/1) #t) (test (>= 1234 123.4) #t) (test (>= 1234 1234) #t) (test (>= 1234 1234/11) #t) (test (>= 1234/11 1) #t) (test (>= 1234/11 1.0) #t) (test (>= 1234/11 1/1) #t) (test (>= 1234/11 123.4) #f) (test (>= 1234/11 1234) #f) (test (>= 1234/11 1234/11) #t) (test (>= 0+i 0+i) 'error) ;?? (test (>= 1 0+i) 'error) (test (>= 1 0-i) 'error) (test (>= 1 1 2) #f) (test (>= 1 2 #\a) 'error) (test (>= 1 3 2) #f) (test (>= 1+i 0+i) 'error) (test (>= 1+i 0-i) 'error) (test (>= +nan.0 1+i) 'error) (test (>= +nan.0 1 1+i) 'error) (test (>= 1 +nan.0 1+i) 'error) (test (>= +inf.0 1+i) 'error) (test (>= +inf.0 +nan.0 0-i 1) 'error) (test (>= 2 1+0/2i) #t) (test (>= 2 1+0i) #t) (test (>= 2 1-0i) #t) (test (>= 3 -4 -6246) #t) (test (>= 8 9) #f) (test (>= 9 9) #t) (test (>= -5 -4 -2 0 4 5) #f) (test (>= 0) 'error) (test (>=) 'error) (test (>= 0.0) 'error) (test (>= 0.0+0.00000001i) 'error) (test (>= 0/1) 'error) (test (>= 1 2 1.0+1.0i) 'error) (test (>= 1.0) 'error) (test (>= 1.0+1.0i) 'error) (test (>= 10/3) 'error) (test (>= 2) 'error) (test (>= 4 3 1 2 0) #f) (test (>= 4 3 2 1 0) #t) (test (>= 4 3 3 2 0) #t) (test (>= 4 3) #t) (test (>= -1.797693134862315699999999999999999999998E308 -9223372036854775808) #f) (test (>= -9223372036854775808 -9223372036854775808) #t) (test (>= -9223372036854775808 5.551115123125783999999999999999999999984E-17) #f) (test (>= -9223372036854775808 9223372036854775807 -9223372036854775808) #f) (test (>= 1.110223024625156799999999999999999999997E-16 -9223372036854775808) #t) (test (>= 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) #t) (test (>= 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) #f) (test (>= 9223372036854775807 -9223372036854775808) #t) (test (>= 9223372036854775807 9223372036854775807) #t) (test (>= -1 -9223372036854775807 -1/9223372036854775807) #f) (test (>= -9223372036854775807 -1/9223372036854775807 -1) #f) (test (>= -9223372036854775807 -1/9223372036854775807) #f) (test (>= 1 -1 -9223372036854775807 -1/9223372036854775807) #f) (test (>= 1 -9223372036854775807 -1/9223372036854775807 -1) #f) (test (>= 1 -9223372036854775807 -1/9223372036854775807) #f) (test (>= 1 1.0 1/9223372036 9223372036) #f) (test (>= 1 1.0 1/922337203685 922337203685) #f) (test (>= 1 1/9223372036 9223372036 1.0) #f) (test (>= 1 1/9223372036 9223372036) #f) (test (>= 1 1/922337203685 922337203685 1.0) #f) (test (>= 1 1/922337203685 922337203685) #f) (test (>= 1 1/9223372036854775807 9223372036854775807 -1) #f) (test (>= 1 1/9223372036854775807 9223372036854775807) #f) (test (>= 1.0 1 1/9223372036 9223372036) #f) (test (>= 1.0 1 1/922337203685 922337203685) #f) (test (>= 1.0 1/9223372036 9223372036 1) #f) (test (>= 1.0 1/9223372036 9223372036) #f) (test (>= 1.0 1/922337203685 922337203685 1) #f) (test (>= 1.0 1/922337203685 922337203685) #f) (test (>= 1/9223372036 9223372036 1 1.0) #f) (test (>= 1/9223372036 9223372036 1) #f) (test (>= 1/9223372036 9223372036 1.0 1) #f) (test (>= 1/9223372036 9223372036 1.0) #f) (test (>= 1/9223372036 9223372036) #f) (test (>= 1/922337203685 922337203685 1 1.0) #f) (test (>= 1/922337203685 922337203685 1) #f) (test (>= 1/922337203685 922337203685 1.0 1) #f) (test (>= 1/922337203685 922337203685 1.0) #f) (test (>= 1/922337203685 922337203685) #f) (test (>= 1/9223372036854775807 9223372036854775807 -1) #f) (test (>= 1/9223372036854775807 9223372036854775807 1 -1) #f) (test (>= 1/9223372036854775807 9223372036854775807 1) #f) (test (>= 1/9223372036854775807 9223372036854775807) #f) (test (>= 9223372036 1/9223372036) #t) (test (>= 922337203685 1/922337203685) #t) (test (>= 1 1.0 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807) #f) (test (>= 1 1.0 9223372036854775807/9223372036854775806) #f) (test (>= 1 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #f) (test (>= 1 9223372036854775806/9223372036854775807 1.0) #f) (test (>= 1.0 9223372036854775807/9223372036854775806 1 9223372036854775806/9223372036854775807) #f) (test (>= 1.0 9223372036854775807/9223372036854775806 1) #f) (test (>= 1.0 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807) #f) (test (>= 1.0 9223372036854775807/9223372036854775806) #f) (test (>= 9223372036854775806/9223372036854775807 1.0 1) #f) (test (>= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806 1) #f) (test (>= 9223372036854775806/9223372036854775807 1.0 9223372036854775807/9223372036854775806) #f) (test (>= 9223372036854775806/9223372036854775807 1.0) #f) (test (>= 9223372036854775807/9223372036854775806 1 9223372036854775806/9223372036854775807 1.0) #f) (test (>= 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807 1.0 1) #f) (test (>= 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807 1.0) #f) (when with-bignums (test (>= 12345678901234567890 12345678901234567891) #f) (test (>= 1267650600228229401496703205376) 'error) (test (let () (define (func) (>= (bignum +nan.0) 10001)) (define (hi) (func)) (hi)) #f) (test (let () (define (func) (>= (bignum +nan.0) 0+i)) (define (hi) (func)) (hi)) 'error) (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207 3587785776203/1142027682075 4272943/1360120) #f) (test (>= 21053343141/6701487259 3587785776203/1142027682075 4272943/1360120) #f) (test (>= 3587785776203/1142027682075 2646693125139304345/842468587426513207 4272943/1360120) #f) (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207 3587785776203/1142027682075) #f) (test (>= 21053343141/6701487259 3587785776203/1142027682075 2646693125139304345/842468587426513207) #f) (test (>= 21053343141/6701487259 3587785776203/1142027682075) #f) (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207) #f) (test (>= 3587785776203/1142027682075 2646693125139304345/842468587426513207) #f) (test (>= 22/7 21053343141/6701487259 2646693125139304345/842468587426513207 4272943/1360120) #f) (test (>= 21053343141/6701487259 2646693125139304345/842468587426513207 4272943/1360120) #f) (test (>= 355/113 21053343141/6701487259 3587785776203/1142027682075) #f) (test (>= 21053343141/6701487259 3587785776203/1142027682075 4272943/1360120) #f)) (test (>= - 1 2) 'error) (test (>=- 1 2) 'error) (for-each (lambda (arg) (test (>= arg +nan.0) 'error) (test (>= +nan.0 arg) 'error) (test (>= arg +inf.0) 'error) (test (>= +inf.0 arg) 'error) (test (>= 0 1 arg) 'error) (test (>= 1 arg) 'error) (test (>= 1/2 arg) 'error) (test (>= 1.0 arg) 'error) (test (>= 1+i arg) 'error) (test (>= arg 1) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (op) (for-each (lambda (arg1) (test (op arg1) 'error) (test (op 0 arg1) 'error) (test (op 0.0 arg1) 'error) (for-each (lambda (arg2) (test (op arg1 arg2) 'error)) (list "hi" () 1 1.5 3/2 1+i (cons 1 2) (list 1 2) #\a 'a-symbol #(1) abs #f (lambda (a) (+ a 1)) # :hi # #))) (list "hi" () (cons 1 2) (list 1 2) #\a 'a-symbol #(1) abs #f (lambda (a) (+ a 1)) # :hi # #))) (list + - * / > < >= <= )) (for-each (lambda (op) (let ((val1 (catch #t (lambda () (op 1.0)) (lambda args 'error))) (val2 (catch #t (lambda () (op 1.0+0i)) (lambda args 'error)))) (if (not (equivalent? val1 val2)) ; ignore nans (format #t ";(~A 1) != (~A 1+0i)? (~A ~A)~%" op op val1 val2)))) (list magnitude angle rationalize abs exp log sin cos tan asin acos atan sinh cosh tanh asinh acosh atanh sqrt floor ceiling truncate round + - * / max min number? integer? real? complex? rational? even? odd? zero? positive? negative? real-part imag-part numerator denominator)) ;;; -------------------------------------------------------------------------------- ;;; sin ;;; -------------------------------------------------------------------------------- (num-test (sin -0.0+0.00000001i) 0.0+0.00000001i) (num-test (sin -0.0+0.0i) 0.0) (num-test (sin -0.0+1.0i) 0.0+1.17520119364380i) (num-test (sin -0.0+3.14159265358979i) 0.0+11.54873935725775i) (num-test (sin -0.0-0.00000001i) -0.0-0.00000001i) (num-test (sin -0.0-0.0i) 0.0) (num-test (sin -0.0-1.0i) -0.0-1.17520119364380i) (num-test (sin -0.0-3.14159265358979i) -0.0-11.54873935725775i) (num-test (sin -0.00000001) -0.00000001) (num-test (sin -0.00000001+0.00000001i) -0.00000001+0.00000001i) (num-test (sin -0.00000001+0.0i) -0.00000001) (num-test (sin -0.00000001+1.0i) -0.00000001543081+1.17520119364380i) (num-test (sin -0.00000001+3.14159265358979i) -0.00000011591953+11.54873935725775i) (num-test (sin -0.00000001-0.00000001i) -0.00000001-0.00000001i) (num-test (sin -0.00000001-0.0i) -0.00000001) (num-test (sin -0.00000001-1.0i) -0.00000001543081-1.17520119364380i) (num-test (sin -0.00000001-3.14159265358979i) -0.00000011591953-11.54873935725775i) (num-test (sin -1) -0.84147098480790) (num-test (sin -1.0) -0.84147098480790) (num-test (sin -1.0+0.00000001i) -0.84147098480790+0.00000000540302i) (num-test (sin -1.0+0.0i) -0.84147098480790) (num-test (sin -1.0+1.0i) -1.29845758141598+0.63496391478474i) (num-test (sin -1.0+3.14159265358979i) -9.75429233860021+6.23981050459650i) (num-test (sin -1.0-0.00000001i) -0.84147098480790-0.00000000540302i) (num-test (sin -1.0-0.0i) -0.84147098480790) (num-test (sin -1.0-1.0i) -1.29845758141598-0.63496391478474i) (num-test (sin -1.0-3.14159265358979i) -9.75429233860021-6.23981050459650i) (num-test (sin -1.57045105981189525579e+00+0.0e+00i) -9.9999994039535581669e-1) (num-test (sin -1.57045105981189525579e+00+1.0e+00i) -1.5430805428404715942e0+4.0575816248730593018e-4i) (num-test (sin -1.57045105981189525579e+00+1.19209289550781250e-07i) -9.9999994039536292211e-1+4.1159030931177815679e-11i) (num-test (sin -1.57045105981189525579e+00+2.0e+00i) -3.7621954668392959445e0+1.2522351259047577385e-3i) (num-test (sin -1.57045105981189525579e+00+5.0e-01i) -1.1276258979946363572e0+1.7991700040937027667e-4i) (num-test (sin -1.57045105981189525579e+00-1.0e+00i) -1.5430805428404715942e0-4.0575816248730593018e-4i) (num-test (sin -1.57045105981189525579e+00-1.19209289550781250e-07i) -9.9999994039536292211e-1-4.1159030931177815679e-11i) (num-test (sin -1.57045105981189525579e+00-2.0e+00i) -3.7621954668392959445e0-1.2522351259047577385e-3i) (num-test (sin -1.57045105981189525579e+00-5.0e-01i) -1.1276258979946363572e0-1.7991700040937027667e-4i) (num-test (sin -1.57114159377789786021e+00+0.0e+00i) -9.9999994039535581673e-1) (num-test (sin -1.57114159377789786021e+00+1.0e+00i) -1.5430805428404715942e0-4.0575816248716200955e-4i) (num-test (sin -1.57114159377789786021e+00+1.19209289550781250e-07i) -9.9999994039536292216e-1-4.1159030931163216752e-11i) (num-test (sin -1.57114159377789786021e+00+2.0e+00i) -3.7621954668392959447e0-1.2522351259043135762e-3i) (num-test (sin -1.57114159377789786021e+00+5.0e-01i) -1.1276258979946363573e0-1.7991700040930646090e-4i) (num-test (sin -1.57114159377789786021e+00-1.0e+00i) -1.5430805428404715942e0+4.0575816248716200955e-4i) (num-test (sin -1.57114159377789786021e+00-1.19209289550781250e-07i) -9.9999994039536292216e-1+4.1159030931163216752e-11i) (num-test (sin -1.57114159377789786021e+00-2.0e+00i) -3.7621954668392959447e0+1.2522351259043135762e-3i) (num-test (sin -1.57114159377789786021e+00-5.0e-01i) -1.1276258979946363573e0+1.7991700040930646090e-4i) (num-test (sin -1/1) -0.84147098480790) (num-test (sin -1/10) -0.09983341664683) (num-test (sin -1/1234) -0.00081037268278) (num-test (sin -1/1234000000) -0.00000000081037) (num-test (sin -1/2) -0.47942553860420) (num-test (sin -1/3) -0.32719469679615) (num-test (sin -1/500029) -0.00000199988401) (num-test (sin -10/1234) -0.00810363901920) (num-test (sin -10/1234000000) -0.00000000810373) (num-test (sin -10/500029) -0.00001999884007) (num-test (sin -1234/500029) -0.00246785435930) (num-test (sin -1234000000/1234000000) -0.84147098480790) (num-test (sin -2) -0.90929742682568) (num-test (sin -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (sin -2/1) -0.90929742682568) (num-test (sin -2/10) -0.19866933079506) (num-test (sin -2/1234) -0.00162074483338) (num-test (sin -2/1234000000) -0.00000000162075) (num-test (sin -2/3) -0.61836980306974) (num-test (sin -2/500029) -0.00000399976801) (num-test (sin -3.14124738660679181379e+00+0.0e+00i) -3.4526697614158608860e-4) (num-test (sin -3.14124738660679181379e+00+1.0e+00i) -5.3277478472529828958e-4-1.1752011235963524659e0i) (num-test (sin -3.14124738660679181379e+00+1.19209289550781250e-07i) -3.4526697614158854187e-4-1.1920928244535424532e-7i) (num-test (sin -3.14124738660679181379e+00+2.0e+00i) -1.2989619299133501696e-3-3.6268601916692946553e0i) (num-test (sin -3.14124738660679181379e+00+5.0e-01i) -3.8933200722554445944e-4-5.2109527443404709206e-1i) (num-test (sin -3.14124738660679181379e+00-1.0e+00i) -5.3277478472529828958e-4+1.1752011235963524659e0i) (num-test (sin -3.14124738660679181379e+00-1.19209289550781250e-07i) -3.4526697614158854187e-4+1.1920928244535424532e-7i) (num-test (sin -3.14124738660679181379e+00-2.0e+00i) -1.2989619299133501696e-3+3.6268601916692946553e0i) (num-test (sin -3.14124738660679181379e+00-5.0e-01i) -3.8933200722554445944e-4+5.2109527443404709206e-1i) (num-test (sin -3.14193792057279441821e+00+0.0e+00i) 3.4526697614134115926e-4) (num-test (sin -3.14193792057279441821e+00+1.0e+00i) 5.3277478472492034385e-4-1.1752011235963524660e0i) (num-test (sin -3.14193792057279441821e+00+1.19209289550781250e-07i) 3.4526697614134361253e-4-1.1920928244535424533e-7i) (num-test (sin -3.14193792057279441821e+00+2.0e+00i) 1.2989619299124286975e-3-3.6268601916692946556e0i) (num-test (sin -3.14193792057279441821e+00+5.0e-01i) 3.8933200722526827075e-4-5.2109527443404709211e-1i) (num-test (sin -3.14193792057279441821e+00-1.0e+00i) 5.3277478472492034385e-4+1.1752011235963524660e0i) (num-test (sin -3.14193792057279441821e+00-1.19209289550781250e-07i) 3.4526697614134361253e-4+1.1920928244535424533e-7i) (num-test (sin -3.14193792057279441821e+00-2.0e+00i) 1.2989619299124286975e-3+3.6268601916692946556e0i) (num-test (sin -3.14193792057279441821e+00-5.0e-01i) 3.8933200722526827075e-4+5.2109527443404709211e-1i) (num-test (sin -3.45266983001243932001e-04+0.0e+00i) -3.4526697614140534807e-4) (num-test (sin -3.45266983001243932001e-04+1.0e+00i) -5.3277478472501939236e-4+1.1752011235963524660e0i) (num-test (sin -3.45266983001243932001e-04+1.19209289550781250e-07i) -3.4526697614140780134e-4+1.1920928244535424533e-7i) (num-test (sin -3.45266983001243932001e-04+2.0e+00i) -1.2989619299126701883e-3+3.6268601916692946556e0i) (num-test (sin -3.45266983001243932001e-04+5.0e-01i) -3.8933200722534065172e-4+5.2109527443404709209e-1i) (num-test (sin -3.45266983001243932001e-04-1.0e+00i) -5.3277478472501939236e-4-1.1752011235963524660e0i) (num-test (sin -3.45266983001243932001e-04-1.19209289550781250e-07i) -3.4526697614140780134e-4-1.1920928244535424533e-7i) (num-test (sin -3.45266983001243932001e-04-2.0e+00i) -1.2989619299126701883e-3-3.6268601916692946556e0i) (num-test (sin -3.45266983001243932001e-04-5.0e-01i) -3.8933200722534065172e-4-5.2109527443404709209e-1i) (num-test (sin -3/10) -0.29552020666134) (num-test (sin -3/1234) -0.00243111591964) (num-test (sin -3/1234000000) -0.00000000243112) (num-test (sin -3/2) -0.99749498660405) (num-test (sin -3/500029) -0.00000599965202) (num-test (sin -4.71204371340168837179e+00+0.0e+00i) 9.9999994039535581664e-1) (num-test (sin -4.71204371340168837179e+00+1.0e+00i) 1.5430805428404715941e0-4.0575816248744985081e-4i) (num-test (sin -4.71204371340168837179e+00+1.19209289550781250e-07i) 9.9999994039536292207e-1-4.1159030931192414605e-11i) (num-test (sin -4.71204371340168837179e+00+2.0e+00i) 3.7621954668392959444e0-1.2522351259052019007e-3i) (num-test (sin -4.71204371340168837179e+00+5.0e-01i) 1.1276258979946363572e0-1.7991700040943409243e-4i) (num-test (sin -4.71204371340168837179e+00-1.0e+00i) 1.5430805428404715941e0+4.0575816248744985081e-4i) (num-test (sin -4.71204371340168837179e+00-1.19209289550781250e-07i) 9.9999994039536292207e-1+4.1159030931192414605e-11i) (num-test (sin -4.71204371340168837179e+00-2.0e+00i) 3.7621954668392959444e0+1.2522351259052019007e-3i) (num-test (sin -4.71204371340168837179e+00-5.0e-01i) 1.1276258979946363572e0+1.7991700040943409243e-4i) (num-test (sin -4.71273424736769097620e+00+0.0e+00i) 9.9999994039535581677e-1) (num-test (sin -4.71273424736769097620e+00+1.0e+00i) 1.5430805428404715943e0+4.0575816248701808892e-4i) (num-test (sin -4.71273424736769097620e+00+1.19209289550781250e-07i) 9.9999994039536292220e-1+4.1159030931148617825e-11i) (num-test (sin -4.71273424736769097620e+00+2.0e+00i) 3.7621954668392959448e0+1.2522351259038694139e-3i) (num-test (sin -4.71273424736769097620e+00+5.0e-01i) 1.1276258979946363573e0+1.7991700040924264514e-4i) (num-test (sin -4.71273424736769097620e+00-1.0e+00i) 1.5430805428404715943e0-4.0575816248701808892e-4i) (num-test (sin -4.71273424736769097620e+00-1.19209289550781250e-07i) 9.9999994039536292220e-1-4.1159030931148617825e-11i) (num-test (sin -4.71273424736769097620e+00-2.0e+00i) 3.7621954668392959448e0-1.2522351259038694139e-3i) (num-test (sin -4.71273424736769097620e+00-5.0e-01i) 1.1276258979946363573e0-1.7991700040924264514e-4i) (num-test (sin -500029/1234000000) -0.00040520987546) (num-test (sin -6.28284004019658492979e+00+0.0e+00i) 3.4526697614170855328e-4) (num-test (sin -6.28284004019658492979e+00+1.0e+00i) 5.3277478472548726245e-4+1.1752011235963524659e0i) (num-test (sin -6.28284004019658492979e+00+1.19209289550781250e-07i) 3.4526697614171100655e-4+1.1920928244535424532e-7i) (num-test (sin -6.28284004019658492979e+00+2.0e+00i) 1.2989619299138109057e-3+3.6268601916692946552e0i) (num-test (sin -6.28284004019658492979e+00+5.0e-01i) 3.8933200722568255379e-4+5.2109527443404709204e-1i) (num-test (sin -6.28284004019658492979e+00-1.0e+00i) 5.3277478472548726245e-4-1.1752011235963524659e0i) (num-test (sin -6.28284004019658492979e+00-1.19209289550781250e-07i) 3.4526697614171100655e-4-1.1920928244535424532e-7i) (num-test (sin -6.28284004019658492979e+00-2.0e+00i) 1.2989619299138109057e-3-3.6268601916692946552e0i) (num-test (sin -6.28284004019658492979e+00-5.0e-01i) 3.8933200722568255379e-4-5.2109527443404709204e-1i) (num-test (sin -6.28353057416258753420e+00+0.0e+00i) -3.4526697614121869459e-4) (num-test (sin -6.28353057416258753420e+00+1.0e+00i) -5.3277478472473137099e-4+1.1752011235963524661e0i) (num-test (sin -6.28353057416258753420e+00+1.19209289550781250e-07i) -3.4526697614122114786e-4+1.1920928244535424534e-7i) (num-test (sin -6.28353057416258753420e+00+2.0e+00i) -1.2989619299119679614e-3+3.6268601916692946558e0i) (num-test (sin -6.28353057416258753420e+00+5.0e-01i) -3.8933200722513017641e-4+5.2109527443404709213e-1i) (num-test (sin -6.28353057416258753420e+00-1.0e+00i) -5.3277478472473137099e-4-1.1752011235963524661e0i) (num-test (sin -6.28353057416258753420e+00-1.19209289550781250e-07i) -3.4526697614122114786e-4-1.1920928244535424534e-7i) (num-test (sin -6.28353057416258753420e+00-2.0e+00i) -1.2989619299119679614e-3-3.6268601916692946558e0i) (num-test (sin -6.28353057416258753420e+00-5.0e-01i) -3.8933200722513017641e-4-5.2109527443404709213e-1i) (num-test (sin -9.42443269378637893396e+00+0.0e+00i) -3.4526697614094283958e-4) (num-test (sin -9.42443269378637893396e+00+1.0e+00i) -5.3277478472430570447e-4-1.1752011235963524662e0i) (num-test (sin -9.42443269378637893396e+00+1.19209289550781250e-07i) -3.4526697614094529285e-4-1.1920928244535424535e-7i) (num-test (sin -9.42443269378637893396e+00+2.0e+00i) -1.2989619299109301409e-3-3.6268601916692946561e0i) (num-test (sin -9.42443269378637893396e+00+5.0e-01i) -3.8933200722481911514e-4-5.2109527443404709218e-1i) (num-test (sin -9.42443269378637893396e+00-1.0e+00i) -5.3277478472430570447e-4+1.1752011235963524662e0i) (num-test (sin -9.42443269378637893396e+00-1.19209289550781250e-07i) -3.4526697614094529285e-4+1.1920928244535424535e-7i) (num-test (sin -9.42443269378637893396e+00-2.0e+00i) -1.2989619299109301409e-3+3.6268601916692946561e0i) (num-test (sin -9.42443269378637893396e+00-5.0e-01i) -3.8933200722481911514e-4+5.2109527443404709218e-1i) (num-test (sin -9.42512322775237976202e+00+0.0e+00i) 3.4526697614020805155e-4) (num-test (sin -9.42512322775237976202e+00+1.0e+00i) 5.3277478472317186729e-4-1.1752011235963524665e0i) (num-test (sin -9.42512322775237976202e+00+1.19209289550781250e-07i) 3.4526697614021050482e-4-1.1920928244535424538e-7i) (num-test (sin -9.42512322775237976202e+00+2.0e+00i) 1.2989619299081657245e-3-3.6268601916692946571e0i) (num-test (sin -9.42512322775237976202e+00+5.0e-01i) 3.8933200722399054908e-4-5.2109527443404709231e-1i) (num-test (sin -9.42512322775237976202e+00-1.0e+00i) 5.3277478472317186729e-4+1.1752011235963524665e0i) (num-test (sin -9.42512322775237976202e+00-1.19209289550781250e-07i) 3.4526697614021050482e-4+1.1920928244535424538e-7i) (num-test (sin -9.42512322775237976202e+00-2.0e+00i) 1.2989619299081657245e-3+3.6268601916692946571e0i) (num-test (sin -9.42512322775237976202e+00-5.0e-01i) 3.8933200722399054908e-4+5.2109527443404709231e-1i) (num-test (sin 0) 0.0) (num-test (sin 0.0) 0.0) (num-test (sin 0.0+0.00000001i) 0.0+0.00000001i) (num-test (sin 0.0+0.0i) 0.0) (num-test (sin 0.0+1.0i) 0.0+1.17520119364380i) (num-test (sin 0.0+3.14159265358979i) 0.0+11.54873935725775i) (num-test (sin 0.0-0.00000001i) 0.0-0.00000001i) (num-test (sin 0.0-0.0i) 0.0) (num-test (sin 0.0-1.0i) 0.0-1.17520119364380i) (num-test (sin 0.0-3.14159265358979i) 0.0-11.54873935725775i) (num-test (sin 0.00000001) 0.00000001) (num-test (sin 0.00000001+0.00000001i) 0.00000001+0.00000001i) (num-test (sin 0.00000001+0.0i) 0.00000001) (num-test (sin 0.00000001+1.0i) 0.00000001543081+1.17520119364380i) (num-test (sin 0.00000001+3.14159265358979i) 0.00000011591953+11.54873935725775i) (num-test (sin 0.00000001-0.00000001i) 0.00000001-0.00000001i) (num-test (sin 0.00000001-0.0i) 0.00000001) (num-test (sin 0.00000001-1.0i) 0.00000001543081-1.17520119364380i) (num-test (sin 0.00000001-3.14159265358979i) 0.00000011591953-11.54873935725775i) (num-test (sin 0/1) 0.0) (num-test (sin 0/1234000000) 0.0) (num-test (sin 0/500029) 0.0) (num-test (sin 1) 0.84147098480790) (num-test (sin 1.0) 0.84147098480790) (num-test (sin 1.0+0.00000001i) 0.84147098480790+0.00000000540302i) (num-test (sin 1.0+0.0i) 0.84147098480790) (num-test (sin 1.0+1.0i) 1.29845758141598+0.63496391478474i) (num-test (sin 1.0+3.14159265358979i) 9.75429233860021+6.23981050459650i) (num-test (sin 1.0-0.00000001i) 0.84147098480790-0.00000000540302i) (num-test (sin 1.0-0.0i) 0.84147098480790) (num-test (sin 1.0-1.0i) 1.29845758141598-0.63496391478474i) (num-test (sin 1.0-3.14159265358979i) 9.75429233860021-6.23981050459650i) (num-test (sin 1.110223024625156799999999999999999999997E-16) 1.11022302462515679999999999999999771924E-16) (num-test (sin 1.57045105981189525579e+00+0.0e+00i) 9.9999994039535581669e-1) (num-test (sin 1.57045105981189525579e+00+1.0e+00i) 1.5430805428404715942e0+4.0575816248730593018e-4i) (num-test (sin 1.57045105981189525579e+00+1.19209289550781250e-07i) 9.9999994039536292211e-1+4.1159030931177815679e-11i) (num-test (sin 1.57045105981189525579e+00+2.0e+00i) 3.7621954668392959445e0+1.2522351259047577385e-3i) (num-test (sin 1.57045105981189525579e+00+5.0e-01i) 1.1276258979946363572e0+1.7991700040937027667e-4i) (num-test (sin 1.57045105981189525579e+00-1.0e+00i) 1.5430805428404715942e0-4.0575816248730593018e-4i) (num-test (sin 1.57045105981189525579e+00-1.19209289550781250e-07i) 9.9999994039536292211e-1-4.1159030931177815679e-11i) (num-test (sin 1.57045105981189525579e+00-2.0e+00i) 3.7621954668392959445e0-1.2522351259047577385e-3i) (num-test (sin 1.57045105981189525579e+00-5.0e-01i) 1.1276258979946363572e0-1.7991700040937027667e-4i) (num-test (sin 1.57114159377789786021e+00+0.0e+00i) 9.9999994039535581673e-1) (num-test (sin 1.57114159377789786021e+00+1.0e+00i) 1.5430805428404715942e0-4.0575816248716200955e-4i) (num-test (sin 1.57114159377789786021e+00+1.19209289550781250e-07i) 9.9999994039536292216e-1-4.1159030931163216752e-11i) (num-test (sin 1.57114159377789786021e+00+2.0e+00i) 3.7621954668392959447e0-1.2522351259043135762e-3i) (num-test (sin 1.57114159377789786021e+00+5.0e-01i) 1.1276258979946363573e0-1.7991700040930646090e-4i) (num-test (sin 1.57114159377789786021e+00-1.0e+00i) 1.5430805428404715942e0+4.0575816248716200955e-4i) (num-test (sin 1.57114159377789786021e+00-1.19209289550781250e-07i) 9.9999994039536292216e-1+4.1159030931163216752e-11i) (num-test (sin 1.57114159377789786021e+00-2.0e+00i) 3.7621954668392959447e0+1.2522351259043135762e-3i) (num-test (sin 1.57114159377789786021e+00-5.0e-01i) 1.1276258979946363573e0+1.7991700040930646090e-4i) (num-test (sin 1/1) 0.84147098480790) (num-test (sin 1/10) 0.09983341664683) (num-test (sin 1/1234) 0.00081037268278) (num-test (sin 1/1234000000) 0.00000000081037) (num-test (sin 1/2) 0.47942553860420) (num-test (sin 1/3) 0.32719469679615) (num-test (sin 1/500029) 0.00000199988401) (num-test (sin 10/1234) 0.00810363901920) (num-test (sin 10/1234000000) 0.00000000810373) (num-test (sin 10/3) -0.1905679628754527) (num-test (sin 10/500029) 0.00001999884007) (num-test (sin 1234.0+0.00000001i) .6019276547624973-7.985506235875843E-9i) (num-test (sin 1234.0+12.0i) 48983.30495194942-64983.97008730317i) (num-test (sin 1234.0+3.14159265358979i) 6.977517249251167-9.222253015388718i) (num-test (sin 1234/10) -0.7693905459455223) (num-test (sin 1234/3) 0.213644699569724) (num-test (sin 1234/500029) 0.00246785435930) (num-test (sin 1234000000.0+0.00000001i) -0.9872932128398908+1.5890913089022285E-9i) (num-test (sin 1234000000.0+3.14159265358979i) -11.44465679247962+1.835200134139553i) (num-test (sin 1234000000/1234000000) 0.84147098480790) (num-test (sin 1234000000/3) 9.98585468017658e-1) (num-test (sin 1234000000/500029) -0.9907886154453116) (num-test (sin 2) 0.90929742682568) (num-test (sin 2/10) 0.19866933079506) (num-test (sin 2/1234) 0.00162074483338) (num-test (sin 2/1234000000) 0.00000000162075) (num-test (sin 2/3) 0.61836980306974) (num-test (sin 2/500029) 0.00000399976801) (num-test (sin 3.14124738660679181379e+00+0.0e+00i) 3.4526697614158608860e-4) (num-test (sin 3.14124738660679181379e+00+1.0e+00i) 5.3277478472529828958e-4-1.1752011235963524659e0i) (num-test (sin 3.14124738660679181379e+00+1.19209289550781250e-07i) 3.4526697614158854187e-4-1.1920928244535424532e-7i) (num-test (sin 3.14124738660679181379e+00+2.0e+00i) 1.2989619299133501696e-3-3.6268601916692946553e0i) (num-test (sin 3.14124738660679181379e+00+5.0e-01i) 3.8933200722554445944e-4-5.2109527443404709206e-1i) (num-test (sin 3.14124738660679181379e+00-1.0e+00i) 5.3277478472529828958e-4+1.1752011235963524659e0i) (num-test (sin 3.14124738660679181379e+00-1.19209289550781250e-07i) 3.4526697614158854187e-4+1.1920928244535424532e-7i) (num-test (sin 3.14124738660679181379e+00-2.0e+00i) 1.2989619299133501696e-3+3.6268601916692946553e0i) (num-test (sin 3.14124738660679181379e+00-5.0e-01i) 3.8933200722554445944e-4+5.2109527443404709206e-1i) (num-test (sin 3.14159265358979+0.00000001i) -6.982889851335445E-15-1.0E-8i) (num-test (sin 3.14159265358979+0.0i) -6.982889851335445E-15) (num-test (sin 3.14159265358979+1.0i) -1.077516210464362E-14-1.175201193643801i) (num-test (sin 3.14159265358979+3.14159265358979i) -8.094533288479446E-14-11.54873935725783i) (num-test (sin 3.14193792057279441821e+00+0.0e+00i) -3.4526697614134115926e-4) (num-test (sin 3.14193792057279441821e+00+1.0e+00i) -5.3277478472492034385e-4-1.1752011235963524660e0i) (num-test (sin 3.14193792057279441821e+00+1.19209289550781250e-07i) -3.4526697614134361253e-4-1.1920928244535424533e-7i) (num-test (sin 3.14193792057279441821e+00+2.0e+00i) -1.2989619299124286975e-3-3.6268601916692946556e0i) (num-test (sin 3.14193792057279441821e+00+5.0e-01i) -3.8933200722526827075e-4-5.2109527443404709211e-1i) (num-test (sin 3.14193792057279441821e+00-1.0e+00i) -5.3277478472492034385e-4+1.1752011235963524660e0i) (num-test (sin 3.14193792057279441821e+00-1.19209289550781250e-07i) -3.4526697614134361253e-4+1.1920928244535424533e-7i) (num-test (sin 3.14193792057279441821e+00-2.0e+00i) -1.2989619299124286975e-3+3.6268601916692946556e0i) (num-test (sin 3.14193792057279441821e+00-5.0e-01i) -3.8933200722526827075e-4+5.2109527443404709211e-1i) (num-test (sin 3.45266983001243932001e-04+0.0e+00i) 3.4526697614140534807e-4) (num-test (sin 3.45266983001243932001e-04+1.0e+00i) 5.3277478472501939236e-4+1.1752011235963524660e0i) (num-test (sin 3.45266983001243932001e-04+1.19209289550781250e-07i) 3.4526697614140780134e-4+1.1920928244535424533e-7i) (num-test (sin 3.45266983001243932001e-04+2.0e+00i) 1.2989619299126701883e-3+3.6268601916692946556e0i) (num-test (sin 3.45266983001243932001e-04+5.0e-01i) 3.8933200722534065172e-4+5.2109527443404709209e-1i) (num-test (sin 3.45266983001243932001e-04-1.0e+00i) 5.3277478472501939236e-4-1.1752011235963524660e0i) (num-test (sin 3.45266983001243932001e-04-1.19209289550781250e-07i) 3.4526697614140780134e-4-1.1920928244535424533e-7i) (num-test (sin 3.45266983001243932001e-04-2.0e+00i) 1.2989619299126701883e-3-3.6268601916692946556e0i) (num-test (sin 3.45266983001243932001e-04-5.0e-01i) 3.8933200722534065172e-4-5.2109527443404709209e-1i) (num-test (sin 3/10) 0.29552020666134) (num-test (sin 3/1234) 0.00243111591964) (num-test (sin 3/1234000000) 0.00000000243112) (num-test (sin 3/2) 0.99749498660405) (num-test (sin 3/500029) 0.00000599965202) (num-test (sin 4.71204371340168837179e+00+0.0e+00i) -9.9999994039535581664e-1) (num-test (sin 4.71204371340168837179e+00+1.0e+00i) -1.5430805428404715941e0-4.0575816248744985081e-4i) (num-test (sin 4.71204371340168837179e+00+1.19209289550781250e-07i) -9.9999994039536292207e-1-4.1159030931192414605e-11i) (num-test (sin 4.71204371340168837179e+00+2.0e+00i) -3.7621954668392959444e0-1.2522351259052019007e-3i) (num-test (sin 4.71204371340168837179e+00+5.0e-01i) -1.1276258979946363572e0-1.7991700040943409243e-4i) (num-test (sin 4.71204371340168837179e+00-1.0e+00i) -1.5430805428404715941e0+4.0575816248744985081e-4i) (num-test (sin 4.71204371340168837179e+00-1.19209289550781250e-07i) -9.9999994039536292207e-1+4.1159030931192414605e-11i) (num-test (sin 4.71204371340168837179e+00-2.0e+00i) -3.7621954668392959444e0+1.2522351259052019007e-3i) (num-test (sin 4.71204371340168837179e+00-5.0e-01i) -1.1276258979946363572e0+1.7991700040943409243e-4i) (num-test (sin 4.71273424736769097620e+00+0.0e+00i) -9.9999994039535581677e-1) (num-test (sin 4.71273424736769097620e+00+1.0e+00i) -1.5430805428404715943e0+4.0575816248701808892e-4i) (num-test (sin 4.71273424736769097620e+00+1.19209289550781250e-07i) -9.9999994039536292220e-1+4.1159030931148617825e-11i) (num-test (sin 4.71273424736769097620e+00+2.0e+00i) -3.7621954668392959448e0+1.2522351259038694139e-3i) (num-test (sin 4.71273424736769097620e+00+5.0e-01i) -1.1276258979946363573e0+1.7991700040924264514e-4i) (num-test (sin 4.71273424736769097620e+00-1.0e+00i) -1.5430805428404715943e0-4.0575816248701808892e-4i) (num-test (sin 4.71273424736769097620e+00-1.19209289550781250e-07i) -9.9999994039536292220e-1-4.1159030931148617825e-11i) (num-test (sin 4.71273424736769097620e+00-2.0e+00i) -3.7621954668392959448e0-1.2522351259038694139e-3i) (num-test (sin 4.71273424736769097620e+00-5.0e-01i) -1.1276258979946363573e0-1.7991700040924264514e-4i) (num-test (sin 500029/10) .9665258739436294) (num-test (sin 500029/1234) .05553717596791147) (num-test (sin 500029/1234000000) 0.00040520987546) (num-test (sin 500029/2) 0.270047165973401) (num-test (sin 500029/3) 7.610322596690986e-1) (num-test (sin 6.28284004019658492979e+00+0.0e+00i) -3.4526697614170855328e-4) (num-test (sin 6.28284004019658492979e+00+1.0e+00i) -5.3277478472548726245e-4+1.1752011235963524659e0i) (num-test (sin 6.28284004019658492979e+00+1.19209289550781250e-07i) -3.4526697614171100655e-4+1.1920928244535424532e-7i) (num-test (sin 6.28284004019658492979e+00+2.0e+00i) -1.2989619299138109057e-3+3.6268601916692946552e0i) (num-test (sin 6.28284004019658492979e+00+5.0e-01i) -3.8933200722568255379e-4+5.2109527443404709204e-1i) (num-test (sin 6.28284004019658492979e+00-1.0e+00i) -5.3277478472548726245e-4-1.1752011235963524659e0i) (num-test (sin 6.28284004019658492979e+00-1.19209289550781250e-07i) -3.4526697614171100655e-4-1.1920928244535424532e-7i) (num-test (sin 6.28284004019658492979e+00-2.0e+00i) -1.2989619299138109057e-3-3.6268601916692946552e0i) (num-test (sin 6.28284004019658492979e+00-5.0e-01i) -3.8933200722568255379e-4-5.2109527443404709204e-1i) (num-test (sin 6.28353057416258753420e+00+0.0e+00i) 3.4526697614121869459e-4) (num-test (sin 6.28353057416258753420e+00+1.0e+00i) 5.3277478472473137099e-4+1.1752011235963524661e0i) (num-test (sin 6.28353057416258753420e+00+1.19209289550781250e-07i) 3.4526697614122114786e-4+1.1920928244535424534e-7i) (num-test (sin 6.28353057416258753420e+00+2.0e+00i) 1.2989619299119679614e-3+3.6268601916692946558e0i) (num-test (sin 6.28353057416258753420e+00+5.0e-01i) 3.8933200722513017641e-4+5.2109527443404709213e-1i) (num-test (sin 6.28353057416258753420e+00-1.0e+00i) 5.3277478472473137099e-4-1.1752011235963524661e0i) (num-test (sin 6.28353057416258753420e+00-1.19209289550781250e-07i) 3.4526697614122114786e-4-1.1920928244535424534e-7i) (num-test (sin 6.28353057416258753420e+00-2.0e+00i) 1.2989619299119679614e-3-3.6268601916692946558e0i) (num-test (sin 6.28353057416258753420e+00-5.0e-01i) 3.8933200722513017641e-4-5.2109527443404709213e-1i) (num-test (sin 9.42443269378637893396e+00+0.0e+00i) 3.4526697614094283958e-4) (num-test (sin 9.42443269378637893396e+00+1.0e+00i) 5.3277478472430570447e-4-1.1752011235963524662e0i) (num-test (sin 9.42443269378637893396e+00+1.19209289550781250e-07i) 3.4526697614094529285e-4-1.1920928244535424535e-7i) (num-test (sin 9.42443269378637893396e+00+2.0e+00i) 1.2989619299109301409e-3-3.6268601916692946561e0i) (num-test (sin 9.42443269378637893396e+00+5.0e-01i) 3.8933200722481911514e-4-5.2109527443404709218e-1i) (num-test (sin 9.42443269378637893396e+00-1.0e+00i) 5.3277478472430570447e-4+1.1752011235963524662e0i) (num-test (sin 9.42443269378637893396e+00-1.19209289550781250e-07i) 3.4526697614094529285e-4+1.1920928244535424535e-7i) (num-test (sin 9.42443269378637893396e+00-2.0e+00i) 1.2989619299109301409e-3+3.6268601916692946561e0i) (num-test (sin 9.42443269378637893396e+00-5.0e-01i) 3.8933200722481911514e-4+5.2109527443404709218e-1i) (num-test (sin 9.42512322775237976202e+00+0.0e+00i) -3.4526697614020805155e-4) (num-test (sin 9.42512322775237976202e+00+1.0e+00i) -5.3277478472317186729e-4-1.1752011235963524665e0i) (num-test (sin 9.42512322775237976202e+00+1.19209289550781250e-07i) -3.4526697614021050482e-4-1.1920928244535424538e-7i) (num-test (sin 9.42512322775237976202e+00+2.0e+00i) -1.2989619299081657245e-3-3.6268601916692946571e0i) (num-test (sin 9.42512322775237976202e+00+5.0e-01i) -3.8933200722399054908e-4-5.2109527443404709231e-1i) (num-test (sin 9.42512322775237976202e+00-1.0e+00i) -5.3277478472317186729e-4+1.1752011235963524665e0i) (num-test (sin 9.42512322775237976202e+00-1.19209289550781250e-07i) -3.4526697614021050482e-4+1.1920928244535424538e-7i) (num-test (sin 9.42512322775237976202e+00-2.0e+00i) -1.2989619299081657245e-3+3.6268601916692946571e0i) (num-test (sin 9.42512322775237976202e+00-5.0e-01i) -3.8933200722399054908e-4+5.2109527443404709231e-1i) (num-test (sin pi) -6.982889851335445E-15) (num-test (sin 32767.) 1.8750655394138942394239E-1) (num-test (sin 8388607.) 9.9234509376961249835628E-1) (num-test (sin 2147483647.) -7.2491655514455639054829E-1) (num-test (sin 80143857.0000000149) 1.283143758817470627530994988383551176295E-10) (num-test (sin (- (/ pi 2) (* 0+i (log (/ (+ 1 (sqrt 5)) 2))))) (/ (sqrt 5) 2)) (num-test (sin (/ pi 10)) (/ (- (sqrt 5) 1) 4)) (num-test (sin (/ pi 12)) (* (/ (sqrt 2) 4) (- (sqrt 3) 1))) (num-test (sin (/ pi 12)) (/ (- (sqrt 6) (sqrt 2)) 4)) (num-test (sin (/ pi 15)) (/ (sqrt (- 7 (sqrt 5) (sqrt (- 30 (* 6 (sqrt 5)))))) 4)) (num-test (sin (/ pi 16)) (/ (sqrt (- 2 (sqrt (+ 2 (sqrt 2))))) 2)) (num-test (sin (/ pi 20)) (/ (sqrt (- 8 (* 2 (sqrt (+ 10 (* 2 (sqrt 5))))))) 4)) (num-test (sin (/ pi 24)) (/ (sqrt (- 2 (sqrt (+ 2 (sqrt 3))))) 2)) (num-test (sin (/ pi 3)) (/ (sqrt 3) 2)) (num-test (sin (/ pi 30)) (/ (+ -1 (- (sqrt 5)) (sqrt (- 30 (* 6 (sqrt 5))))) 8)) (num-test (sin (/ pi 32)) (/ (sqrt (- 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt 2))))))) 2)) (num-test (sin (/ pi 4)) (/ (sqrt 2) 2)) (num-test (sin (/ pi 5)) (/ (sqrt (- 10 (* 2 (sqrt 5)))) 4)) (num-test (sin (/ pi 6)) 1/2) (num-test (sin (/ pi 8)) (/ (sqrt (- 2 (sqrt 2))) 2)) (num-test (* (sin (/ pi 11)) (sin (/ (* 2 pi) 11)) (sin (/ (* 3 pi) 11)) (sin (/ (* 4 pi) 11)) (sin (/ (* 5 pi) 11))) (sqrt (/ 11 1024))) (num-test (* (sin (/ pi 7)) (sin (/ (* 2 pi) 7)) (sin (/ (* 3 pi) 7))) (/ (sqrt 7) 8)) (num-test (* (sin (/ pi 9)) (sin (/ (* 2 pi) 9)) (sin (/ (* 4 pi) 9))) (/ (sqrt 3) 8)) (num-test (* pi (+ 1.0 (atan (tan (acos (cos (asin (sin (/ 1.0 (/ 1.0 pi)))))))))) pi) (num-test (+ (* (sin 0.1) (sin 0.1)) (* (cos 0.1) (cos 0.1))) 1.0) (num-test (/ (- (sqrt 5) 1) 2) (/ (sin (* pi 1/5)) (sin (* pi 2/5)))) (let ((val1 (sin (/ pi 60))) (val2 (* 1/16 (- (* (+ (sqrt 6) (sqrt 2)) (- (sqrt 5) 1)) (* 2 (- (sqrt 3) 1) (sqrt (+ 5 (sqrt 5)))))))) (num-test (- val1 val2) 0.0)) (let ((val1 (sin (/ (* 4 pi) 15))) (val2 (* 1/8 (+ (sqrt (+ 10 (* 2 (sqrt 5)))) (sqrt 15) (- (sqrt 3)))))) (num-test (- val1 val2) 0.0)) (num-test (sin 22) -8.851309290403875921690256815772332463307E-3) (when with-bignums (num-test (sin 9223372036854775806) (sin (bignum 9223372036854775806))) (num-test (sin 1e22) -8.522008497671888017727058937530293682616E-1) (num-test (sin 1+100i) 1.130986289301505745599509129978056149094E43+7.261979450834655624032117190441273726075E42i) (num-test (sin 0+100i) 0.0+1.34405857090806772420631277579000679368E43i) (num-test (sin 0+1000i) 0.0+9.850355570085234969444396761216615626576E433i) (num-test (sin 1+1000i) 8.288788402267571487966465808315066740252E433+5.322169828138126401369949836048836144292E433i) (num-test (sin 1e-100+1e-100i) 9.999999999999999999999999999999999999992E-101+9.999999999999999999999999999999999999992E-101i)) ;; not even close if not bignums: 0.4626130407646 ;; we start to lose around 1e18 -- running out of bits of fraction? (test (>= 0.0000001 (sin 0.0000001)) #t) (test (>= 0.000000001 (sin 0.000000001)) #t) ;(test (>= 0.0000001 (sin (+ (* 2 pi) 0.0000001))) #t) ; this fails because "pi" is inaccurate? (num-test (sin 31415926.0) -0.5106132968486) (num-test (sin (+ (* 200 pi) 0.001)) 9.999998333333416874831395573527051109993E-4) (test (< (abs (- (sin (+ (* 200 pi) 0.001)) (- (sin (- (* 200 pi) 0.001))))) 5e-13) #t) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'sin num (sin num) val))) (vector (list 0 0) (list 1 0.8414709848079) (list 2 0.90929742682568) (list 3 0.14112000805987) (list -1 -0.8414709848079) (list -2 -0.90929742682568) (list -3 -0.14112000805987) (list 1/2 0.4794255386042) (list 1/3 0.32719469679615) (list -1/2 -0.4794255386042) (list -1/3 -0.32719469679615) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 0.8414709848079) (list 2.0 0.90929742682568) (list -2.0 -0.90929742682568) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 0+1i 0+1.1752011936438i) (list 0+2i 0+3.626860407847i) (list 0-1i 0-1.1752011936438i) (list 1+1i 1.298457581416+0.63496391478474i) (list 1-1i 1.298457581416-0.63496391478474i) (list -1+1i -1.298457581416+0.63496391478474i) (list -1-1i -1.298457581416-0.63496391478474i) (list 0.1+0.1i 0.10033299984131+0.099666333492108i) (list 1e-16+1e-16i 1e-16+1e-16i) )) (test (sin) 'error) (test (sin "hi") 'error) (test (sin 1.0+23.0i 1.0+23.0i) 'error) (test (sin 0 1) 'error) (for-each (lambda (arg) (test (sin arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (when with-bignums (letrec ((sin-m*pi/n (lambda (m1 n1) ;; this returns an expression giving the exact value of sin(m*pi/n), m and n integer ;; if we can handle n -- currently it can be anything of the form 2^a 3^b 5^c 7^d 11^h 13^e 17^f 257^g ;; so (sin-m*pi/n 1 60) returns an exact expression for sin(pi/60). (let ((m (numerator (/ m1 n1))) (n (denominator (/ m1 n1)))) (set! m (modulo m (* 2 n))) ;; now it's in lowest terms without extra factors of 2*pi (cond ((zero? m) 0) ((zero? n) (error 'divide-by-zero "divide by zero (sin-m*pi/n n = 0)")) ((= n 1) 0) ((negative? n) (let ((val (sin-m*pi/n m (- n)))) (and val `(- ,val)))) ((> m n) (let ((val (sin-m*pi/n (- m n) n))) (and val `(- ,val)))) ((= n 2) (if (= m 0) 0 1)) ((= n 3) `(sqrt 3/4)) ((> m 1) (let ((m1 (sin-m*pi/n (- m 1) n)) (n1 (sin-m*pi/n 1 n)) (m2 (sin-m*pi/n (- m 2) n))) (and m1 m2 n1 `(- (* 2 ,m1 (sqrt (- 1 (* ,n1 ,n1)))) ,m2)))) ((= n 5) `(/ (sqrt (- 10 (* 2 (sqrt 5)))) 4)) ((= n 7) `(let ((A1 (expt (+ -7/3456 (sqrt -49/442368)) 1/3)) (A2 (expt (- -7/3456 (sqrt -49/442368)) 1/3))) (sqrt (+ 7/12 (* -1/2 (+ A1 A2)) (* 1/2 0+i (sqrt 3) (- A1 A2)))))) ((= n 17) `(let* ((A1 (sqrt (- 17 (sqrt 17)))) (A2 (sqrt (+ 17 (sqrt 17)))) (A3 (sqrt (+ 34 (* 6 (sqrt 17)) (* (sqrt 2) (- (sqrt 17) 1) A1) (* -8 (sqrt 2) A2))))) (* 1/8 (sqrt 2) (sqrt (- 17 (sqrt 17) (* (sqrt 2) (+ A1 A3))))))) ((= n 11) `(let* ((SQRT5 (* 1/2 (- (sqrt 5) 1))) (B5 (sqrt (+ 2 (* 1/2 (+ (sqrt 5) 1))))) (B6 (+ SQRT5 (* 0+i B5))) (B6_2 (* B6 B6)) (B6_3 (* B6 B6 B6)) (B6_4 (* B6 B6 B6 B6)) (D1 (+ 6 (* 3/2 B6) (* 3/4 B6_2))) (D2 (+ SQRT5 (* 0+i B5) (* 1/4 B6_2))) (D3 (* 1/2 (- (+ 1 (* 0+i (sqrt 11)))))) (D4 (* 1/2 (- (* 0+i (sqrt 11)) 1))) (D6 (+ 1 (* 1/4 B6_2) (* 1/8 B6_3))) (D7 (+ (* 1/2 B6) (* 1/16 B6_4))) (D8 (+ 2 (* 1/2 B6))) (D9 (+ 13 (* 21 B6) (* 67/4 B6_2) (* 21/4 B6_3) (* 2 B6_4))) (D11 (+ 129 (* 109/2 B6) (* 59/4 B6_2) (* 9/8 B6_3) (* 9/16 B6_4))) (D13 (+ (* 3 B6) B6_2)) (D14 (+ (* 3 B6) (* 3/4 B6_2) (* 3/8 B6_3))) (D15 (+ 79 (* 27 B6) (* 39/4 B6_2) (* 37/4 B6_3) (* 21/4 B6_4))) (D16 (+ D11 (* D3 D9) (* D4 D15))) (D17 (+ D11 (* D4 D9) (* D3 D15))) (D30 (/ (* B6_2 (+ (* D3 D6) (* D4 D7))) (* 4 (expt D17 1/5)))) (D32 (* 1/2 (+ 1 (* 0+i (sqrt 11))))) (D33 (/ (* B6_3 (+ (* D4 D6) (* D3 D7))) (* 8 (expt D16 1/5)))) (D34 (* 1/4 B6_2 (expt D16 1/5))) (D35 (+ 2 (* 1/8 B6_4) (* 1/2 B6 D8) (* 1/8 B6_3 D2))) (D36 (+ SQRT5 (* 0+i B5) (* 1/2 B6_2) (* 1/4 B6_3) (* 1/2 B6 D2) (* 1/4 B6_2 (+ (* 1/4 B6_3) (* 1/16 B6_4))))) (D38 (* 1/2 (+ -1 (* 0+i (sqrt 11))))) (D39 (* 1/8 B6_3 (expt D17 1/5))) (D40 (+ 3 (* 3/2 B6) (* 9/4 B6_2) (* 7/8 B6_3) (* 3/16 B6_4) (* 1/2 B6 (+ 6 (* 2 B6))) (* 1/16 B6_4 D1) (* 1/4 B6_2 D13) (* 1/8 B6_3 (+ 3 (* 3/4 B6_3) (* 3/16 B6_4))))) (D41 (+ (* 1/4 B6_2 D1) (* 1/8 B6_3 D13) (* 1/16 B6_4 D14) (* 1/2 B6 (+ 4 (* 3/8 B6_4))))) (D42 (+ 3 (* 3/4 B6_3) (* 3/16 B6_4) (* 1/8 B6_3 D1) (* 1/4 B6_2 D14) (* 1/2 B6 (+ (* 3/2 B6_2) (* 3/8 B6_3) (* 3/16 B6_4))) (* 1/16 B6_4 (+ 3 (* 3/2 B6) (* 3/8 B6_4))))) (D43 (+ (* 1/4 B6_3) (* 1/16 B6_4) (* 1/8 B6_3 D8) (* 1/4 B6_2 D2) (* 1/2 B6 (+ (* 1/2 B6_2) (* 1/8 B6_3))) (* 1/16 B6_4 (+ 1 (* 1/8 B6_4))))) (D44 (/ (* B6_4 (+ D42 (* D4 D40) (* D3 D41))) (* 16 (expt D16 3/5)))) (D45 (/ (* B6 (+ D42 (* D3 D40) (* D4 D41))) (* 2 (expt D17 3/5)))) (D48 (/ (* B6 (+ D43 (* D3 D35) (* D4 D36))) (* 2 (expt D16 2/5)))) (D49 (/ (* B6_4 (+ D43 (* D4 D35) (* D3 D36))) (* 16 (expt D17 2/5))))) (* -1/2 0+i (+ (* 1/5 (- D32 D33 D34 D48 D44)) (* 1/5 (+ D38 D30 D39 D49 D45)))))) ((= n 13) `(let* ((A1 (/ (- -1 (sqrt 13)) 2)) (A2 (/ (+ -1 (sqrt 13)) 2)) (A3 (/ (+ -1 (* 0+i (sqrt 3))) 2)) (A4 (+ -1 (* 0+i (sqrt 3)))) (A5 (* 0+i (sqrt (+ 7 (sqrt 13) A2)))) (A6 (* 0+i (sqrt (+ 7 (- (sqrt 13)) A1)))) (A8 (* 1/2 (- A2 A6))) (A9 (* 1/2 (+ A1 A5))) (A11 (* 1/2 (+ A2 A6))) (A12 (* 1/2 (- A1 A5))) (A13 (* 3/2 A4 A8)) (A14 (* 3/2 A4 A11)) (A15 (* 3/4 A4 A4 A11)) (A16 (* 3/4 A4 A4 A8)) (A17 (+ A3 (* 1/4 A4 A4)))) (* -1/6 0+i (+ (- A9 A12) (* A4 (+ (/ (+ A8 (* A17 A12)) (* 2 (expt (+ 6 A13 A15 A9) 1/3))) (/ (+ A11 (* A17 A9)) (* -2 (expt (+ 6 A16 A14 A12) 1/3))) (* 1/4 A4 (- (expt (+ 6 A13 A15 A9) 1/3) (expt (+ 6 A16 A14 A12) 1/3))))))))) ((= n 257) `(let* ((A1 (sqrt (- 514 (* 2 (sqrt 257))))) (A2 (- 257 (* 15 (sqrt 257)))) (A3 (+ 257 (* 15 (sqrt 257)))) (A4 (- 257 (sqrt 257))) (A5 (+ (sqrt 257) 257)) (A7 (+ 257 (* 9 (sqrt 257)))) (A8 (- 514 (* 18 (sqrt 257)))) (AA (sqrt (* 2 A5))) (A9 (sqrt (+ A2 (* 8 A1) (* -7 AA)))) (A10 (sqrt (+ A2 (* -8 A1) (* 7 AA)))) (A11 (sqrt (+ A3 (* 7 A1) (* 8 AA)))) (A12 (sqrt (+ A3 (* -7 A1) (* -8 AA)))) (A13 (sqrt (+ A8 (* 6 A1) (* 8 A9) (* -24 A10) (* 12 A11)))) (A14 (* 4 (sqrt (+ A8 (* 6 A1) (* -8 A9) (* 24 A10) (* -12 A11))))) (A15 (* 4 (sqrt (+ A8 (* -6 A1) (* -12 A12) (* 24 A9) (* 8 A10))))) (A16 (* 4 (sqrt (* 2 (+ (- 257 (* 9 (sqrt 257))) (* -3 A1) (* 6 A12) (* -12 A9) (* -4 A10)))))) (A17 (sqrt (* 2 (+ A7 (* -3 AA) (* -4 A12) (* 6 A9) (* 12 A11))))) (A18 (sqrt (* 2 (+ A7 (* 3 AA) (* 12 A12) (* -6 A10) (* 4 A11))))) (A19 (* 4 (sqrt (* 2 (+ A7 (* 3 AA) (* -12 A12) (* 6 A10) (* -4 A11)))))) (A20 (* 4 (sqrt (* 2 (+ A7 (* -3 AA) (* 4 A12) (* -6 A9) (* -12 A11)))))) (A22 (+ A4 (* 3 A1) (* -4 AA) (* -4 A12) (* 4 A9) (* -4 A10) (* 2 A11))) (A23 (+ A5 (* -4 A1) (* -3 AA) (* -4 A12) (* 2 A9) (* 4 A10) (* 4 A11))) (A24 (+ A5 (* 4 A1) (* 3 AA) (* 4 A12) (* 4 A9) (* -2 A10) (* 4 A11))) (A26 (sqrt (+ A22 (+ (- A16) (- A19) (* 4 A17) (* -6 A13))))) (A27 (sqrt (+ A22 (+ A16 A19 (* -4 A17) (* 6 A13))))) (A28 (+ 257 (* 7 (sqrt 257)) (* 3 A1) (* -4 A9) (* 4 A10) (* 6 A11))) (A29 (* 8 (sqrt (+ A24 A15 (- A20) (* -6 A18) (* -4 A13))))) (A30 (+ A28 (* -4 A18) (* -4 A17) (* -2 A13))) (A31 (+ (* 8 (sqrt (+ A23 A15 A14 (* 4 A18) (* -6 A17)))) (* 4 A26) A29 (* -8 A27)))) (* 1/16 (sqrt (* 1/2 (+ A4 (- A1) (* -2 A11) (* -2 A13) (* -4 A26) (* -4 (sqrt (* 2 (+ A30 (- A31))))) (* -8 (sqrt (+ A4 (- A1) (* -2 A11) (* 6 A13) (* -4 A26) (* -8 A27) (* 4 (sqrt (* 2 (+ A30 A31)))) (* -8 (sqrt (* 2 (+ A28 (* 4 A18) (* 4 A17) (* 2 A13) (* -8 A26) (* -4 A27) (* -8 (sqrt (+ A23 (- A15) (- A14) (* -4 A18) (* 6 A17)))) (* -8 (sqrt (+ A24 (- A15) A20 (* 6 A18) (* 4 A13))))))))))))))))) ((or (= (modulo n 2) 0) (= (modulo n 3) 0) (= (modulo n 5) 0) (= (modulo n 7) 0) (= (modulo n 17) 0) (= (modulo n 13) 0) (= (modulo n 257) 0) (= (modulo n 11) 0)) (let ((divisor (if (= (modulo n 2) 0) 2 (if (= (modulo n 3) 0) 3 (if (= (modulo n 5) 0) 5 (if (= (modulo n 7) 0) 7 (if (= (modulo n 17) 0) 17 (if (= (modulo n 13) 0) 13 (if (= (modulo n 11) 0) 11 257))))))))) (let ((val (sin-m*pi/n 1 (/ n divisor)))) (and val `(let ((ex ,val)) (/ (- (expt (+ (sqrt (- 1 (* ex ex))) (* 0+i ex)) (/ 1 ,divisor)) (expt (- (sqrt (- 1 (* ex ex))) (* 0+i ex)) (/ 1 ,divisor))) 0+2i)))))) (else #f)))))) (let ((maxerr 0.0) (max-case #f) (cases 0)) (do ((n 1 (+ n 1))) ((= n 100)) (do ((m 1 (+ m 1))) ((= m 4)) (letrec ((bigify (lambda (lst) (if (pair? lst) (cons (if (number? (car lst)) (list 'bignum (number->string (car lst))) (bigify (car lst))) (bigify (cdr lst))) lst)))) (let ((val (sin (/ (* m pi) n))) (expr (bigify (sin-m*pi/n m n)))) (if expr (let ((err (magnitude (- val (eval expr))))) (set! cases (+ cases 1)) (if (> err maxerr) (begin (set! max-case (/ m n)) (set! maxerr err))))))))) (if (> maxerr 1e-35) (format #t "sin-m*pi/n (~A cases) max err ~A at ~A~%" cases maxerr max-case))))) (let ((sins (list 0.00000000000000000000000000000000000000000000000000000000000000000000 0.09983341664682815230681419841062202698991538801798225999276686156165 0.19866933079506121545941262711838975037020672954020540398639599139797 0.29552020666133957510532074568502737367783211174261844850153103617326 0.38941834230865049166631175679570526459306018344395889511584896585734 0.47942553860420300027328793521557138808180336794060067518861661312553 0.56464247339503535720094544565865790710988808499415177102426589426735 0.64421768723769105367261435139872018306581384457368964474396308809382 0.71735609089952276162717461058138536619278523779142282098968252068287 0.78332690962748338846138231571354862314014792572030960356048515256195 0.84147098480789650665250232163029899962256306079837106567275170999191 0.89120736006143533995180257787170353831890931945282652766035329176720 0.93203908596722634967013443549482599541507058820873073536659789445024 0.96355818541719296470134863003955481534204849131773911795564922309212 0.98544972998846018065947457880609751735626167234736563194021894560084 0.99749498660405443094172337114148732270665142592211582194997482405934 0.99957360304150516434211382554623417197949791475491995534260751586102 0.99166481045246861534613339864787565240681957116712372532710249102330 0.97384763087819518653237317884335760670293947136523395566725825917196 0.94630008768741448848970961163495776211399866559491176443047155279581 0.90929742682568169539601986591174484270225497144789026837897301153096 0.86320936664887377068075931326902458492047242489508107697183045949721 0.80849640381959018430403691041611906515855960597557707903336060873485 0.74570521217672017738540621164349953894264877802047425750762828050000 0.67546318055115092656577152534128337425336495789352584226890212866520 0.59847214410395649405185470218616227170359717157722357330262703263874 0.51550137182146423525772693520936824389387858775426312126259173008382 0.42737988023382993455605308585788064749647642266670256499017776070511 0.33498815015590491954385375271242210603030652888358671068410107309479 0.23924932921398232818425691873957537221555293029961877411621026588071 0.14112000805986722210074480280811027984693326425226558415188264123242 0.04158066243329057919469827159667310055461342296380675064800900076588 -0.05837414342757990913721741461909518512512509908292656970935025422273))) (let ((mxerr 0.0)) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 32)) (let ((err (abs (- (sin x) (list-ref sins i))))) (if (> err mxerr) (set! mxerr err)))) (if (> mxerr 1e-12) (format #t "sin err: ~A~%" mxerr)))) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((sin-vals (list ;arprec mathtool table[Sin[k/10], {k, 0, 30}] "0.00000000000000000000000000000000000000000000000000000000000000000000" "0.09983341664682815230681419841062202698991538801798225999276686156165" "0.19866933079506121545941262711838975037020672954020540398639599139797" "0.29552020666133957510532074568502737367783211174261844850153103617326" "0.38941834230865049166631175679570526459306018344395889511584896585734" "0.47942553860420300027328793521557138808180336794060067518861661312553" "0.56464247339503535720094544565865790710988808499415177102426589426735" "0.64421768723769105367261435139872018306581384457368964474396308809382" "0.71735609089952276162717461058138536619278523779142282098968252068287" "0.78332690962748338846138231571354862314014792572030960356048515256195" "0.84147098480789650665250232163029899962256306079837106567275170999191" "0.89120736006143533995180257787170353831890931945282652766035329176720" "0.93203908596722634967013443549482599541507058820873073536659789445024" "0.96355818541719296470134863003955481534204849131773911795564922309212" "0.98544972998846018065947457880609751735626167234736563194021894560084" "0.99749498660405443094172337114148732270665142592211582194997482405934" "0.99957360304150516434211382554623417197949791475491995534260751586102" "0.99166481045246861534613339864787565240681957116712372532710249102330" "0.97384763087819518653237317884335760670293947136523395566725825917196" "0.94630008768741448848970961163495776211399866559491176443047155279581" "0.90929742682568169539601986591174484270225497144789026837897301153096" "0.86320936664887377068075931326902458492047242489508107697183045949721" "0.80849640381959018430403691041611906515855960597557707903336060873485" "0.74570521217672017738540621164349953894264877802047425750762828050000" "0.67546318055115092656577152534128337425336495789352584226890212866520" "0.59847214410395649405185470218616227170359717157722357330262703263874" "0.51550137182146423525772693520936824389387858775426312126259173008382" "0.42737988023382993455605308585788064749647642266670256499017776070511" "0.33498815015590491954385375271242210603030652888358671068410107309479" "0.23924932921398232818425691873957537221555293029961877411621026588071" "0.14112000805986722210074480280811027984693326425226558415188264123242"))) (do ((k 2 (+ k 1))) ((= k 30)) (let ((sin-val-2 (number->string (sin (bignum (/ k 10)))))) (if (not (string=? (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59))) (format #t ";(sin (/ ~A 10)) mp: ~A does not match~%~A~%" k (substring (list-ref sin-vals k) 3 60) (substring sin-val-2 2 59)))))) (let ((sin-vals (list ;arprec mathtool table[Sin[k/10], {k, 0, 30}] 0.00000000000000000000000000000000000000000000000000000000000000000000 0.09983341664682815230681419841062202698991538801798225999276686156165 0.19866933079506121545941262711838975037020672954020540398639599139797 0.29552020666133957510532074568502737367783211174261844850153103617326 0.38941834230865049166631175679570526459306018344395889511584896585734 0.47942553860420300027328793521557138808180336794060067518861661312553 0.56464247339503535720094544565865790710988808499415177102426589426735 0.64421768723769105367261435139872018306581384457368964474396308809382 0.71735609089952276162717461058138536619278523779142282098968252068287 0.78332690962748338846138231571354862314014792572030960356048515256195 0.84147098480789650665250232163029899962256306079837106567275170999191 0.89120736006143533995180257787170353831890931945282652766035329176720 0.93203908596722634967013443549482599541507058820873073536659789445024 0.96355818541719296470134863003955481534204849131773911795564922309212 0.98544972998846018065947457880609751735626167234736563194021894560084 0.99749498660405443094172337114148732270665142592211582194997482405934 0.99957360304150516434211382554623417197949791475491995534260751586102 0.99166481045246861534613339864787565240681957116712372532710249102330 0.97384763087819518653237317884335760670293947136523395566725825917196 0.94630008768741448848970961163495776211399866559491176443047155279581 0.90929742682568169539601986591174484270225497144789026837897301153096 0.86320936664887377068075931326902458492047242489508107697183045949721 0.80849640381959018430403691041611906515855960597557707903336060873485 0.74570521217672017738540621164349953894264877802047425750762828050000 0.67546318055115092656577152534128337425336495789352584226890212866520 0.59847214410395649405185470218616227170359717157722357330262703263874 0.51550137182146423525772693520936824389387858775426312126259173008382 0.42737988023382993455605308585788064749647642266670256499017776070511 0.33498815015590491954385375271242210603030652888358671068410107309479 0.23924932921398232818425691873957537221555293029961877411621026588071 0.14112000805986722210074480280811027984693326425226558415188264123242)) (mxerr 0.0)) (do ((x 0 (+ x 1))) ((= x 20)) (let ((phase (* 2 pi (expt 10 x)))) (do ((k 0 (+ k 1))) ((= k 30)) (let ((sin-val-2 (sin (bignum (+ phase (/ k 10)))))) (let ((err (magnitude (- sin-val-2 (list-ref sin-vals k))))) (if (> err mxerr) (set! mxerr err))))))) (if (> mxerr 1e-35) (format #t ";(sin big-angle) max error: ~A" mxerr))))) #| (do ((i 0 (+ i 1))) ((= i 20)) (format *stderr* "~16F ~16F~%" (sin (* (expt 10 i) pi)) (cos (* (expt 10 i) pi)))) no gmp: 0.000000 -1.000000 -0.000000 1.000000 0.000000 1.000000 -0.000000 1.000000 -0.000000 1.000000 -0.000000 1.000000 -0.000000 1.000000 0.000000 1.000000 -0.000000 1.000000 -0.000000 1.000000 -0.000002 1.000000 -0.000015 1.000000 -0.000270 1.000000 -0.002697 0.999996 -0.011346 0.999936 -0.236209 0.971702 -0.375213 0.926939 -0.847970 -0.530045 -0.641653 -0.766995 0.746337 0.665569 gmp: 1.883041077660785116745909548456034940273E-39 -1.00E0 -4.234029779305360132683382622900526295916E-38 1.000E0 -6.114820740621020145433361082456119380431E-37 1.000E0 -3.105555202515964125033395547167170445206E-36 1.000E0 -3.10555520251596412503339554716717044521E-35 1.000E0 -5.031485146903199978089373489752097763739E-34 1.000E0 -5.031485146903199978089373489752097763744E-33 1.000E0 -2.566294818087538086177721723243390796012E-32 1.000E0 1.378009708017520940880921103170540352349E-31 1.000E0 1.378009708017520940880921103170540352352E-30 1.000E0 -1.146345188689716836436610305734375582604E-29 1.000E0 -1.146345188689716836436610305734375582607E-28 1.000E0 -4.37751945647498119140305050913266797935E-27 1.000E0 -1.792580042246769707429898346414034061949E-26 1.000E0 2.343323020518368666927145113935780205877E-25 1.000E0 -4.274121879905852732044124422623922622644E-24 1.000E0 -4.274121879905852732044124422623922622652E-23 1.000E0 -3.895714363435103670251191922571281239311E-24 1.000E0 3.349174645382850319570778083492855035814E-21 1.000E0 -4.782341648258432935485117923031707799885E-20 1.000E0 |# ;;; -------------------------------------------------------------------------------- ;;; cos ;;; -------------------------------------------------------------------------------- (num-test (cos 0) 1.0) (num-test (cos 1) 0.54030230586814) (num-test (cos 2) -0.41614683654714) (num-test (cos 3) -0.98999249660045) (num-test (cos 0/1) 1.0) (num-test (cos 0/2) 1.0) (num-test (cos 0/3) 1.0) (num-test (cos 0/10) 1.0) (num-test (cos 0/1234) 1.0) (num-test (cos 0/500029) 1.0) (num-test (cos 1/1) 0.54030230586814) (num-test (cos 1/2) 0.87758256189037) (num-test (cos -1/2) 0.87758256189037) (num-test (cos 1/3) 0.94495694631474) (num-test (cos -1/3) 0.94495694631474) (num-test (cos 1/10) 0.99500416527803) (num-test (cos -1/10) 0.99500416527803) (num-test (cos 1/1234) 0.99999967164800) (num-test (cos -1/1234) 0.99999967164800) (num-test (cos 1/500029) 0.99999999999800) (num-test (cos -1/500029) 0.99999999999800) (num-test (cos 2/1) -0.41614683654714) (num-test (cos 2/2) 0.54030230586814) (num-test (cos 2/3) 0.78588726077695) (num-test (cos 2/10) 0.98006657784124) (num-test (cos -2/10) 0.98006657784124) (num-test (cos 2/1234) 0.99999868659223) (num-test (cos -2/1234) 0.99999868659223) (num-test (cos 2/500029) 0.99999999999200) (num-test (cos -2/500029) 0.99999999999200) (num-test (cos 3/1) -0.98999249660045) (num-test (cos 3/2) 0.07073720166770) (num-test (cos 3/3) 0.54030230586814) (num-test (cos 3/10) 0.95533648912561) (num-test (cos -3/10) 0.95533648912561) (num-test (cos 3/1234) 0.99999704483333) (num-test (cos -3/1234) 0.99999704483333) (num-test (cos 3/500029) 0.99999999998200) (num-test (cos -3/500029) 0.99999999998200) (num-test (cos 10/3) -0.98167400471108) (num-test (cos 10/10) 0.54030230586814) (num-test (cos 10/1234) 0.99996716497825) (num-test (cos -10/1234) 0.99996716497825) (num-test (cos 10/500029) 0.99999999980002) (num-test (cos -10/500029) 0.99999999980002) (num-test (cos 1234/500029) 0.99999695484279) (num-test (cos -1234/500029) 0.99999695484279) (num-test (cos 500029/500029) 0.54030230586814) (num-test (cos 0.0) 1.0) (num-test (cos 0.00000001) 1.0) (num-test (cos -0.00000001) 1.0) (num-test (cos 1.0) 0.54030230586814) (num-test (cos pi) -1.0) (num-test (cos 0.0+0.0i) 1.0) (num-test (cos -0.0+0.0i) 1.0) (num-test (cos 0.0-0.0i) 1.0) (num-test (cos -0.0-0.0i) 1.0) (num-test (cos 0.0+0.00000001i) 1.0) (num-test (cos -0.0+0.00000001i) 1.0) (num-test (cos 0.0-0.00000001i) 1.0) (num-test (cos -0.0-0.00000001i) 1.0) (num-test (cos 0.0+1.0i) 1.54308063481524) (num-test (cos -0.0+1.0i) 1.54308063481524) (num-test (cos 0.0-1.0i) 1.54308063481524) (num-test (cos 0.0+3.14159265358979i) 11.59195327552152) (num-test (cos -0.0+3.14159265358979i) 11.59195327552152) (num-test (cos 0.0-3.14159265358979i) 11.59195327552152) (num-test (cos 0.00000001+0.0i) 1.0) (num-test (cos -0.00000001+0.0i) 1.0) (num-test (cos 0.00000001-0.0i) 1.0) (num-test (cos -0.00000001-0.0i) 1.0) (num-test (cos 0.00000001+0.00000001i) 1.0-1e-16i) ; maxima (num-test (cos -0.00000001+0.00000001i) 1.0+1e-16i) (num-test (cos 0.00000001-0.00000001i) 1.0+1e-16i) (num-test (cos -0.00000001-0.00000001i) 1.0-1e-16i) (num-test (cos 0.00000001+1.0i) 1.54308063481524-0.00000001175201i) (num-test (cos 0.00000001-1.0i) 1.54308063481524+0.00000001175201i) (num-test (cos 0.00000001+3.14159265358979i) 11.59195327552152-0.00000011548739i) (num-test (cos 0.00000001-3.14159265358979i) 11.59195327552152+0.00000011548739i) (num-test (cos 1.0+0.0i) 0.54030230586814) (num-test (cos 1.0-0.0i) 0.54030230586814) (num-test (cos 1.0+0.00000001i) 0.54030230586814-0.00000000841471i) (num-test (cos 1.0-0.00000001i) 0.54030230586814+0.00000000841471i) (num-test (cos 1.0+1.0i) 0.83373002513115-0.98889770576287i) (num-test (cos 1.0-1.0i) 0.83373002513115+0.98889770576287i) (num-test (cos 1.0+3.14159265358979i) 6.26315908428001-9.71792908024139i) (num-test (cos 1.0-3.14159265358979i) 6.26315908428001+9.71792908024139i) (num-test (cos 3.14159265358979+0.0i) -1.0) (num-test (cos 3.14159265358979-0.0i) -1.0) (num-test (cos 3.14159265358979+0.00000001i) -1.0-3.23121723694911E-23i) ; maxima (num-test (cos 3.14159265358979-0.00000001i) -1.0+3.23121723694911E-23i) ; maxima (num-test (cos 3.14159265358979+1.0i) -1.54308063481524) (num-test (cos 3.14159265358979-1.0i) -1.54308063481524) (num-test (cos 3.14159265358979+3.14159265358979i) -11.5919532755216+8.064357485351393E-14i) ; maxima (num-test (cos 3.14159265358979-3.14159265358979i) -11.59195327552152+3.73164856762037E-14i) (num-test (cos -2/3) .7858872607769459) (num-test (cos -3/2) 0.0707372016677029) (num-test (cos -10/3) -0.9816740047110853) (num-test (cos 1234/3) -0.9769114301438807) (num-test (cos 1234/10) -0.6387786688749486) (num-test (cos 500029/2) 0.962847094896035) (num-test (cos 500029/3) -0.6487140328750399) (num-test (cos 500029/10) .2565691622107056) (num-test (cos 500029/1234) -0.9984566200318916) (num-test (cos -3.14159265358979) -1.0) (num-test (cos 0.0+3.14159265358979i) 11.5919532755216) (num-test (cos 0.00000001+1.0i) 1.543080634815244-1.1752011936438014E-8i) (num-test (cos 0.00000001+3.14159265358979i) 11.5919532755216-1.154873935725783E-7i) (num-test (cos 1.0+0.00000001i) .5403023058681398-8.414709848078964E-9i) (num-test (cos 1.0+3.14159265358979i) 6.263159084280057-9.71792908024146i) (num-test (cos 3.14159265358979+0.00000001i) -1.0+6.982889851335445E-23i) (num-test (cos 3.14159265358979+1.0i) -1.543080634815244+8.206300488372603E-15i) (num-test (cos 3.14159265358979+3.14159265358979i) -11.5919532755216+8.064357485351393E-14i) (num-test (cos 1234.0+0.00000001i) -0.7985506235875843-6.019276547624973E-9i) (num-test (cos 1234.0+3.14159265358979i) -9.256761516765916-6.951505596777556i) (num-test (cos 1234.0+12.0i) -64983.97009220963-48983.30494825104i) (num-test (cos -3.45266983001243932001e-04+0.0e+00i) 9.9999994039535581673e-1) (num-test (cos 3.45266983001243932001e-04+0.0e+00i) 9.9999994039535581673e-1) (num-test (cos -3.45266983001243932001e-04+1.19209289550781250e-07i) 9.9999994039536292216e-1+4.1159030931163569191e-11i) (num-test (cos -3.45266983001243932001e-04-1.19209289550781250e-07i) 9.9999994039536292216e-1-4.1159030931163569191e-11i) (num-test (cos 3.45266983001243932001e-04+1.19209289550781250e-07i) 9.9999994039536292216e-1-4.1159030931163569191e-11i) (num-test (cos 3.45266983001243932001e-04-1.19209289550781250e-07i) 9.9999994039536292216e-1+4.1159030931163569191e-11i) (num-test (cos -3.45266983001243932001e-04+5.0e-01i) 1.1276258979946363573e0+1.7991700040930800151e-4i) (num-test (cos -3.45266983001243932001e-04-5.0e-01i) 1.1276258979946363573e0-1.7991700040930800151e-4i) (num-test (cos 3.45266983001243932001e-04+5.0e-01i) 1.1276258979946363573e0-1.7991700040930800151e-4i) (num-test (cos 3.45266983001243932001e-04-5.0e-01i) 1.1276258979946363573e0+1.7991700040930800151e-4i) (num-test (cos -3.45266983001243932001e-04+1.0e+00i) 1.5430805428404715942e0+4.057581624871654840e-4i) (num-test (cos -3.45266983001243932001e-04-1.0e+00i) 1.5430805428404715942e0-4.057581624871654840e-4i) (num-test (cos 3.45266983001243932001e-04+1.0e+00i) 1.5430805428404715942e0-4.057581624871654840e-4i) (num-test (cos 3.45266983001243932001e-04-1.0e+00i) 1.5430805428404715942e0+4.057581624871654840e-4i) (num-test (cos -3.45266983001243932001e-04+2.0e+00i) 3.7621954668392959447e0+1.2522351259043242989e-3i) (num-test (cos -3.45266983001243932001e-04-2.0e+00i) 3.7621954668392959447e0-1.2522351259043242989e-3i) (num-test (cos 3.45266983001243932001e-04+2.0e+00i) 3.7621954668392959447e0-1.2522351259043242989e-3i) (num-test (cos 3.45266983001243932001e-04-2.0e+00i) 3.7621954668392959447e0+1.2522351259043242989e-3i) (num-test (cos 1.57045105981189525579e+00+0.0e+00i) 3.4526697614152485627e-4) (num-test (cos -1.57045105981189525579e+00+0.0e+00i) 3.4526697614152485627e-4) (num-test (cos 1.57045105981189525579e+00+1.19209289550781250e-07i) 3.4526697614152730954e-4-1.1920928244535424532e-7i) (num-test (cos 1.57045105981189525579e+00-1.19209289550781250e-07i) 3.4526697614152730954e-4+1.1920928244535424532e-7i) (num-test (cos -1.57045105981189525579e+00+1.19209289550781250e-07i) 3.4526697614152730954e-4+1.1920928244535424532e-7i) (num-test (cos -1.57045105981189525579e+00-1.19209289550781250e-07i) 3.4526697614152730954e-4-1.1920928244535424532e-7i) (num-test (cos 1.57045105981189525579e+00+5.0e-01i) 3.8933200722547541227e-4-5.2109527443404709207e-1i) (num-test (cos 1.57045105981189525579e+00-5.0e-01i) 3.8933200722547541227e-4+5.2109527443404709207e-1i) (num-test (cos -1.57045105981189525579e+00+5.0e-01i) 3.8933200722547541227e-4+5.2109527443404709207e-1i) (num-test (cos -1.57045105981189525579e+00-5.0e-01i) 3.8933200722547541227e-4-5.2109527443404709207e-1i) (num-test (cos 1.57045105981189525579e+00+1.0e+00i) 5.3277478472520380315e-4-1.1752011235963524659e0i) (num-test (cos 1.57045105981189525579e+00-1.0e+00i) 5.3277478472520380315e-4+1.1752011235963524659e0i) (num-test (cos -1.57045105981189525579e+00+1.0e+00i) 5.3277478472520380315e-4+1.1752011235963524659e0i) (num-test (cos -1.57045105981189525579e+00-1.0e+00i) 5.3277478472520380315e-4-1.1752011235963524659e0i) (num-test (cos 1.57045105981189525579e+00+2.0e+00i) 1.2989619299131198016e-3-3.6268601916692946554e0i) (num-test (cos 1.57045105981189525579e+00-2.0e+00i) 1.2989619299131198016e-3+3.6268601916692946554e0i) (num-test (cos -1.57045105981189525579e+00+2.0e+00i) 1.2989619299131198016e-3+3.6268601916692946554e0i) (num-test (cos -1.57045105981189525579e+00-2.0e+00i) 1.2989619299131198016e-3-3.6268601916692946554e0i) (num-test (cos 1.57114159377789786021e+00+0.0e+00i) -3.4526697614140239160e-4) (num-test (cos -1.57114159377789786021e+00+0.0e+00i) -3.4526697614140239160e-4) (num-test (cos 1.57114159377789786021e+00+1.19209289550781250e-07i) -3.4526697614140484486e-4-1.1920928244535424533e-7i) (num-test (cos 1.57114159377789786021e+00-1.19209289550781250e-07i) -3.4526697614140484486e-4+1.1920928244535424533e-7i) (num-test (cos -1.57114159377789786021e+00+1.19209289550781250e-07i) -3.4526697614140484486e-4+1.1920928244535424533e-7i) (num-test (cos -1.57114159377789786021e+00-1.19209289550781250e-07i) -3.4526697614140484486e-4-1.1920928244535424533e-7i) (num-test (cos 1.57114159377789786021e+00+5.0e-01i) -3.8933200722533731792e-4-5.2109527443404709209e-1i) (num-test (cos 1.57114159377789786021e+00-5.0e-01i) -3.8933200722533731792e-4+5.2109527443404709209e-1i) (num-test (cos -1.57114159377789786021e+00+5.0e-01i) -3.8933200722533731792e-4+5.2109527443404709209e-1i) (num-test (cos -1.57114159377789786021e+00-5.0e-01i) -3.8933200722533731792e-4-5.2109527443404709209e-1i) (num-test (cos 1.57114159377789786021e+00+1.0e+00i) -5.3277478472501483029e-4-1.1752011235963524660e0i) (num-test (cos 1.57114159377789786021e+00-1.0e+00i) -5.3277478472501483029e-4+1.1752011235963524660e0i) (num-test (cos -1.57114159377789786021e+00+1.0e+00i) -5.3277478472501483029e-4+1.1752011235963524660e0i) (num-test (cos -1.57114159377789786021e+00-1.0e+00i) -5.3277478472501483029e-4-1.1752011235963524660e0i) (num-test (cos 1.57114159377789786021e+00+2.0e+00i) -1.2989619299126590655e-3-3.6268601916692946556e0i) (num-test (cos 1.57114159377789786021e+00-2.0e+00i) -1.2989619299126590655e-3+3.6268601916692946556e0i) (num-test (cos -1.57114159377789786021e+00+2.0e+00i) -1.2989619299126590655e-3+3.6268601916692946556e0i) (num-test (cos -1.57114159377789786021e+00-2.0e+00i) -1.2989619299126590655e-3-3.6268601916692946556e0i) (num-test (cos 3.14124738660679181379e+00+0.0e+00i) -9.9999994039535581667e-1) (num-test (cos -3.14124738660679181379e+00+0.0e+00i) -9.9999994039535581667e-1) (num-test (cos 3.14124738660679181379e+00+1.19209289550781250e-07i) -9.9999994039536292209e-1-4.1159030931185115142e-11i) (num-test (cos 3.14124738660679181379e+00-1.19209289550781250e-07i) -9.9999994039536292209e-1+4.1159030931185115142e-11i) (num-test (cos -3.14124738660679181379e+00+1.19209289550781250e-07i) -9.9999994039536292209e-1+4.1159030931185115142e-11i) (num-test (cos -3.14124738660679181379e+00-1.19209289550781250e-07i) -9.9999994039536292209e-1-4.1159030931185115142e-11i) (num-test (cos 3.14124738660679181379e+00+5.0e-01i) -1.1276258979946363572e0-1.7991700040940218455e-4i) (num-test (cos 3.14124738660679181379e+00-5.0e-01i) -1.1276258979946363572e0+1.7991700040940218455e-4i) (num-test (cos -3.14124738660679181379e+00+5.0e-01i) -1.1276258979946363572e0+1.7991700040940218455e-4i) (num-test (cos -3.14124738660679181379e+00-5.0e-01i) -1.1276258979946363572e0-1.7991700040940218455e-4i) (num-test (cos 3.14124738660679181379e+00+1.0e+00i) -1.5430805428404715941e0-4.0575816248737789049e-4i) (num-test (cos 3.14124738660679181379e+00-1.0e+00i) -1.5430805428404715941e0+4.0575816248737789049e-4i) (num-test (cos -3.14124738660679181379e+00+1.0e+00i) -1.5430805428404715941e0+4.0575816248737789049e-4i) (num-test (cos -3.14124738660679181379e+00-1.0e+00i) -1.5430805428404715941e0-4.0575816248737789049e-4i) (num-test (cos 3.14124738660679181379e+00+2.0e+00i) -3.7621954668392959444e0-1.2522351259049798196e-3i) (num-test (cos 3.14124738660679181379e+00-2.0e+00i) -3.7621954668392959444e0+1.2522351259049798196e-3i) (num-test (cos -3.14124738660679181379e+00+2.0e+00i) -3.7621954668392959444e0+1.2522351259049798196e-3i) (num-test (cos -3.14124738660679181379e+00-2.0e+00i) -3.7621954668392959444e0-1.2522351259049798196e-3i) (num-test (cos 3.14193792057279441821e+00+0.0e+00i) -9.9999994039535581675e-1) (num-test (cos -3.14193792057279441821e+00+0.0e+00i) -9.9999994039535581675e-1) (num-test (cos 3.14193792057279441821e+00+1.19209289550781250e-07i) -9.9999994039536292218e-1+4.1159030931155917289e-11i) (num-test (cos 3.14193792057279441821e+00-1.19209289550781250e-07i) -9.9999994039536292218e-1-4.1159030931155917289e-11i) (num-test (cos -3.14193792057279441821e+00+1.19209289550781250e-07i) -9.9999994039536292218e-1-4.1159030931155917289e-11i) (num-test (cos -3.14193792057279441821e+00-1.19209289550781250e-07i) -9.9999994039536292218e-1+4.1159030931155917289e-11i) (num-test (cos 3.14193792057279441821e+00+5.0e-01i) -1.1276258979946363573e0+1.7991700040927455302e-4i) (num-test (cos 3.14193792057279441821e+00-5.0e-01i) -1.1276258979946363573e0-1.7991700040927455302e-4i) (num-test (cos -3.14193792057279441821e+00+5.0e-01i) -1.1276258979946363573e0-1.7991700040927455302e-4i) (num-test (cos -3.14193792057279441821e+00-5.0e-01i) -1.1276258979946363573e0+1.7991700040927455302e-4i) (num-test (cos 3.14193792057279441821e+00+1.0e+00i) -1.5430805428404715943e0+4.0575816248709004923e-4i) (num-test (cos 3.14193792057279441821e+00-1.0e+00i) -1.5430805428404715943e0-4.0575816248709004923e-4i) (num-test (cos -3.14193792057279441821e+00+1.0e+00i) -1.5430805428404715943e0-4.0575816248709004923e-4i) (num-test (cos -3.14193792057279441821e+00-1.0e+00i) -1.5430805428404715943e0+4.0575816248709004923e-4i) (num-test (cos 3.14193792057279441821e+00+2.0e+00i) -3.7621954668392959448e0+1.2522351259040914950e-3i) (num-test (cos 3.14193792057279441821e+00-2.0e+00i) -3.7621954668392959448e0-1.2522351259040914950e-3i) (num-test (cos -3.14193792057279441821e+00+2.0e+00i) -3.7621954668392959448e0-1.2522351259040914950e-3i) (num-test (cos -3.14193792057279441821e+00-2.0e+00i) -3.7621954668392959448e0+1.2522351259040914950e-3i) (num-test (cos 4.71204371340168837179e+00+0.0e+00i) -3.4526697614164732094e-4) (num-test (cos -4.71204371340168837179e+00+0.0e+00i) -3.4526697614164732094e-4) (num-test (cos 4.71204371340168837179e+00+1.19209289550781250e-07i) -3.4526697614164977421e-4+1.1920928244535424532e-7i) (num-test (cos 4.71204371340168837179e+00-1.19209289550781250e-07i) -3.4526697614164977421e-4-1.1920928244535424532e-7i) (num-test (cos -4.71204371340168837179e+00+1.19209289550781250e-07i) -3.4526697614164977421e-4-1.1920928244535424532e-7i) (num-test (cos -4.71204371340168837179e+00-1.19209289550781250e-07i) -3.4526697614164977421e-4+1.1920928244535424532e-7i) (num-test (cos 4.71204371340168837179e+00+5.0e-01i) -3.8933200722561350661e-4+5.2109527443404709205e-1i) (num-test (cos 4.71204371340168837179e+00-5.0e-01i) -3.8933200722561350661e-4-5.2109527443404709205e-1i) (num-test (cos -4.71204371340168837179e+00+5.0e-01i) -3.8933200722561350661e-4-5.2109527443404709205e-1i) (num-test (cos -4.71204371340168837179e+00-5.0e-01i) -3.8933200722561350661e-4+5.2109527443404709205e-1i) (num-test (cos 4.71204371340168837179e+00+1.0e+00i) -5.3277478472539277601e-4+1.1752011235963524659e0i) (num-test (cos 4.71204371340168837179e+00-1.0e+00i) -5.3277478472539277601e-4-1.1752011235963524659e0i) (num-test (cos -4.71204371340168837179e+00+1.0e+00i) -5.3277478472539277601e-4-1.1752011235963524659e0i) (num-test (cos -4.71204371340168837179e+00-1.0e+00i) -5.3277478472539277601e-4+1.1752011235963524659e0i) (num-test (cos 4.71204371340168837179e+00+2.0e+00i) -1.2989619299135805376e-3+3.6268601916692946552e0i) (num-test (cos 4.71204371340168837179e+00-2.0e+00i) -1.2989619299135805376e-3-3.6268601916692946552e0i) (num-test (cos -4.71204371340168837179e+00+2.0e+00i) -1.2989619299135805376e-3-3.6268601916692946552e0i) (num-test (cos -4.71204371340168837179e+00-2.0e+00i) -1.2989619299135805376e-3+3.6268601916692946552e0i) (num-test (cos 4.71273424736769097620e+00+0.0e+00i) 3.4526697614127992692e-4) (num-test (cos -4.71273424736769097620e+00+0.0e+00i) 3.4526697614127992692e-4) (num-test (cos 4.71273424736769097620e+00+1.19209289550781250e-07i) 3.4526697614128238019e-4+1.1920928244535424533e-7i) (num-test (cos 4.71273424736769097620e+00-1.19209289550781250e-07i) 3.4526697614128238019e-4-1.1920928244535424533e-7i) (num-test (cos -4.71273424736769097620e+00+1.19209289550781250e-07i) 3.4526697614128238019e-4-1.1920928244535424533e-7i) (num-test (cos -4.71273424736769097620e+00-1.19209289550781250e-07i) 3.4526697614128238019e-4+1.1920928244535424533e-7i) (num-test (cos 4.71273424736769097620e+00+5.0e-01i) 3.8933200722519922358e-4+5.2109527443404709212e-1i) (num-test (cos 4.71273424736769097620e+00-5.0e-01i) 3.8933200722519922358e-4-5.2109527443404709212e-1i) (num-test (cos -4.71273424736769097620e+00+5.0e-01i) 3.8933200722519922358e-4-5.2109527443404709212e-1i) (num-test (cos -4.71273424736769097620e+00-5.0e-01i) 3.8933200722519922358e-4+5.2109527443404709212e-1i) (num-test (cos 4.71273424736769097620e+00+1.0e+00i) 5.3277478472482585742e-4+1.1752011235963524660e0i) (num-test (cos 4.71273424736769097620e+00-1.0e+00i) 5.3277478472482585742e-4-1.1752011235963524660e0i) (num-test (cos -4.71273424736769097620e+00+1.0e+00i) 5.3277478472482585742e-4-1.1752011235963524660e0i) (num-test (cos -4.71273424736769097620e+00-1.0e+00i) 5.3277478472482585742e-4+1.1752011235963524660e0i) (num-test (cos 4.71273424736769097620e+00+2.0e+00i) 1.2989619299121983294e-3+3.6268601916692946557e0i) (num-test (cos 4.71273424736769097620e+00-2.0e+00i) 1.2989619299121983294e-3-3.6268601916692946557e0i) (num-test (cos -4.71273424736769097620e+00+2.0e+00i) 1.2989619299121983294e-3-3.6268601916692946557e0i) (num-test (cos -4.71273424736769097620e+00-2.0e+00i) 1.2989619299121983294e-3+3.6268601916692946557e0i) (num-test (cos 6.28284004019658492979e+00+0.0e+00i) 9.9999994039535581662e-1) (num-test (cos -6.28284004019658492979e+00+0.0e+00i) 9.9999994039535581662e-1) (num-test (cos 6.28284004019658492979e+00+1.19209289550781250e-07i) 9.9999994039536292205e-1+4.1159030931199714069e-11i) (num-test (cos 6.28284004019658492979e+00-1.19209289550781250e-07i) 9.9999994039536292205e-1-4.1159030931199714069e-11i) (num-test (cos -6.28284004019658492979e+00+1.19209289550781250e-07i) 9.9999994039536292205e-1-4.1159030931199714069e-11i) (num-test (cos -6.28284004019658492979e+00-1.19209289550781250e-07i) 9.9999994039536292205e-1+4.1159030931199714069e-11i) (num-test (cos 6.28284004019658492979e+00+5.0e-01i) 1.1276258979946363572e0+1.7991700040946600032e-4i) (num-test (cos 6.28284004019658492979e+00-5.0e-01i) 1.1276258979946363572e0-1.7991700040946600032e-4i) (num-test (cos -6.28284004019658492979e+00+5.0e-01i) 1.1276258979946363572e0-1.7991700040946600032e-4i) (num-test (cos -6.28284004019658492979e+00-5.0e-01i) 1.1276258979946363572e0+1.7991700040946600032e-4i) (num-test (cos 6.28284004019658492979e+00+1.0e+00i) 1.5430805428404715941e0+4.0575816248752181112e-4i) (num-test (cos 6.28284004019658492979e+00-1.0e+00i) 1.5430805428404715941e0-4.0575816248752181112e-4i) (num-test (cos -6.28284004019658492979e+00+1.0e+00i) 1.5430805428404715941e0-4.0575816248752181112e-4i) (num-test (cos -6.28284004019658492979e+00-1.0e+00i) 1.5430805428404715941e0+4.0575816248752181112e-4i) (num-test (cos 6.28284004019658492979e+00+2.0e+00i) 3.7621954668392959443e0+1.2522351259054239819e-3i) (num-test (cos 6.28284004019658492979e+00-2.0e+00i) 3.7621954668392959443e0-1.2522351259054239819e-3i) (num-test (cos -6.28284004019658492979e+00+2.0e+00i) 3.7621954668392959443e0-1.2522351259054239819e-3i) (num-test (cos -6.28284004019658492979e+00-2.0e+00i) 3.7621954668392959443e0+1.2522351259054239819e-3i) (num-test (cos 6.28353057416258753420e+00+0.0e+00i) 9.9999994039535581679e-1) (num-test (cos -6.28353057416258753420e+00+0.0e+00i) 9.9999994039535581679e-1) (num-test (cos 6.28353057416258753420e+00+1.19209289550781250e-07i) 9.9999994039536292222e-1-4.1159030931141318362e-11i) (num-test (cos 6.28353057416258753420e+00-1.19209289550781250e-07i) 9.9999994039536292222e-1+4.1159030931141318362e-11i) (num-test (cos -6.28353057416258753420e+00+1.19209289550781250e-07i) 9.9999994039536292222e-1+4.1159030931141318362e-11i) (num-test (cos -6.28353057416258753420e+00-1.19209289550781250e-07i) 9.9999994039536292222e-1-4.1159030931141318362e-11i) (num-test (cos 6.28353057416258753420e+00+5.0e-01i) 1.1276258979946363574e0-1.7991700040921073725e-4i) (num-test (cos 6.28353057416258753420e+00-5.0e-01i) 1.1276258979946363574e0+1.7991700040921073725e-4i) (num-test (cos -6.28353057416258753420e+00+5.0e-01i) 1.1276258979946363574e0+1.7991700040921073725e-4i) (num-test (cos -6.28353057416258753420e+00-5.0e-01i) 1.1276258979946363574e0-1.7991700040921073725e-4i) (num-test (cos 6.28353057416258753420e+00+1.0e+00i) 1.5430805428404715943e0-4.0575816248694612861e-4i) (num-test (cos 6.28353057416258753420e+00-1.0e+00i) 1.5430805428404715943e0+4.0575816248694612861e-4i) (num-test (cos -6.28353057416258753420e+00+1.0e+00i) 1.5430805428404715943e0+4.0575816248694612861e-4i) (num-test (cos -6.28353057416258753420e+00-1.0e+00i) 1.5430805428404715943e0-4.0575816248694612861e-4i) (num-test (cos 6.28353057416258753420e+00+2.0e+00i) 3.7621954668392959449e0-1.2522351259036473328e-3i) (num-test (cos 6.28353057416258753420e+00-2.0e+00i) 3.7621954668392959449e0+1.2522351259036473328e-3i) (num-test (cos -6.28353057416258753420e+00+2.0e+00i) 3.7621954668392959449e0+1.2522351259036473328e-3i) (num-test (cos -6.28353057416258753420e+00-2.0e+00i) 3.7621954668392959449e0-1.2522351259036473328e-3i) (num-test (cos 9.42443269378637893396e+00+0.0e+00i) -9.9999994039535581689e-1) (num-test (cos -9.42443269378637893396e+00+0.0e+00i) -9.9999994039535581689e-1) (num-test (cos 9.42443269378637893396e+00+1.19209289550781250e-07i) -9.9999994039536292231e-1-4.1159030931108433883e-11i) (num-test (cos 9.42443269378637893396e+00-1.19209289550781250e-07i) -9.9999994039536292231e-1+4.1159030931108433883e-11i) (num-test (cos -9.42443269378637893396e+00+1.19209289550781250e-07i) -9.9999994039536292231e-1+4.1159030931108433883e-11i) (num-test (cos -9.42443269378637893396e+00-1.19209289550781250e-07i) -9.9999994039536292231e-1-4.1159030931108433883e-11i) (num-test (cos 9.42443269378637893396e+00+5.0e-01i) -1.1276258979946363575e0-1.7991700040906699050e-4i) (num-test (cos 9.42443269378637893396e+00-5.0e-01i) -1.1276258979946363575e0+1.7991700040906699050e-4i) (num-test (cos -9.42443269378637893396e+00+5.0e-01i) -1.1276258979946363575e0+1.7991700040906699050e-4i) (num-test (cos -9.42443269378637893396e+00-5.0e-01i) -1.1276258979946363575e0-1.7991700040906699050e-4i) (num-test (cos 9.42443269378637893396e+00+1.0e+00i) -1.5430805428404715945e0-4.0575816248662194348e-4i) (num-test (cos 9.42443269378637893396e+00-1.0e+00i) -1.5430805428404715945e0+4.0575816248662194348e-4i) (num-test (cos -9.42443269378637893396e+00+1.0e+00i) -1.5430805428404715945e0+4.0575816248662194348e-4i) (num-test (cos -9.42443269378637893396e+00-1.0e+00i) -1.5430805428404715945e0-4.0575816248662194348e-4i) (num-test (cos 9.42443269378637893396e+00+2.0e+00i) -3.7621954668392959453e0-1.2522351259026468452e-3i) (num-test (cos 9.42443269378637893396e+00-2.0e+00i) -3.7621954668392959453e0+1.2522351259026468452e-3i) (num-test (cos -9.42443269378637893396e+00+2.0e+00i) -3.7621954668392959453e0+1.2522351259026468452e-3i) (num-test (cos -9.42443269378637893396e+00-2.0e+00i) -3.7621954668392959453e0-1.2522351259026468452e-3i) (num-test (cos 9.42512322775237976202e+00+0.0e+00i) -9.9999994039535581714e-1) (num-test (cos -9.42512322775237976202e+00+0.0e+00i) -9.9999994039535581714e-1) (num-test (cos 9.42512322775237976202e+00+1.19209289550781250e-07i) -9.9999994039536292257e-1+4.1159030931020840323e-11i) (num-test (cos 9.42512322775237976202e+00-1.19209289550781250e-07i) -9.9999994039536292257e-1-4.1159030931020840323e-11i) (num-test (cos -9.42512322775237976202e+00+1.19209289550781250e-07i) -9.9999994039536292257e-1-4.1159030931020840323e-11i) (num-test (cos -9.42512322775237976202e+00-1.19209289550781250e-07i) -9.9999994039536292257e-1+4.1159030931020840323e-11i) (num-test (cos 9.42512322775237976202e+00+5.0e-01i) -1.1276258979946363577e0+1.7991700040868409591e-4i) (num-test (cos 9.42512322775237976202e+00-5.0e-01i) -1.1276258979946363577e0-1.7991700040868409591e-4i) (num-test (cos -9.42512322775237976202e+00+5.0e-01i) -1.1276258979946363577e0-1.7991700040868409591e-4i) (num-test (cos -9.42512322775237976202e+00-5.0e-01i) -1.1276258979946363577e0+1.7991700040868409591e-4i) (num-test (cos 9.42512322775237976202e+00+1.0e+00i) -1.5430805428404715949e0+4.0575816248575841970e-4i) (num-test (cos 9.42512322775237976202e+00-1.0e+00i) -1.5430805428404715949e0-4.0575816248575841970e-4i) (num-test (cos -9.42512322775237976202e+00+1.0e+00i) -1.5430805428404715949e0-4.0575816248575841970e-4i) (num-test (cos -9.42512322775237976202e+00-1.0e+00i) -1.5430805428404715949e0+4.0575816248575841970e-4i) (num-test (cos 9.42512322775237976202e+00+2.0e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i) (num-test (cos 9.42512322775237976202e+00-2.0e+00i) -3.7621954668392959462e0-1.2522351258999818715e-3i) (num-test (cos -9.42512322775237976202e+00+2.0e+00i) -3.7621954668392959462e0-1.2522351258999818715e-3i) (num-test (cos -9.42512322775237976202e+00-2.0e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i) (num-test (cos -2.225073858507201399999999999999999999996E-308) 1.000E0) (num-test (cos 1.110223024625156799999999999999999999997E-16) 9.999999999999999999999999999999938370242E-1) (num-test (cos 22) -9.999608263946371264541747392126937741354E-1) (num-test (cos 32767.) 9.8226335176928229845654E-1) (num-test (cos 8388607.) -1.2349580912475928183718E-1) (num-test (cos 2147483647.) -6.8883669187794383467976E-1) (num-test (cos (* pi (cos (* pi (cos (log (+ pi 20))))))) -1.0) ; actually there's a 3.93216e-35 imag part (num-test (cos (/ pi 10)) (/ (sqrt (+ 10 (* 2 (sqrt 5)))) 4)) (num-test (cos (/ pi 12)) (* (/ (sqrt 2) 4) (+ (sqrt 3) 1))) (num-test (cos (/ pi 12)) (/ (+ (sqrt 6) (sqrt 2)) 4)) (num-test (cos (/ pi 128)) (* 1/2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt 2))))))))))))) (num-test (cos (/ pi 15)) (/ (+ (sqrt (+ 30 (* 6 (sqrt 5)))) (sqrt 5) -1) 8)) (num-test (cos (/ pi 16)) (/ (sqrt (+ 2 (sqrt (+ 2 (sqrt 2))))) 2)) (num-test (cos (/ pi 20)) (/ (sqrt (+ 8 (* 2 (sqrt (+ 10 (* 2 (sqrt 5))))))) 4)) (num-test (cos (/ pi 24)) (/ (sqrt (+ 2 (sqrt (+ 2 (sqrt 3))))) 2)) (num-test (cos (/ pi 3)) 1/2) (num-test (cos (/ pi 30)) (/ (sqrt (+ 7 (sqrt 5) (sqrt (* 6 (+ 5 (sqrt 5)))))) 4)) (num-test (cos (/ pi 32)) (/ (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt 2))))))) 2)) (num-test (cos (/ pi 4)) (/ (sqrt 2) 2)) (num-test (cos (/ pi 5)) (/ (+ 1 (sqrt 5)) 4)) (num-test (cos (/ pi 6)) (/ (sqrt 3) 2)) (num-test (cos (/ pi 64)) (* 1/2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt 2))))))))))) (num-test (cos (/ pi 8)) (/ (sqrt (+ 2 (sqrt 2))) 2)) (num-test (cos (log (+ pi 20))) -0.99999999924368) (num-test (* (cos (/ pi 11)) (cos (/ (* 2 pi) 11)) (cos (/ (* 3 pi) 11)) (cos (/ (* 4 pi) 11)) (cos (/ (* 5 pi) 11))) 1/32) (num-test (* (cos (/ pi 7)) (cos (/ (* 2 pi) 7)) (cos (/ (* 3 pi) 7))) 1/8) (num-test (* (cos (/ pi 9)) (cos (/ (* 2 pi) 9)) (cos (/ (* 4 pi) 9))) 1/8) (num-test (do ((i 1 (+ i 1)) (sum 0.0 (+ sum (cos (/ (* 2 pi i) 11))))) ((= i 6) sum)) -0.5) (num-test (let ((a (/ (* 2 pi) 13))) (* 8 (+ (cos a) (cos (* 5 a))) (+ (cos (* 2 a)) (cos (* 3 a))) (+ (cos (* 4 a)) (cos (* 6 a))))) -1.0) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'cos num (cos num) val))) (vector (list 0 1) (list 1 0.54030230586814) (list 2 -0.41614683654714) (list 3 -0.98999249660045) (list -1 0.54030230586814) (list -2 -0.41614683654714) (list -3 -0.98999249660045) (list 1/2 0.87758256189037) (list 1/3 0.94495694631474) (list -1/2 0.87758256189037) (list -1/3 0.94495694631474) (list 1/9223372036854775807 1.0) (list 0.0 1.0) (list 1.0 0.54030230586814) (list 2.0 -0.41614683654714) (list -2.0 -0.41614683654714) (list 1.000000000000000000000000000000000000002E-309 1.000E0) (list 0+1i 1.5430806348152) (list 0+2i 3.7621956910836) (list 0-1i 1.5430806348152) (list 1+1i 0.83373002513115-0.98889770576287i) (list 1-1i 0.83373002513115+0.98889770576287i) (list -1+1i 0.83373002513115+0.98889770576287i) (list -1-1i 0.83373002513115-0.98889770576287i) (list 0.1+0.1i 0.9999833333373-0.0099999888888898i) (list 1e-16+1e-16i 1-1e-32i) )) ;; these are from the error analysis package from ETH, Gaston H. Gonnet (num-test (cos -1.79424124483688191e-11) 9.999999999999999999998390349177663098196E-1) (num-test (sqrt 3.63861067050296029e-308) 1.907514264822929257351751954551699751189E-154) (if with-bignums (num-test (tan 10526671570.5) 1.140653720398103887405511659009364634384E12)) (if with-bignums (num-test (tan (modulo 10526671570.5 (* 2 pi))) 1.140653720398103899436689297531030608688E12)) (num-test (modulo 10526671570.5 (* 2 pi)) 4.712388980383813167439843967777959731718E0) ;; this is so sensitive because (cos 4.712388980383813167439843967777959731718E0) = -8.766902541211071412945944658266052999824E-13 ;; unfair! (test (cos) 'error) (test (cos "hi") 'error) (test (cos 1.0+23.0i 1.0+23.0i) 'error) (test (cos 0 1) 'error) (for-each (lambda (arg) (test (cos arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (unless (provided? 'osx) ; why does this cause a segfault on a mac -- can't run gdb, and lldb crashes (let* ((angle 0.0) (z 1.18) (result (* z (cos angle)))) (do ((k 0 (+ 1 k))) ((= k 1000)) (set! result (* z (cos result)))) ;; result: 0.81194462369499 ;; (let ((x 0.0)) ;; (do ((i 0 (+ 1 i))) ;; ((= i 10000)) ;; (set! x (+ x (* (expt -1 i) ;; (/ (bes-jn (+ 1 (* 2 i)) (* z (+ 1 (* 2 i)))) ;; (+ 1 (* 2 i))))))) ;; (* 2 x)) ;; 0.81194498071946 (let ((x (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos 0.0)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) ;; 47? calls here so we're at around .812 (oscillating around .8119) (test (< (abs (- x result)) .001) #t)))) (when full-s7test (let () ; this is trying to cause a stack overflow (define (f1 z) (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos (* z (cos 0.0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (num-test (f1 0.5) 0.4501836112948736) (let ((c #f) (i 0)) (call/cc (lambda (c1) (set! c c1))) (set! i (+ i 1)) (let ((result (f1 0.5))) (if (< i 2) (c)) (num-test result 0.4501836112948736))))) (let () (define (dht data) ;; the Hartley transform of 'data' (let* ((len (vector-length data)) (arr (make-vector len 0.0)) (w (/ (* 2.0 pi) len))) (do ((i 0 (+ 1 i))) ((= i len)) (do ((j 0 (+ 1 j))) ((= j len)) (vector-set! arr i (+ (vector-ref arr i) (* (vector-ref data j) (+ (cos (* i j w)) (sin (* i j w)))))))) arr)) (let ((data (list->vector '(0.9196 0.9457 0.0268 0.0839 0.1974 0.1060 0.1463 0.3513 0.0391 0.6310 0.9556 0.6259 0.9580 0.8848 0.0104 0.1440 0.0542 0.3001 0.1844 0.3781 0.9641 0.6051 0.3319 0.6143 0.1828 0.2290 0.4026 0.5990 0.7906 0.0403 0.7882 0.1591))) (saved-data (make-vector 32 0.0))) (do ((i 0 (+ i 1))) ((= i 32)) (vector-set! saved-data i (vector-ref data i))) (dht data) (dht data) (let ((mx 0.0)) (do ((i 0 (+ i 1))) ((= i 32)) (let ((err (abs (- (vector-ref data i) (vector-ref saved-data i))))) (if (> err mx) (set! mx err)))) (if (> mx 1e-6) (format #t "dht error: ~A~%" mx))))) (let ((coss (list 1.00000000000000000000000000000000000000000000000000000000000000000000 0.99500416527802576609556198780387029483857622541508403595935274468526 0.98006657784124163112419651674816887739352436080656799405254829012618 0.95533648912560601964231022756804989824421408263203767451761361222758 0.92106099400288508279852673205180161402585956931985044561508926713514 0.87758256189037271611628158260382965199164519710974405299761086831595 0.82533561490967829724095249895537603887809103918847038136974977367156 0.76484218728448842625585999019186490926821055037370335607293245825206 0.69670670934716542092074998164232492610178601370806078363714489414924 0.62160996827066445648471615140713350872176136659123900757638348453897 0.54030230586813971740093660744297660373231042061792222767009725538110 0.45359612142557738777137005178471612212146729566259504745593805541880 0.36235775447667357763837335562307602033994778557664862648774972093613 0.26749882862458740699798410929287135927592992167912966191725336742182 0.16996714290024093861674803520364980292818392102853430898236521149464 0.07073720166770291008818985143426870908509102756334686942264541719092 -0.02919952230128872620577046294649852444486472109384694500313007908245 -0.12884449429552468408764285733487351410164007964520297633178213994289 -0.22720209469308705531667430653058073247695158653826107158496911100681 -0.32328956686350342227883369508031017459419076544223959990115436505106 -0.41614683654714238699756822950076218976600077107554489075514997378196 -0.50484610459985745162093852371916747040702337674136205964819622353659 -0.58850111725534570852414261265492841629376036669872798974753517400616 -0.66627602127982419331788057116601723016327537100376988865266957182167 -0.73739371554124549960882222733478290843301289199228479878436568873073 -0.80114361554693371483350279046735166442856784876782013507459799166202 -0.85688875336894723379770215164520111235392263823324404910501242714241 -0.90407214201706114798252728194333012633184973516362471104126694868604 -0.94222234066865815258678811736615401246341423446824662018098201995710 -0.97095816514959052178110666934553217911761475942423954213867099245327 -0.98999249660044545727157279473126130239367909661558832881408593292832 -0.99913515027327946449237605454146626283664166994794274354471598254947 -0.99829477579475308466166072228358269144701258595166016759508002045139))) (let ((mxerr 0.0)) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.1))) ((= i 32)) (let ((err (abs (- (cos x) (list-ref coss i))))) (if (> err mxerr) (set! mxerr err)))) (if (> mxerr 1e-12) (format #t "cos err: ~A~%" mxerr)))) (when with-bignums (num-test (cos 100000000000000000000000000000000) -9.207313839241906875982573440296245746235E-1) (num-test (cos 100000000000000000000000000000000.0) -9.207313839241906875982573440296245746235E-1) (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((cos-vals (list ; arprec mathtool table[Cos[k/20], {k, 0, 30}] "1.00000000000000000000000000000000000000000000000000000000000000000000" "0.99875026039496624656287081115652109495898026202467575301500996478674" "0.99500416527802576609556198780387029483857622541508403595935274468526" "0.98877107793604228673498099865433895791835001710693704356129574806756" "0.98006657784124163112419651674816887739352436080656799405254829012618" "0.96891242171064478414459544949418919980413419028744283114812812428894" "0.95533648912560601964231022756804989824421408263203767451761361222758" "0.93937271284737892003503235730366558297406104641303414382897205809282" "0.92106099400288508279852673205180161402585956931985044561508926713514" "0.90044710235267692166884061148644643975762309272876915613354673932299" "0.87758256189037271611628158260382965199164519710974405299761086831595" "0.85252452205950574280498179761777305104031900079223767166865534849083" "0.82533561490967829724095249895537603887809103918847038136974977367156" "0.79608379854905582891760457067990587351049589381429244823834230313846" "0.76484218728448842625585999019186490926821055037370335607293245825206" "0.73168886887382088631183875300008454384054127605077248250768322022075" "0.69670670934716542092074998164232492610178601370806078363714489414924" "0.65998314588498217039541602946146607363862433893076798146474793887138" "0.62160996827066445648471615140713350872176136659123900757638348453897" "0.58168308946388349416618097376045571713934034193760200851355170750073" "0.54030230586813971740093660744297660373231042061792222767009725538110" "0.49757104789172699029084957281210067725147811164693171708781576506313" "0.45359612142557738777137005178471612212146729566259504745593805541880" "0.40848744088415729815257671880991853998462713510786075458328732035938" "0.36235775447667357763837335562307602033994778557664862648774972093613" "0.31532236239526866544753855243803801372798570798275680751499914045328" "0.26749882862458740699798410929287135927592992167912966191725336742182" "0.21900668709304158142002217301062666089672421266400567061594451723594" "0.16996714290024093861674803520364980292818392102853430898236521149464" "0.12050276936736657053286662724801883979155423770384722087315404654227" "0.07073720166770291008818985143426870908509102756334686942264541719092"))) (do ((k 1 (+ k 1))) ((= k 30)) (let ((cos-val-2 (number->string (cos (bignum (/ k 20)))))) (if (not (string=? (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59))) (format #t ";(cos (/ ~A 20)) mp: ~A does not match~%~A~%" k (substring (list-ref cos-vals k) 3 60) (substring cos-val-2 2 59)))))))) ;;; -------------------------------------------------------------------------------- ;;; tan ;;; -------------------------------------------------------------------------------- (num-test (tan 0) 0.0) (num-test (tan 1) 1.55740772465490) (num-test (tan -1) -1.55740772465490) (num-test (tan 0/1) 0.0) (num-test (tan 0/2) 0.0) (num-test (tan 0/3) 0.0) (num-test (tan 0/10) 0.0) (num-test (tan 0/1234) 0.0) (num-test (tan 0/500029) 0.0) (num-test (tan 1/1) 1.55740772465490) (num-test (tan -1/1) -1.55740772465490) (num-test (tan 1/2) 0.54630248984379) (num-test (tan -1/2) -0.54630248984379) (num-test (tan 1/3) 0.34625354951058) (num-test (tan -1/3) -0.34625354951058) (num-test (tan 1/10) 0.10033467208545) (num-test (tan -1/10) -0.10033467208545) (num-test (tan 1/1234) 0.00081037294887) (num-test (tan -1/1234) -0.00081037294887) (num-test (tan 1/500029) 0.00000199988401) (num-test (tan -1/500029) -0.00000199988401) (num-test (tan 2/2) 1.55740772465490) (num-test (tan -2/2) -1.55740772465490) (num-test (tan 2/3) 0.78684288947298) (num-test (tan -2/3) -0.78684288947298) (num-test (tan 2/10) 0.20271003550867) (num-test (tan -2/10) -0.20271003550867) (num-test (tan 2/1234) 0.00162074696208) (num-test (tan -2/1234) -0.00162074696208) (num-test (tan 2/500029) 0.00000399976801) (num-test (tan -2/500029) -0.00000399976801) (num-test (tan 3/2) 14.10141994717166) (num-test (tan -3/2) -14.10141994717166) (num-test (tan 3/3) 1.55740772465490) (num-test (tan -3/3) -1.55740772465490) (num-test (tan 3/10) 0.30933624960962) (num-test (tan -3/10) -0.30933624960962) (num-test (tan 3/1234) 0.00243112310401) (num-test (tan -3/1234) -0.00243112310401) (num-test (tan 3/500029) 0.00000599965202) (num-test (tan -3/500029) -0.00000599965202) (num-test (tan 10/10) 1.55740772465490) (num-test (tan -10/10) -1.55740772465490) (num-test (tan 10/1234) 0.00810390511110) (num-test (tan -10/1234) -0.00810390511110) (num-test (tan 10/500029) 0.00001999884007) (num-test (tan -10/500029) -0.00001999884007) (num-test (tan 1234/500029) 0.00246786187432) (num-test (tan -1234/500029) -0.00246786187432) (num-test (tan 500029/500029) 1.55740772465490) (num-test (tan -500029/500029) -1.55740772465490) (num-test (tan 0.0) 0.0) (num-test (tan 0.00000001) 0.00000001) (num-test (tan -0.00000001) -0.00000001) (num-test (tan 1.0) 1.55740772465490) (num-test (tan -1.0) -1.55740772465490) (num-test (tan 0.0+0.0i) 0.0) (num-test (tan -0.0+0.0i) 0.0) (num-test (tan 0.0-0.0i) 0.0) (num-test (tan -0.0-0.0i) 0.0) (num-test (tan 0.0+0.00000001i) 0.0+0.00000001i) (num-test (tan -0.0+0.00000001i) 0.0+0.00000001i) (num-test (tan 0.0-0.00000001i) 0.0-0.00000001i) (num-test (tan -0.0-0.00000001i) -0.0-0.00000001i) (num-test (tan 0.0+1.0i) 0.0+0.76159415595576i) (num-test (tan -0.0+1.0i) 0.0+0.76159415595576i) (num-test (tan 0.0-1.0i) 0.0-0.76159415595576i) (num-test (tan -0.0-1.0i) -0.0-0.76159415595576i) (num-test (tan 0.0+3.14159265358979i) 0.0+0.99627207622075i) (num-test (tan -0.0+3.14159265358979i) 0.0+0.99627207622075i) (num-test (tan 0.0-3.14159265358979i) 0.0-0.99627207622075i) (num-test (tan -0.0-3.14159265358979i) -0.0-0.99627207622075i) (num-test (tan 0.00000001+0.0i) 0.00000001) (num-test (tan -0.00000001+0.0i) -0.00000001) (num-test (tan 0.00000001-0.0i) 0.00000001) (num-test (tan -0.00000001-0.0i) -0.00000001) (num-test (tan 0.00000001+0.00000001i) 0.00000001+0.00000001i) (num-test (tan -0.00000001+0.00000001i) -0.00000001+0.00000001i) (num-test (tan 0.00000001-0.00000001i) 0.00000001-0.00000001i) (num-test (tan -0.00000001-0.00000001i) -0.00000001-0.00000001i) (num-test (tan 0.00000001+1.0i) 0.00000000419974+0.76159415595576i) (num-test (tan -0.00000001+1.0i) -0.00000000419974+0.76159415595576i) (num-test (tan 0.00000001-1.0i) 0.00000000419974-0.76159415595576i) (num-test (tan -0.00000001-1.0i) -0.00000000419974-0.76159415595576i) (num-test (tan 0.00000001+3.14159265358979i) 0.00000000007442+0.99627207622075i) (num-test (tan -0.00000001+3.14159265358979i) -0.00000000007442+0.99627207622075i) (num-test (tan 0.00000001-3.14159265358979i) 0.00000000007442-0.99627207622075i) (num-test (tan -0.00000001-3.14159265358979i) -0.00000000007442-0.99627207622075i) (num-test (tan 1.0+0.0i) 1.55740772465490) (num-test (tan -1.0+0.0i) -1.55740772465490) (num-test (tan 1.0-0.0i) 1.55740772465490) (num-test (tan -1.0-0.0i) -1.55740772465490) (num-test (tan 1.0+0.00000001i) 1.55740772465490+0.00000003425519i) (num-test (tan -1.0+0.00000001i) -1.55740772465490+0.00000003425519i) (num-test (tan 1.0-0.00000001i) 1.55740772465490-0.00000003425519i) (num-test (tan -1.0-0.00000001i) -1.55740772465490-0.00000003425519i) (num-test (tan 1.0+1.0i) 0.27175258531951+1.08392332733869i) (num-test (tan -1.0+1.0i) -0.27175258531951+1.08392332733869i) (num-test (tan 1.0-1.0i) 0.27175258531951-1.08392332733869i) (num-test (tan -1.0-1.0i) -0.27175258531951-1.08392332733869i) (num-test (tan 1.0+3.14159265358979i) 0.00340139653674+1.00154968930275i) (num-test (tan -1.0+3.14159265358979i) -0.00340139653674+1.00154968930275i) (num-test (tan 1.0-3.14159265358979i) 0.00340139653674-1.00154968930275i) (num-test (tan -1.0-3.14159265358979i) -0.00340139653674-1.00154968930275i) (num-test (tan 1234.0+1234.0i) 2.7e-20+1.0i) (num-test (tan 1234.0-1234.0i) 2.7e-20-1.0i) (num-test (tan 10/3) .1941255059835657) (num-test (tan 1234/3) -0.2186940320047828) (num-test (tan 1234/10) 1.204471256531804) (num-test (tan 500029/2) .2804673425353792) (num-test (tan 500029/3) -1.173139817032177) (num-test (tan 500029/10) 3.767116303516932) (num-test (tan 500029/1234) -0.05562302342803592) (num-test (tan pi) 6.982889851335445E-15) (num-test (tan 0.00000001+1234.0i) +8.077935669463161E-28+1.0i) (num-test (tan 3.14159265358979+0.0i) 6.982889851335445E-15) (num-test (tan 3.14159265358979+0.00000001i) +6.982889851335444E-15+1.0E-8i) (num-test (tan 3.14159265358979+1.0i) +2.932634567877868E-15+0.7615941559557649i) (num-test (tan 3.14159265358979+3.14159265358979i) +5.196631812627532E-17+0.99627207622075i) (num-test (tan 3.14159265358979+1234.0i) 0.0+1.0i) (num-test (tan 1234.0+0.00000001i) -0.7537751984442328+1.5681770497896427E-8i) (num-test (tan 1234.0+3.14159265358979i) -0.003586791196867043+0.9989656315245496i) ;(num-test (tan 1.5707963259845+2.0630965522972e-18i) 1.234000079689074E+9+3.141593059344448i) (num-test (tan -3.45266983001243932001e-04+0.0e+00i) -3.4526699672092183585e-4) (num-test (tan 3.45266983001243932001e-04+0.0e+00i) 3.4526699672092183585e-4) (num-test (tan -3.45266983001243932001e-04+1.19209289550781250e-07i) -3.4526699672091692931e-4+1.1920930376163652989e-7i) (num-test (tan -3.45266983001243932001e-04-1.19209289550781250e-07i) -3.4526699672091692931e-4-1.1920930376163652989e-7i) (num-test (tan 3.45266983001243932001e-04+1.19209289550781250e-07i) 3.4526699672091692931e-4+1.1920930376163652989e-7i) (num-test (tan 3.45266983001243932001e-04-1.19209289550781250e-07i) 3.4526699672091692931e-4-1.1920930376163652989e-7i) (num-test (tan -3.45266983001243932001e-04+5.0e-01i) -2.7153443992655805934e-4+4.6211720058436229979e-1i) (num-test (tan -3.45266983001243932001e-04-5.0e-01i) -2.7153443992655805934e-4-4.6211720058436229979e-1i) (num-test (tan 3.45266983001243932001e-04+5.0e-01i) 2.7153443992655805934e-4+4.6211720058436229979e-1i) (num-test (tan 3.45266983001243932001e-04-5.0e-01i) 2.7153443992655805934e-4-4.6211720058436229979e-1i) (num-test (tan -3.45266983001243932001e-04+1.0e+00i) -1.4500326960274960880e-4+7.6159419408485704836e-1i) (num-test (tan -3.45266983001243932001e-04-1.0e+00i) -1.4500326960274960880e-4-7.6159419408485704836e-1i) (num-test (tan 3.45266983001243932001e-04+1.0e+00i) 1.4500326960274960880e-4+7.6159419408485704836e-1i) (num-test (tan 3.45266983001243932001e-04-1.0e+00i) 1.4500326960274960880e-4-7.6159419408485704836e-1i) (num-test (tan -3.45266983001243932001e-04+2.0e+00i) -2.4393395410435306874e-5+9.6402758819508310556e-1i) (num-test (tan -3.45266983001243932001e-04-2.0e+00i) -2.4393395410435306874e-5-9.6402758819508310556e-1i) (num-test (tan 3.45266983001243932001e-04+2.0e+00i) 2.4393395410435306874e-5+9.6402758819508310556e-1i) (num-test (tan 3.45266983001243932001e-04-2.0e+00i) 2.4393395410435306874e-5-9.6402758819508310556e-1i) (num-test (tan 1.57045105981189525579e+00+0.0e+00i) 2.8963092606501007060e3) (num-test (tan -1.57045105981189525579e+00+0.0e+00i) -2.8963092606501007060e3) (num-test (tan 1.57045105981189525579e+00+1.19209289550781250e-07i) 2.8963089153831588642e3+9.9999992052646305569e-1i) (num-test (tan 1.57045105981189525579e+00-1.19209289550781250e-07i) 2.8963089153831588642e3-9.9999992052646305569e-1i) (num-test (tan -1.57045105981189525579e+00+1.19209289550781250e-07i) -2.8963089153831588642e3+9.9999992052646305569e-1i) (num-test (tan -1.57045105981189525579e+00-1.19209289550781250e-07i) -2.8963089153831588642e3-9.9999992052646305569e-1i) (num-test (tan 1.57045105981189525579e+00+5.0e-01i) 1.2715121175455623363e-3+2.1639524637389325996e0i) (num-test (tan 1.57045105981189525579e+00-5.0e-01i) 1.2715121175455623363e-3-2.1639524637389325996e0i) (num-test (tan -1.57045105981189525579e+00+5.0e-01i) -1.2715121175455623363e-3+2.1639524637389325996e0i) (num-test (tan -1.57045105981189525579e+00-5.0e-01i) -1.2715121175455623363e-3-2.1639524637389325996e0i) (num-test (tan 1.57045105981189525579e+00+1.0e+00i) 2.4999454374276273814e-4+1.3130351721648674823e0i) (num-test (tan 1.57045105981189525579e+00-1.0e+00i) 2.4999454374276273814e-4-1.3130351721648674823e0i) (num-test (tan -1.57045105981189525579e+00+1.0e+00i) -2.4999454374276273814e-4+1.3130351721648674823e0i) (num-test (tan -1.57045105981189525579e+00-1.0e+00i) -2.4999454374276273814e-4-1.3130351721648674823e0i) (num-test (tan 1.57045105981189525579e+00+2.0e+00i) 2.6247825506572821595e-5+1.0373147113268752620e0i) (num-test (tan 1.57045105981189525579e+00-2.0e+00i) 2.6247825506572821595e-5-1.0373147113268752620e0i) (num-test (tan -1.57045105981189525579e+00+2.0e+00i) -2.6247825506572821595e-5+1.0373147113268752620e0i) (num-test (tan -1.57045105981189525579e+00-2.0e+00i) -2.6247825506572821595e-5-1.0373147113268752620e0i) (num-test (tan 1.57114159377789786021e+00+0.0e+00i) -2.8963092606511280143e3) (num-test (tan -1.57114159377789786021e+00+0.0e+00i) 2.8963092606511280143e3) (num-test (tan 1.57114159377789786021e+00+1.19209289550781250e-07i) -2.8963089153841861720e3+9.9999992052717244672e-1i) (num-test (tan 1.57114159377789786021e+00-1.19209289550781250e-07i) -2.8963089153841861720e3-9.9999992052717244672e-1i) (num-test (tan -1.57114159377789786021e+00+1.19209289550781250e-07i) 2.8963089153841861720e3+9.9999992052717244672e-1i) (num-test (tan -1.57114159377789786021e+00-1.19209289550781250e-07i) 2.8963089153841861720e3-9.9999992052717244672e-1i) (num-test (tan 1.57114159377789786021e+00+5.0e-01i) -1.2715121175451113370e-3+2.1639524637389326002e0i) (num-test (tan 1.57114159377789786021e+00-5.0e-01i) -1.2715121175451113370e-3-2.1639524637389326002e0i) (num-test (tan -1.57114159377789786021e+00+5.0e-01i) 1.2715121175451113370e-3+2.1639524637389326002e0i) (num-test (tan -1.57114159377789786021e+00-5.0e-01i) 1.2715121175451113370e-3-2.1639524637389326002e0i) (num-test (tan 1.57114159377789786021e+00+1.0e+00i) -2.4999454374267406620e-4+1.3130351721648674824e0i) (num-test (tan 1.57114159377789786021e+00-1.0e+00i) -2.4999454374267406620e-4-1.3130351721648674824e0i) (num-test (tan -1.57114159377789786021e+00+1.0e+00i) 2.4999454374267406620e-4+1.3130351721648674824e0i) (num-test (tan -1.57114159377789786021e+00-1.0e+00i) 2.4999454374267406620e-4-1.3130351721648674824e0i) (num-test (tan 1.57114159377789786021e+00+2.0e+00i) -2.6247825506563511609e-5+1.0373147113268752620e0i) (num-test (tan 1.57114159377789786021e+00-2.0e+00i) -2.6247825506563511609e-5-1.0373147113268752620e0i) (num-test (tan -1.57114159377789786021e+00+2.0e+00i) 2.6247825506563511609e-5+1.0373147113268752620e0i) (num-test (tan -1.57114159377789786021e+00-2.0e+00i) 2.6247825506563511609e-5-1.0373147113268752620e0i) (num-test (tan 3.14124738660679181379e+00+0.0e+00i) -3.4526699672110257641e-4) (num-test (tan -3.14124738660679181379e+00+0.0e+00i) 3.4526699672110257641e-4) (num-test (tan 3.14124738660679181379e+00+1.19209289550781250e-07i) -3.4526699672109766987e-4+1.1920930376163652991e-7i) (num-test (tan 3.14124738660679181379e+00-1.19209289550781250e-07i) -3.4526699672109766987e-4-1.1920930376163652991e-7i) (num-test (tan -3.14124738660679181379e+00+1.19209289550781250e-07i) 3.4526699672109766987e-4+1.1920930376163652991e-7i) (num-test (tan -3.14124738660679181379e+00-1.19209289550781250e-07i) 3.4526699672109766987e-4-1.1920930376163652991e-7i) (num-test (tan 3.14124738660679181379e+00+5.0e-01i) -2.7153443992670020234e-4+4.6211720058436229984e-1i) (num-test (tan 3.14124738660679181379e+00-5.0e-01i) -2.7153443992670020234e-4-4.6211720058436229984e-1i) (num-test (tan -3.14124738660679181379e+00+5.0e-01i) 2.7153443992670020234e-4+4.6211720058436229984e-1i) (num-test (tan -3.14124738660679181379e+00-5.0e-01i) 2.7153443992670020234e-4-4.6211720058436229984e-1i) (num-test (tan 3.14124738660679181379e+00+1.0e+00i) -1.4500326960282551519e-4+7.6159419408485704840e-1i) (num-test (tan 3.14124738660679181379e+00-1.0e+00i) -1.4500326960282551519e-4-7.6159419408485704840e-1i) (num-test (tan -3.14124738660679181379e+00+1.0e+00i) 1.4500326960282551519e-4+7.6159419408485704840e-1i) (num-test (tan -3.14124738660679181379e+00-1.0e+00i) 1.4500326960282551519e-4-7.6159419408485704840e-1i) (num-test (tan 3.14124738660679181379e+00+2.0e+00i) -2.4393395410448076340e-5+9.6402758819508310557e-1i) (num-test (tan 3.14124738660679181379e+00-2.0e+00i) -2.4393395410448076340e-5-9.6402758819508310557e-1i) (num-test (tan -3.14124738660679181379e+00+2.0e+00i) 2.4393395410448076340e-5+9.6402758819508310557e-1i) (num-test (tan -3.14124738660679181379e+00-2.0e+00i) 2.4393395410448076340e-5-9.6402758819508310557e-1i) (num-test (tan 3.14193792057279441821e+00+0.0e+00i) 3.4526699672085764703e-4) (num-test (tan -3.14193792057279441821e+00+0.0e+00i) -3.4526699672085764703e-4) (num-test (tan 3.14193792057279441821e+00+1.19209289550781250e-07i) 3.4526699672085274049e-4+1.1920930376163652989e-7i) (num-test (tan 3.14193792057279441821e+00-1.19209289550781250e-07i) 3.4526699672085274049e-4-1.1920930376163652989e-7i) (num-test (tan -3.14193792057279441821e+00+1.19209289550781250e-07i) -3.4526699672085274049e-4+1.1920930376163652989e-7i) (num-test (tan -3.14193792057279441821e+00-1.19209289550781250e-07i) -3.4526699672085274049e-4-1.1920930376163652989e-7i) (num-test (tan 3.14193792057279441821e+00+5.0e-01i) 2.7153443992650757820e-4+4.6211720058436229978e-1i) (num-test (tan 3.14193792057279441821e+00-5.0e-01i) 2.7153443992650757820e-4-4.6211720058436229978e-1i) (num-test (tan -3.14193792057279441821e+00+5.0e-01i) -2.7153443992650757820e-4+4.6211720058436229978e-1i) (num-test (tan -3.14193792057279441821e+00-5.0e-01i) -2.7153443992650757820e-4-4.6211720058436229978e-1i) (num-test (tan 3.14193792057279441821e+00+1.0e+00i) 1.4500326960272265115e-4+7.6159419408485704835e-1i) (num-test (tan 3.14193792057279441821e+00-1.0e+00i) 1.4500326960272265115e-4-7.6159419408485704835e-1i) (num-test (tan -3.14193792057279441821e+00+1.0e+00i) -1.4500326960272265115e-4+7.6159419408485704835e-1i) (num-test (tan -3.14193792057279441821e+00-1.0e+00i) -1.4500326960272265115e-4-7.6159419408485704835e-1i) (num-test (tan 3.14193792057279441821e+00+2.0e+00i) 2.4393395410430771882e-5+9.6402758819508310556e-1i) (num-test (tan 3.14193792057279441821e+00-2.0e+00i) 2.4393395410430771882e-5-9.6402758819508310556e-1i) (num-test (tan -3.14193792057279441821e+00+2.0e+00i) -2.4393395410430771882e-5+9.6402758819508310556e-1i) (num-test (tan -3.14193792057279441821e+00-2.0e+00i) -2.4393395410430771882e-5-9.6402758819508310556e-1i) (num-test (tan 4.71204371340168837179e+00+0.0e+00i) 2.8963092606490733978e3) (num-test (tan -4.71204371340168837179e+00+0.0e+00i) -2.8963092606490733978e3) (num-test (tan 4.71204371340168837179e+00+1.19209289550781250e-07i) 2.8963089153821315563e3+9.9999992052575366466e-1i) (num-test (tan 4.71204371340168837179e+00-1.19209289550781250e-07i) 2.8963089153821315563e3-9.9999992052575366466e-1i) (num-test (tan -4.71204371340168837179e+00+1.19209289550781250e-07i) -2.8963089153821315563e3+9.9999992052575366466e-1i) (num-test (tan -4.71204371340168837179e+00-1.19209289550781250e-07i) -2.8963089153821315563e3-9.9999992052575366466e-1i) (num-test (tan 4.71204371340168837179e+00+5.0e-01i) 1.2715121175460133355e-3+2.1639524637389325989e0i) (num-test (tan 4.71204371340168837179e+00-5.0e-01i) 1.2715121175460133355e-3-2.1639524637389325989e0i) (num-test (tan -4.71204371340168837179e+00+5.0e-01i) -1.2715121175460133355e-3+2.1639524637389325989e0i) (num-test (tan -4.71204371340168837179e+00-5.0e-01i) -1.2715121175460133355e-3-2.1639524637389325989e0i) (num-test (tan 4.71204371340168837179e+00+1.0e+00i) 2.4999454374285141007e-4+1.3130351721648674822e0i) (num-test (tan 4.71204371340168837179e+00-1.0e+00i) 2.4999454374285141007e-4-1.3130351721648674822e0i) (num-test (tan -4.71204371340168837179e+00+1.0e+00i) -2.4999454374285141007e-4+1.3130351721648674822e0i) (num-test (tan -4.71204371340168837179e+00-1.0e+00i) -2.4999454374285141007e-4-1.3130351721648674822e0i) (num-test (tan 4.71204371340168837179e+00+2.0e+00i) 2.6247825506582131582e-5+1.0373147113268752620e0i) (num-test (tan 4.71204371340168837179e+00-2.0e+00i) 2.6247825506582131582e-5-1.0373147113268752620e0i) (num-test (tan -4.71204371340168837179e+00+2.0e+00i) -2.6247825506582131582e-5+1.0373147113268752620e0i) (num-test (tan -4.71204371340168837179e+00-2.0e+00i) -2.6247825506582131582e-5-1.0373147113268752620e0i) (num-test (tan 4.71273424736769097620e+00+0.0e+00i) -2.8963092606521553225e3) (num-test (tan -4.71273424736769097620e+00+0.0e+00i) 2.8963092606521553225e3) (num-test (tan 4.71273424736769097620e+00+1.19209289550781250e-07i) -2.8963089153852134799e3+9.9999992052788183776e-1i) (num-test (tan 4.71273424736769097620e+00-1.19209289550781250e-07i) -2.8963089153852134799e3-9.9999992052788183776e-1i) (num-test (tan -4.71273424736769097620e+00+1.19209289550781250e-07i) 2.8963089153852134799e3+9.9999992052788183776e-1i) (num-test (tan -4.71273424736769097620e+00-1.19209289550781250e-07i) 2.8963089153852134799e3-9.9999992052788183776e-1i) (num-test (tan 4.71273424736769097620e+00+5.0e-01i) -1.2715121175446603377e-3+2.1639524637389326009e0i) (num-test (tan 4.71273424736769097620e+00-5.0e-01i) -1.2715121175446603377e-3-2.1639524637389326009e0i) (num-test (tan -4.71273424736769097620e+00+5.0e-01i) 1.2715121175446603377e-3+2.1639524637389326009e0i) (num-test (tan -4.71273424736769097620e+00-5.0e-01i) 1.2715121175446603377e-3-2.1639524637389326009e0i) (num-test (tan 4.71273424736769097620e+00+1.0e+00i) -2.4999454374258539427e-4+1.3130351721648674825e0i) (num-test (tan 4.71273424736769097620e+00-1.0e+00i) -2.4999454374258539427e-4-1.3130351721648674825e0i) (num-test (tan -4.71273424736769097620e+00+1.0e+00i) 2.4999454374258539427e-4+1.3130351721648674825e0i) (num-test (tan -4.71273424736769097620e+00-1.0e+00i) 2.4999454374258539427e-4-1.3130351721648674825e0i) (num-test (tan 4.71273424736769097620e+00+2.0e+00i) -2.6247825506554201622e-5+1.0373147113268752620e0i) (num-test (tan 4.71273424736769097620e+00-2.0e+00i) -2.6247825506554201622e-5-1.0373147113268752620e0i) (num-test (tan -4.71273424736769097620e+00+2.0e+00i) 2.6247825506554201622e-5+1.0373147113268752620e0i) (num-test (tan -4.71273424736769097620e+00-2.0e+00i) 2.6247825506554201622e-5-1.0373147113268752620e0i) (num-test (tan 6.28284004019658492979e+00+0.0e+00i) -3.4526699672122504111e-4) (num-test (tan -6.28284004019658492979e+00+0.0e+00i) 3.4526699672122504111e-4) (num-test (tan 6.28284004019658492979e+00+1.19209289550781250e-07i) -3.4526699672122013457e-4+1.1920930376163652992e-7i) (num-test (tan 6.28284004019658492979e+00-1.19209289550781250e-07i) -3.4526699672122013457e-4-1.1920930376163652992e-7i) (num-test (tan -6.28284004019658492979e+00+1.19209289550781250e-07i) 3.4526699672122013457e-4+1.1920930376163652992e-7i) (num-test (tan -6.28284004019658492979e+00-1.19209289550781250e-07i) 3.4526699672122013457e-4-1.1920930376163652992e-7i) (num-test (tan 6.28284004019658492979e+00+5.0e-01i) -2.7153443992679651442e-4+4.6211720058436229987e-1i) (num-test (tan 6.28284004019658492979e+00-5.0e-01i) -2.7153443992679651442e-4-4.6211720058436229987e-1i) (num-test (tan -6.28284004019658492979e+00+5.0e-01i) 2.7153443992679651442e-4+4.6211720058436229987e-1i) (num-test (tan -6.28284004019658492979e+00-5.0e-01i) 2.7153443992679651442e-4-4.6211720058436229987e-1i) (num-test (tan 6.28284004019658492979e+00+1.0e+00i) -1.4500326960287694721e-4+7.6159419408485704843e-1i) (num-test (tan 6.28284004019658492979e+00-1.0e+00i) -1.4500326960287694721e-4-7.6159419408485704843e-1i) (num-test (tan -6.28284004019658492979e+00+1.0e+00i) 1.4500326960287694721e-4+7.6159419408485704843e-1i) (num-test (tan -6.28284004019658492979e+00-1.0e+00i) 1.4500326960287694721e-4-7.6159419408485704843e-1i) (num-test (tan 6.28284004019658492979e+00+2.0e+00i) -2.4393395410456728569e-5+9.6402758819508310558e-1i) (num-test (tan 6.28284004019658492979e+00-2.0e+00i) -2.4393395410456728569e-5-9.6402758819508310558e-1i) (num-test (tan -6.28284004019658492979e+00+2.0e+00i) 2.4393395410456728569e-5+9.6402758819508310558e-1i) (num-test (tan -6.28284004019658492979e+00-2.0e+00i) 2.4393395410456728569e-5-9.6402758819508310558e-1i) (num-test (tan 6.28353057416258753420e+00+0.0e+00i) 3.4526699672073518233e-4) (num-test (tan -6.28353057416258753420e+00+0.0e+00i) -3.4526699672073518233e-4) (num-test (tan 6.28353057416258753420e+00+1.19209289550781250e-07i) 3.4526699672073027579e-4+1.1920930376163652988e-7i) (num-test (tan 6.28353057416258753420e+00-1.19209289550781250e-07i) 3.4526699672073027579e-4-1.1920930376163652988e-7i) (num-test (tan -6.28353057416258753420e+00+1.19209289550781250e-07i) -3.4526699672073027579e-4+1.1920930376163652988e-7i) (num-test (tan -6.28353057416258753420e+00-1.19209289550781250e-07i) -3.4526699672073027579e-4-1.1920930376163652988e-7i) (num-test (tan 6.28353057416258753420e+00+5.0e-01i) 2.7153443992641126612e-4+4.6211720058436229974e-1i) (num-test (tan 6.28353057416258753420e+00-5.0e-01i) 2.7153443992641126612e-4-4.6211720058436229974e-1i) (num-test (tan -6.28353057416258753420e+00+5.0e-01i) -2.7153443992641126612e-4+4.6211720058436229974e-1i) (num-test (tan -6.28353057416258753420e+00-5.0e-01i) -2.7153443992641126612e-4-4.6211720058436229974e-1i) (num-test (tan 6.28353057416258753420e+00+1.0e+00i) 1.4500326960267121913e-4+7.6159419408485704832e-1i) (num-test (tan 6.28353057416258753420e+00-1.0e+00i) 1.4500326960267121913e-4-7.6159419408485704832e-1i) (num-test (tan -6.28353057416258753420e+00+1.0e+00i) -1.4500326960267121913e-4+7.6159419408485704832e-1i) (num-test (tan -6.28353057416258753420e+00-1.0e+00i) -1.4500326960267121913e-4-7.6159419408485704832e-1i) (num-test (tan 6.28353057416258753420e+00+2.0e+00i) 2.4393395410422119654e-5+9.6402758819508310555e-1i) (num-test (tan 6.28353057416258753420e+00-2.0e+00i) 2.4393395410422119654e-5-9.6402758819508310555e-1i) (num-test (tan -6.28353057416258753420e+00+2.0e+00i) -2.4393395410422119654e-5+9.6402758819508310555e-1i) (num-test (tan -6.28353057416258753420e+00-2.0e+00i) -2.4393395410422119654e-5-9.6402758819508310555e-1i) (num-test (tan 9.42443269378637893396e+00+0.0e+00i) -3.4526699672045932728e-4) (num-test (tan -9.42443269378637893396e+00+0.0e+00i) 3.4526699672045932728e-4) (num-test (tan 9.42443269378637893396e+00+1.19209289550781250e-07i) -3.4526699672045442074e-4+1.1920930376163652985e-7i) (num-test (tan 9.42443269378637893396e+00-1.19209289550781250e-07i) -3.4526699672045442074e-4-1.1920930376163652985e-7i) (num-test (tan -9.42443269378637893396e+00+1.19209289550781250e-07i) 3.4526699672045442074e-4+1.1920930376163652985e-7i) (num-test (tan -9.42443269378637893396e+00-1.19209289550781250e-07i) 3.4526699672045442074e-4-1.1920930376163652985e-7i) (num-test (tan 9.42443269378637893396e+00+5.0e-01i) -2.7153443992619432056e-4+4.6211720058436229968e-1i) (num-test (tan 9.42443269378637893396e+00-5.0e-01i) -2.7153443992619432056e-4-4.6211720058436229968e-1i) (num-test (tan -9.42443269378637893396e+00+5.0e-01i) 2.7153443992619432056e-4+4.6211720058436229968e-1i) (num-test (tan -9.42443269378637893396e+00-5.0e-01i) 2.7153443992619432056e-4-4.6211720058436229968e-1i) (num-test (tan 9.42443269378637893396e+00+1.0e+00i) -1.4500326960255536711e-4+7.6159419408485704826e-1i) (num-test (tan 9.42443269378637893396e+00-1.0e+00i) -1.4500326960255536711e-4-7.6159419408485704826e-1i) (num-test (tan -9.42443269378637893396e+00+1.0e+00i) 1.4500326960255536711e-4+7.6159419408485704826e-1i) (num-test (tan -9.42443269378637893396e+00-1.0e+00i) 1.4500326960255536711e-4-7.6159419408485704826e-1i) (num-test (tan 9.42443269378637893396e+00+2.0e+00i) -2.4393395410402630273e-5+9.6402758819508310554e-1i) (num-test (tan 9.42443269378637893396e+00-2.0e+00i) -2.4393395410402630273e-5-9.6402758819508310554e-1i) (num-test (tan -9.42443269378637893396e+00+2.0e+00i) 2.4393395410402630273e-5+9.6402758819508310554e-1i) (num-test (tan -9.42443269378637893396e+00-2.0e+00i) 2.4393395410402630273e-5-9.6402758819508310554e-1i) (num-test (tan 9.42512322775237976202e+00+0.0e+00i) 3.4526699671972453911e-4) (num-test (tan -9.42512322775237976202e+00+0.0e+00i) -3.4526699671972453911e-4) (num-test (tan 9.42512322775237976202e+00+1.19209289550781250e-07i) 3.4526699671971963257e-4+1.1920930376163652979e-7i) (num-test (tan 9.42512322775237976202e+00-1.19209289550781250e-07i) 3.4526699671971963257e-4-1.1920930376163652979e-7i) (num-test (tan -9.42512322775237976202e+00+1.19209289550781250e-07i) -3.4526699671971963257e-4+1.1920930376163652979e-7i) (num-test (tan -9.42512322775237976202e+00-1.19209289550781250e-07i) -3.4526699671971963257e-4-1.1920930376163652979e-7i) (num-test (tan 9.42512322775237976202e+00+5.0e-01i) 2.7153443992561644811e-4+4.6211720058436229949e-1i) (num-test (tan 9.42512322775237976202e+00-5.0e-01i) 2.7153443992561644811e-4-4.6211720058436229949e-1i) (num-test (tan -9.42512322775237976202e+00+5.0e-01i) -2.7153443992561644811e-4+4.6211720058436229949e-1i) (num-test (tan -9.42512322775237976202e+00-5.0e-01i) -2.7153443992561644811e-4-4.6211720058436229949e-1i) (num-test (tan 9.42512322775237976202e+00+1.0e+00i) 1.450032696022467750e-4+7.6159419408485704810e-1i) (num-test (tan 9.42512322775237976202e+00-1.0e+00i) 1.450032696022467750e-4-7.6159419408485704810e-1i) (num-test (tan -9.42512322775237976202e+00+1.0e+00i) -1.450032696022467750e-4+7.6159419408485704810e-1i) (num-test (tan -9.42512322775237976202e+00-1.0e+00i) -1.450032696022467750e-4-7.6159419408485704810e-1i) (num-test (tan 9.42512322775237976202e+00+2.0e+00i) 2.439339541035071690e-5+9.6402758819508310550e-1i) (num-test (tan 9.42512322775237976202e+00-2.0e+00i) 2.439339541035071690e-5-9.6402758819508310550e-1i) (num-test (tan -9.42512322775237976202e+00+2.0e+00i) -2.439339541035071690e-5+9.6402758819508310550e-1i) (num-test (tan -9.42512322775237976202e+00-2.0e+00i) -2.439339541035071690e-5-9.6402758819508310550e-1i) (num-test (tan 32767.) 1.9089234430221485740826E-1) (num-test (tan 8388607.) -8.0354556223613614748329E0) (num-test (tan 2147483647.) 1.0523779637351339136698E0) (num-test (tan -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (tan 1.110223024625156799999999999999999999997E-16) 1.110223024625156800000000000000004561517E-16) (num-test (tan (* 1/4 (atan 4))) (* 2 (+ (cos (/ (* 6 pi) 17)) (cos (/ (* 10 pi) 17))))) (num-test (tan (/ pi 10)) (/ (sqrt (- 25 (* 10 (sqrt 5)))) 5)) (num-test (tan (/ pi 12)) (- 2 (sqrt 3))) (num-test (tan (/ pi 16)) (- (sqrt (+ 4 (* 2 (sqrt 2)))) (sqrt 2) 1)) (num-test (tan (/ pi 20)) (+ 1 (sqrt 5) (- (sqrt (+ 5 (* 2 (sqrt 5))))))) (num-test (tan (/ pi 24)) (+ -2 (sqrt 2) (- (sqrt 3)) (sqrt 6))) (num-test (tan (/ pi 3)) (sqrt 3)) (num-test (tan (/ pi 30)) (sqrt (- 7 (* 2 (sqrt 5)) (* 2 (sqrt (- 15 (* 6 (sqrt 5)))))))) (num-test (tan (/ pi 4)) 1) (num-test (tan (/ pi 4)) 1.0) (num-test (tan (/ pi 5)) (sqrt (- 5 (* 2 (sqrt 5))))) (num-test (tan (/ pi 6)) (/ (sqrt 3) 3)) (num-test (tan (/ pi 6)) (/ (sqrt 3))) (num-test (tan (/ pi 8)) (- (sqrt 2) 1)) (num-test (* (tan (/ pi 11)) (tan (/ (* 2 pi) 11)) (tan (/ (* 3 pi) 11)) (tan (/ (* 4 pi) 11)) (tan (/ (* 5 pi) 11))) (sqrt 11)) (num-test (* (tan (/ pi 9)) (tan (/ (* 2 pi) 9)) (tan (/ (* 4 pi) 9))) (sqrt 3)) (num-test (tan 0-1000i) 0-i) (num-test (tan 0+1000i) 0+i) (num-test (tan (complex 0 +inf.0)) 0+i) (when with-bignums (num-test (tan 9223372036854775806) (tan (bignum 9223372036854775806))) (letrec ((sum-cot (lambda (n) (let ((sum 0.0)) (do ((k 1 (+ k 1))) ((= k n) sum) (set! sum (+ sum (sin (/ (* k pi) n))))))))) (let ((mxerr 0.0) (mxcase 0)) (do ((i 2 (+ i 1))) ((= i 100)) (let ((val1 (sum-cot i)) (val2 (/ 1.0 (tan (/ pi (* 2 i)))))) (let ((err (magnitude (- val1 val2)))) (if (> err mxerr) (begin (set! mxerr err) (set! mxcase i)))))) (if (> mxerr 1e-35) (format #t "sum-cot max error ~A at ~A~%" mxerr mxcase))))) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'tan num (tan num) val))) (vector (list 0 0) (list 1 1.5574077246549) (list 2 -2.1850398632615) (list 3 -0.14254654307428) (list -1 -1.5574077246549) (list -2 2.1850398632615) (list -3 0.14254654307428) (list 1/2 0.54630248984379) (list 1/3 0.34625354951058) (list -1/2 -0.54630248984379) (list -1/3 -0.34625354951058) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 1.5574077246549) (list 2.0 -2.1850398632615) (list -2.0 2.1850398632615) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 0+1i 0+0.76159415595576i) (list 0+2i 0+0.96402758007582i) (list 0-1i 0-0.76159415595576i) (list 1+1i 0.27175258531951+1.0839233273387i) (list 1-1i 0.27175258531951-1.0839233273387i) (list -1+1i -0.27175258531951+1.0839233273387i) (list -1-1i -0.27175258531951-1.0839233273387i) (list 0.1+0.1i 0.099328043521656+0.10066129051146i) (list 1e+16+1e+16i 0+1i) (list 1e-16+1e-16i 1e-16+1e-16i) )) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((tans (list ; table[Tan[k/10], {k, 0, 30}] 0.00000000000000000000000000000000000000000000000000000000000000000000e0 0.10033467208545054505808004578111153681900480457644204002220806579803 0.20271003550867248332135827164753448262687566965163133004781996689038 0.30933624960962323303530367969829466725781590680046134075142272636569 0.42279321873816176198163542716529033394198977271569358984733094139266 0.54630248984379051325517946578028538329755172017979124616409138593290 0.68413680834169231707092541746333574524265408075678204603738401651742 0.84228838046307944812813500221293771718722125080419899879692251366850 1.02963855705036401274636117282036528416821960677230780766895721581894 1.26015821755033913713457548539574847783362583439629440734976898386523 1.55740772465490223050697480745836017308725077238152003838394660569886 1.96475965724865195093092278177937824371908489378986426895526379547792 2.57215162212631893540999423603336395652940930604338927922563726223880 3.60210244796797815123114551507651373970302582865487479569579648938869 5.79788371548288964370772024360369904599369751893967972517934732424182 14.10141994717171938764608365198775644565954357723586186612326758608969 -34.23253273555741705801487543047619090177569941115323597430813746321248 -7.69660213945915841412819296829866091636528991430764756294574142318097 -4.28626167462806352545188895228026668020736003385824824436108662437549 -2.92709751467777270368689918927087330066328793602580283437505670792996 -2.18503986326151899164330610231368254343201774622766316456295586996677 -1.70984654290450774834778079380390375776090098123394621314534682027235 -1.37382305676879516014003676333346987430263329223370049420804295416122 -1.11921364173413217123235669407622790313829418580200248125375565107236 -0.91601428967341051273086324750810579399364554997699617941685909082222 -0.74702229723866027935535268782527455790411695688301127906659308970027 -0.60159661308975872273608189269127978293417758666969145078057164875561 -0.47272762910303750795198918126389516105797171531608327694222778882857 -0.35552983165117587757735260363543503816953711960914396739605909199266 -0.24640539397196625534356707388530576476208894415934539659747894722272 -0.14254654307427780529563541053391349322609228490180464763323897668885))) (do ((i 0 (+ i 1))) ((= i 30)) (let ((val (tan (bignum (/ i 10))))) (if (> (magnitude (- val (list-ref tans i))) 1e-35) (format #t ";(tan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref tans i) (magnitude (- val (list-ref tans i)))))))))) (test (tan) 'error) (test (tan "hi") 'error) (test (tan 1.0+23.0i 1.0+23.0i) 'error) (test (tan 0 1) 'error) (for-each (lambda (arg) (test (tan arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; asin ;;; -------------------------------------------------------------------------------- (num-test (asin 0) 0.0) (num-test (asin 1) 1.57079632679490) (num-test (asin -1) -1.57079632679490) (num-test (asin 2) 1.57079632679490+1.31695789692482i) (num-test (asin -2) -1.57079632679490+1.31695789692482i) (num-test (asin 3) 1.57079632679490+1.76274717403909i) (num-test (asin -3) -1.57079632679490+1.76274717403909i) (num-test (asin 10) 1.57079632679490+2.99322284612638i) (num-test (asin -10) -1.57079632679490+2.99322284612638i) (num-test (asin 1234) 1.57079632679490+7.81116322068415i) (num-test (asin -1234) -1.57079632679490+7.81116322068415i) (num-test (asin 0/1) 0.0) (num-test (asin 0/2) 0.0) (num-test (asin 0/3) 0.0) (num-test (asin 0/10) 0.0) (num-test (asin 0/1234) 0.0) (num-test (asin 0/500029) 0.0) (num-test (asin 1/1) 1.57079632679490) (num-test (asin -1/1) -1.57079632679490) (num-test (asin 1/2) 0.52359877559830) (num-test (asin -1/2) -0.52359877559830) (num-test (asin 1/3) 0.33983690945412) (num-test (asin -1/3) -0.33983690945412) (num-test (asin 1/10) 0.10016742116156) (num-test (asin -1/10) -0.10016742116156) (num-test (asin 1/1234) 0.00081037286017) (num-test (asin -1/1234) -0.00081037286017) (num-test (asin 1/500029) 0.00000199988401) (num-test (asin -1/500029) -0.00000199988401) (num-test (asin 2/1) 1.57079632679490+1.31695789692482i) (num-test (asin -2/1) -1.57079632679490+1.31695789692482i) (num-test (asin 2/2) 1.57079632679490) (num-test (asin -2/2) -1.57079632679490) (num-test (asin 2/3) 0.72972765622697) (num-test (asin -2/3) -0.72972765622697) (num-test (asin 2/10) 0.20135792079033) (num-test (asin -2/10) -0.20135792079033) (num-test (asin 2/1234) 0.00162074625252) (num-test (asin -2/1234) -0.00162074625252) (num-test (asin 2/500029) 0.00000399976801) (num-test (asin -2/500029) -0.00000399976801) (num-test (asin 3/1) 1.57079632679490+1.76274717403909i) (num-test (asin -3/1) -1.57079632679490+1.76274717403909i) (num-test (asin 3/2) 1.57079632679490+0.96242365011921i) (num-test (asin -3/2) -1.57079632679490+0.96242365011921i) (num-test (asin 3/3) 1.57079632679490) (num-test (asin -3/3) -1.57079632679490) (num-test (asin 3/10) 0.30469265401540) (num-test (asin -3/10) -0.30469265401540) (num-test (asin 3/1234) 0.00243112070922) (num-test (asin -3/1234) -0.00243112070922) (num-test (asin 3/500029) 0.00000599965202) (num-test (asin -3/500029) -0.00000599965202) (num-test (asin 10/1) 1.57079632679490+2.99322284612638i) (num-test (asin -10/1) -1.57079632679490+2.99322284612638i) (num-test (asin 10/2) 1.57079632679490+2.29243166956117i) (num-test (asin -10/2) -1.57079632679490+2.29243166956117i) (num-test (asin 10/3) 1.57079632679490+1.87382024252741i) (num-test (asin -10/3) -1.57079632679490+1.87382024252741i) (num-test (asin 10/10) 1.57079632679490) (num-test (asin -10/10) -1.57079632679490) (num-test (asin 10/1234) 0.00810381641321) (num-test (asin -10/1234) -0.00810381641321) (num-test (asin 10/500029) 0.00001999884007) (num-test (asin -10/500029) -0.00001999884007) (num-test (asin 1234/1) 1.57079632679490+7.81116322068415i) (num-test (asin -1234/1) -1.57079632679490+7.81116322068415i) (num-test (asin 1234/2) 1.57079632679490+7.11801554770806i) (num-test (asin -1234/2) -1.57079632679490+7.11801554770806i) (num-test (asin 1234/3) 1.57079632679490+6.71254961876657i) (num-test (asin -1234/3) -1.57079632679490+6.71254961876657i) (num-test (asin 1234/10) 1.57079632679490+5.50856187402751i) (num-test (asin -1234/10) -1.57079632679490+5.50856187402751i) (num-test (asin 1234/500029) 0.00246785936931) (num-test (asin -1234/500029) -0.00246785936931) (num-test (asin 500029/3) 1.570796326794897-12.71695626760523i) (num-test (asin -500029/3) -1.570796326794897+12.71695626760523i) (num-test (asin 500029/10) 1.570796326794897-1.151298346318831e1i) (num-test (asin -500029/10) -1.57079632679490+1.151298346318831e1i) (num-test (asin 500029/1234) 1.57079632679490+6.69755082925184i) (num-test (asin -500029/1234) -1.57079632679490+6.69755082925184i) (num-test (asin 500029/500029) 1.57079632679490) (num-test (asin -500029/500029) -1.57079632679490) (num-test (asin 0.0) 0.0) (num-test (asin 0.00000001) 0.00000001) (num-test (asin -0.00000001) -0.00000001) (num-test (asin 1.0) 1.57079632679490) (num-test (asin -1.0) -1.57079632679490) (num-test (asin pi) 1.57079632679490+1.81152627246085i) (num-test (asin -3.14159265358979) -1.57079632679490+1.81152627246085i) (num-test (asin 1234.0) 1.57079632679490+7.81116322068415i) (num-test (asin -1234.0) -1.57079632679490+7.81116322068415i) (num-test (asin 0.0+0.0i) 0.0) (num-test (asin -0.0+0.0i) 0.0) (num-test (asin 0.0-0.0i) 0.0) (num-test (asin -0.0-0.0i) 0.0) (num-test (asin 0.0+0.00000001i) 0.0+0.00000001i) (num-test (asin -0.0+0.00000001i) 0.0+0.00000001i) (num-test (asin 0.0-0.00000001i) 0.0-0.00000001i) (num-test (asin -0.0-0.00000001i) -0.0-0.00000001i) (num-test (asin 0.0+1.0i) 0.0+0.88137358701954i) (num-test (asin -0.0+1.0i) 0.0+0.88137358701954i) (num-test (asin 0.0-1.0i) 0.0-0.88137358701954i) (num-test (asin -0.0-1.0i) -0.0-0.88137358701954i) (num-test (asin 0.0+3.14159265358979i) 0.0+1.86229574331085i) (num-test (asin -0.0+3.14159265358979i) 0.0+1.86229574331085i) (num-test (asin 0.0-3.14159265358979i) 0.0-1.86229574331085i) (num-test (asin -0.0-3.14159265358979i) -0.0-1.86229574331085i) (num-test (asin 0.0+1234.0i) 0.0+7.81116354896171i) (num-test (asin -0.0+1234.0i) 0.0+7.81116354896171i) (num-test (asin 0.0-1234.0i) 0.0-7.81116354920125i) (num-test (asin -0.0-1234.0i) -0.0-7.81116354920125i) (num-test (asin 0.00000001+0.0i) 0.00000001) (num-test (asin -0.00000001+0.0i) -0.00000001) (num-test (asin 0.00000001-0.0i) 0.00000001) (num-test (asin -0.00000001-0.0i) -0.00000001) (num-test (asin 0.00000001+0.00000001i) 0.00000001+0.00000001i) (num-test (asin -0.00000001+0.00000001i) -0.00000001+0.00000001i) (num-test (asin 0.00000001-0.00000001i) 0.00000001-0.00000001i) (num-test (asin -0.00000001-0.00000001i) -0.00000001-0.00000001i) (num-test (asin 0.00000001+1.0i) 0.00000000707107+0.88137358701954i) (num-test (asin -0.00000001+1.0i) -0.00000000707107+0.88137358701954i) (num-test (asin 0.00000001-1.0i) 0.00000000707107-0.88137358701954i) (num-test (asin -0.00000001-1.0i) -0.00000000707107-0.88137358701954i) (num-test (asin 0.00000001+3.14159265358979i) 0.00000000303314+1.86229574331085i) (num-test (asin -0.00000001+3.14159265358979i) -0.00000000303314+1.86229574331085i) (num-test (asin 0.00000001-3.14159265358979i) 0.00000000303314-1.86229574331085i) (num-test (asin -0.00000001-3.14159265358979i) -0.00000000303314-1.86229574331085i) (num-test (asin 0.00000001+1234.0i) 0.00000000000810+7.81116354896171i) (num-test (asin -0.00000001+1234.0i) -0.00000000000810+7.81116354896171i) (num-test (asin 0.00000001-1234.0i) 0.00000000000810-7.81116354920125i) (num-test (asin -0.00000001-1234.0i) -0.00000000000810-7.81116354920125i) (num-test (asin 1.0+0.0i) 1.57079632679490) (num-test (asin -1.0+0.0i) -1.57079632679490) (num-test (asin 1.0-0.0i) 1.57079632679490) (num-test (asin -1.0-0.0i) -1.57079632679490) (num-test (asin 1.0+0.00000001i) 1.57069632679498+0.00010000000008i) (num-test (asin -1.0+0.00000001i) -1.57069632679498+0.00010000000008i) (num-test (asin 1.0-0.00000001i) 1.57069632679498-0.00010000000008i) (num-test (asin -1.0-0.00000001i) -1.57069632679498-0.00010000000008i) (num-test (asin 1.0+1.0i) 0.66623943249252+1.06127506190504i) (num-test (asin -1.0+1.0i) -0.66623943249252+1.06127506190504i) (num-test (asin 1.0-1.0i) 0.66623943249252-1.06127506190504i) (num-test (asin -1.0-1.0i) -0.66623943249252-1.06127506190504i) (num-test (asin 1.0+3.14159265358979i) 0.29558503421163+1.90462768697066i) (num-test (asin -1.0+3.14159265358979i) -0.29558503421163+1.90462768697066i) (num-test (asin 1.0-3.14159265358979i) 0.29558503421163-1.90462768697066i) (num-test (asin -1.0-3.14159265358979i) -0.29558503421163-1.90462768697066i) (num-test (asin 1.0+1234.0i) 0.00081037232806+7.81116387772663i) (num-test (asin -1.0+1234.0i) -0.00081037232806+7.81116387772663i) (num-test (asin 1.0-1234.0i) 0.00081037232800-7.81116387755283i) (num-test (asin -1.0-1234.0i) -0.00081037232800-7.81116387755283i) (num-test (asin 3.14159265358979+0.0i) 1.57079632679490+1.81152627246085i) (num-test (asin -3.14159265358979+0.0i) -1.57079632679490+1.81152627246085i) (num-test (asin 3.14159265358979-0.0i) 1.57079632679490+1.81152627246085i) (num-test (asin -3.14159265358979-0.0i) -1.57079632679490+1.81152627246085i) (num-test (asin 3.14159265358979+0.00000001i) 1.57079632343715+1.81152627246085i) (num-test (asin -3.14159265358979+0.00000001i) -1.57079632343715+1.81152627246085i) (num-test (asin 3.14159265358979-0.00000001i) 1.57079632343715-1.81152627246085i) (num-test (asin -3.14159265358979-0.00000001i) -1.57079632343715-1.81152627246085i) (num-test (asin 3.14159265358979+1.0i) 1.24854303281344+1.86711439316026i) (num-test (asin -3.14159265358979+1.0i) -1.24854303281344+1.86711439316026i) (num-test (asin 3.14159265358979-1.0i) 1.24854303281344-1.86711439316026i) (num-test (asin -3.14159265358979-1.0i) -1.24854303281344-1.86711439316026i) (num-test (asin 3.14159265358979+3.14159265358979i) 0.77273977912748+2.18469104082751i) (num-test (asin -3.14159265358979+3.14159265358979i) -0.77273977912748+2.18469104082751i) (num-test (asin 3.14159265358979-3.14159265358979i) 0.77273977912748-2.18469104082751i) (num-test (asin -3.14159265358979-3.14159265358979i) -0.77273977912748-2.18469104082751i) (num-test (asin 3.14159265358979+1234.0i) 0.00254585480900+7.81116678966949i) (num-test (asin -3.14159265358979+1234.0i) -0.00254585480900+7.81116678966949i) (num-test (asin 3.14159265358979-1234.0i) 0.00254585480937-7.81116678989204i) (num-test (asin -3.14159265358979-1234.0i) -0.00254585480937-7.81116678989204i) (num-test (asin 1234.0+0.0i) 1.57079632679490+7.81116322068415i) (num-test (asin -1234.0+0.0i) -1.57079632679490+7.81116322068415i) (num-test (asin 1234.0-0.0i) 1.57079632679490+7.81116322068415i) (num-test (asin -1234.0-0.0i) -1.57079632679490+7.81116322068415i) (num-test (asin 1234.0+0.00000001i) 1.57079632678679+7.81116322068415i) (num-test (asin -1234.0+0.00000001i) -1.57079632678679+7.81116322068415i) (num-test (asin 1234.0-0.00000001i) 1.57079632678679-7.81116322084923i) (num-test (asin -1234.0-0.00000001i) -1.57079632678679-7.81116322084923i) (num-test (asin 1234.0+1.0i) 1.56998595393442+7.81116354944842i) (num-test (asin -1234.0+1.0i) -1.56998595393442+7.81116354944842i) (num-test (asin 1234.0-1.0i) 1.56998595393473-7.81116354920146i) (num-test (asin -1234.0-1.0i) -1.56998595393473-7.81116354920146i) (num-test (asin 1234.0+3.14159265358979i) 1.56825047031506+7.81116646138554i) (num-test (asin -1234.0+3.14159265358979i) -1.56825047031506+7.81116646138554i) (num-test (asin 1234.0-3.14159265358979i) 1.56825047031367-7.81116646154641i) (num-test (asin -1234.0-3.14159265358979i) -1.56825047031367-7.81116646154641i) (num-test (asin 1234.0+1234.0i) 0.78539808146835+8.15773697538346i) (num-test (asin -1234.0+1234.0i) -0.78539808146835+8.15773697538346i) (num-test (asin 1234.0-1234.0i) 0.78539808130944-8.15773697530526i) (num-test (asin -1234.0-1234.0i) -0.78539808130944-8.15773697530526i) (num-test (asin 8.2729394e-17) 8.2729394e-17) (num-test (asin 1.821832e-231) 1.821832e-231) (num-test (asin 48983.30495194942-64983.97008730317i) 0.6459128607940432-12i) (num-test (asin 500029/2) 1.570796326794897-13.12242137571839i) (num-test (asin 0.0e+00+0.0e+00i) 0e0+0.0i) (num-test (asin 0.0e+00+1.19209289550781250e-07i) 0+1.1920928955078096766e-7i) (num-test (asin 0.0e+00-1.19209289550781250e-07i) 0-1.1920928955078096766e-7i) (num-test (asin 0.0e+00+5.0e-01i) 0+4.8121182505960344750e-1i) (num-test (asin 0.0e+00-5.0e-01i) 0-4.8121182505960344750e-1i) (num-test (asin 0.0e+00+1.0e+00i) 0+8.8137358701954302523e-1i) (num-test (asin 0.0e+00-1.0e+00i) 0-8.8137358701954302523e-1i) (num-test (asin 0.0e+00+2.0e+00i) 0+1.4436354751788103425e0i) (num-test (asin 0.0e+00-2.0e+00i) 0-1.4436354751788103425e0i) (num-test (asin 0.0e+00+8.3886080e+06i) 0+1.6635532333438690979e1i) (num-test (asin 0.0e+00-8.3886080e+06i) 0-1.6635532333438690979e1i) (num-test (asin 1.19209289550781250e-07+0.0e+00i) 1.1920928955078153234e-7) (num-test (asin -1.19209289550781250e-07+0.0e+00i) -1.1920928955078153234e-7) (num-test (asin 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078068531e-7+1.1920928955078181469e-7i) (num-test (asin 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078068531e-7-1.1920928955078181469e-7i) (num-test (asin -1.19209289550781250e-07+1.19209289550781250e-07i) -1.1920928955078068531e-7+1.1920928955078181469e-7i) (num-test (asin -1.19209289550781250e-07-1.19209289550781250e-07i) -1.1920928955078068531e-7-1.1920928955078181469e-7i) (num-test (asin 1.19209289550781250e-07+5.0e-01i) 1.0662402999400097805e-7+4.8121182505960598961e-1i) (num-test (asin 1.19209289550781250e-07-5.0e-01i) 1.0662402999400097805e-7-4.8121182505960598961e-1i) (num-test (asin -1.19209289550781250e-07+5.0e-01i) -1.0662402999400097805e-7+4.8121182505960598961e-1i) (num-test (asin -1.19209289550781250e-07-5.0e-01i) -1.0662402999400097805e-7-4.8121182505960598961e-1i) (num-test (asin 1.19209289550781250e-07+1.0e+00i) 8.4293697021788013662e-8+8.8137358701954553738e-1i) (num-test (asin 1.19209289550781250e-07-1.0e+00i) 8.4293697021788013662e-8-8.8137358701954553738e-1i) (num-test (asin -1.19209289550781250e-07+1.0e+00i) -8.4293697021788013662e-8+8.8137358701954553738e-1i) (num-test (asin -1.19209289550781250e-07-1.0e+00i) -8.4293697021788013662e-8-8.8137358701954553738e-1i) (num-test (asin 1.19209289550781250e-07+2.0e+00i) 5.3312014997000413263e-8+1.4436354751788116136e0i) (num-test (asin 1.19209289550781250e-07-2.0e+00i) 5.3312014997000413263e-8-1.4436354751788116136e0i) (num-test (asin -1.19209289550781250e-07+2.0e+00i) -5.3312014997000413263e-8+1.4436354751788116136e0i) (num-test (asin -1.19209289550781250e-07-2.0e+00i) -5.3312014997000413263e-8-1.4436354751788116136e0i) (num-test (asin 1.19209289550781250e-07+8.3886080e+06i) 1.4210854715201902743e-14+1.6635532333438690979e1i) (num-test (asin 1.19209289550781250e-07-8.3886080e+06i) 1.4210854715201902743e-14-1.6635532333438690979e1i) (num-test (asin -1.19209289550781250e-07+8.3886080e+06i) -1.4210854715201902743e-14+1.6635532333438690979e1i) (num-test (asin -1.19209289550781250e-07-8.3886080e+06i) -1.4210854715201902743e-14-1.6635532333438690979e1i) (num-test (asin 5.0e-01+0.0e+00i) 5.2359877559829887308e-1) (num-test (asin -5.0e-01+0.0e+00i) -5.2359877559829887308e-1) (num-test (asin 5.0e-01+1.19209289550781250e-07i) 5.2359877559829340332e-1+1.3765103082409432364e-7i) (num-test (asin 5.0e-01-1.19209289550781250e-07i) 5.2359877559829340332e-1-1.3765103082409432364e-7i) (num-test (asin -5.0e-01+1.19209289550781250e-07i) -5.2359877559829340332e-1+1.3765103082409432364e-7i) (num-test (asin -5.0e-01-1.19209289550781250e-07i) -5.2359877559829340332e-1-1.3765103082409432364e-7i) (num-test (asin 5.0e-01+5.0e-01i) 4.5227844715119068206e-1+5.3063753095251782602e-1i) (num-test (asin 5.0e-01-5.0e-01i) 4.5227844715119068206e-1-5.3063753095251782602e-1i) (num-test (asin -5.0e-01+5.0e-01i) -4.5227844715119068206e-1+5.3063753095251782602e-1i) (num-test (asin -5.0e-01-5.0e-01i) -4.5227844715119068206e-1-5.3063753095251782602e-1i) (num-test (asin 5.0e-01+1.0e+00i) 3.4943906285721329363e-1+9.2613303135018242455e-1i) (num-test (asin 5.0e-01-1.0e+00i) 3.4943906285721329363e-1-9.2613303135018242455e-1i) (num-test (asin -5.0e-01+1.0e+00i) -3.4943906285721329363e-1+9.2613303135018242455e-1i) (num-test (asin -5.0e-01-1.0e+00i) -3.4943906285721329363e-1-9.2613303135018242455e-1i) (num-test (asin 5.0e-01+2.0e+00i) 2.2101863562288385890e-1+1.4657153519472905218e0i) (num-test (asin 5.0e-01-2.0e+00i) 2.2101863562288385890e-1-1.4657153519472905218e0i) (num-test (asin -5.0e-01+2.0e+00i) -2.2101863562288385890e-1+1.4657153519472905218e0i) (num-test (asin -5.0e-01-2.0e+00i) -2.2101863562288385890e-1-1.4657153519472905218e0i) (num-test (asin 5.0e-01+8.3886080e+06i) 5.9604644775390130897e-8+1.6635532333438692755e1i) (num-test (asin 5.0e-01-8.3886080e+06i) 5.9604644775390130897e-8-1.6635532333438692755e1i) (num-test (asin -5.0e-01+8.3886080e+06i) -5.9604644775390130897e-8+1.6635532333438692755e1i) (num-test (asin -5.0e-01-8.3886080e+06i) -5.9604644775390130897e-8-1.6635532333438692755e1i) (num-test (asin 1.0e+00+0.0e+00i) 1.5707963267948966192e0) (num-test (asin -1.0e+00+0.0e+00i) -1.5707963267948966192e0) (num-test (asin 1.0e+00+1.19209289550781250e-07i) 1.5704510598153252947e0+3.4526698643116312881e-4i) (num-test (asin 1.0e+00-1.19209289550781250e-07i) 1.5704510598153252947e0-3.4526698643116312881e-4i) (num-test (asin -1.0e+00+1.19209289550781250e-07i) -1.5704510598153252947e0+3.4526698643116312881e-4i) (num-test (asin -1.0e+00-1.19209289550781250e-07i) -1.5704510598153252947e0-3.4526698643116312881e-4i) (num-test (asin 1.0e+00+5.0e-01i) 8.9590748120889023907e-1+7.3285767597364526089e-1i) (num-test (asin 1.0e+00-5.0e-01i) 8.9590748120889023907e-1-7.3285767597364526089e-1i) (num-test (asin -1.0e+00+5.0e-01i) -8.9590748120889023907e-1+7.3285767597364526089e-1i) (num-test (asin -1.0e+00-5.0e-01i) -8.9590748120889023907e-1-7.3285767597364526089e-1i) (num-test (asin 1.0e+00+1.0e+00i) 6.6623943249251525510e-1+1.0612750619050356520e0i) (num-test (asin 1.0e+00-1.0e+00i) 6.6623943249251525510e-1-1.0612750619050356520e0i) (num-test (asin -1.0e+00+1.0e+00i) -6.6623943249251525510e-1+1.0612750619050356520e0i) (num-test (asin -1.0e+00-1.0e+00i) -6.6623943249251525510e-1-1.0612750619050356520e0i) (num-test (asin 1.0e+00+2.0e+00i) 4.2707858639247612548e-1+1.5285709194809981613e0i) (num-test (asin 1.0e+00-2.0e+00i) 4.2707858639247612548e-1-1.5285709194809981613e0i) (num-test (asin -1.0e+00+2.0e+00i) -4.2707858639247612548e-1+1.5285709194809981613e0i) (num-test (asin -1.0e+00-2.0e+00i) -4.2707858639247612548e-1-1.5285709194809981613e0i) (num-test (asin 1.0e+00+8.3886080e+06i) 1.1920928955077983828e-7+1.6635532333438698084e1i) (num-test (asin 1.0e+00-8.3886080e+06i) 1.1920928955077983828e-7-1.6635532333438698084e1i) (num-test (asin -1.0e+00+8.3886080e+06i) -1.1920928955077983828e-7+1.6635532333438698084e1i) (num-test (asin -1.0e+00-8.3886080e+06i) -1.1920928955077983828e-7-1.6635532333438698084e1i) (num-test (asin 2.0e+00+0.0e+00i) 1.5707963267948966192e0-1.3169578969248167086e0i) (num-test (asin -2.0e+00+0.0e+00i) -1.5707963267948966192e0+1.3169578969248167086e0i) (num-test (asin 2.0e+00+1.19209289550781250e-07i) 1.5707962579693812072e0+1.3169578969248194435e0i) (num-test (asin 2.0e+00-1.19209289550781250e-07i) 1.5707962579693812072e0-1.3169578969248194435e0i) (num-test (asin -2.0e+00+1.19209289550781250e-07i) -1.5707962579693812072e0+1.3169578969248194435e0i) (num-test (asin -2.0e+00-1.19209289550781250e-07i) -1.5707962579693812072e0-1.3169578969248194435e0i) (num-test (asin 2.0e+00+5.0e-01i) 1.2930420702371826591e0+1.3618009008578457882e0i) (num-test (asin 2.0e+00-5.0e-01i) 1.2930420702371826591e0-1.3618009008578457882e0i) (num-test (asin -2.0e+00+5.0e-01i) -1.2930420702371826591e0+1.3618009008578457882e0i) (num-test (asin -2.0e+00-5.0e-01i) -1.2930420702371826591e0-1.3618009008578457882e0i) (num-test (asin 2.0e+00+1.0e+00i) 1.0634400235777520562e0+1.4693517443681852733e0i) (num-test (asin 2.0e+00-1.0e+00i) 1.0634400235777520562e0-1.4693517443681852733e0i) (num-test (asin -2.0e+00+1.0e+00i) -1.0634400235777520562e0+1.4693517443681852733e0i) (num-test (asin -2.0e+00-1.0e+00i) -1.0634400235777520562e0-1.4693517443681852733e0i) (num-test (asin 2.0e+00+2.0e+00i) 7.5424914469804604071e-1+1.7343245214879664480e0i) (num-test (asin 2.0e+00-2.0e+00i) 7.5424914469804604071e-1-1.7343245214879664480e0i) (num-test (asin -2.0e+00+2.0e+00i) -7.5424914469804604071e-1+1.7343245214879664480e0i) (num-test (asin -2.0e+00-2.0e+00i) -7.5424914469804604071e-1-1.7343245214879664480e0i) (num-test (asin 2.0e+00+8.3886080e+06i) 2.3841857910155628843e-7+1.663553233343871940e1i) (num-test (asin 2.0e+00-8.3886080e+06i) 2.3841857910155628843e-7-1.663553233343871940e1i) (num-test (asin -2.0e+00+8.3886080e+06i) -2.3841857910155628843e-7+1.663553233343871940e1i) (num-test (asin -2.0e+00-8.3886080e+06i) -2.3841857910155628843e-7-1.663553233343871940e1i) (num-test (asin 8.3886080e+06+0.0e+00i) 1.5707963267948966192e0-1.6635532333438683873e1i) (num-test (asin -8.3886080e+06+0.0e+00i) -1.5707963267948966192e0+1.6635532333438683873e1i) (num-test (asin 8.3886080e+06+1.19209289550781250e-07i) 1.5707963267948824084e0+1.6635532333438683873e1i) (num-test (asin 8.3886080e+06-1.19209289550781250e-07i) 1.5707963267948824084e0-1.6635532333438683873e1i) (num-test (asin -8.3886080e+06+1.19209289550781250e-07i) -1.5707963267948824084e0+1.6635532333438683873e1i) (num-test (asin -8.3886080e+06-1.19209289550781250e-07i) -1.5707963267948824084e0-1.6635532333438683873e1i) (num-test (asin 8.3886080e+06+5.0e-01i) 1.5707962671902518438e0+1.6635532333438685650e1i) (num-test (asin 8.3886080e+06-5.0e-01i) 1.5707962671902518438e0-1.6635532333438685650e1i) (num-test (asin -8.3886080e+06+5.0e-01i) -1.5707962671902518438e0+1.6635532333438685650e1i) (num-test (asin -8.3886080e+06-5.0e-01i) -1.5707962671902518438e0-1.6635532333438685650e1i) (num-test (asin 8.3886080e+06+1.0e+00i) 1.5707962075856070684e0+1.6635532333438690979e1i) (num-test (asin 8.3886080e+06-1.0e+00i) 1.5707962075856070684e0-1.6635532333438690979e1i) (num-test (asin -8.3886080e+06+1.0e+00i) -1.5707962075856070684e0+1.6635532333438690979e1i) (num-test (asin -8.3886080e+06-1.0e+00i) -1.5707962075856070684e0-1.6635532333438690979e1i) (num-test (asin 8.3886080e+06+2.0e+00i) 1.5707960883763175177e0+1.6635532333438712295e1i) (num-test (asin 8.3886080e+06-2.0e+00i) 1.5707960883763175177e0-1.6635532333438712295e1i) (num-test (asin -8.3886080e+06+2.0e+00i) -1.5707960883763175177e0+1.6635532333438712295e1i) (num-test (asin -8.3886080e+06-2.0e+00i) -1.5707960883763175177e0-1.6635532333438712295e1i) (num-test (asin 8.3886080e+06+8.3886080e+06i) 7.8539816339744653326e-1+1.6982105923718660081e1i) (num-test (asin 8.3886080e+06-8.3886080e+06i) 7.8539816339744653326e-1-1.6982105923718660081e1i) (num-test (asin -8.3886080e+06+8.3886080e+06i) -7.8539816339744653326e-1+1.6982105923718660081e1i) (num-test (asin -8.3886080e+06-8.3886080e+06i) -7.8539816339744653326e-1-1.6982105923718660081e1i) (num-test (asin -1.0e+01) -1.5707963267948966192e0+2.9932228461263808979e0i) (num-test (asin -2.0e+00) -1.5707963267948966192e0+1.3169578969248167086e0i) (num-test (asin -1.0e+00) -1.5707963267948966192e0) (num-test (asin -7.50e-01) -8.4806207898148100805e-1) (num-test (asin -5.0e-01) -5.2359877559829887308e-1) (num-test (asin -1.250e-01) -1.2532783116806539687e-1) (num-test (asin -3.45266983001243932001e-04) -3.4526698986108292481e-4) (num-test (asin -1.19209289550781250e-07) -1.1920928955078153234e-7) (num-test (asin 0.0e+00) 0e0) (num-test (asin 1.19209289550781250e-07) 1.1920928955078153234e-7) (num-test (asin 3.45266983001243932001e-04) 3.4526698986108292481e-4) (num-test (asin 1.250e-01) 1.2532783116806539687e-1) (num-test (asin 5.0e-01) 5.2359877559829887308e-1) (num-test (asin 7.50e-01) 8.4806207898148100805e-1) (num-test (asin 1.0e+00) 1.5707963267948966192e0) (num-test (asin 2.0e+00) 1.5707963267948966192e0-1.3169578969248167086e0i) (num-test (asin 1.0e+01) 1.5707963267948966192e0-2.9932228461263808979e0i) (num-test (asin 2) 1.570796326794897-1.316957896924817i) (num-test (asin 3.0+70000000i) 4.2857142400327436E-8+18.7571529895002i) (num-test (asin 70000000+3i) 1.570796279536826+18.75715298057358i) (num-test (asin 3.0-70000000i) 4.2857142400327436E-8-18.7571529895002i) (num-test (asin -70000000+3i) -1.570796279536826+18.75715298057358i) (num-test (asin 1e17+1e17i) 0.78539816339745+40.183667351739i) (num-test (asin 1+1e17i) 1e-17+39.837093761459i) (num-test (asin -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (asin 1.110223024625156799999999999999999999997E-16) 1.110223024625156800000000000000002280754E-16) (num-test (asin (/ (sqrt 2) 2)) (/ pi 4)) (num-test (asin (/ (sqrt 3) -2)) (/ pi -3)) (num-test (* 10 (asin (/ (- (sqrt 5) 1) 4))) pi) (num-test (* 2 (asin 1)) pi) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'asin num (asin num) val))) (vector (list 0 0) (list 1 1.5707963267949) (list 2 1.5707963267949-1.3169578969248i) (list 3 1.5707963267949-1.7627471740391i) (list -1 -1.5707963267949) (list -2 -1.5707963267949+1.3169578969248i) (list -3 -1.5707963267949+1.7627471740391i) (list 9223372036854775807 1.5707963267949-44.361419555836i) (list -9223372036854775808 -1.5707963267949+44.361419555836i) (list 1/2 0.5235987755983) (list 1/3 0.33983690945412) (list -1/2 -0.5235987755983) (list -1/3 -0.33983690945412) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 1.5707963267949) (list 2.0 1.5707963267949-1.3169578969248i) (list -2.0 -1.5707963267949+1.3169578969248i) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 1e+16 1.5707963267949-37.534508668465i) (list 0+1i 0+0.88137358701954i) (list 0+2i 0+1.4436354751788i) (list 0-1i 0-0.88137358701954i) (list 1+1i 0.66623943249252+1.061275061905i) (list 1-1i 0.66623943249252-1.061275061905i) (list -1+1i -0.66623943249252+1.061275061905i) (list -1-1i -0.66623943249252-1.061275061905i) (list 0.1+0.1i 0.099663702859795+0.10033029811221i) (list 1e+16+1e+16i 0.78539816339745+37.881082258745i) (list 1e-16+1e-16i 1e-16+1.1102230246252e-16i) )) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x -10.0 (+ x .1))) ((= i 200)) (let ((y (magnitude (- x (sin (asin x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-12) (format #t ";(sin (asin ~A)) error: ~A~%" mx err))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x 1.0-i (+ x -.1+i))) ((= i 100)) (let ((y (magnitude (- x (sin (asin x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-9) (format #t ";(sin (asin ~A)) error: ~A~%" mx err))) (test (asin) 'error) (test (asin "hi") 'error) (test (asin 1.0+23.0i 1.0+23.0i) 'error) (test (asin 0 1) 'error) (for-each (lambda (arg) (test (asin arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (let ((asins (list 0.00000000000000000000000000000000000000000000000000000000000000000000 0.02500260489936113599406838915349107150195748368840710160729904233944 0.05002085680577001466274438682046411497780608049468789272874398055703 0.07507049107671654265775143572317089898194705496817785120910161299955 0.10016742116155979634552317945269331856867597222962954139102385503640 0.12532783116806539687456698635708471804814772683867237523396403098649 0.15056827277668602642326030146739539047425784470580485344319902595849 0.17590576816371628737774199743846051972730948209298253171964068749984 0.20135792079033079145512555221762341024003808140222838625725124345560 0.22694303617851994909359260763689579636930963064761339672521677581090 0.25268025514207865348565743699371097225219373309683819363392377874057 0.27858970239165058217050815183568882129133935843106227203280647300877 0.30469265401539750797200296122752916695456003170677638739297794874647 0.33101172808929452771961639961139035858195303667932389628972377319123 0.35757110364551028671483849232064256784674132498948776325141270863037 0.38439677449563908303819487296704697375277948430656504155058375479079 0.41151684606748801938473789761733560485570113512702585178394678070009 0.43896188560976067483321619602147236009843505358239561712817387552271 0.46676533904729636185033976030413712126156503909241369925276357159851 0.49496403171689461363027991615293072605447706550005723007748628111125 0.52359877559829887307710723054658381403286156656251763682915743205130 0.55271511309678317285035596261806027710654731438452549350875265730232 0.58236423786874344183204729090997636797897358751436418853659347126034 0.61260414804862246566851988030718610964520075565860642564808142300476 0.64350110879328438680280922871732263804151059111531238286560611871351 0.67513153293703164720905626529438801420418535124967921737841984904557 0.70758443672535557545286474430459468476197717933193633785448106190261 0.74096470220302000164595109317351452207440076171206748884906746063949 0.77539749661075306374035335271498711355578873864116199359771996373272 0.81103439428758154765966499519016990220446846078107874166646027112837 0.84806207898148100805294433899841808007336621326311264286071816357020 0.88671509499956738294114522105877020358977872696702934222169938478807 0.92729521800161223242851246292242880405707410857224052762186617744039 0.97020219992884564627294507144637975649395034794671876838355202607208 1.01598529381482513116231792163105149400316379682053508778250056579494 1.06543581651073931226000681765232949759419723349387652321962473867275 1.11976951499863418668667705584539961589516218640330288237568186391443 1.18103559399742179696187441797151603545275866323114802494551011137296 1.25323589750337525873710391866600599574114067342736145636046515573871 1.34672104149307735953151290762049740983950868154764854526693662237423 1.57079632679489661923132169163975144209858469968755291048747229615390))) (let ((mxerr 0.0)) (do ((i 0 (+ i 1)) (x 0.0 (+ x (/ 1.0 40.0)))) ((= i 40)) (let ((err (abs (- (asin x) (list-ref asins i))))) (if (> err mxerr) (set! mxerr err)))) (if (> mxerr 1e-12) (format #t "asin err: ~A~%" mxerr)))) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((asins (list ; table[Arcsin[k/30], {k, 0, 30}] 0.00000000000000000000000000000000000000000000000000000000000000000000e0 0.03333950926130208699143488077083860917565937855129663393680393744362 0.06671614841022525954540510327036927409184944434654403274652597117428 0.10016742116155979634552317945269331856867597222962954139102385503640 0.13373158940994152865632332716309743011405498274444165545458875924377 0.16744807921968933055327460604363822091495716231623832046578730373329 0.20135792079033079145512555221762341024003808140222838625725124345560 0.23550423672079979129288448393723556648106234259531297814541683051663 0.26993279583340344442461498978851864365647337427020501782962042633379 0.30469265401539750797200296122752916695456003170677638739297794874647 0.33983690945412193709639251339176406638824469033245807143192396248991 0.37542360798103940368516545708214708494670535320625397496008012654413 0.41151684606748801938473789761733560485570113512702585178394678070009 0.44818813597943128994043756304906477118029918046343080720212217855713 0.48551812229559116327223435902482444763168509494201196125953547218486 0.52359877559829887307710723054658381403286156656251763682915743205130 0.56253624454385561973132565694853319169977493405170278279550382560769 0.60245463338499055124863378781466897272136400811697167837514413874507 0.64350110879328438680280922871732263804151059111531238286560611871351 0.68585296461871075596328071793021108476903703940127104404158318225766 0.72972765622696636345479665981332069539650591404771369070894949146181 0.77539749661075306374035335271498711355578873864116199359771996373272 0.82321197712587582143797706006235798228453830885144107684904792594002 0.87363319315266432351068180914720023973456695459982111043494836254140 0.92729521800161223242851246292242880405707410857224052762186617744039 0.98511078333774565961356415316223367589822363251591140783691296893264 1.04848150498884799670722286578404816608970376214442109090268484725633 1.11976951499863418668667705584539961589516218640330288237568186391443 1.20358830623705947672584877793852613585139977949919656045114461770445 1.31187478478867540346593147633958737932614651512288222488818316043445 1.57079632679489661923132169163975144209858469968755291048747229615390))) (do ((i 0 (+ i 1))) ((= i 30)) (let ((val (asin (bignum (/ i 30))))) (if (> (magnitude (- val (list-ref asins i))) 1e-36) (format #t ";(asin ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref asins i) (magnitude (- val (list-ref asins i)))))))))) ;;;-------------------------------------------------------------------------------- ;;; acos ;;; -------------------------------------------------------------------------------- (num-test (acos 0) 1.57079632679490) (num-test (acos 1) 0.0) (num-test (acos -1) pi) (num-test (acos 2) 0.0-1.31695789692482i) (num-test (acos -2) 3.14159265358979-1.31695789692482i) (num-test (acos 3) 0.0-1.76274717403909i) (num-test (acos -3) 3.14159265358979-1.76274717403909i) (num-test (acos 10) 0.0-2.99322284612638i) (num-test (acos -10) 3.14159265358979-2.99322284612638i) (num-test (acos 1234) 0.0-7.81116322068415i) (num-test (acos -1234) 3.14159265358979-7.81116322068415i) (num-test (acos 0/1) 1.57079632679490) (num-test (acos 0/2) 1.57079632679490) (num-test (acos 0/3) 1.57079632679490) (num-test (acos 0/10) 1.57079632679490) (num-test (acos 0/1234) 1.57079632679490) (num-test (acos 0/500029) 1.57079632679490) (num-test (acos 1/1) 0.0) (num-test (acos -1/1) pi) (num-test (acos 1/2) 1.04719755119660) (num-test (acos -1/2) 2.09439510239320) (num-test (acos 1/3) 1.23095941734077) (num-test (acos -1/3) 1.91063323624902) (num-test (acos 1/10) 1.47062890563334) (num-test (acos -1/10) 1.67096374795646) (num-test (acos 1/1234) 1.56998595393473) (num-test (acos -1/1234) 1.57160669965507) (num-test (acos 1/500029) 1.57079432691089) (num-test (acos -1/500029) 1.57079832667890) (num-test (acos 2/1) 0.0-1.31695789692482i) (num-test (acos -2/1) 3.14159265358979-1.31695789692482i) (num-test (acos 2/2) 0.0) (num-test (acos -2/2) pi) (num-test (acos 2/3) 0.84106867056793) (num-test (acos -2/3) 2.30052398302186) (num-test (acos 2/10) 1.36943840600457) (num-test (acos -2/10) 1.77215424758523) (num-test (acos 2/1234) 1.56917558054238) (num-test (acos -2/1234) 1.57241707304741) (num-test (acos 2/500029) 1.57079232702688) (num-test (acos -2/500029) 1.57080032656291) (num-test (acos 3/1) 0.0-1.76274717403909i) (num-test (acos -3/1) 3.14159265358979-1.76274717403909i) (num-test (acos 3/2) 0.0-0.96242365011921i) (num-test (acos -3/2) 3.14159265358979-0.96242365011921i) (num-test (acos 3/3) 0.0) (num-test (acos -3/3) pi) (num-test (acos 3/10) 1.26610367277950) (num-test (acos -3/10) 1.87548898081029) (num-test (acos 3/1234) 1.56836520608568) (num-test (acos -3/1234) 1.57322744750412) (num-test (acos 3/500029) 1.57079032714288) (num-test (acos -3/500029) 1.57080232644692) (num-test (acos 10/1) 0.0-2.99322284612638i) (num-test (acos -10/1) 3.14159265358979-2.99322284612638i) (num-test (acos 10/2) 0.0-2.29243166956117i) (num-test (acos -10/2) 3.14159265358979-2.29243166956117i) (num-test (acos 10/3) 0.0-1.87382024252741i) (num-test (acos -10/3) 3.14159265358979-1.87382024252741i) (num-test (acos 10/10) 0.0) (num-test (acos -10/10) pi) (num-test (acos 10/1234) 1.56269251038168) (num-test (acos -10/1234) 1.57890014320811) (num-test (acos 10/500029) 1.57077632795483) (num-test (acos -10/500029) 1.57081632563497) (num-test (acos 1234/1) 0.0-7.81116322068415i) (num-test (acos -1234/1) 3.14159265358979-7.81116322068415i) (num-test (acos 1234/2) 0.0-7.11801554770806i) (num-test (acos -1234/2) 3.14159265358979-7.11801554770806i) (num-test (acos 1234/3) 0.0-6.71254961876657i) (num-test (acos -1234/3) 3.14159265358979-6.71254961876657i) (num-test (acos 1234/10) 0.0-5.50856187402751i) (num-test (acos -1234/10) 3.14159265358979-5.50856187402751i) (num-test (acos 1234/500029) 1.56832846742558) (num-test (acos -1234/500029) 1.57326418616421) (num-test (acos 500029/3) 0+12.7169561400958i) (num-test (acos -500029/3) 3.14159265358979-12.7169561400958i) (num-test (acos 500029/10) 0.0+11.51298346318831i) ; maxima (num-test (acos -500029/10) 3.14159265358979-11.51298333576987i) (num-test (acos 500029/1234) 0.0-6.69755082925184i) (num-test (acos -500029/1234) 3.14159265358979-6.69755082925184i) (num-test (acos 500029/500029) 0.0) (num-test (acos -500029/500029) pi) (num-test (acos 0.0) 1.57079632679490) (num-test (acos 0.00000001) 1.57079631679490) (num-test (acos -0.00000001) 1.57079633679490) (num-test (acos 1.0) 0.0) (num-test (acos -1.0) pi) (num-test (acos pi) 0.0-1.81152627246085i) (num-test (acos -3.14159265358979) 3.14159265358979-1.81152627246085i) (num-test (acos 1234.0) 0.0-7.81116322068415i) (num-test (acos -1234.0) 3.14159265358979-7.81116322068415i) (num-test (acos 0.0+0.0i) 1.57079632679490) (num-test (acos -0.0+0.0i) 1.57079632679490) (num-test (acos 0.0-0.0i) 1.57079632679490) (num-test (acos -0.0-0.0i) 1.57079632679490) (num-test (acos 0.0+0.00000001i) 1.57079632679490-0.00000001i) (num-test (acos -0.0+0.00000001i) 1.57079632679490-0.00000001i) (num-test (acos 0.0-0.00000001i) 1.57079632679490+0.00000001i) (num-test (acos -0.0-0.00000001i) 1.57079632679490+0.00000001i) (num-test (acos 0.0+1.0i) 1.57079632679490-0.88137358701954i) (num-test (acos -0.0+1.0i) 1.57079632679490-0.88137358701954i) (num-test (acos 0.0-1.0i) 1.57079632679490+0.88137358701954i) (num-test (acos -0.0-1.0i) 1.57079632679490+0.88137358701954i) (num-test (acos 0.0+3.14159265358979i) 1.57079632679490-1.86229574331085i) (num-test (acos -0.0+3.14159265358979i) 1.57079632679490-1.86229574331085i) (num-test (acos 0.0-3.14159265358979i) 1.57079632679490+1.86229574331085i) (num-test (acos -0.0-3.14159265358979i) 1.57079632679490+1.86229574331085i) (num-test (acos 0.0+1234.0i) 1.57079632679490-7.81116354896171i) (num-test (acos -0.0+1234.0i) 1.57079632679490-7.81116354896171i) (num-test (acos 0.0-1234.0i) 1.57079632679490+7.81116354920125i) (num-test (acos -0.0-1234.0i) 1.57079632679490+7.81116354920125i) (num-test (acos 0.00000001+0.0i) 1.57079631679490) (num-test (acos -0.00000001+0.0i) 1.57079633679490) (num-test (acos 0.00000001-0.0i) 1.57079631679490) (num-test (acos -0.00000001-0.0i) 1.57079633679490) (num-test (acos 0.00000001+0.00000001i) 1.57079631679490-0.00000001i) (num-test (acos -0.00000001+0.00000001i) 1.57079633679490-0.00000001i) (num-test (acos 0.00000001-0.00000001i) 1.57079631679490+0.00000001i) (num-test (acos -0.00000001-0.00000001i) 1.57079633679490+0.00000001i) (num-test (acos 0.00000001+1.0i) 1.57079631972383-0.88137358701954i) (num-test (acos -0.00000001+1.0i) 1.57079633386596-0.88137358701954i) (num-test (acos 0.00000001-1.0i) 1.57079631972383+0.88137358701954i) (num-test (acos -0.00000001-1.0i) 1.57079633386596+0.88137358701954i) (num-test (acos 0.00000001+3.14159265358979i) 1.57079632376175-1.86229574331085i) (num-test (acos -0.00000001+3.14159265358979i) 1.57079632982804-1.86229574331085i) (num-test (acos 0.00000001-3.14159265358979i) 1.57079632376175+1.86229574331085i) (num-test (acos -0.00000001-3.14159265358979i) 1.57079632982804+1.86229574331085i) (num-test (acos 0.00000001+1234.0i) 1.57079632678679-7.81116354896171i) (num-test (acos -0.00000001+1234.0i) 1.57079632680300-7.81116354896171i) (num-test (acos 0.00000001-1234.0i) 1.57079632678679+7.81116354920125i) (num-test (acos -0.00000001-1234.0i) 1.57079632680300+7.81116354920125i) (num-test (acos 1.0+0.0i) 0.0) (num-test (acos -1.0+0.0i) pi) (num-test (acos 1.0-0.0i) 0.0) (num-test (acos -1.0-0.0i) pi) (num-test (acos 1.0+0.00000001i) 0.00009999999992-0.00010000000008i) (num-test (acos -1.0+0.00000001i) 3.14149265358988-0.00010000000008i) (num-test (acos 1.0-0.00000001i) 0.00009999999992+0.00010000000008i) (num-test (acos -1.0-0.00000001i) 3.14149265358988+0.00010000000008i) (num-test (acos 1.0+1.0i) 0.90455689430238-1.06127506190504i) (num-test (acos -1.0+1.0i) 2.23703575928741-1.06127506190504i) (num-test (acos 1.0-1.0i) 0.90455689430238+1.06127506190504i) (num-test (acos -1.0-1.0i) 2.23703575928741+1.06127506190504i) (num-test (acos 1.0+3.14159265358979i) 1.27521129258327-1.90462768697066i) (num-test (acos -1.0+3.14159265358979i) 1.86638136100653-1.90462768697066i) (num-test (acos 1.0-3.14159265358979i) 1.27521129258327+1.90462768697066i) (num-test (acos -1.0-3.14159265358979i) 1.86638136100653+1.90462768697066i) (num-test (acos 1.0+1234.0i) 1.56998595446684-7.81116387772663i) (num-test (acos -1.0+1234.0i) 1.57160669912296-7.81116387772663i) (num-test (acos 1.0-1234.0i) 1.56998595446690+7.81116387755283i) (num-test (acos -1.0-1234.0i) 1.57160669912289+7.81116387755283i) (num-test (acos 3.14159265358979+0.0i) 0.0-1.81152627246085i) (num-test (acos -3.14159265358979+0.0i) 3.14159265358979-1.81152627246085i) (num-test (acos 3.14159265358979-0.0i) 0.0-1.81152627246085i) (num-test (acos -3.14159265358979-0.0i) 3.14159265358979-1.81152627246085i) (num-test (acos 3.14159265358979+0.00000001i) 0.00000000335775-1.81152627246085i) (num-test (acos -3.14159265358979+0.00000001i) 3.14159265023205-1.81152627246085i) (num-test (acos 3.14159265358979-0.00000001i) 0.00000000335775+1.81152627246085i) (num-test (acos -3.14159265358979-0.00000001i) 3.14159265023205+1.81152627246085i) (num-test (acos 3.14159265358979+1.0i) 0.32225329398146-1.86711439316026i) (num-test (acos -3.14159265358979+1.0i) 2.81933935960833-1.86711439316026i) (num-test (acos 3.14159265358979-1.0i) 0.32225329398146+1.86711439316026i) (num-test (acos -3.14159265358979-1.0i) 2.81933935960833+1.86711439316026i) (num-test (acos 3.14159265358979+3.14159265358979i) 0.79805654766741-2.18469104082751i) (num-test (acos -3.14159265358979+3.14159265358979i) 2.34353610592238-2.18469104082751i) (num-test (acos 3.14159265358979-3.14159265358979i) 0.79805654766741+2.18469104082751i) (num-test (acos -3.14159265358979-3.14159265358979i) 2.34353610592238+2.18469104082751i) (num-test (acos 3.14159265358979+1234.0i) 1.56825047198589-7.81116678966949i) (num-test (acos -3.14159265358979+1234.0i) 1.57334218160390-7.81116678966949i) (num-test (acos 3.14159265358979-1234.0i) 1.56825047198552+7.81116678989204i) (num-test (acos -3.14159265358979-1234.0i) 1.57334218160427+7.81116678989204i) (num-test (acos 1234.0+0.0i) 0.0-7.81116322068415i) (num-test (acos -1234.0+0.0i) 3.14159265358979-7.81116322068415i) (num-test (acos 1234.0-0.0i) 0.0-7.81116322068415i) (num-test (acos -1234.0-0.0i) 3.14159265358979-7.81116322068415i) (num-test (acos 1234.0+0.00000001i) 0.00000000000810-7.81116322068415i) (num-test (acos -1234.0+0.00000001i) 3.14159265358169-7.81116322068415i) (num-test (acos 1234.0-0.00000001i) 0.00000000000810+7.81116322084923i) (num-test (acos -1234.0-0.00000001i) 3.14159265358169+7.81116322084923i) (num-test (acos 1234.0+1.0i) 0.00081037286048-7.81116354944842i) (num-test (acos -1234.0+1.0i) 3.14078228072931-7.81116354944842i) (num-test (acos 1234.0-1.0i) 0.00081037286017+7.81116354920146i) (num-test (acos -1234.0-1.0i) 3.14078228072962+7.81116354920146i) (num-test (acos 1234.0+3.14159265358979i) 0.00254585647983-7.81116646138554i) (num-test (acos -1234.0+3.14159265358979i) 3.13904679710996-7.81116646138554i) (num-test (acos 1234.0-3.14159265358979i) 0.00254585648123+7.81116646154641i) (num-test (acos -1234.0-3.14159265358979i) 3.13904679710856+7.81116646154641i) (num-test (acos 1234.0+1234.0i) 0.78539824532655-8.15773697538346i) (num-test (acos -1234.0+1234.0i) 2.35619440826324-8.15773697538346i) (num-test (acos 1234.0-1234.0i) 0.78539824548545+8.15773697530526i) (num-test (acos -1234.0-1234.0i) 2.35619440810434+8.15773697530526i) (num-test (acos -2.0) 3.141592653589793-1.316957896924817i) (num-test (acos 3.0+70000000i) 1.570796283937754-18.7571529895002i) ; C breaks near here (num-test (acos 70000000+3i) 4.725807101202406E-8-18.75715298057358i) (num-test (acos 3.0-70000000i) 1.570796283937754+18.7571529895002i) (num-test (acos -70000000+3i) 3.141592606331722-18.75715298057358i) (num-test (acos 1.5) 0.0+0.9624236501192069i) (num-test (acos -1.5) 3.141592653589793-0.9624236501192069i) (num-test (acos -1.0e+01) 3.1415926535897932385e0-2.9932228461263808979e0i) (num-test (acos -2.0e+00) 3.1415926535897932385e0-1.3169578969248167086e0i) (num-test (acos -1.0e+00) pi) (num-test (acos -7.50e-01) 2.4188584057763776273e0) (num-test (acos -5.0e-01) 2.0943951023931954923e0) (num-test (acos -1.250e-01) 1.6961241579629620161e0) (num-test (acos -3.45266983001243932001e-04) 1.5711415937847577022e0) (num-test (acos -1.19209289550781250e-07) 1.570796446004186170e0) (num-test (acos 0.0e+00) 1.5707963267948966192e0) (num-test (acos 1.19209289550781250e-07) 1.5707962075856070684e0) (num-test (acos 3.45266983001243932001e-04) 1.5704510598050355363e0) (num-test (acos 1.250e-01) 1.4454684956268312224e0) (num-test (acos 5.0e-01) 1.0471975511965977462e0) (num-test (acos 7.50e-01) 7.2273424781341561118e-1) (num-test (acos 1.0e+00) 0e0) (num-test (acos 2.0e+00) 0+1.3169578969248167086e0i) (num-test (acos 1.0e+01) 0+2.9932228461263808979e0i) (num-test (acos 0.0e+00+0.0e+00i) 1.5707963267948966192e0) (num-test (acos 0.0e+00+1.19209289550781250e-07i) 1.5707963267948966192e0-1.1920928955078096766e-7i) (num-test (acos 0.0e+00-1.19209289550781250e-07i) 1.5707963267948966192e0+1.1920928955078096766e-7i) (num-test (acos 0.0e+00+5.0e-01i) 1.5707963267948966192e0-4.8121182505960344750e-1i) (num-test (acos 0.0e+00-5.0e-01i) 1.5707963267948966192e0+4.8121182505960344750e-1i) (num-test (acos 0.0e+00+1.0e+00i) 1.5707963267948966192e0-8.8137358701954302523e-1i) (num-test (acos 0.0e+00-1.0e+00i) 1.5707963267948966192e0+8.8137358701954302523e-1i) (num-test (acos 0.0e+00+2.0e+00i) 1.5707963267948966192e0-1.4436354751788103425e0i) (num-test (acos 0.0e+00-2.0e+00i) 1.5707963267948966192e0+1.4436354751788103425e0i) (num-test (acos 0.0e+00+8.3886080e+06i) 1.5707963267948966192e0-1.6635532333438690979e1i) (num-test (acos 0.0e+00-8.3886080e+06i) 1.5707963267948966192e0+1.6635532333438690979e1i) (num-test (acos 1.19209289550781250e-07+0.0e+00i) 1.5707962075856070684e0) (num-test (acos -1.19209289550781250e-07+0.0e+00i) 1.570796446004186170e0) (num-test (acos 1.19209289550781250e-07+1.19209289550781250e-07i) 1.5707962075856070685e0-1.1920928955078181469e-7i) (num-test (acos 1.19209289550781250e-07-1.19209289550781250e-07i) 1.5707962075856070685e0+1.1920928955078181469e-7i) (num-test (acos -1.19209289550781250e-07+1.19209289550781250e-07i) 1.570796446004186170e0-1.1920928955078181469e-7i) (num-test (acos -1.19209289550781250e-07-1.19209289550781250e-07i) 1.570796446004186170e0+1.1920928955078181469e-7i) (num-test (acos 1.19209289550781250e-07+5.0e-01i) 1.5707962201708666252e0-4.8121182505960598961e-1i) (num-test (acos 1.19209289550781250e-07-5.0e-01i) 1.5707962201708666252e0+4.8121182505960598961e-1i) (num-test (acos -1.19209289550781250e-07+5.0e-01i) 1.5707964334189266132e0-4.8121182505960598961e-1i) (num-test (acos -1.19209289550781250e-07-5.0e-01i) 1.5707964334189266132e0+4.8121182505960598961e-1i) (num-test (acos 1.19209289550781250e-07+1.0e+00i) 1.5707962425011995974e0-8.8137358701954553738e-1i) (num-test (acos 1.19209289550781250e-07-1.0e+00i) 1.5707962425011995974e0+8.8137358701954553738e-1i) (num-test (acos -1.19209289550781250e-07+1.0e+00i) 1.5707964110885936410e0-8.8137358701954553738e-1i) (num-test (acos -1.19209289550781250e-07-1.0e+00i) 1.5707964110885936410e0+8.8137358701954553738e-1i) (num-test (acos 1.19209289550781250e-07+2.0e+00i) 1.5707962734828816222e0-1.4436354751788116136e0i) (num-test (acos 1.19209289550781250e-07-2.0e+00i) 1.5707962734828816222e0+1.4436354751788116136e0i) (num-test (acos -1.19209289550781250e-07+2.0e+00i) 1.5707963801069116162e0-1.4436354751788116136e0i) (num-test (acos -1.19209289550781250e-07-2.0e+00i) 1.5707963801069116162e0+1.4436354751788116136e0i) (num-test (acos 1.19209289550781250e-07+8.3886080e+06i) 1.5707963267948824084e0-1.6635532333438690979e1i) (num-test (acos 1.19209289550781250e-07-8.3886080e+06i) 1.5707963267948824084e0+1.6635532333438690979e1i) (num-test (acos -1.19209289550781250e-07+8.3886080e+06i) 1.5707963267949108301e0-1.6635532333438690979e1i) (num-test (acos -1.19209289550781250e-07-8.3886080e+06i) 1.5707963267949108301e0+1.6635532333438690979e1i) (num-test (acos 5.0e-01+0.0e+00i) 1.0471975511965977462e0) (num-test (acos -5.0e-01+0.0e+00i) 2.0943951023931954923e0) (num-test (acos 5.0e-01+1.19209289550781250e-07i) 1.0471975511966032159e0-1.3765103082409432364e-7i) (num-test (acos 5.0e-01-1.19209289550781250e-07i) 1.0471975511966032159e0+1.3765103082409432364e-7i) (num-test (acos -5.0e-01+1.19209289550781250e-07i) 2.0943951023931900225e0-1.3765103082409432364e-7i) (num-test (acos -5.0e-01-1.19209289550781250e-07i) 2.0943951023931900225e0+1.3765103082409432364e-7i) (num-test (acos 5.0e-01+5.0e-01i) 1.1185178796437059372e0-5.3063753095251782602e-1i) (num-test (acos 5.0e-01-5.0e-01i) 1.1185178796437059372e0+5.3063753095251782602e-1i) (num-test (acos -5.0e-01+5.0e-01i) 2.0230747739460873013e0-5.3063753095251782602e-1i) (num-test (acos -5.0e-01-5.0e-01i) 2.0230747739460873013e0+5.3063753095251782602e-1i) (num-test (acos 5.0e-01+1.0e+00i) 1.2213572639376833256e0-9.2613303135018242455e-1i) (num-test (acos 5.0e-01-1.0e+00i) 1.2213572639376833256e0+9.2613303135018242455e-1i) (num-test (acos -5.0e-01+1.0e+00i) 1.9202353896521099129e0-9.2613303135018242455e-1i) (num-test (acos -5.0e-01-1.0e+00i) 1.9202353896521099129e0+9.2613303135018242455e-1i) (num-test (acos 5.0e-01+2.0e+00i) 1.3497776911720127603e0-1.4657153519472905218e0i) (num-test (acos 5.0e-01-2.0e+00i) 1.3497776911720127603e0+1.4657153519472905218e0i) (num-test (acos -5.0e-01+2.0e+00i) 1.7918149624177804781e0-1.4657153519472905218e0i) (num-test (acos -5.0e-01-2.0e+00i) 1.7918149624177804781e0+1.4657153519472905218e0i) (num-test (acos 5.0e-01+8.3886080e+06i) 1.5707962671902518438e0-1.6635532333438692755e1i) (num-test (acos 5.0e-01-8.3886080e+06i) 1.5707962671902518438e0+1.6635532333438692755e1i) (num-test (acos -5.0e-01+8.3886080e+06i) 1.5707963863995413946e0-1.6635532333438692755e1i) (num-test (acos -5.0e-01-8.3886080e+06i) 1.5707963863995413946e0+1.6635532333438692755e1i) (num-test (acos 1.0e+00+0.0e+00i) 0e0) (num-test (acos -1.0e+00+0.0e+00i) pi) (num-test (acos 1.0e+00+1.19209289550781250e-07i) 3.4526697957132450399e-4-3.4526698643116312881e-4i) (num-test (acos 1.0e+00-1.19209289550781250e-07i) 3.4526697957132450399e-4+3.4526698643116312881e-4i) (num-test (acos -1.0e+00+1.19209289550781250e-07i) 3.1412473866102219140e0-3.4526698643116312881e-4i) (num-test (acos -1.0e+00-1.19209289550781250e-07i) 3.1412473866102219140e0+3.4526698643116312881e-4i) (num-test (acos 1.0e+00+5.0e-01i) 6.7488884558600638016e-1-7.3285767597364526089e-1i) (num-test (acos 1.0e+00-5.0e-01i) 6.7488884558600638016e-1+7.3285767597364526089e-1i) (num-test (acos -1.0e+00+5.0e-01i) 2.4667038080037868583e0-7.3285767597364526089e-1i) (num-test (acos -1.0e+00-5.0e-01i) 2.4667038080037868583e0+7.3285767597364526089e-1i) (num-test (acos 1.0e+00+1.0e+00i) 9.0455689430238136413e-1-1.0612750619050356520e0i) (num-test (acos 1.0e+00-1.0e+00i) 9.0455689430238136413e-1+1.0612750619050356520e0i) (num-test (acos -1.0e+00+1.0e+00i) 2.2370357592874118743e0-1.0612750619050356520e0i) (num-test (acos -1.0e+00-1.0e+00i) 2.2370357592874118743e0+1.0612750619050356520e0i) (num-test (acos 1.0e+00+2.0e+00i) 1.1437177404024204938e0-1.5285709194809981613e0i) (num-test (acos 1.0e+00-2.0e+00i) 1.1437177404024204938e0+1.5285709194809981613e0i) (num-test (acos -1.0e+00+2.0e+00i) 1.9978749131873727447e0-1.5285709194809981613e0i) (num-test (acos -1.0e+00-2.0e+00i) 1.9978749131873727447e0+1.5285709194809981613e0i) (num-test (acos 1.0e+00+8.3886080e+06i) 1.5707962075856070685e0-1.6635532333438698084e1i) (num-test (acos 1.0e+00-8.3886080e+06i) 1.5707962075856070685e0+1.6635532333438698084e1i) (num-test (acos -1.0e+00+8.3886080e+06i) 1.570796446004186170e0-1.6635532333438698084e1i) (num-test (acos -1.0e+00-8.3886080e+06i) 1.570796446004186170e0+1.6635532333438698084e1i) (num-test (acos 2.0e+00+0.0e+00i) 0+1.3169578969248167086e0i) (num-test (acos -2.0e+00+0.0e+00i) 3.1415926535897932385e0-1.3169578969248167086e0i) (num-test (acos 2.0e+00+1.19209289550781250e-07i) 6.8825515412047433504e-8-1.3169578969248194435e0i) (num-test (acos 2.0e+00-1.19209289550781250e-07i) 6.8825515412047433504e-8+1.3169578969248194435e0i) (num-test (acos -2.0e+00+1.19209289550781250e-07i) 3.1415925847642778264e0-1.3169578969248194435e0i) (num-test (acos -2.0e+00-1.19209289550781250e-07i) 3.1415925847642778264e0+1.3169578969248194435e0i) (num-test (acos 2.0e+00+5.0e-01i) 2.7775425655771396018e-1-1.3618009008578457882e0i) (num-test (acos 2.0e+00-5.0e-01i) 2.7775425655771396018e-1+1.3618009008578457882e0i) (num-test (acos -2.0e+00+5.0e-01i) 2.8638383970320792783e0-1.3618009008578457882e0i) (num-test (acos -2.0e+00-5.0e-01i) 2.8638383970320792783e0+1.3618009008578457882e0i) (num-test (acos 2.0e+00+1.0e+00i) 5.0735630321714456304e-1-1.4693517443681852733e0i) (num-test (acos 2.0e+00-1.0e+00i) 5.0735630321714456304e-1+1.4693517443681852733e0i) (num-test (acos -2.0e+00+1.0e+00i) 2.6342363503726486754e0-1.4693517443681852733e0i) (num-test (acos -2.0e+00-1.0e+00i) 2.6342363503726486754e0+1.4693517443681852733e0i) (num-test (acos 2.0e+00+2.0e+00i) 8.1654718209685057852e-1-1.7343245214879664480e0i) (num-test (acos 2.0e+00-2.0e+00i) 8.1654718209685057852e-1+1.7343245214879664480e0i) (num-test (acos -2.0e+00+2.0e+00i) 2.3250454714929426599e0-1.7343245214879664480e0i) (num-test (acos -2.0e+00-2.0e+00i) 2.3250454714929426599e0+1.7343245214879664480e0i) (num-test (acos 2.0e+00+8.3886080e+06i) 1.5707960883763175177e0-1.663553233343871940e1i) (num-test (acos 2.0e+00-8.3886080e+06i) 1.5707960883763175177e0+1.663553233343871940e1i) (num-test (acos -2.0e+00+8.3886080e+06i) 1.5707965652134757208e0-1.663553233343871940e1i) (num-test (acos -2.0e+00-8.3886080e+06i) 1.5707965652134757208e0+1.663553233343871940e1i) (num-test (acos 8.3886080e+06+0.0e+00i) 0+1.6635532333438683873e1i) (num-test (acos -8.3886080e+06+0.0e+00i) 3.1415926535897932385e0-1.6635532333438683873e1i) (num-test (acos 8.3886080e+06+1.19209289550781250e-07i) 1.4210854715202104692e-14-1.6635532333438683873e1i) (num-test (acos 8.3886080e+06-1.19209289550781250e-07i) 1.4210854715202104692e-14+1.6635532333438683873e1i) (num-test (acos -8.3886080e+06+1.19209289550781250e-07i) 3.1415926535897790276e0-1.6635532333438683873e1i) (num-test (acos -8.3886080e+06-1.19209289550781250e-07i) 3.1415926535897790276e0+1.6635532333438683873e1i) (num-test (acos 8.3886080e+06+5.0e-01i) 5.9604644775390977930e-8-1.6635532333438685650e1i) (num-test (acos 8.3886080e+06-5.0e-01i) 5.9604644775390977930e-8+1.6635532333438685650e1i) (num-test (acos -8.3886080e+06+5.0e-01i) 3.1415925939851484631e0-1.6635532333438685650e1i) (num-test (acos -8.3886080e+06-5.0e-01i) 3.1415925939851484631e0+1.6635532333438685650e1i) (num-test (acos 8.3886080e+06+1.0e+00i) 1.1920928955078153234e-7-1.6635532333438690979e1i) (num-test (acos 8.3886080e+06-1.0e+00i) 1.1920928955078153234e-7+1.6635532333438690979e1i) (num-test (acos -8.3886080e+06+1.0e+00i) 3.1415925343805036877e0-1.6635532333438690979e1i) (num-test (acos -8.3886080e+06-1.0e+00i) 3.1415925343805036877e0+1.6635532333438690979e1i) (num-test (acos 8.3886080e+06+2.0e+00i) 2.3841857910155967656e-7-1.6635532333438712295e1i) (num-test (acos 8.3886080e+06-2.0e+00i) 2.3841857910155967656e-7+1.6635532333438712295e1i) (num-test (acos -8.3886080e+06+2.0e+00i) 3.1415924151712141369e0-1.6635532333438712295e1i) (num-test (acos -8.3886080e+06-2.0e+00i) 3.1415924151712141369e0+1.6635532333438712295e1i) (num-test (acos 8.3886080e+06+8.3886080e+06i) 7.8539816339745008597e-1-1.6982105923718660081e1i) (num-test (acos 8.3886080e+06-8.3886080e+06i) 7.8539816339745008597e-1+1.6982105923718660081e1i) (num-test (acos -8.3886080e+06+8.3886080e+06i) 2.3561944901923431525e0-1.6982105923718660081e1i) (num-test (acos -8.3886080e+06-8.3886080e+06i) 2.3561944901923431525e0+1.6982105923718660081e1i) (num-test (acos -64983.97009220963-48983.30494825104i) 2.495679792792491+12.0i) (num-test (acos -2.225073858507201399999999999999999999996E-308) 1.570796326794896619231321691639751442098E0) (num-test (acos 1.110223024625156799999999999999999999997E-16) 1.570796326794896508209019229124071442098E0) (num-test (acos (/ (sqrt 2) 2)) (/ pi 4)) (num-test (acos (/ (sqrt 3) -2)) (- pi (/ pi 6))) (num-test (acos 1.00001) 0.0+0.004472132228240686i) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'acos num (acos num) val))) (vector (list 0 1.5707963267949) (list 1 0) (list 2 0+1.3169578969248i) (list 3 0+1.7627471740391i) (list -1 3.1415926535898) (list -2 3.1415926535898-1.3169578969248i) (list -3 3.1415926535898-1.7627471740391i) (list 9223372036854775807 0+44.361419555836i) (list -9223372036854775808 3.1415926535898-44.361419555836i) (list 1/2 1.0471975511966) (list 1/3 1.2309594173408) (list -1/2 2.0943951023932) (list -1/3 1.910633236249) (list 1/9223372036854775807 1.5707963267949) (list 0.0 1.5707963267949) (list 1.0 0.0) (list 2.0 0+1.3169578969248i) (list -2.0 3.1415926535898-1.3169578969248i) (list 1.000000000000000000000000000000000000002E-309 1.570796326794896619231321691639751442098E0) (list 1e+16 0+37.534508668465i) (list 0+1i 1.5707963267949-0.88137358701954i) (list 0+2i 1.5707963267949-1.4436354751788i) (list 0-1i 1.5707963267949+0.88137358701954i) (list 1+1i 0.90455689430238-1.061275061905i) (list 1-1i 0.90455689430238+1.061275061905i) (list -1+1i 2.2370357592874-1.061275061905i) (list -1-1i 2.2370357592874+1.061275061905i) (list 0.1+0.1i 1.4711326239351-0.10033029811221i) (list 1e+16+1e+16i 0.78539816339745-37.881082258745i) (list 1e-16+1e-16i 1.5707963267949-1.1102230246252e-16i) )) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x -10.0 (+ x .1))) ((= i 200)) (let ((y (magnitude (- x (cos (acos x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-12) (format #t ";(cos (acos ~A)) error: ~A~%" mx err))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x 1.0-i (+ x -0.1+0.1i))) ((= i 200)) (let ((y (magnitude (- x (cos (acos x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-10) (format #t ";(cos (acos ~A)) error: ~A~%" mx err))) (test (acos) 'error) (test (acos "hi") 'error) (test (acos 1.0+23.0i 1.0+23.0i) 'error) (test (acos 0 1) 'error) (for-each (lambda (arg) (test (acos arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((acoss (list ; table[Arccos[k/30], {k, 0, 30}] 1.57079632679489661923132169163975144209858469968755291048747229615390 1.53745681753359453223988681086891283292292532113625627655066835871028 1.50408017838467135968591658836938216800673525534100887774094632497961 1.47062890563333682288579851218705812352990872745792336909644844111750 1.43706473738495509057499836447665401198452971694311125503288353691013 1.40334824757520728867804708559611322118362753737131459002168499242061 1.36943840600456582777619613942212803185854661828532452423022105269829 1.33529209007409682793843720770251587561752235709223993234205546563727 1.30086353096149317480670670185123279844211132541734789265785186982011 1.26610367277949911125931873041222227514402466798077652309449434740743 1.23095941734077468213492917824798737571034000935509483905554833366399 1.19537271881385721554615623455760435715187934648129893552739216960977 1.15927948072740859984658379402241583724288356456052705870352551545381 1.12260819081546532929088412859068667091828551922412210328535011759677 1.08527820449930545595908733261492699446689960474554094922793682396904 1.04719755119659774615421446109316762806572313312503527365831486410260 1.00826008225104099949999603469121825039880976563585012769196847054621 0.96834169340990606798268790382508246937722069157058123211232815740883 0.92729521800161223242851246292242880405707410857224052762186617744039 0.88494336217618586326804097370954035732954766028628186644588911389624 0.84106867056793025577652503182643074670207878563983921977852280469208 0.79539883018414355549096833892476432854279596104639091688975233242118 0.74758434966902079779334463157739345981404639083611183363842437021388 0.69716313364223229572063988249255120236401774508773180005252393361250 0.64350110879328438680280922871732263804151059111531238286560611871351 0.58568554345715095961775753847751776620036106717164150265055932722126 0.52231482180604862252409882585570327600888093754313181958478744889757 0.45102681179626243254464463579435182620342251328425002811179043223947 0.36720802055783714250547291370122530624718492018835635003632767844945 0.25892154200622121576539021530016406277243818456467068559928913571945 0.00000000000000000000000000000000000000000000000000000000000000000000e0))) (do ((i 0 (+ i 1))) ((= i 30)) (let ((val (acos (bignum (/ i 30))))) (if (> (magnitude (- val (list-ref acoss i))) 1e-36) (format #t ";(acos ~A) -> ~A ~A~%[~A]~%" (/ i 30) val (list-ref acoss i) (magnitude (- val (list-ref acoss i)))))))))) ;;; -------------------------------------------------------------------------------- ;;; atan ;;; -------------------------------------------------------------------------------- (num-test (atan 0) 0.0) (num-test (atan 1) 0.78539816339745) (num-test (atan -1) -0.78539816339745) (num-test (atan 2) 1.10714871779409) (num-test (atan -2) -1.10714871779409) (num-test (atan 3) 1.24904577239825) (num-test (atan -3) -1.24904577239825) (num-test (atan 10) 1.47112767430373) (num-test (atan -10) -1.47112767430373) (num-test (atan 1234) 1.56998595420081) (num-test (atan -1234) -1.56998595420081) (num-test (atan 0/1) 0.0) (num-test (atan 0/2) 0.0) (num-test (atan 0/3) 0.0) (num-test (atan 0/10) 0.0) (num-test (atan 0/1234) 0.0) (num-test (atan 0/500029) 0.0) (num-test (atan 1/1) 0.78539816339745) (num-test (atan -1/1) -0.78539816339745) (num-test (atan 1/2) 0.46364760900081) (num-test (atan -1/2) -0.46364760900081) (num-test (atan 1/3) 0.32175055439664) (num-test (atan -1/3) -0.32175055439664) (num-test (atan 1/10) 0.09966865249116) (num-test (atan -1/10) -0.09966865249116) (num-test (atan 1/1234) 0.00081037259408) (num-test (atan -1/1234) -0.00081037259408) (num-test (atan 1/500029) 0.00000199988401) (num-test (atan -1/500029) -0.00000199988401) (num-test (atan 2/1) 1.10714871779409) (num-test (atan -2/1) -1.10714871779409) (num-test (atan 2/2) 0.78539816339745) (num-test (atan -2/2) -0.78539816339745) (num-test (atan 2/3) 0.58800260354757) (num-test (atan -2/3) -0.58800260354757) (num-test (atan 2/10) 0.19739555984988) (num-test (atan -2/10) -0.19739555984988) (num-test (atan 2/1234) 0.00162074412382) (num-test (atan -2/1234) -0.00162074412382) (num-test (atan 2/500029) 0.00000399976801) (num-test (atan -2/500029) -0.00000399976801) (num-test (atan 3/1) 1.24904577239825) (num-test (atan -3/1) -1.24904577239825) (num-test (atan 3/2) 0.98279372324733) (num-test (atan -3/2) -0.98279372324733) (num-test (atan 3/3) 0.78539816339745) (num-test (atan -3/3) -0.78539816339745) (num-test (atan 3/10) 0.29145679447787) (num-test (atan -3/10) -0.29145679447787) (num-test (atan 3/1234) 0.00243111352487) (num-test (atan -3/1234) -0.00243111352487) (num-test (atan 3/500029) 0.00000599965202) (num-test (atan -3/500029) -0.00000599965202) (num-test (atan 10/1) 1.47112767430373) (num-test (atan -10/1) -1.47112767430373) (num-test (atan 10/2) 1.37340076694502) (num-test (atan -10/2) -1.37340076694502) (num-test (atan 10/3) 1.27933953231703) (num-test (atan -10/3) -1.27933953231703) (num-test (atan 10/10) 0.78539816339745) (num-test (atan -10/10) -0.78539816339745) (num-test (atan 10/1234) 0.00810355033005) (num-test (atan -10/1234) -0.00810355033005) (num-test (atan 10/500029) 0.00001999884006) (num-test (atan -10/500029) -0.00001999884006) (num-test (atan 1234/1) 1.56998595420081) (num-test (atan -1234/1) -1.56998595420081) (num-test (atan 1234/2) 1.56917558267108) (num-test (atan -1234/2) -1.56917558267108) (num-test (atan 1234/3) 1.56836521327003) (num-test (atan -1234/3) -1.56836521327003) (num-test (atan 1234/10) 1.56269277646485) (num-test (atan -1234/10) -1.56269277646485) (num-test (atan 1234/500029) 0.00246785185431) (num-test (atan -1234/500029) -0.00246785185431) (num-test (atan 500029/2) 1.57079232702688) (num-test (atan -500029/2) -1.57079232702688) (num-test (atan 500029/3) 1.57079032714288) (num-test (atan -500029/3) -1.57079032714288) (num-test (atan 500029/10) 1.57077632795483) (num-test (atan -500029/10) -1.57077632795483) (num-test (atan 500029/1234) 1.56832847494059) (num-test (atan -500029/1234) -1.56832847494059) (num-test (atan 500029/500029) 0.78539816339745) (num-test (atan -500029/500029) -0.78539816339745) (num-test (atan 0.0) 0.0) (num-test (atan 0.00000001) 0.00000001) (num-test (atan -0.00000001) -0.00000001) (num-test (atan 1.0) 0.78539816339745) (num-test (atan -1.0) -0.78539816339745) (num-test (atan pi) 1.26262725567891) (num-test (atan -3.14159265358979) -1.26262725567891) (num-test (atan 1234.0) 1.56998595420081) (num-test (atan -1234.0) -1.56998595420081) (num-test (atan 0.0+0.0i) 0.0) (num-test (atan -0.0+0.0i) 0.0) (num-test (atan 0.0-0.0i) 0.0) (num-test (atan -0.0-0.0i) 0.0) (num-test (atan 0.0+0.00000001i) 0.0+0.00000001i) (num-test (atan -0.0+0.00000001i) 0.0+0.00000001i) (num-test (atan 0.0-0.00000001i) 0.0-0.00000001i) (num-test (atan -0.0-0.00000001i) -0.0-0.00000001i) (num-test (atan 0.0+3.14159265358979i) 1.57079632679490+0.32976531495670i) (num-test (atan -0.0+3.14159265358979i) 1.57079632679490+0.32976531495670i) (num-test (atan 0.0-3.14159265358979i) 1.57079632679490-0.32976531495670i) (num-test (atan -0.0-3.14159265358979i) -1.57079632679490-0.32976531495670i) (num-test (atan 0.0+1234.0i) 1.57079632679490+0.00081037294887i) (num-test (atan -0.0+1234.0i) 1.57079632679490+0.00081037294887i) (num-test (atan 0.0-1234.0i) 1.57079632679490-0.00081037294887i) (num-test (atan -0.0-1234.0i) -1.57079632679490-0.00081037294887i) (num-test (atan 0.00000001+0.0i) 0.00000001) (num-test (atan -0.00000001+0.0i) -0.00000001) (num-test (atan 0.00000001-0.0i) 0.00000001) (num-test (atan -0.00000001-0.0i) -0.00000001) (num-test (atan 0.00000001+0.00000001i) 0.00000001+0.00000001i) (num-test (atan -0.00000001+0.00000001i) -0.00000001+0.00000001i) (num-test (atan 0.00000001-0.00000001i) 0.00000001-0.00000001i) (num-test (atan -0.00000001-0.00000001i) -0.00000001-0.00000001i) (num-test (atan 0.00000001+1.0i) 0.78539816589789+9.55691396225616i) (num-test (atan -0.00000001+1.0i) -0.78539816589789+9.55691396225616i) (num-test (atan 0.00000001-1.0i) 0.78539816589789-9.55691396225616i) (num-test (atan -0.00000001-1.0i) -0.78539816589789-9.55691396225616i) (num-test (atan 0.00000001+3.14159265358979i) 1.57079632566745+0.32976531495670i) (num-test (atan -0.00000001+3.14159265358979i) -1.57079632566745+0.32976531495670i) (num-test (atan 0.00000001-3.14159265358979i) 1.57079632566745-0.32976531495670i) (num-test (atan -0.00000001-3.14159265358979i) -1.57079632566745-0.32976531495670i) (num-test (atan 0.00000001+1234.0i) 1.57079632679489+0.00081037294887i) (num-test (atan -0.00000001+1234.0i) -1.57079632679489+0.00081037294887i) (num-test (atan 0.00000001-1234.0i) 1.57079632679489-0.00081037294887i) (num-test (atan -0.00000001-1234.0i) -1.57079632679489-0.00081037294887i) (num-test (atan 1.0+0.0i) 0.78539816339745) (num-test (atan -1.0+0.0i) -0.78539816339745) (num-test (atan 1.0-0.0i) 0.78539816339745) (num-test (atan -1.0-0.0i) -0.78539816339745) (num-test (atan 1.0+0.00000001i) 0.78539816339745+0.00000000500000i) (num-test (atan -1.0+0.00000001i) -0.78539816339745+0.00000000500000i) (num-test (atan 1.0-0.00000001i) 0.78539816339745-0.00000000500000i) (num-test (atan -1.0-0.00000001i) -0.78539816339745-0.00000000500000i) (num-test (atan 1.0+1.0i) 1.01722196789785+0.40235947810853i) (num-test (atan -1.0+1.0i) -1.01722196789785+0.40235947810853i) (num-test (atan 1.0-1.0i) 1.01722196789785-0.40235947810853i) (num-test (atan -1.0-1.0i) -1.01722196789785-0.40235947810853i) (num-test (atan 1.0+3.14159265358979i) 1.47082882591946+0.29462144034086i) (num-test (atan -1.0+3.14159265358979i) -1.47082882591946+0.29462144034086i) (num-test (atan 1.0-3.14159265358979i) 1.47082882591946-0.29462144034086i) (num-test (atan -1.0-3.14159265358979i) -1.47082882591946-0.29462144034086i) (num-test (atan 1.0+1234.0i) 1.57079567009087+0.00081037241669i) (num-test (atan -1.0+1234.0i) -1.57079567009087+0.00081037241669i) (num-test (atan 1.0-1234.0i) 1.57079567009087-0.00081037241669i) (num-test (atan -1.0-1234.0i) -1.57079567009087-0.00081037241669i) (num-test (atan 3.14159265358979+0.0i) 1.26262725567891) (num-test (atan -3.14159265358979+0.0i) -1.26262725567891) (num-test (atan 3.14159265358979-0.0i) 1.26262725567891) (num-test (atan -3.14159265358979-0.0i) -1.26262725567891) (num-test (atan 3.14159265358979+0.00000001i) 1.26262725567891+0.00000000092000i) (num-test (atan -3.14159265358979+0.00000001i) -1.26262725567891+0.00000000092000i) (num-test (atan 3.14159265358979-0.00000001i) 1.26262725567891-0.00000000092000i) (num-test (atan -3.14159265358979-0.00000001i) -1.26262725567891-0.00000000092000i) (num-test (atan 3.14159265358979+1.0i) 1.28734057432439+0.08505998507745i) (num-test (atan -3.14159265358979+1.0i) -1.28734057432439+0.08505998507745i) (num-test (atan 3.14159265358979-1.0i) 1.28734057432439-0.08505998507745i) (num-test (atan -3.14159265358979-1.0i) -1.28734057432439-0.08505998507745i) (num-test (atan 3.14159265358979+3.14159265358979i) 1.40903828502376+0.15638868878130i) (num-test (atan -3.14159265358979+3.14159265358979i) -1.40903828502376+0.15638868878130i) (num-test (atan 3.14159265358979-3.14159265358979i) 1.40903828502376-0.15638868878130i) (num-test (atan -3.14159265358979-3.14159265358979i) -1.40903828502376-0.15638868878130i) (num-test (atan 3.14159265358979+1234.0i) 1.57079426371036+0.00081036769654i) (num-test (atan -3.14159265358979+1234.0i) -1.57079426371036+0.00081036769654i) (num-test (atan 3.14159265358979-1234.0i) 1.57079426371036-0.00081036769654i) (num-test (atan -3.14159265358979-1234.0i) -1.57079426371036-0.00081036769654i) (num-test (atan 1234.0+0.0i) 1.56998595420081) (num-test (atan -1234.0+0.0i) -1.56998595420081) (num-test (atan 1234.0-0.0i) 1.56998595420081) (num-test (atan -1234.0-0.0i) -1.56998595420081) (num-test (atan 1234.0+0.00000001i) 1.56998595420081+0.00000000000001i) (num-test (atan -1234.0+0.00000001i) -1.56998595420081+0.00000000000001i) (num-test (atan 1234.0-0.00000001i) 1.56998595420081-0.00000000000001i) (num-test (atan -1234.0-0.00000001i) -1.56998595420081-0.00000000000001i) (num-test (atan 1234.0+1.0i) 1.56998595473299+0.00000065670317i) (num-test (atan -1234.0+1.0i) -1.56998595473299+0.00000065670317i) (num-test (atan 1234.0-1.0i) 1.56998595473299-0.00000065670317i) (num-test (atan -1234.0-1.0i) -1.56998595473299-0.00000065670317i) (num-test (atan 1234.0+3.14159265358979i) 1.56998595945313+0.00000206308183i) (num-test (atan -1234.0+3.14159265358979i) -1.56998595945313+0.00000206308183i) (num-test (atan 1234.0-3.14159265358979i) 1.56998595945313-0.00000206308183i) (num-test (atan -1234.0-3.14159265358979i) -1.56998595945313-0.00000206308183i) (num-test (atan 1234.0+1234.0i) 1.57039114036481+0.00040518634139i) (num-test (atan -1234.0+1234.0i) -1.57039114036481+0.00040518634139i) (num-test (atan 1234.0-1234.0i) 1.57039114036481-0.00040518634139i) (num-test (atan -1234.0-1234.0i) -1.57039114036481-0.00040518634139i) (num-test (atan 6.9279836e-17) 6.9279836e-17) (num-test (atan 1.7976931e+308) 1.5707963267949) (num-test (atan 0 0) 0.0) (num-test (atan 0 1.0) 0.0) (num-test (atan 0 -1.0) pi) (num-test (atan 1.0 0) (/ pi 2)) (num-test (atan -1.0 0) (/ pi -2)) (num-test (atan 0.0 0.0) 0.0) (num-test (atan 0.0 0.00000001) 0.0) (num-test (atan 0.0 1.0) 0.0) (num-test (atan 0.0 pi) 0.0) (num-test (atan 0.0 1234.0) 0.0) (num-test (atan 0.00000001 0.0) 1.57079632679490) (num-test (atan 0.00000001 0.00000001) 0.78539816339745) (num-test (atan 0.00000001 1.0) 0.00000001) (num-test (atan 0.00000001 pi) 0.00000000318310) (num-test (atan 0.00000001 1234.0) 0.00000000000810) (num-test (atan 1.0 0.0) 1.57079632679490) (num-test (atan 1.0 0.00000001) 1.57079631679490) (num-test (atan 1.0 1.0) 0.78539816339745) (num-test (atan 1.0 pi) 0.30816907111598) (num-test (atan 1.0 1234.0) 0.00081037259408) (num-test (atan 3.14159265358979 0.0) 1.57079632679490) (num-test (atan 3.14159265358979 0.00000001) 1.57079632361180) (num-test (atan 3.14159265358979 1.0) 1.26262725567891) (num-test (atan 3.14159265358979 pi) 0.78539816339745) (num-test (atan 3.14159265358979 1234.0) 0.00254585564530) (num-test (atan 1234.0 0.0) 1.57079632679490) (num-test (atan 1234.0 0.00000001) 1.57079632678679) (num-test (atan 1234.0 1.0) 1.56998595420081) (num-test (atan 1234.0 pi) 1.56825047114960) (num-test (atan 1234.0 1234.0) 0.78539816339745) (num-test (atan 1) 0.7853981633974483) (num-test (atan 0.0e+00+0.0e+00i) 0e0) (num-test (atan 0.0e+00+1.19209289550781250e-07i) 0+1.1920928955078181469e-7i) (num-test (atan 0.0e+00-1.19209289550781250e-07i) 0-1.1920928955078181469e-7i) (num-test (atan 0.0e+00+5.0e-01i) 0+5.4930614433405484570e-1i) (num-test (atan 0.0e+00-5.0e-01i) 0-5.4930614433405484570e-1i) (num-test (atan 0.0e+00+2.0e+00i) 1.5707963267948966192e0+5.4930614433405484570e-1i) (num-test (atan 0.0e+00-2.0e+00i) -1.5707963267948966192e0-5.4930614433405484570e-1i) (num-test (atan 0.0e+00+8.3886080e+06i) 1.5707963267948966192e0+1.1920928955078181469e-7i) (num-test (atan 0.0e+00-8.3886080e+06i) -1.5707963267948966192e0-1.1920928955078181469e-7i) (num-test (atan 1.19209289550781250e-07+0.0e+00i) 1.1920928955078068531e-7) (num-test (atan -1.19209289550781250e-07+0.0e+00i) -1.1920928955078068531e-7) (num-test (atan 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078237938e-7+1.1920928955078012062e-7i) (num-test (atan 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078237938e-7-1.1920928955078012062e-7i) (num-test (atan -1.19209289550781250e-07+1.19209289550781250e-07i) -1.1920928955078237938e-7+1.1920928955078012062e-7i) (num-test (atan -1.19209289550781250e-07-1.19209289550781250e-07i) -1.1920928955078237938e-7-1.1920928955078012062e-7i) (num-test (atan 1.19209289550781250e-07+5.0e-01i) 1.5894571940103932425e-7+5.4930614433404221383e-1i) (num-test (atan 1.19209289550781250e-07-5.0e-01i) 1.5894571940103932425e-7-5.4930614433404221383e-1i) (num-test (atan -1.19209289550781250e-07+5.0e-01i) -1.5894571940103932425e-7+5.4930614433404221383e-1i) (num-test (atan -1.19209289550781250e-07-5.0e-01i) -1.5894571940103932425e-7-5.4930614433404221383e-1i) (num-test (atan 1.19209289550781250e-07+1.0e+00i) 7.8539819319977069731e-1+8.3177661667193446012e0i) (num-test (atan 1.19209289550781250e-07-1.0e+00i) 7.8539819319977069731e-1-8.3177661667193446012e0i) (num-test (atan -1.19209289550781250e-07+1.0e+00i) -7.8539819319977069731e-1+8.3177661667193446012e0i) (num-test (atan -1.19209289550781250e-07-1.0e+00i) -7.8539819319977069731e-1-8.3177661667193446012e0i) (num-test (atan 1.19209289550781250e-07+2.0e+00i) 1.5707962870584667690e0+5.4930614433405168773e-1i) (num-test (atan 1.19209289550781250e-07-2.0e+00i) 1.5707962870584667690e0-5.4930614433405168773e-1i) (num-test (atan -1.19209289550781250e-07+2.0e+00i) -1.5707962870584667690e0+5.4930614433405168773e-1i) (num-test (atan -1.19209289550781250e-07-2.0e+00i) -1.5707962870584667690e0-5.4930614433405168773e-1i) (num-test (atan 1.19209289550781250e-07+8.3886080e+06i) 1.5707963267948966192e0+1.1920928955078181469e-7i) (num-test (atan 1.19209289550781250e-07-8.3886080e+06i) 1.5707963267948966192e0-1.1920928955078181469e-7i) (num-test (atan -1.19209289550781250e-07+8.3886080e+06i) -1.5707963267948966192e0+1.1920928955078181469e-7i) (num-test (atan -1.19209289550781250e-07-8.3886080e+06i) -1.5707963267948966192e0-1.1920928955078181469e-7i) (num-test (atan 5.0e-01+0.0e+00i) 4.6364760900080611621e-1) (num-test (atan -5.0e-01+0.0e+00i) -4.6364760900080611621e-1) (num-test (atan 5.0e-01+1.19209289550781250e-07i) 4.6364760900081066369e-1+9.5367431640625072280e-8i) (num-test (atan 5.0e-01-1.19209289550781250e-07i) 4.6364760900081066369e-1-9.5367431640625072280e-8i) (num-test (atan -5.0e-01+1.19209289550781250e-07i) -4.6364760900081066369e-1+9.5367431640625072280e-8i) (num-test (atan -5.0e-01-1.19209289550781250e-07i) -4.6364760900081066369e-1-9.5367431640625072280e-8i) (num-test (atan 5.0e-01+5.0e-01i) 5.5357435889704525151e-1+4.0235947810852509365e-1i) (num-test (atan 5.0e-01-5.0e-01i) 5.5357435889704525151e-1-4.0235947810852509365e-1i) (num-test (atan -5.0e-01+5.0e-01i) -5.5357435889704525151e-1+4.0235947810852509365e-1i) (num-test (atan -5.0e-01-5.0e-01i) -5.5357435889704525151e-1-4.0235947810852509365e-1i) (num-test (atan 5.0e-01+1.0e+00i) 9.0788749496088038670e-1+7.0830333601405402006e-1i) (num-test (atan 5.0e-01-1.0e+00i) 9.0788749496088038670e-1-7.0830333601405402006e-1i) (num-test (atan -5.0e-01+1.0e+00i) -9.0788749496088038670e-1+7.0830333601405402006e-1i) (num-test (atan -5.0e-01-1.0e+00i) -9.0788749496088038670e-1-7.0830333601405402006e-1i) (num-test (atan 5.0e-01+2.0e+00i) 1.4215468610018069803e0+5.0037000005253101744e-1i) (num-test (atan 5.0e-01-2.0e+00i) 1.4215468610018069803e0-5.0037000005253101744e-1i) (num-test (atan -5.0e-01+2.0e+00i) -1.4215468610018069803e0+5.0037000005253101744e-1i) (num-test (atan -5.0e-01-2.0e+00i) -1.4215468610018069803e0-5.0037000005253101744e-1i) (num-test (atan 5.0e-01+8.3886080e+06i) 1.5707963267948895138e0+1.1920928955078139117e-7i) (num-test (atan 5.0e-01-8.3886080e+06i) 1.5707963267948895138e0-1.1920928955078139117e-7i) (num-test (atan -5.0e-01+8.3886080e+06i) -1.5707963267948895138e0+1.1920928955078139117e-7i) (num-test (atan -5.0e-01-8.3886080e+06i) -1.5707963267948895138e0-1.1920928955078139117e-7i) (num-test (atan 1.0e+00+0.0e+00i) 7.8539816339744830962e-1) (num-test (atan -1.0e+00+0.0e+00i) -7.8539816339744830962e-1) (num-test (atan 1.0e+00+1.19209289550781250e-07i) 7.8539816339745186233e-1+5.9604644775390483828e-8i) (num-test (atan 1.0e+00-1.19209289550781250e-07i) 7.8539816339745186233e-1-5.9604644775390483828e-8i) (num-test (atan -1.0e+00+1.19209289550781250e-07i) -7.8539816339745186233e-1+5.9604644775390483828e-8i) (num-test (atan -1.0e+00-1.19209289550781250e-07i) -7.8539816339745186233e-1-5.9604644775390483828e-8i) (num-test (atan 1.0e+00+5.0e-01i) 8.4757566067082902713e-1+2.3887786125685909036e-1i) (num-test (atan 1.0e+00-5.0e-01i) 8.4757566067082902713e-1-2.3887786125685909036e-1i) (num-test (atan -1.0e+00+5.0e-01i) -8.4757566067082902713e-1+2.3887786125685909036e-1i) (num-test (atan -1.0e+00-5.0e-01i) -8.4757566067082902713e-1-2.3887786125685909036e-1i) (num-test (atan 1.0e+00+1.0e+00i) 1.0172219678978513677e0+4.0235947810852509365e-1i) (num-test (atan 1.0e+00-1.0e+00i) 1.0172219678978513677e0-4.0235947810852509365e-1i) (num-test (atan -1.0e+00+1.0e+00i) -1.0172219678978513677e0+4.0235947810852509365e-1i) (num-test (atan -1.0e+00-1.0e+00i) -1.0172219678978513677e0-4.0235947810852509365e-1i) (num-test (atan 1.0e+00+2.0e+00i) 1.3389725222944935611e0+4.0235947810852509365e-1i) (num-test (atan 1.0e+00-2.0e+00i) 1.3389725222944935611e0-4.0235947810852509365e-1i) (num-test (atan -1.0e+00+2.0e+00i) -1.3389725222944935611e0+4.0235947810852509365e-1i) (num-test (atan -1.0e+00-2.0e+00i) -1.3389725222944935611e0-4.0235947810852509365e-1i) (num-test (atan 1.0e+00+8.3886080e+06i) 1.5707963267948824084e0+1.1920928955078012062e-7i) (num-test (atan 1.0e+00-8.3886080e+06i) 1.5707963267948824084e0-1.1920928955078012062e-7i) (num-test (atan -1.0e+00+8.3886080e+06i) -1.5707963267948824084e0+1.1920928955078012062e-7i) (num-test (atan -1.0e+00-8.3886080e+06i) -1.5707963267948824084e0-1.1920928955078012062e-7i) (num-test (atan 2.0e+00+0.0e+00i) 1.1071487177940905030e0) (num-test (atan -2.0e+00+0.0e+00i) -1.1071487177940905030e0) (num-test (atan 2.0e+00+1.19209289550781250e-07i) 1.1071487177940916399e0+2.3841857910156200307e-8i) (num-test (atan 2.0e+00-1.19209289550781250e-07i) 1.1071487177940916399e0-2.3841857910156200307e-8i) (num-test (atan -2.0e+00+1.19209289550781250e-07i) -1.1071487177940916399e0+2.3841857910156200307e-8i) (num-test (atan -2.0e+00-1.19209289550781250e-07i) -1.1071487177940916399e0-2.3841857910156200307e-8i) (num-test (atan 2.0e+00+5.0e-01i) 1.1265564408348223487e0+9.6415620202996167238e-2i) (num-test (atan 2.0e+00-5.0e-01i) 1.1265564408348223487e0-9.6415620202996167238e-2i) (num-test (atan -2.0e+00+5.0e-01i) -1.1265564408348223487e0+9.6415620202996167238e-2i) (num-test (atan -2.0e+00-5.0e-01i) -1.1265564408348223487e0-9.6415620202996167238e-2i) (num-test (atan 2.0e+00+1.0e+00i) 1.1780972450961724644e0+1.7328679513998632735e-1i) (num-test (atan 2.0e+00-1.0e+00i) 1.1780972450961724644e0-1.7328679513998632735e-1i) (num-test (atan -2.0e+00+1.0e+00i) -1.1780972450961724644e0+1.7328679513998632735e-1i) (num-test (atan -2.0e+00-1.0e+00i) -1.1780972450961724644e0-1.7328679513998632735e-1i) (num-test (atan 2.0e+00+2.0e+00i) 1.3112232696716351433e0+2.3887786125685909036e-1i) (num-test (atan 2.0e+00-2.0e+00i) 1.3112232696716351433e0-2.3887786125685909036e-1i) (num-test (atan -2.0e+00+2.0e+00i) -1.3112232696716351433e0+2.3887786125685909036e-1i) (num-test (atan -2.0e+00-2.0e+00i) -1.3112232696716351433e0-2.3887786125685909036e-1i) (num-test (atan 2.0e+00+8.3886080e+06i) 1.5707963267948681975e0+1.1920928955077503843e-7i) (num-test (atan 2.0e+00-8.3886080e+06i) 1.5707963267948681975e0-1.1920928955077503843e-7i) (num-test (atan -2.0e+00+8.3886080e+06i) -1.5707963267948681975e0+1.1920928955077503843e-7i) (num-test (atan -2.0e+00-8.3886080e+06i) -1.5707963267948681975e0-1.1920928955077503843e-7i) (num-test (atan 8.3886080e+06+0.0e+00i) 1.5707962075856070685e0) (num-test (atan -8.3886080e+06+0.0e+00i) -1.5707962075856070685e0) (num-test (atan 8.3886080e+06+1.19209289550781250e-07i) 1.5707962075856070685e0+1.6940658945085766040e-21i) (num-test (atan 8.3886080e+06-1.19209289550781250e-07i) 1.5707962075856070685e0-1.6940658945085766040e-21i) (num-test (atan -8.3886080e+06+1.19209289550781250e-07i) -1.5707962075856070685e0+1.6940658945085766040e-21i) (num-test (atan -8.3886080e+06-1.19209289550781250e-07i) -1.5707962075856070685e0-1.6940658945085766040e-21i) (num-test (atan 8.3886080e+06+5.0e-01i) 1.5707962075856070685e0+7.1054273576008756410e-15i) (num-test (atan 8.3886080e+06-5.0e-01i) 1.5707962075856070685e0-7.1054273576008756410e-15i) (num-test (atan -8.3886080e+06+5.0e-01i) -1.5707962075856070685e0+7.1054273576008756410e-15i) (num-test (atan -8.3886080e+06-5.0e-01i) -1.5707962075856070685e0-7.1054273576008756410e-15i) (num-test (atan 8.3886080e+06+1.0e+00i) 1.5707962075856070685e0+1.4210854715201599821e-14i) (num-test (atan 8.3886080e+06-1.0e+00i) 1.5707962075856070685e0-1.4210854715201599821e-14i) (num-test (atan -8.3886080e+06+1.0e+00i) -1.5707962075856070685e0+1.4210854715201599821e-14i) (num-test (atan -8.3886080e+06-1.0e+00i) -1.5707962075856070685e0-1.4210854715201599821e-14i) (num-test (atan 8.3886080e+06+2.0e+00i) 1.5707962075856070685e0+2.8421709430401987951e-14i) (num-test (atan 8.3886080e+06-2.0e+00i) 1.5707962075856070685e0-2.8421709430401987951e-14i) (num-test (atan -8.3886080e+06+2.0e+00i) -1.5707962075856070685e0+2.8421709430401987951e-14i) (num-test (atan -8.3886080e+06-2.0e+00i) -1.5707962075856070685e0-2.8421709430401987951e-14i) (num-test (atan 8.3886080e+06+8.3886080e+06i) 1.5707962671902518438e0+5.9604644775390483828e-8i) (num-test (atan 8.3886080e+06-8.3886080e+06i) 1.5707962671902518438e0-5.9604644775390483828e-8i) (num-test (atan -8.3886080e+06+8.3886080e+06i) -1.5707962671902518438e0+5.9604644775390483828e-8i) (num-test (atan -8.3886080e+06-8.3886080e+06i) -1.5707962671902518438e0-5.9604644775390483828e-8i) (num-test (atan -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (atan 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999995438476E-16) (num-test (/ pi 2) (+ (* 2 (atan (/ (sqrt 2)))) (atan (/ (sqrt 8))))) (num-test (/ pi 4) (+ (* 12 (atan (/ 18))) (* 8 (atan (/ 57))) (* -5 (atan (/ 239))))) (num-test (/ pi 4) (+ (* 2 (atan 1/3)) (atan 1/7))) (num-test (/ pi 4) (+ (* 5 (atan 1/7)) (* 2 (atan 3/79)))) (num-test (/ pi 4) (+ (atan 1/2) (atan 1/3))) (num-test (/ pi 4) (- (* 2 (atan 1/2)) (atan 1/7))) (num-test (/ pi 4) (- (* 4 (atan (/ 1 5))) (atan (/ 1 239)))) (num-test (* 4 (+ (* 3 (atan 1/4)) (atan 1/20) (atan 1/1985))) pi) (num-test (+ (* 176 (atan (/ 57))) (* 28 (atan (/ 239))) (* -48 (atan (/ 682))) (* 96 (atan (/ 12943)))) pi) (num-test (+ (* 2 (atan (/ (sqrt 2)))) (atan (/ (sqrt 8)))) (/ pi 2)) (num-test (+ (* 48 (atan (/ 49))) (* 128 (atan (/ 57))) (* -20 (atan (/ 239))) (* 48 (atan (/ 110443)))) pi) (num-test (/ (+ (atan (/ 239)) (atan (/ 70)) (- (atan (/ 99)))) 2) (+ (atan (/ 408)) (atan (/ 577)))) (num-test (atan (/ -1 (sqrt 3))) (/ pi -6)) (num-test (atan (sqrt 3)) (/ pi 3)) (num-test (atan 1/2 1/2) 0.78539816339745) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'atan num (atan num) val))) (vector (list 0 0) (list 1 0.78539816339745) (list 2 1.1071487177941) (list 3 1.2490457723983) (list -1 -0.78539816339745) (list -2 -1.1071487177941) (list -3 -1.2490457723983) (list 9223372036854775807 1.5707963267949) (list -9223372036854775808 -1.5707963267949) (list 1/2 0.46364760900081) (list 1/3 0.32175055439664) (list -1/2 -0.46364760900081) (list -1/3 -0.32175055439664) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 0.78539816339745) (list 2.0 1.1071487177941) (list -2.0 -1.1071487177941) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 1e+16 1.5707963267949) (list +inf.0 1.5707963267949) (list -inf.0 -1.5707963267949) (list 0+2i 1.5707963267949+0.54930614433405i) (list 1+1i 1.0172219678979+0.40235947810853i) (list 1-1i 1.0172219678979-0.40235947810853i) (list -1+1i -1.0172219678979+0.40235947810853i) (list -1-1i -1.0172219678979-0.40235947810853i) (list 0.1+0.1i 0.10065855418732+0.099325449367251i) (list 1e+16+1e+16i 1.5707963267949+5.5511151231258e-17i) (list 1e-16+1e-16i 1e-16+1.1102230246252e-16i) )) ;; the x=0 cases are errors in clisp (num-test (atan 0 0.0) 0.0) (num-test (atan 0 1) 0.0) (num-test (atan 0 -1) pi) (num-test (atan 0 2) 0.0) (num-test (atan 0 -2) pi) (num-test (atan 0 1.5) 0.0) (num-test (atan 0 -1.5) pi) (num-test (atan 0 3.0) 0.0) (num-test (atan 0 -3.0) pi) (num-test (atan 0 4.0) 0.0) (num-test (atan 0 -4.0) pi) (num-test (atan 0 pi) 0.0) (num-test (atan 0 (- pi)) pi) (num-test (atan 0.0 0) 0.0) (num-test (atan 0.0 1) 0.0) (num-test (atan 0.0 -1) pi) (num-test (atan 0.0 2) 0.0) (num-test (atan 0.0 -2) pi) (num-test (atan 0.0 1.5) 0.0) (num-test (atan 0.0 -1.5) pi) (num-test (atan 0.0 3.0) 0.0) (num-test (atan 0.0 -3.0) pi) (num-test (atan 0.0 4.0) 0.0) (num-test (atan 0.0 -4.0) pi) (num-test (atan 0.0 (- pi)) pi) (num-test (atan 1 0) 1.5707963267949) (num-test (atan 1 0.0) 1.5707963267949) (num-test (atan 1 1) 0.78539816339745) (num-test (atan 1 -1) 2.3561944901923) (num-test (atan 1 2) 0.46364760900081) (num-test (atan 1 -2) 2.677945044589) (num-test (atan 1 1.5) 0.58800260354757) (num-test (atan 1 -1.5) 2.5535900500422) (num-test (atan 1 3.0) 0.32175055439664) (num-test (atan 1 -3.0) 2.8198420991932) (num-test (atan 1 4.0) 0.24497866312686) (num-test (atan 1 -4.0) 2.8966139904629) (num-test (atan 1 pi) 3.081690711159849357869996080340530985905E-1) (num-test (atan 1 (- pi)) 2.833423582473808302675643775245449785612E0) (num-test (atan -1 0) -1.5707963267949) (num-test (atan -1 0.0) -1.5707963267949) (num-test (atan -1 1) -0.78539816339745) (num-test (atan -1 -1) -2.3561944901923) (num-test (atan -1 2) -0.46364760900081) (num-test (atan -1 -2) -2.677945044589) (num-test (atan -1 1.5) -0.58800260354757) (num-test (atan -1 -1.5) -2.5535900500422) (num-test (atan -1 3.0) -0.32175055439664) (num-test (atan -1 -3.0) -2.8198420991932) (num-test (atan -1 4.0) -0.24497866312686) (num-test (atan -1 -4.0) -2.8966139904629) (num-test (atan -1 pi) -3.081690711159849357869996080340530985905E-1) (num-test (atan -1 (- pi)) -2.833423582473808302675643775245449785612E0) (num-test (atan 2 0) 1.5707963267949) (num-test (atan 2 0.0) 1.5707963267949) (num-test (atan 2 1) 1.1071487177941) (num-test (atan 2 -1) 2.0344439357957) (num-test (atan 2 2) 0.78539816339745) (num-test (atan 2 -2) 2.3561944901923) (num-test (atan 2 1.5) 0.92729521800161) (num-test (atan 2 -1.5) 2.2142974355882) (num-test (atan 2 3.0) 0.58800260354757) (num-test (atan 2 -3.0) 2.5535900500422) (num-test (atan 2 4.0) 0.46364760900081) (num-test (atan 2 -4.0) 2.677945044589) (num-test (atan 2 pi) 5.669115049410094050828977467226191538068E-1) (num-test (atan 2 (- pi)) 2.574681148648783833379745636556883730391E0) (num-test (atan -2 0) -1.5707963267949) (num-test (atan -2 0.0) -1.5707963267949) (num-test (atan -2 1) -1.1071487177941) (num-test (atan -2 -1) -2.0344439357957) (num-test (atan -2 2) -0.78539816339745) (num-test (atan -2 -2) -2.3561944901923) (num-test (atan -2 1.5) -0.92729521800161) (num-test (atan -2 -1.5) -2.2142974355882) (num-test (atan -2 3.0) -0.58800260354757) (num-test (atan -2 -3.0) -2.5535900500422) (num-test (atan -2 4.0) -0.46364760900081) (num-test (atan -2 -4.0) -2.677945044589) (num-test (atan -2 pi) -5.669115049410094050828977467226191538068E-1) (num-test (atan -2 (- pi)) -2.574681148648783833379745636556883730391E0) (num-test (atan 1.5 0) 1.5707963267949) (num-test (atan 1.5 0.0) 1.5707963267949) (num-test (atan 1.5 1) 0.98279372324733) (num-test (atan 1.5 -1) 2.1587989303425) (num-test (atan 1.5 2) 0.64350110879328) (num-test (atan 1.5 -2) 2.4980915447965) (num-test (atan 1.5 1.5) 0.78539816339745) (num-test (atan 1.5 -1.5) 2.3561944901923) (num-test (atan 1.5 3.0) 0.46364760900081) (num-test (atan 1.5 -3.0) 2.677945044589) (num-test (atan 1.5 4.0) 0.35877067027057) (num-test (atan 1.5 -4.0) 2.7828219833192) (num-test (atan 1.5 pi) 4.454574939105981596935303215574368401686E-1) (num-test (atan 1.5 (- pi)) 2.696135159679195078769113061722066044025E0) (num-test (atan -1.5 0) -1.5707963267949) (num-test (atan -1.5 0.0) -1.5707963267949) (num-test (atan -1.5 1) -0.98279372324733) (num-test (atan -1.5 -1) -2.1587989303425) (num-test (atan -1.5 2) -0.64350110879328) (num-test (atan -1.5 -2) -2.4980915447965) (num-test (atan -1.5 1.5) -0.78539816339745) (num-test (atan -1.5 -1.5) -2.3561944901923) (num-test (atan -1.5 3.0) -0.46364760900081) (num-test (atan -1.5 -3.0) -2.677945044589) (num-test (atan -1.5 4.0) -0.35877067027057) (num-test (atan -1.5 -4.0) -2.7828219833192) (num-test (atan -1.5 pi) -4.454574939105981596935303215574368401686E-1) (num-test (atan -1.5 (- pi)) -2.696135159679195078769113061722066044025E0) (num-test (atan 3.0 0) 1.5707963267949) (num-test (atan 3.0 0.0) 1.5707963267949) (num-test (atan 3.0 1) 1.2490457723983) (num-test (atan 3.0 -1) 1.8925468811915) (num-test (atan 3.0 2) 0.98279372324733) (num-test (atan 3.0 -2) 2.1587989303425) (num-test (atan 3.0 1.5) 1.1071487177941) (num-test (atan 3.0 -1.5) 2.0344439357957) (num-test (atan 3.0 3.0) 0.78539816339745) (num-test (atan 3.0 -3.0) 2.3561944901923) (num-test (atan 3.0 4.0) 0.64350110879328) (num-test (atan 3.0 -4.0) 2.4980915447965) (num-test (atan 3.0 pi) 7.623475341648745879175385302461797760774E-1) (num-test (atan 3.0 (- pi)) 2.379245119424918650545104853033323108118E0) (num-test (atan -3.0 0) -1.5707963267949) (num-test (atan -3.0 0.0) -1.5707963267949) (num-test (atan -3.0 1) -1.2490457723983) (num-test (atan -3.0 -1) -1.8925468811915) (num-test (atan -3.0 2) -0.98279372324733) (num-test (atan -3.0 -2) -2.1587989303425) (num-test (atan -3.0 1.5) -1.1071487177941) (num-test (atan -3.0 -1.5) -2.0344439357957) (num-test (atan -3.0 3.0) -0.78539816339745) (num-test (atan -3.0 -3.0) -2.3561944901923) (num-test (atan -3.0 4.0) -0.64350110879328) (num-test (atan -3.0 -4.0) -2.4980915447965) (num-test (atan -3.0 pi) -7.623475341648745879175385302461797760774E-1) (num-test (atan -3.0 (- pi)) -2.379245119424918650545104853033323108118E0) (num-test (atan 4.0 0) 1.5707963267949) (num-test (atan 4.0 0.0) 1.5707963267949) (num-test (atan 4.0 1) 1.325817663668) (num-test (atan 4.0 -1) 1.8157749899218) (num-test (atan 4.0 2) 1.1071487177941) (num-test (atan 4.0 -2) 2.0344439357957) (num-test (atan 4.0 1.5) 1.2120256565243) (num-test (atan 4.0 -1.5) 1.9295669970655) (num-test (atan 4.0 3.0) 0.92729521800161) (num-test (atan 4.0 -3.0) 2.2142974355882) (num-test (atan 4.0 4.0) 0.78539816339745) (num-test (atan 4.0 -4.0) 2.3561944901923) (num-test (atan 4.0 pi) 9.050225767665427556408039831275762329032E-1) (num-test (atan 4.0 (- pi)) 2.236570076823250482821839400151926651295E0) (num-test (atan -4.0 0) -1.5707963267949) (num-test (atan -4.0 0.0) -1.5707963267949) (num-test (atan -4.0 1) -1.325817663668) (num-test (atan -4.0 -1) -1.8157749899218) (num-test (atan -4.0 2) -1.1071487177941) (num-test (atan -4.0 -2) -2.0344439357957) (num-test (atan -4.0 1.5) -1.2120256565243) (num-test (atan -4.0 -1.5) -1.9295669970655) (num-test (atan -4.0 3.0) -0.92729521800161) (num-test (atan -4.0 -3.0) -2.2142974355882) (num-test (atan -4.0 4.0) -0.78539816339745) (num-test (atan -4.0 -4.0) -2.3561944901923) (num-test (atan -4.0 pi) -9.050225767665427556408039831275762329032E-1) (num-test (atan -4.0 (- pi)) -2.236570076823250482821839400151926651295E0) (num-test (atan pi 0) 1.570796326794896619231321691639751442098E0) (num-test (atan pi 0.0) 1.570796326794896619231321691639751442098E0) (num-test (atan pi 1) 1.262627255678911683444322083605698343509E0) (num-test (atan pi -1) 1.878965397910881555018321299673804540687E0) (num-test (atan pi 2) 1.003884821853887214148423944917132288294E0) (num-test (atan pi -2) 2.137707831735906024314219438362370595907E0) (num-test (atan pi 1.5) 1.125338832884298459537791370082314601928E0) (num-test (atan pi -1.5) 2.016253820705494778924852013197188282274E0) (num-test (atan pi 3.0) 8.084487926300220313137831613935716660202E-1) (num-test (atan pi -3.0) 2.333143860959771207148860221885931218181E0) (num-test (atan pi 4.0) 6.657737500283538635905177085121752091944E-1) (num-test (atan pi -4.0) 2.475818903561439374872125674767327675004E0) (num-test (atan pi pi) 7.853981633974483096156608458198757210488E-1) (num-test (atan pi (- pi)) 2.356194490192344928846982537459627163149E0) (num-test (atan (- pi) 0) -1.570796326794896619231321691639751442098E0) (num-test (atan (- pi) 0.0) -1.570796326794896619231321691639751442098E0) (num-test (atan (- pi) 1) -1.262627255678911683444322083605698343509E0) (num-test (atan (- pi) -1) -1.878965397910881555018321299673804540687E0) (num-test (atan (- pi) 2) -1.003884821853887214148423944917132288294E0) (num-test (atan (- pi) -2) -2.137707831735906024314219438362370595907E0) (num-test (atan (- pi) 1.5) -1.125338832884298459537791370082314601928E0) (num-test (atan (- pi) -1.5) -2.016253820705494778924852013197188282274E0) (num-test (atan (- pi) 3.0) -8.084487926300220313137831613935716660202E-1) (num-test (atan (- pi) -3.0) -2.333143860959771207148860221885931218181E0) (num-test (atan (- pi) 4.0) -6.657737500283538635905177085121752091944E-1) (num-test (atan (- pi) -4.0) -2.475818903561439374872125674767327675004E0) (num-test (atan (- pi) pi) -7.853981633974483096156608458198757210488E-1) (num-test (atan (- pi) (- pi)) -2.356194490192344928846982537459627163149E0) (num-test (atan 3037000500 1/3037000500) 1.570796326794896619122901474392911039606E0) (num-test (atan most-positive-fixnum) 1.570796326794896619122901474391200998685E0) (num-test (atan 1/3037000500 3037000500) 1.084202172468404024919078833314741441372E-19) (test (atan) 'error) (test (atan "hi") 'error) (test (atan 1.0+23.0i 1.0+23.0i) 'error) (test (atan 0 1 2) 'error) (test (atan 0 0-i) 'error) (test (atan 1+i 0-i) 'error) (test (atan 1 0-i) 'error) (for-each (lambda (arg) (test (atan arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (arg) (test (atan arg +nan.0) 'error) (test (atan +nan.0 arg) 'error) (test (atan arg +inf.0) 'error) (test (atan +inf.0 arg) 'error) (test (atan 1 arg) 'error) (test (atan 1.0 arg) 'error) (test (atan 1/2 arg) 'error) (test (atan 1+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (arg) (test (atan arg 1) 'error) (test (atan arg 1/2) 'error) (test (atan arg 1.0) 'error) (test (atan arg 1+i) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (let ((formulas '((1/4 (1 1)) (1/4 (1 2) (1 3)) (1/4 (2 2) (-1 7)) (1/4 (2 3) (1 7)) (1/4 (4 5) (-1 239)) (1/4 (1 2) (1 4) (1 13)) (1/4 (1 2) (1 5) (1 8)) (1/4 (1 2) (2 6) (-1 117)) (1/4 (1 3) (2 4) (-1 38)) (1/4 (2 2) (-2 12) (1 41)) (1/4 (2 2) (-2 14) (1 1393)) (1/4 (2 2) (-2 17) (-1 41)) (1/4 (2 2) (-1 5) (1 18)) (1/4 (2 2) (-1 6) (1 43)) (1/4 (2 2) (-1 8) (-1 57)) (1/4 (2 2) (-1 9) (-1 32)) (1/4 (2 2) (-1 12) (-1 17)) (1/4 (2 3) (1 5) (-1 18)) (1/4 (2 3) (1 6) (-1 43)) (1/4 (2 3) (1 8) (1 57)) (1/4 (2 3) (1 9) (1 32)) (1/4 (2 3) (1 12) (1 17)) (1/4 (2 3) (2 12) (-1 41)) (1/4 (2 3) (2 14) (-1 1393)) (1/4 (2 3) (2 17) (1 41)) (1/4 (2 4) (1 7) (2 13)) (1/4 (2 5) (1 7) (2 8)) (1/4 (2 5) (3 7) (-2 57)) (1/4 (2 5) (3 8) (1 57)) (1/4 (2 6) (3 7) (2 68)) (1/4 (2 7) (4 8) (1 239)) (1/4 (3 3) (-2 11) (1 682)) (1/4 (3 3) (-2 13) (-1 38)) (1/4 (3 3) (-1 5) (1 57)) (1/4 (3 3) (-1 6) (-1 68)) (1/4 (3 3) (-1 8) (-1 18)) (1/4 (3 4) (1 13) (-1 38)) (1/4 (3 4) (1 20) (1 1985)) (1/4 (3 5) (2 8) (-1 18)) (1/4 (3 7) (2 8) (2 18)) (1/4 (3 7) (4 11) (-2 682)) (1/4 (3 7) (4 13) (2 38)) (1/4 (4 3) (-4 8) (-1 239)) (1/4 (4 4) (-1 7) (-2 38)) (1/4 (4 4) (-4 21) (-1 239)) (1/4 (4 5) (-2 408) (1 1393)) (1/4 (4 5) (-2 478) (1 54608393)) (1/4 (4 5) (-2 577) (-1 1393)) (1/4 (4 5) (-1 41) (2 99)) (1/4 (4 5) (-1 70) (1 99)) (1/4 (4 5) (-1 213) (1 1958)) (1/4 (4 5) (-1 226) (1 4155)) (1/4 (4 5) (-1 237) (1 28322)) (1/4 (4 5) (-1 238) (1 56883)) (1/4 (4 5) (-1 240) (-1 57361)) (1/4 (4 5) (-1 241) (-1 28800)) (1/4 (4 5) (-1 252) (-1 4633)) (1/4 (4 5) (-1 265) (-1 2436)) (1/4 (4 5) (-1 408) (-1 577)) (1/4 (4 5) (1 41) (-2 70)) (1/4 (4 6) (1 7) (-2 117)) (1/4 (4 6) (4 31) (-1 239)) (1/4 (4 7) (4 18) (-1 239)) (1/4 (5 5) (-3 18) (-2 57)) (1/4 (5 6) (-1 43) (-2 117)) (1/4 (5 6) (-1 68) (-3 117)) (1/4 (-29 239) (256 378) (200 829) (244 882) (-388 993) (324 2943) (-144 18543)) (1/4 (-4 307) (394 577) (163 1393) (-12 12238) (-24 58911) (-68 1999509) (-68 11653127)) (1/4 (7 10) (2 50) (4 100) (1 682) (4 1000) (3 1303) (-4 90109)) (1/4 (7 10) (8 100) (1 682) (4 1000) (3 1303) (-4 90109) (-2 500150)) (1/4 (12 18) (8 307) (46 577) (19 1393) (-8 2827807) (-16 11653127) (-8 16480443)) (1/4 (17 23) (11 882) (24 931) (10 1143) (-2 34208) (-8 44179) (-13 485298)) (1/4 (29 268) (198 378) (142 829) (186 882) (-301 993) (237 2943) (-115 18543)) (1/4 (43 57) (22 746) (-2 1568) (1 4662) (28 12943) (14 32807) (11 157318)) (1/4 (44 515) (95 538) (127 682) (176 782) (95 1068) (88 4030) (17 12943)) (1/4 (76 682) (190 746) (271 882) (315 2917) (-132 9466) (295 12943) (-95 19703)) (1/4 (83 107) (17 4443) (68 11343) (-5 113568) (-34 595667) (-5 23481902) (5 168925949733307)) (1/4 (83 107) (17 4443) (68 11343) (-5 111693) (-34 595667) (5 9503057) (5 232633636378307)) (1/4 (95 418) (171 682) (176 882) (315 2917) (-132 9466) (105 12943) (95 16693)) (1/4 (100 437) (254 577) (127 1393) (44 2072) (24 2943) (-12 16432) (-100 28800)) (1/4 (122 162) (22 568) (-29 1432) (83 5087) (-7 6107) (-10 27493) (-29 30027)) (1/4 (122 183) (108 1177) (29 1393) (22 4443) (54 5087) (-64 7078) (-10 27493)) (1/4 (122 418) (237 557) (29 1068) (144 3458) (-61 5087) (122 16452) (105 27493)) (1/4 (127 239) (100 343) (-56 2072) (-76 2943) (100 7983) (-12 16432) (100 28322)) (1/4 (127 239) (212 1068) (-144 2072) (188 2309) (-200 6105) (376 6807) (288 13637)) (1/4 (127 239) (400 1068) (44 2072) (-376 2943) (-200 6105) (100 13637) (188 16432)) (1/4 (127 682) (227 788) (227 843) (44 2072) (51 2943) (-27 12943) (88 16432)) (1/4 (127 682) (454 818) (271 1303) (-403 2943) (-44 6118) (-254 12943) (-183 3014557)) (1/4 (171 239) (68 788) (-56 1744) (36 2943) (44 6613) (-112 13603) (144 28322)) (1/4 (171 239) (68 993) (-20 2943) (56 4443) (-44 13252) (-112 17088) (156 28322)) (1/4 (171 239) (124 993) (-56 1252) (56 2855) (-76 2943) (-100 13252) (100 28322)) (1/4 (171 682) (183 788) (227 843) (95 2943) (44 6613) (-115 12943) (88 28322)) (1/4 (171 682) (271 882) (95 993) (315 2917) (95 2943) (-227 9466) (200 12943)) (1/4 (171 682) (366 1068) (139 2436) (271 5357) (315 5507) (227 6962) (-71 12943)) (1/4 (176 463) (32 682) (241 798) (241 3141) (-58 5357) (-122 12943) (-51 390112)) (1/4 (176 557) (244 757) (90 1068) (61 1393) (22 3458) (122 11018) (44 27493)) (1/4 (179 239) (44 5357) (80 5507) (156 12943) (8 17923) (48 32807) (-40 157318)) (1/4 (179 239) (120 4662) (4 5357) (116 12943) (-32 17923) (88 32807) (40 390112)) (1/4 (179 233) (120 4662) (4 5357) (-63 12943) (-32 17923) (-91 32807) (40 390112)) (1/4 (183 239) (32 682) (-88 1143) (132 2673) (68 12943) (-132 34208) (-44 44179)) (1/4 (183 239) (32 1023) (-68 5832) (12 111693) (-100 6826318) (-12 9503057) (-12 232633636378307)) (1/4 (183 239) (32 1023) (-68 5832) (12 112068) (-100 6826318) (-12 13288972) (-12 49541920807)) (1/4 (183 239) (32 1023) (-68 5832) (12 113568) (-100 6826318) (12 23476958) (-12 111432033307)) (1/4 (183 239) (32 1023) (-68 5832) (12 113568) (-100 6826318) (12 23481005) (-12 612463280182)) (1/4 (183 239) (32 1023) (-68 5832) (12 113568) (-100 6826318) (12 23463218) (-12 29483238307)) (1/4 (183 239) (32 1023) (-68 5832) (12 113568) (-100 6826318) (12 23481902) (-12 168925949733307)) (1/4 (183 294) (44 905) (115 1292) (88 3957) (-32 12238) (68 12943) (51 114483)) (1/4 (183 307) (32 682) (95 1143) (132 2673) (68 12943) (51 34208) (139 44179)) (1/4 (183 378) (115 557) (29 1068) (122 2943) (144 3458) (-244 14318) (44 27493)) (1/4 (183 378) (144 606) (86 1772) (122 2943) (-115 6118) (-71 14318) (-71 27493)) (1/4 (183 378) (144 905) (115 1057) (151 2943) (-29 3957) (-100 14318) (-100 27493)) (1/4 (183 378) (215 682) (44 1432) (51 2943) (-315 5257) (-71 12943) (44 13043)) (1/4 (183 538) (215 682) (51 1068) (44 2309) (88 2673) (88 3039) (17 12943)) (1/4 (183 568) (215 682) (278 1636) (-139 6107) (112 12943) (-234 19703) (132 32807)) (1/4 (186 307) (41 378) (27 829) (-13 1713) (122 2943) (42 12238) (71 58911)) (1/4 (190 577) (76 682) (176 882) (95 1393) (220 2917) (-132 9466) (200 12943)) (1/4 (198 577) (200 606) (127 1393) (-20 2943) (112 3740) (-44 6118) (56 11018)) (1/4 (199 233) (-60 1393) (-76 5357) (-43 12943) (-152 17923) (9 32807) (120 1049433)) (1/4 (215 233) (-216 1568) (12 4662) (-64 6898) (113 12943) (-51 32807) (-32 534568)) (1/4 (215 239) (-248 1568) (76 4662) (296 12943) (132 32807) (64 83270) (32 1493208)) (1/4 (160 200) (-1 239) (-4 515) (-8 4030) (-16 50105) (-16 62575) (-32 500150) (-80 4000300)) (1/4 (215 682) (644 1568) (227 5767) (366 6898) (-532 12943) (227 24331) (-51 32807) (183 534568)) (1/4 (295 4193) (3767 5507) (593 18543) (-1228 39307) (2068 55603) (-962 211050) (-708 390112) (-1587 2867938)) (1/4 (537 1393) (1118 5357) (952 12943) (3032 17923) (-1384 32807) (-1194 157318) (-1870 1049433) (796 21638297)) (1/4 (581 1023) (183 4443) (664 5832) (732 11343) (-171 110443) (-366 595667) (171 4841182) (83 6826318)) (1/4 (581 1252) (764 4853) (1030 5832) (-398 58898) (-764 97232) (195 110443) (537 4841182) (266 6826318)) (1/4 (581 1252) (764 5593) (1030 5827) (366 58898) (195 110443) (537 4841182) (-764 6826318) (-1030 1561886607)) (1/4 (581 1252) (764 5618) (1030 5832) (366 58898) (195 110443) (764 1256859) (537 4841182) (266 6826318)) (1/4 (581 1252) (764 5593) (1030 5832) (366 69051) (195 110443) (366 369957) (171 4841182) (266 6826318)) (1/4 (581 1252) (764 5593) (1030 11557) (1030 11773) (366 58898) (195 110443) (537 4841182) (266 6826318)) (1/4 (581 1252) (1030 5507) (764 5593) (366 58898) (-1030 98821) (195 110443) (537 4841182) (266 6826318)) (1/4 (764 1068) (298 5832) (581 26307) (-183 78813) (-171 110443) (215 314982) (171 4841182) (83 6826318)) (1/4 (808 1477) (1308 2436) (-1635 5283) (-417 5507) (593 6962) (632 390112) (-561 2733307) (266 23747457)) (1/4 (1074 1568) (840 5357) (-779 12943) (625 17923) (-1106 32807) (657 198505) (-259 390112) (657 24185182)) (1/4 (1074 4246) (1257 5357) (1731 6107) (295 12943) (625 19703) (-481 32807) (-1042 39307) (398 390112)) (1/4 (1484 4693) (2097 4831) (366 18543) (1189 49457) (-227 123093) (-879 128643) (481 27872057) (-266 31895807)) (1/4 (1738 4193) (1699 4246) (144 6687) (-1443 32318) (-266 39307) (337 235318) (-227 390112) (-481 2282363)) (1/4 (2363 4557) (1218 5507) (1850 18543) (-266 39307) (-2658 49457) (1257 123093) (-1484 390112) (481 27872057)) (1/4 (-31739656 201229582) (38819595 231373438) (110380200 284862638) (122355452 312322593) (-134055653 496651953) (5301720 509435077) (63861353 543644509) (68679613 934981432) (130575087 1845907403) (-32548340 2189376182) (-71616726 2539791558) (98822066 4732978887) (119051879 7804016832) (48482068 9233371207) (-99832073 41734246913) (-99143267 66492889557) (-25601898 73276714818) (-79323772 579766497643)) (1/4 (16106659 103224943) (48702787 196047454) (18674705 199762118) (8786524 201229582) (-16824928 244653118) (-9582339 261221282) (33092716 266981905) (50379909 270684757) (24748365 909140573) (31675677 1770638022) (1576733 2189376182) (-4742586 2701984943) (-34586991 5475957057) (10864048 14033378718) (-13079131 18986886768) (22266057 25220059245) (17791526 34840696582) (-12650410 193100304493)) (1/4 (154370374 124845505) (-90941691 193788912) (64454803 196047454) (-82996236 201229582) (109691394 244653118) (-15562779 462333568) (6518215 553806443) (-169821027 1134156517) (-244516782 1222853176) (100563577 2154947322) (-47118309 2189376182) (-35713908 4006581229) (60656646 5475957057) (-4001125 18986886768) (-68810571 37093513413) (-20888958 100083704193) (16990004 250645741818) (-62587614 5142102426318)) (1/4 (-119375678 193788912) (61799442 201229582) (-19991865 272525023) (20438744 321390012) (88331413 331905423) (103467976 343841922) (88464202 378026293) (138122046 600536193) (44232101 653023206) (115219328 846974497) (-81969855 1033937133) (-63521464 1454097393) (-118694678 2189376182) (117332455 2322170807) (-26482877 6884660047) (-18702052 29546599818) (7415308 250645741818) (166718050 512223806648)) (1/4 (-85386445 101859193) (4420755 112519818) (43555859 193788912) (15003774 194195097) (108912996 201229582) (61225652 231373438) (16824928 262992072) (73421340 284862638) (123118321 1057929843) (-10593254 2189376182) (40618746 2539791558) (73863237 2616939213) (-30947737 14811180432) (58354910 41734246913) (19908612 66492889557) (5345839 73276714818) (-90280386 120563046313) (61328880 579766497643)) (1/4 (-75143577 193788912) (17567341 201229582) (64670845 321390012) (88331413 331905423) (103467976 343841922) (68472337 372954564) (49657844 600536193) (115219328 846974497) (24240236 1012047353) (-81969855 1033937133) (24942738 1454097393) (-118694678 2189376182) (73100354 2322170807) (-88464202 4549886677) (-26482877 6884660047) (-18702052 29546599818) (7415308 250645741818) (34021747 512223806648)) (1/4 (-9761163 108220762) (13910116 144252856) (12032992 157157432) (55358773 167207057) (6697039 168623905) (-28651627 193788912) (1825738 201229582) (67020547 215266693) (-1575761 216260702) (45238607 284862638) (10024910 934981432) (20338355 2189376182) (-450675 4832545807) (-27703534 4935283579) (-25688998 7804016832) (-58020549 18986886768) (-28330426 120563046313) (-20446387 69971515635443)) (1/4 (-9719634 193788912) (17567341 201229582) (70452403 204415882) (12270610 244653118) (18184957 313467682) (44573394 426775692) (3945487 600536193) (33076315 892642643) (62731148 919331002) (18631836 1012047353) (58964485 1454097393) (32836016 2032914193) (-3430506 2189376182) (-19017973 5475957057) (60427493 6884660047) (-9222216 16406542707) (25467476 22827763470) (-8020348 29546599818)) (1/4 (-7707046 100457781) (102467557 168623905) (-37989469 201229582) (-19264491 216904033) (74130709 231373438) (9117882 262992072) (61898132 284862638) (-26046661 314198789) (20721724 327012132) (-6893934 1111885489) (-40541219 1183092682) (-40255386 2189376182) (82347539 2296713307) (31354293 12988236682) (27538131 18221678207) (-68243977 41734246913) (12646329 73276714818) (-45544955 193100304493)) (1/4 (-6829481 193788912) (49141523 227661182) (80561462 231373438) (12671730 244653118) (29897458 284862638) (-73630486 355671793) (58626712 398795108) (62468573 509435077) (24454447 543644509) (-19908612 657922943) (28905471 1057929843) (35237534 1845907403) (26678061 2189376182) (-117350972 4866438247) (-61240161 5475957057) (23212961 9075730623) (-20886351 9233371207) (-65421299 60402345333)) (1/4 (-6249813 193788912) (56771042 201229582) (28076746 231373438) (-19468648 262992072) (30639871 266981905) (19911270 284862638) (130457979 532399876) (96830507 672554667) (-25661007 1057929843) (13459441 1111885489) (-45480502 1183092682) (5693286 1770638022) (-21577251 2170952313) (-67486342 2189376182) (2925523 2701984943) (27538131 18221678207) (-7198038 193100304493) (36293576 307026452057)) (1/4 (-60656646 143846482) (38271221 144309885) (138138220 157565949) (35739707 193788912) (-42115413 201229582) (-49270023 231373438) (94471578 278263393) (-68287996 398795108) (87062724 462333568) (-21411533 593897943) (-13257608 1057929843) (-106971336 1206519637) (34427295 2189376182) (166256019 4006581229) (111296506 4832545807) (58999250 18986886768) (100563577 373139596292) (100694535 5142102426318)) (1/4 (-5621437 103224943) (81294931 115811807) (23943179 193788912) (33709426 199762118) (-2077524 201229582) (-31310435 261221282) (4978864 266981905) (-15147806 282218776) (-1688365 909140573) (20050974 1047764193) (-18279356 1770638022) (-1777511 2189376182) (19200593 2701984943) (-21507860 5475957057) (30332696 34840696582) (26011854 48312162432) (7938525 193100304493) (9186926 250645741818)) (1/4 (-5497394 101057042) (65180148 144309885) (53832596 193788912) (48554212 201229582) (52075350 447821668) (-105963621 539290393) (-8554603 2060228568) (7313117 2112819717) (-57858314 2189376182) (-3891660 2572149874) (7518287 3261365450) (-19908612 4044044333) (12568802 4866438247) (-83992146 5494891577) (-68408704 9233371207) (6071631 20336334426) (26993421 45384196187) (-20080982 71617196968)) (1/4 (-52897653 193788912) (17567341 201229582) (88637360 214539684) (16824928 329492391) (87365276 426775692) (89084239 434859193) (64670845 478798161) (-60879340 600536193) (51820567 706366957) (25661007 1033937133) (-7721255 1119211358) (-11874055 1454097393) (-46608525 2189376182) (-7415308 2674664693) (38361126 6884660047) (-54246761 29546599818) (29095538 42354792693) (55834766 512223806648)) (1/4 (-51730315 193788912) (50509639 201229582) (-2925523 224497457) (34338149 231373438) (56651725 266981905) (88974774 284862638) (6009207 367829623) (44851350 532399876) (77361859 672554667) (-36293576 1047764193) (19819495 1057929843) (-26011854 1695830317) (-10691678 1770638022) (-51609424 2170952313) (-31380534 2189376182) (21276728 18221678207) (9186926 250645741818) (-16384964 4125516427007)) (1/4 (-50738726 193788912) (95363435 196047454) (69453144 225823278) (69510447 227661182) (22432893 244653118) (-32772323 266981905) (-17689880 284862638) (-25151223 657922943) (45597610 672554667) (-15126313 934981432) (76492809 1770638022) (84039104 2189376182) (-104948381 4832545807) (-85627080 5475957057) (-40656362 5684017953) (-5242611 7804016832) (-197723175 18986886768) (42533486 25220059245)) (1/4 (-28765620 120868561) (44046442 160007778) (67427201 167207057) (37325093 191800592) (70499068 270090468) (-57543499 289008998) (17519675 361632045) (-4374603 747769833) (-52576452 2674664693) (-7666625 2971354082) (83775059 3069221943) (44136928 4549886677) (-7704241 4832545807) (109211041 4935283579) (43406332 5271470807) (-4967047 8815417307) (24253605 14033378718) (72936300 69392205693)) (1/4 (-19504206 100457781) (24986381 107793452) (26438497 121042733) (40255386 160007778) (28377269 168623905) (23815821 314198789) (-2374068 361632045) (25057307 672554667) (-9351768 773302059) (11008080 1479406293) (574237 2296713307) (-3020779 2701984943) (17648998 4038832337) (-9422284 12139595709) (27538131 12957904393) (20007517 12988236682) (23727647 18710140581) (-4711783 120563046313)) (1/4 (-42543389 193788912) (74917830 201229582) (28076746 231373438) (16824928 262992072) (30639871 266981905) (74351634 284862638) (21577251 640348873) (78683719 672554667) (-25661007 1057929843) (-4687347 1111885489) (-27333714 1183092682) (5693286 1770638022) (8531273 2189376182) (-76017615 2674664693) (2925523 2701984943) (-39724039 4309606382) (27538131 18221678207) (68819577 193100304493)) (1/4 (-41665661 138884933) (61863206 168623905) (-24923249 201229582) (1860735 231373438) (152322833 244685917) (16824928 262992072) (45004160 284862638) (6816407 306903943) (-25731933 2189376182) (-2937113 2539791558) (-80514719 4100676432) (-30142453 5157407572) (88702086 17249711432) (10077565 18986886768) (-34456033 41734246913) (19908612 66492889557) (66436029 73276714818) (-10644159 579766497643)) (1/4 (-39775463 119742462) (20197545 168623905) (93476735 201229582) (1860735 231373438) (58490589 262992072) (86669821 284862638) (-4706801 437768635) (41665661 1258140850) (-35068662 1396533757) (-56669435 1624720807) (61079955 2189376182) (69090409 2539791558) (-73253757 3712239557) (42278290 41734246913) (-46591870 52254287493) (59684075 66492889557) (-12188492 73276714818) (-15350960 579766497643)) (1/4 (-3944315 103224943) (48706548 136899993) (18362609 186695067) (14767496 193788912) (-25501467 201229582) (-15136563 244653118) (29933522 261221282) (30079929 266981905) (117267526 480808760) (-30911261 1012047353) (40320881 1770638022) (53656250 2189376182) (20888958 2701984943) (-63283169 5475957057) (-32599626 37093513413) (-43463674 43917943025) (-64759288 193100304493) (21735578 5142102426318)) (1/4 (-3908713 100351813) (64565359 115453918) (26685223 201229582) (-8153925 214539684) (96935488 385231007) (15853328 459637173) (-19281720 539290393) (-48760063 883337939) (62688235 909140573) (-67639108 1282794079) (-5891323 1304967682) (-10583319 2189376182) (34749426 2572149874) (-55437542 3508373380) (-90085473 4427365493) (-35842901 5494891577) (-35317011 18986886768) (-22926686 45119420807)) (1/4 (-36515828 110175338) (5722932 193788912) (17567341 201229582) (83804410 203283777) (85603231 244653118) (79850836 273202197) (68353757 345311195) (-87424385 549758463) (-63893191 1454097393) (-111387800 1459933093) (69893108 1725455932) (-61767440 2189376182) (-19017973 5475957057) (102875038 6930719818) (47464799 16406542707) (21866697 29546599818) (-15003774 37093513413) (-46223313 5142102426318)) (1/4 (-36293576 132095062) (57870827 168623905) (-42543389 193788912) (35193791 201229582) (-8216830 231373438) (53118504 262992072) (30639871 266981905) (128791998 284862638) (60536931 672554667) (-25661007 1057929843) (49753017 1111885489) (-45480502 1183092682) (-30600290 1770638022) (-9615515 2189376182) (-69661629 2701984943) (63831707 18221678207) (29095538 193100304493) (-36293576 5142102426318)) (1/4 (-35775309 107793452) (-7119735 111530944) (127376638 115811807) (66649464 193788912) (-21949674 201229582) (-43413311 244653118) (-45561148 261221282) (49941099 266981905) (-9186926 396134107) (-886843 1770638022) (73138594 2189376182) (-39140796 2296713307) (61906878 2701984943) (-3565489 5458840213) (-21696619 5475957057) (-7498561 55237647473) (75356069 193100304493) (-1877124 579766497643)) (1/4 (-35368492 144309885) (-13432309 201229582) (124560353 231373438) (-8671679 284862638) (3303573 398795108) (141414744 509435077) (203277950 543644509) (-124589816 1845907403) (-32548340 2189376182) (-53309379 2539791558) (115883211 4732978887) (68679613 9075730623) (-1890198 9233371207) (19219806 41734246913) (19908612 66492889557) (60138860 73276714818) (-53675839 102428655030) (-10644159 579766497643)) (1/4 (-35368492 110911039) (50372266 113561432) (3303573 168623905) (-16735882 201229582) (74188087 231373438) (30000386 284862638) (106046252 509435077) (99229845 543644509) (-89221324 1845907403) (-67916832 2189376182) (-53309379 2539791558) (-15003774 3658567505) (65510945 4732978887) (-16893972 9233371207) (-19452259 41734246913) (-30463654 66492889557) (75142634 73276714818) (-10644159 579766497643)) (1/4 (-34897469 115453918) (87164915 118708522) (27407173 168623905) (87908983 193788912) (-27111639 201229582) (25214128 284862638) (-104763374 426775692) (55687060 600536193) (-49901243 909140573) (3434531 975229968) (-44950370 1454097393) (75180138 2189376182) (27482161 3508373380) (-68146942 4866438247) (-85620582 6884660047) (15583442 9233371207) (30725109 29546599818) (2193045 1442060060693)) (1/4 (-32461025 169937257) (42456472 193788912) (60136529 201229582) (45652872 230845763) (-11582317 231373438) (-12390325 448235443) (44415233 539290393) (59855124 595484173) (64938439 1057929843) (30600290 1500534537) (71357041 2189376182) (45920466 2616939213) (48826263 2701984943) (27854052 5494891577) (22522061 7193374037) (-21720539 11115923863) (1241486 14811180432) (-44678980 58240834569)) (1/4 (-30911476 193788912) (17567341 201229582) (68472337 272525023) (64670845 321390012) (88331413 331905423) (15003774 343841922) (5425743 600536193) (70987227 846974497) (-37737754 1033937133) (69174839 1454097393) (-30230476 2189376182) (28868253 2322170807) (-26482877 6884660047) (-44232101 24139206772) (-18702052 29546599818) (-44232101 50443911578) (7415308 250645741818) (-10210354 512223806648)) (1/4 (-30692741 227661182) (12504894 231373438) (-39446702 244653118) (114600079 262992072) (92590873 284862638) (113856011 314198789) (86140179 346369967) (-22467890 355671793) (-141382552 398795108) (59415160 657922943) (-7326899 1620933557) (-1037771 2189376182) (-79323772 8895085098) (-27205340 17997844652) (-10574983 41734246913) (-27904591 60402345333) (-79821190 73276714818) (16893972 102428655030)) (1/4 (-30361861 113561432) (85628068 168623905) (20493345 231373438) (53783788 262992072) (46894358 284862638) (65430523 1172624874) (36958860 1258140850) (-16893972 1624720807) (21304492 2189376182) (-1046915 2539791558) (-16436052 3658567505) (20222978 3712239557) (18632610 9549201618) (-27859034 41734246913) (-6816407 52254287493) (50270473 66492889557) (22880170 73276714818) (-10644159 579766497643)) (1/4 (-29735286 115453918) (-1890198 149299093) (12010178 168623905) (30661691 195053432) (7109402 201229582) (55743030 213255960) (32522426 231373438) (65751551 262992072) (35890388 284862638) (40220018 687606629) (-29216048 909140573) (-63654586 2189376182) (44099312 2539791558) (-33529628 41734246913) (-20830644 66492889557) (26660566 73276714818) (28204899 579766497643) (-48926623 1197009532318)) (1/2 (94283734 231373438) (147962666 262992072) (211308992 284862638) (-26800082 318942476) (-69173113 610076381) (-137945216 1111885489) (126007473 1183092682) (333203505 2189376182) (-250903561 2296713307) (248078871 2539791558) (-379960570 5458840213) (-73879914 18221678207) (132652425 30446482737) (68447160 41734246913) (-28954879 66492889557) (35907922 73276714818) (124495078 193100304493) (118351969 579766497643) (18339615 69971515635443)) (1/4 (-177112869 1047764193) (690072825 1057929843) (94777525 1082548618) (102841728 1770638022) (254740469 1845907403) (-7897447 2189376182) (-276135745 4866438247) (382919489 8634733487) (364832031 9233371207) (-255036003 18221678207) (-47281269 30446482737) (-14754756 31147706551) (145805470 35587716432) (-60553945 41734246913) (275062833 73276714818) (130937707 73745675437) (225667081 91140429801) (-58222931 120563046313) (217205407 250645741818) (-335335373 69971515635443)) (1/4 (48554212 1047764193) (-8064203 1695830317) (273129107 1845907403) (256152120 2060228568) (387484239 2170952313) (522262813 2189376182) (139928940 2426435870) (35269543 6249781117) (-116987170 9233371207) (-153310392 14885462059) (243523167 16346803247) (-191276069 18221678207) (-114320902 30446482737) (430509851 31147706551) (-62448154 35587716432) (118676670 41734246913) (-206756368 73276714818) (103732367 73745675437) (887580 250645741818) (-42628659 69971515635443)) (1/4 (59529729 1111885489) (411801489 1183092682) (-11697838 1770638022) (-10217933 2189376182) (178183864 2420845318) (481604223 2674664693) (200815307 2701984943) (18311409 4309606382) (-54066665 5684017953) (391091355 9566096322) (433050011 14033378718) (155959834 14474950443) (123563452 18221678207) (-322558047 18986886768) (-187246484 41734246913) (182267620 73276714818) (70949047 120563046313) (85657566 134237866432) (150508360 193100304493) (16824928 804006285737)) (1/4 (79674619 1057929843) (430112898 1183092682) (103029535 1770638022) (419995354 1845907403) (161719567 2189376182) (25897285 2701984943) (-165526275 3651666474) (-450635225 4866438247) (418811986 5684017953) (520079918 9233371207) (-370946465 11079391432) (11498734 14033378718) (1575319 15548138481) (-17734177 18221678207) (310673925 18986886768) (179773324 91140429801) (10643092 193100304493) (158038974 250645741818) (-165442692 804006285737) (119720378 11484937157318)) (1/4 (210413195 1047764193) (49034748 1057929843) (129893399 1111885489) (920835218 1222853176) (-367170458 1770638022) (-460082449 2154947322) (471386290 2189376182) (-4742586 2701984943) (-385386694 3651666474) (239038662 5684017953) (399473027 12988236682) (-298167989 14033378718) (111903950 15548138481) (-327400900 18221678207) (-789934617 18986886768) (-490722320 34352737807) (-639330225 193100304493) (-182267620 250645741818) (264670206 804006285737) (460026972 11484937157318)) (1/4 (245117311 1057929843) (-441536832 1111885489) (694624721 1183092682) (357582197 1845907403) (993878808 2189376182) (-264511823 2296713307) (279266579 2701984943) (-1351244216 4866438247) (255211890 9233371207) (142361641 10855443178) (-647040605 11079391432) (-55648319 15548138481) (-29232911 18221678207) (533067633 35587716432) (34223580 41734246913) (165442692 73276714818) (-215957611 91140429801) (786436927 120563046313) (939525243 193100304493) (311982932 250645741818)) (1/4 (290087814 1057929843) (129893399 1111885489) (189059832 1183092682) (312611694 1770638022) (-177755991 2189376182) (30639871 2539791558) (236310480 2701984943) (285108950 3651666474) (-530648699 5458840213) (208398791 5684017953) (381614163 14033378718) (81264079 15548138481) (-679782152 17249711432) (321741381 18221678207) (130900601 18986886768) (210413195 66492889557) (250865122 193100304493) (28145575 250645741818) (44970503 804006285737) (-460808246 11484937157318)) (1/4 (719865552 1057929843) (-120111015 1111885489) (-210078035 1183092682) (62607280 1770638022) (322252837 2189376182) (486314894 2701984943) (254469079 3651666474) (149133453 4832545807) (-401152271 5684017953) (491057480 7804016832) (-30639871 8995467682) (-328807860 14033378718) (392548235 15548138481) (-311284156 17058320068) (-669324927 18221678207) (-180383555 18986886768) (-60419034 193100304493) (278149989 250645741818) (325614788 804006285737) (-180163961 11484937157318)) (1/4 (764256596 1183092682) (340757269 1770638022) (82030807 2189376182) (-651971659 2296713307) (188678845 2539791558) (371182743 2701984943) (-541133952 5458840213) (282350263 5684017953) (261942239 9566096322) (414738602 14033378718) (-578034328 17249711432) (219993557 18221678207) (-126062774 18986886768) (-58097368 41734246913) (129149116 66492889557) (53118504 73276714818) (-68972608 120563046313) (210038089 193100304493) (285108950 579766497643) (16824928 804006285737)) (1/2 (-389355483 1111885489) (-85198635 1770638022) (942772580 2189376182) (860225796 2296713307) (958295292 2439473093) (1701938869 2701984943) (570217900 3651666474) (-653171089 5684017953) (1290597651 9566096322) (632981931 14033378718) (-258298232 15548138481) (-716081542 18221678207) (-448620821 18986886768) (-1711424041 41734246913) (1131248413 73276714818) (1650144299 120563046313) (1441452520 193100304493) (766713173 250645741818) (800363029 804006285737) (-1590316151 11484937157318)) (1/2 (-383575951 1082548618) (367447545 1695830317) (470326860 1845907403) (302791880 2060228568) (1332608020 2170952313) (1886585069 2189376182) (-562201563 2426435870) (610170129 2539791558) (-707278553 4732978887) (-215928441 6249781117) (-232950527 9233371207) (201602620 16346803247) (172870593 31147706551) (-125920121 35587716432) (696860645 41734246913) (207464734 66492889557) (-412488923 73276714818) (689924269 250645741818) (305596971 579766497643) (199162583 69971515635443)) (1/2 (468218462 2189376182) (1818521088 2439473093) (1312583386 2701984943) (121856072 5684017953) (-1109476277 6327662603) (570217900 8634733487) (1720710549 9566096322) (718180566 14033378718) (601927564 15548138481) (-1921221601 18221678207) (-59265338 18986886768) (1164382644 30446482737) (-936396880 41734246913) (701135515 73276714818) (1205140059 73745675437) (875117138 120563046313) (236312461 193100304493) (336600275 250645741818) (715164394 804006285737) (-815288990 11484937157318) (-860225796 69971515635443)) ))) (for-each (lambda (formula) (let ((r (/ 1 (car formula))) (sum 0.0)) (for-each (lambda (arg) (set! sum (+ sum (* (car arg) (atan (/ 1 (cadr arg))))))) (cdr formula)) (if (> (abs (- (* r sum) pi)) 1e-12) (begin (display formula) (display " = ") (display (* r sum)) (newline))))) formulas) (when with-bignums (let ((mxerr 0.0)) (for-each (lambda (formula) (let ((r (/ (bignum 1) (car formula))) (sum (bignum "0.0"))) (for-each (lambda (arg) (set! sum (+ sum (* (car arg) (atan (bignum 1) (cadr arg)))))) (cdr formula)) (let ((err (abs (- (* r sum) (* 4 (atan (bignum 1.0) 1.0)))))) (if (> err mxerr) (set! mxerr err))))) formulas) (if (> mxerr 1e-30) (format #t "big max error: ~A~%" mxerr))))) (let ((atans (list 0.00000000000000000000000000000000000000000000000000000000000000000000 0.04995839572194276141000628703484488149127708042350717441085345482998 0.09966865249116202737844611987802059024327832250431464801550877681002 0.14888994760949725058653039165586728099052584656913639751654183508627 0.19739555984988075837004976519479029344758510378785210151768894024103 0.24497866312686415417208248121127581091414409838118406712737591466735 0.29145679447786709199560462143289119350316759901206541927220608308729 0.33667481938672718139669863134176645842796861176681965716976593102220 0.38050637711236488630358791681043310449740571365810083757630562232420 0.42285392613294071296648279098114197360332058559089653470801277782477 0.46364760900080611621425623146121440202853705428612026381093308872019 0.50284321092786082733088202924527755577645581499776483101147435179592 0.54041950027058415544357836460859991013514825146259238811636023340959 0.57637522059118368022757047839377004593402018294846332167674413471879 0.61072596438920861654375887649023609381850306612882761584286773000023 0.64350110879328438680280922871732263804151059111531238286560611871351 0.67474094222355266305652097360981361507400625484071242312092170496930 0.70449406424221771665748034078199625698360683805607748632242138272858 0.73281510178650659164079207273428025198575567935825608631050693192821 0.75976275487577082892296119539998182400552294838843900175686400378812 0.78539816339744830961566084581987572104929234984377645524373614807695 0.80978357257016684662414585801888523310377327237135123533486105150550 0.83298126667443170541769356183636123851585134443710842085342312250327 0.85505273712601651097815432807058769283799489703232752323972864020297 0.87605805059819342311404752112834133907534524616033200346065614838499 0.89605538457134395617480071802993782702457844484684048736655059118459 0.91510070055336041656680197245527296654755880944161873770852665151657 0.93324752865620386989366255071265925262560793377140310475404520234906 0.95054684081207514789478913546381917504767901030880427426177057808809 0.96704699339746024466331914650201513140746494542545306371969751473184 0.98279372324732906798571061101466601449687745363162855676142508831798 0.99783018390619045494496187944270463542510496590550026609871776901127 1.01219701145133418325981347523809017175213711715353810435383625801215 1.02593241134335292660599590143869494280346122674543977431139573494988 1.03907225953609102762125033790727884531233378855364699989530509706554 1.05165021254837366745986731208629982963024430034204461753698029655611 1.06369782240255966094389111605254547856256296541932752568273985366635 1.07524465330906808242086208732184320752064516718532174460312177009311 1.08631839775787341806397958192567762897580047046812780208748680606431 1.09694499030013626798639002132512259906130967805041989207206852796014 1.10714871779409050301706546017853704007004764540143264667653920743371))) (let ((mxerr 0.0)) (do ((i 0 (+ i 1)) (x 0.0 (+ x 0.05))) ((= i 40)) (let ((err (abs (- (atan x) (list-ref atans i))))) (if (> err mxerr) (set! mxerr err)))) (if (> mxerr 1e-12) (format #t "atan err: ~A~%" mxerr)))) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((atans (list ; table[Arctan[k/10], {k, 0, 30}] 0.00000000000000000000000000000000000000000000000000000000000000000000e0 0.09966865249116202737844611987802059024327832250431464801550877681002 0.19739555984988075837004976519479029344758510378785210151768894024103 0.29145679447786709199560462143289119350316759901206541927220608308729 0.38050637711236488630358791681043310449740571365810083757630562232420 0.46364760900080611621425623146121440202853705428612026381093308872019 0.54041950027058415544357836460859991013514825146259238811636023340959 0.61072596438920861654375887649023609381850306612882761584286773000023 0.67474094222355266305652097360981361507400625484071242312092170496930 0.73281510178650659164079207273428025198575567935825608631050693192821 0.78539816339744830961566084581987572104929234984377645524373614807695 0.83298126667443170541769356183636123851585134443710842085342312250327 0.87605805059819342311404752112834133907534524616033200346065614838499 0.91510070055336041656680197245527296654755880944161873770852665151657 0.95054684081207514789478913546381917504767901030880427426177057808809 0.98279372324732906798571061101466601449687745363162855676142508831798 1.01219701145133418325981347523809017175213711715353810435383625801215 1.03907225953609102762125033790727884531233378855364699989530509706554 1.06369782240255966094389111605254547856256296541932752568273985366635 1.08631839775787341806397958192567762897580047046812780208748680606431 1.10714871779409050301706546017853704007004764540143264667653920743371 1.12637711689379770989641767275145325372112241040085015241064879177491 1.14416883366802053001158090974633622082626800572469223488413501483165 1.16066898625340562678011092078453217718605394084134102434206195147540 1.17600520709513510249122216125017085520341449211184870745209441567184 1.19028994968253173292773377482931833760117898602945207291116667382970 1.20362249297667741080683267484687578339840429857832439350850411338551 1.21609067478395630285892632134113779481025954203667431449700610948231 1.22777238637419322215779309222594182541102155201281262388880100298534 1.23873685925201114137796025438808735907407693977120210817129118165791 1.24904577239825442582991707728109012307782940412989671905466923679715))) (do ((i 0 (+ i 1))) ((= i 30)) (let ((val (atan (bignum (/ i 10))))) (if (> (magnitude (- val (list-ref atans i))) 1e-36) (format #t ";(atan ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref atans i) (magnitude (- val (list-ref atans i)))))))))) ;;; -------------------------------------------------------------------------------- ;;; sinh ;;; -------------------------------------------------------------------------------- (num-test (sinh 0) 0.0) (num-test (sinh 1) 1.17520119364380) (num-test (sinh -1) -1.17520119364380) (num-test (sinh 2) 3.62686040784702) (num-test (sinh -2) -3.62686040784702) (num-test (sinh 3) 10.01787492740990) (num-test (sinh -3) -10.01787492740990) (num-test (sinh 10) 11013.23287470339346) (num-test (sinh -10) -11013.23287470339346) (num-test (sinh 0/1) 0.0) (num-test (sinh 0/2) 0.0) (num-test (sinh 0/3) 0.0) (num-test (sinh 0/10) 0.0) (num-test (sinh 0/1234) 0.0) (num-test (sinh 0/500029) 0.0) (num-test (sinh 1/1) 1.17520119364380) (num-test (sinh -1/1) -1.17520119364380) (num-test (sinh 1/2) 0.52109530549375) (num-test (sinh -1/2) -0.52109530549375) (num-test (sinh 1/3) 0.33954055725615) (num-test (sinh -1/3) -0.33954055725615) (num-test (sinh 1/10) 0.10016675001984) (num-test (sinh -1/10) -0.10016675001984) (num-test (sinh 1/1234) 0.00081037286017) (num-test (sinh -1/1234) -0.00081037286017) (num-test (sinh 1/500029) 0.00000199988401) (num-test (sinh -1/500029) -0.00000199988401) (num-test (sinh 2/1) 3.62686040784702) (num-test (sinh -2/1) -3.62686040784702) (num-test (sinh 2/2) 1.17520119364380) (num-test (sinh -2/2) -1.17520119364380) (num-test (sinh 2/3) 0.71715846101104) (num-test (sinh -2/3) -0.71715846101104) (num-test (sinh 2/10) 0.20133600254109) (num-test (sinh -2/10) -0.20133600254109) (num-test (sinh 2/1234) 0.00162074625252) (num-test (sinh -2/1234) -0.00162074625252) (num-test (sinh 2/500029) 0.00000399976801) (num-test (sinh -2/500029) -0.00000399976801) (num-test (sinh 3/1) 10.01787492740990) (num-test (sinh -3/1) -10.01787492740990) (num-test (sinh 3/2) 2.12927945509482) (num-test (sinh -3/2) -2.12927945509482) (num-test (sinh 3/3) 1.17520119364380) (num-test (sinh -3/3) -1.17520119364380) (num-test (sinh 3/10) 0.30452029344714) (num-test (sinh -3/10) -0.30452029344714) (num-test (sinh 3/1234) 0.00243112070921) (num-test (sinh -3/1234) -0.00243112070921) (num-test (sinh 3/500029) 0.00000599965202) (num-test (sinh -3/500029) -0.00000599965202) (num-test (sinh 10/1) 11013.23287470339346) (num-test (sinh -10/1) -11013.23287470339346) (num-test (sinh 10/2) 74.20321057778875) (num-test (sinh -10/2) -74.20321057778875) (num-test (sinh 10/3) 13.99797545058944) (num-test (sinh -10/3) -13.99797545058944) (num-test (sinh 10/10) 1.17520119364380) (num-test (sinh -10/10) -1.17520119364380) (num-test (sinh 10/1234) 0.00810381641088) (num-test (sinh -10/1234) -0.00810381641088) (num-test (sinh 10/500029) 0.00001999884007) (num-test (sinh -10/500029) -0.00001999884007) (num-test (sinh 1234/500029) 0.00246785936931) (num-test (sinh -1234/500029) -0.00246785936931) (num-test (sinh 500029/500029) 1.17520119364380) (num-test (sinh -500029/500029) -1.17520119364380) (num-test (sinh 0.0) 0.0) (num-test (sinh 0.00000001) 0.00000001) (num-test (sinh -0.00000001) -0.00000001) (num-test (sinh 1.0) 1.17520119364380) (num-test (sinh -1.0) -1.17520119364380) (num-test (sinh pi) 11.54873935725775) (num-test (sinh -3.14159265358979) -11.54873935725775) (num-test (sinh 0.0+0.0i) 0.0) (num-test (sinh -0.0+0.0i) 0.0) (num-test (sinh 0.0-0.0i) 0.0) (num-test (sinh -0.0-0.0i) 0.0) (num-test (sinh 0.0+0.00000001i) 0.0+0.00000001i) (num-test (sinh -0.0+0.00000001i) 0.0+0.00000001i) (num-test (sinh 0.0-0.00000001i) 0.0-0.00000001i) (num-test (sinh -0.0-0.00000001i) -0.0-0.00000001i) (num-test (sinh 0.0+1.0i) 0.0+0.84147098480790i) (num-test (sinh -0.0+1.0i) 0.0+0.84147098480790i) (num-test (sinh 0.0-1.0i) 0.0-0.84147098480790i) (num-test (sinh -0.0-1.0i) -0.0-0.84147098480790i) (num-test (sinh 0.00000001+0.0i) 0.00000001) (num-test (sinh -0.00000001+0.0i) -0.00000001) (num-test (sinh 0.00000001-0.0i) 0.00000001) (num-test (sinh -0.00000001-0.0i) -0.00000001) (num-test (sinh 0.00000001+0.00000001i) 0.00000001+0.00000001i) (num-test (sinh -0.00000001+0.00000001i) -0.00000001+0.00000001i) (num-test (sinh 0.00000001-0.00000001i) 0.00000001-0.00000001i) (num-test (sinh -0.00000001-0.00000001i) -0.00000001-0.00000001i) (num-test (sinh 0.00000001+1.0i) 0.00000000540302+0.84147098480790i) (num-test (sinh -0.00000001+1.0i) -0.00000000540302+0.84147098480790i) (num-test (sinh 0.00000001-1.0i) 0.00000000540302-0.84147098480790i) (num-test (sinh -0.00000001-1.0i) -0.00000000540302-0.84147098480790i) (num-test (sinh 1.0+0.0i) 1.17520119364380) (num-test (sinh -1.0+0.0i) -1.17520119364380) (num-test (sinh 1.0-0.0i) 1.17520119364380) (num-test (sinh -1.0-0.0i) -1.17520119364380) (num-test (sinh 1.0+0.00000001i) 1.17520119364380+0.00000001543081i) (num-test (sinh -1.0+0.00000001i) -1.17520119364380+0.00000001543081i) (num-test (sinh 1.0-0.00000001i) 1.17520119364380-0.00000001543081i) (num-test (sinh -1.0-0.00000001i) -1.17520119364380-0.00000001543081i) (num-test (sinh 1.0+1.0i) 0.63496391478474+1.29845758141598i) (num-test (sinh -1.0+1.0i) -0.63496391478474+1.29845758141598i) (num-test (sinh 1.0-1.0i) 0.63496391478474-1.29845758141598i) (num-test (sinh -1.0-1.0i) -0.63496391478474-1.29845758141598i) (num-test (sinh 3.14159265358979+0.0i) 11.54873935725775) (num-test (sinh -3.14159265358979+0.0i) -11.54873935725775) (num-test (sinh 3.14159265358979-0.0i) 11.54873935725775) (num-test (sinh -3.14159265358979-0.0i) -11.54873935725775) (num-test (sinh 3.14159265358979+0.00000001i) 11.54873935725775+0.00000011591953i) (num-test (sinh -3.14159265358979+0.00000001i) -11.54873935725775+0.00000011591953i) (num-test (sinh 3.14159265358979-0.00000001i) 11.54873935725775-0.00000011591953i) (num-test (sinh -3.14159265358979-0.00000001i) -11.54873935725775-0.00000011591953i) (num-test (sinh 3.14159265358979+1.0i) 6.23981050459650+9.75429233860021i) (num-test (sinh -3.14159265358979+1.0i) -6.23981050459650+9.75429233860021i) (num-test (sinh 3.14159265358979-1.0i) 6.23981050459650-9.75429233860021i) (num-test (sinh -3.14159265358979-1.0i) -6.23981050459650-9.75429233860021i) (num-test (sinh 1234/3) 2.18155865313939E+178) (num-test (sinh 1234/10) 1.953930316004457E+53) (num-test (sinh 0.0+3.14159265358979i) 0.0-6.982889851335445E-15i) (num-test (sinh 0.00000001+3.14159265358979i) -1.00000000000000003758922749678992050291E-8+3.231089148865173792463232707134864571569E-15i) (num-test (sinh 0.00000001+1234.0i) -7.985506235875843E-9+0.6019276547624973i) (num-test (sinh 1.0+3.14159265358979i) -1.175201193643801-1.077516210464362E-14i) (num-test (sinh 3.14159265358979+3.14159265358979i) -11.54873935725783-8.094533288479446E-14i) (num-test (sinh 3.14159265358979+1234.0i) -9.222253015388718+6.977517249251167i) (num-test (sinh 0.0e+00-3.45266983001243932001e-04i) 0-3.4526697614140534807e-4i) (num-test (sinh 0.0e+00+3.45266983001243932001e-04i) 0+3.4526697614140534807e-4i) (num-test (sinh 0.0e+00+1.57045105981189525579e+00i) 0+9.9999994039535581669e-1i) (num-test (sinh 0.0e+00-1.57045105981189525579e+00i) 0-9.9999994039535581669e-1i) (num-test (sinh 0.0e+00+1.57114159377789786021e+00i) 0+9.9999994039535581673e-1i) (num-test (sinh 0.0e+00-1.57114159377789786021e+00i) 0-9.9999994039535581673e-1i) (num-test (sinh 0.0e+00+3.14124738660679181379e+00i) 0+3.4526697614158608860e-4i) (num-test (sinh 0.0e+00-3.14124738660679181379e+00i) 0-3.4526697614158608860e-4i) (num-test (sinh 0.0e+00+3.14193792057279441821e+00i) 0-3.4526697614134115926e-4i) (num-test (sinh 0.0e+00-3.14193792057279441821e+00i) 0+3.4526697614134115926e-4i) (num-test (sinh 0.0e+00+4.71204371340168837179e+00i) 0-9.9999994039535581664e-1i) (num-test (sinh 0.0e+00-4.71204371340168837179e+00i) 0+9.9999994039535581664e-1i) (num-test (sinh 0.0e+00+4.71273424736769097620e+00i) 0-9.9999994039535581677e-1i) (num-test (sinh 0.0e+00-4.71273424736769097620e+00i) 0+9.9999994039535581677e-1i) (num-test (sinh 0.0e+00+6.28284004019658492979e+00i) 0-3.4526697614170855328e-4i) (num-test (sinh 0.0e+00-6.28284004019658492979e+00i) 0+3.4526697614170855328e-4i) (num-test (sinh 0.0e+00+6.28353057416258753420e+00i) 0+3.4526697614121869459e-4i) (num-test (sinh 0.0e+00-6.28353057416258753420e+00i) 0-3.4526697614121869459e-4i) (num-test (sinh 0.0e+00+9.42443269378637893396e+00i) 0+3.4526697614094283958e-4i) (num-test (sinh 0.0e+00-9.42443269378637893396e+00i) 0-3.4526697614094283958e-4i) (num-test (sinh 0.0e+00+9.42512322775237976202e+00i) 0-3.4526697614020805155e-4i) (num-test (sinh 0.0e+00-9.42512322775237976202e+00i) 0+3.4526697614020805155e-4i) (num-test (sinh 1.19209289550781250e-07-3.45266983001243932001e-04i) 1.1920928244535424533e-7-3.4526697614140780134e-4i) (num-test (sinh 1.19209289550781250e-07+3.45266983001243932001e-04i) 1.1920928244535424533e-7+3.4526697614140780134e-4i) (num-test (sinh -1.19209289550781250e-07-3.45266983001243932001e-04i) -1.1920928244535424533e-7-3.4526697614140780134e-4i) (num-test (sinh -1.19209289550781250e-07+3.45266983001243932001e-04i) -1.1920928244535424533e-7+3.4526697614140780134e-4i) (num-test (sinh 1.19209289550781250e-07+1.57045105981189525579e+00i) 4.1159030931177815679e-11+9.9999994039536292211e-1i) (num-test (sinh 1.19209289550781250e-07-1.57045105981189525579e+00i) 4.1159030931177815679e-11-9.9999994039536292211e-1i) (num-test (sinh -1.19209289550781250e-07+1.57045105981189525579e+00i) -4.1159030931177815679e-11+9.9999994039536292211e-1i) (num-test (sinh -1.19209289550781250e-07-1.57045105981189525579e+00i) -4.1159030931177815679e-11-9.9999994039536292211e-1i) (num-test (sinh 1.19209289550781250e-07+1.57114159377789786021e+00i) -4.1159030931163216752e-11+9.9999994039536292216e-1i) (num-test (sinh 1.19209289550781250e-07-1.57114159377789786021e+00i) -4.1159030931163216752e-11-9.9999994039536292216e-1i) (num-test (sinh -1.19209289550781250e-07+1.57114159377789786021e+00i) 4.1159030931163216752e-11+9.9999994039536292216e-1i) (num-test (sinh -1.19209289550781250e-07-1.57114159377789786021e+00i) 4.1159030931163216752e-11-9.9999994039536292216e-1i) (num-test (sinh 1.19209289550781250e-07+3.14124738660679181379e+00i) -1.1920928244535424532e-7+3.4526697614158854187e-4i) (num-test (sinh 1.19209289550781250e-07-3.14124738660679181379e+00i) -1.1920928244535424532e-7-3.4526697614158854187e-4i) (num-test (sinh -1.19209289550781250e-07+3.14124738660679181379e+00i) 1.1920928244535424532e-7+3.4526697614158854187e-4i) (num-test (sinh -1.19209289550781250e-07-3.14124738660679181379e+00i) 1.1920928244535424532e-7-3.4526697614158854187e-4i) (num-test (sinh 1.19209289550781250e-07+3.14193792057279441821e+00i) -1.1920928244535424533e-7-3.4526697614134361253e-4i) (num-test (sinh 1.19209289550781250e-07-3.14193792057279441821e+00i) -1.1920928244535424533e-7+3.4526697614134361253e-4i) (num-test (sinh -1.19209289550781250e-07+3.14193792057279441821e+00i) 1.1920928244535424533e-7-3.4526697614134361253e-4i) (num-test (sinh -1.19209289550781250e-07-3.14193792057279441821e+00i) 1.1920928244535424533e-7+3.4526697614134361253e-4i) (num-test (sinh 1.19209289550781250e-07+4.71204371340168837179e+00i) -4.1159030931192414605e-11-9.9999994039536292207e-1i) (num-test (sinh 1.19209289550781250e-07-4.71204371340168837179e+00i) -4.1159030931192414605e-11+9.9999994039536292207e-1i) (num-test (sinh -1.19209289550781250e-07+4.71204371340168837179e+00i) 4.1159030931192414605e-11-9.9999994039536292207e-1i) (num-test (sinh -1.19209289550781250e-07-4.71204371340168837179e+00i) 4.1159030931192414605e-11+9.9999994039536292207e-1i) (num-test (sinh 1.19209289550781250e-07+4.71273424736769097620e+00i) 4.1159030931148617825e-11-9.9999994039536292220e-1i) (num-test (sinh 1.19209289550781250e-07-4.71273424736769097620e+00i) 4.1159030931148617825e-11+9.9999994039536292220e-1i) (num-test (sinh -1.19209289550781250e-07+4.71273424736769097620e+00i) -4.1159030931148617825e-11-9.9999994039536292220e-1i) (num-test (sinh -1.19209289550781250e-07-4.71273424736769097620e+00i) -4.1159030931148617825e-11+9.9999994039536292220e-1i) (num-test (sinh 1.19209289550781250e-07+6.28284004019658492979e+00i) 1.1920928244535424532e-7-3.4526697614171100655e-4i) (num-test (sinh 1.19209289550781250e-07-6.28284004019658492979e+00i) 1.1920928244535424532e-7+3.4526697614171100655e-4i) (num-test (sinh -1.19209289550781250e-07+6.28284004019658492979e+00i) -1.1920928244535424532e-7-3.4526697614171100655e-4i) (num-test (sinh -1.19209289550781250e-07-6.28284004019658492979e+00i) -1.1920928244535424532e-7+3.4526697614171100655e-4i) (num-test (sinh 1.19209289550781250e-07+6.28353057416258753420e+00i) 1.1920928244535424534e-7+3.4526697614122114786e-4i) (num-test (sinh 1.19209289550781250e-07-6.28353057416258753420e+00i) 1.1920928244535424534e-7-3.4526697614122114786e-4i) (num-test (sinh -1.19209289550781250e-07+6.28353057416258753420e+00i) -1.1920928244535424534e-7+3.4526697614122114786e-4i) (num-test (sinh -1.19209289550781250e-07-6.28353057416258753420e+00i) -1.1920928244535424534e-7-3.4526697614122114786e-4i) (num-test (sinh 1.19209289550781250e-07+9.42443269378637893396e+00i) -1.1920928244535424535e-7+3.4526697614094529285e-4i) (num-test (sinh 1.19209289550781250e-07-9.42443269378637893396e+00i) -1.1920928244535424535e-7-3.4526697614094529285e-4i) (num-test (sinh -1.19209289550781250e-07+9.42443269378637893396e+00i) 1.1920928244535424535e-7+3.4526697614094529285e-4i) (num-test (sinh -1.19209289550781250e-07-9.42443269378637893396e+00i) 1.1920928244535424535e-7-3.4526697614094529285e-4i) (num-test (sinh 1.19209289550781250e-07+9.42512322775237976202e+00i) -1.1920928244535424538e-7-3.4526697614021050482e-4i) (num-test (sinh 1.19209289550781250e-07-9.42512322775237976202e+00i) -1.1920928244535424538e-7+3.4526697614021050482e-4i) (num-test (sinh -1.19209289550781250e-07+9.42512322775237976202e+00i) 1.1920928244535424538e-7-3.4526697614021050482e-4i) (num-test (sinh -1.19209289550781250e-07-9.42512322775237976202e+00i) 1.1920928244535424538e-7+3.4526697614021050482e-4i) (num-test (sinh 5.0e-01-3.45266983001243932001e-04i) 5.2109527443404709209e-1-3.8933200722534065172e-4i) (num-test (sinh 5.0e-01+3.45266983001243932001e-04i) 5.2109527443404709209e-1+3.8933200722534065172e-4i) (num-test (sinh -5.0e-01-3.45266983001243932001e-04i) -5.2109527443404709209e-1-3.8933200722534065172e-4i) (num-test (sinh -5.0e-01+3.45266983001243932001e-04i) -5.2109527443404709209e-1+3.8933200722534065172e-4i) (num-test (sinh 5.0e-01+1.57045105981189525579e+00i) 1.7991700040937027667e-4+1.1276258979946363572e0i) (num-test (sinh 5.0e-01-1.57045105981189525579e+00i) 1.7991700040937027667e-4-1.1276258979946363572e0i) (num-test (sinh -5.0e-01+1.57045105981189525579e+00i) -1.7991700040937027667e-4+1.1276258979946363572e0i) (num-test (sinh -5.0e-01-1.57045105981189525579e+00i) -1.7991700040937027667e-4-1.1276258979946363572e0i) (num-test (sinh 5.0e-01+1.57114159377789786021e+00i) -1.7991700040930646090e-4+1.1276258979946363573e0i) (num-test (sinh 5.0e-01-1.57114159377789786021e+00i) -1.7991700040930646090e-4-1.1276258979946363573e0i) (num-test (sinh -5.0e-01+1.57114159377789786021e+00i) 1.7991700040930646090e-4+1.1276258979946363573e0i) (num-test (sinh -5.0e-01-1.57114159377789786021e+00i) 1.7991700040930646090e-4-1.1276258979946363573e0i) (num-test (sinh 5.0e-01+3.14124738660679181379e+00i) -5.2109527443404709206e-1+3.8933200722554445944e-4i) (num-test (sinh 5.0e-01-3.14124738660679181379e+00i) -5.2109527443404709206e-1-3.8933200722554445944e-4i) (num-test (sinh -5.0e-01+3.14124738660679181379e+00i) 5.2109527443404709206e-1+3.8933200722554445944e-4i) (num-test (sinh -5.0e-01-3.14124738660679181379e+00i) 5.2109527443404709206e-1-3.8933200722554445944e-4i) (num-test (sinh 5.0e-01+3.14193792057279441821e+00i) -5.2109527443404709211e-1-3.8933200722526827075e-4i) (num-test (sinh 5.0e-01-3.14193792057279441821e+00i) -5.2109527443404709211e-1+3.8933200722526827075e-4i) (num-test (sinh -5.0e-01+3.14193792057279441821e+00i) 5.2109527443404709211e-1-3.8933200722526827075e-4i) (num-test (sinh -5.0e-01-3.14193792057279441821e+00i) 5.2109527443404709211e-1+3.8933200722526827075e-4i) (num-test (sinh 5.0e-01+4.71204371340168837179e+00i) -1.7991700040943409243e-4-1.1276258979946363572e0i) (num-test (sinh 5.0e-01-4.71204371340168837179e+00i) -1.7991700040943409243e-4+1.1276258979946363572e0i) (num-test (sinh -5.0e-01+4.71204371340168837179e+00i) 1.7991700040943409243e-4-1.1276258979946363572e0i) (num-test (sinh -5.0e-01-4.71204371340168837179e+00i) 1.7991700040943409243e-4+1.1276258979946363572e0i) (num-test (sinh 5.0e-01+4.71273424736769097620e+00i) 1.7991700040924264514e-4-1.1276258979946363573e0i) (num-test (sinh 5.0e-01-4.71273424736769097620e+00i) 1.7991700040924264514e-4+1.1276258979946363573e0i) (num-test (sinh -5.0e-01+4.71273424736769097620e+00i) -1.7991700040924264514e-4-1.1276258979946363573e0i) (num-test (sinh -5.0e-01-4.71273424736769097620e+00i) -1.7991700040924264514e-4+1.1276258979946363573e0i) (num-test (sinh 5.0e-01+6.28284004019658492979e+00i) 5.2109527443404709204e-1-3.8933200722568255379e-4i) (num-test (sinh 5.0e-01-6.28284004019658492979e+00i) 5.2109527443404709204e-1+3.8933200722568255379e-4i) (num-test (sinh -5.0e-01+6.28284004019658492979e+00i) -5.2109527443404709204e-1-3.8933200722568255379e-4i) (num-test (sinh -5.0e-01-6.28284004019658492979e+00i) -5.2109527443404709204e-1+3.8933200722568255379e-4i) (num-test (sinh 5.0e-01+6.28353057416258753420e+00i) 5.2109527443404709213e-1+3.8933200722513017641e-4i) (num-test (sinh 5.0e-01-6.28353057416258753420e+00i) 5.2109527443404709213e-1-3.8933200722513017641e-4i) (num-test (sinh -5.0e-01+6.28353057416258753420e+00i) -5.2109527443404709213e-1+3.8933200722513017641e-4i) (num-test (sinh -5.0e-01-6.28353057416258753420e+00i) -5.2109527443404709213e-1-3.8933200722513017641e-4i) (num-test (sinh 5.0e-01+9.42443269378637893396e+00i) -5.2109527443404709218e-1+3.8933200722481911514e-4i) (num-test (sinh 5.0e-01-9.42443269378637893396e+00i) -5.2109527443404709218e-1-3.8933200722481911514e-4i) (num-test (sinh -5.0e-01+9.42443269378637893396e+00i) 5.2109527443404709218e-1+3.8933200722481911514e-4i) (num-test (sinh -5.0e-01-9.42443269378637893396e+00i) 5.2109527443404709218e-1-3.8933200722481911514e-4i) (num-test (sinh 5.0e-01+9.42512322775237976202e+00i) -5.2109527443404709231e-1-3.8933200722399054908e-4i) (num-test (sinh 5.0e-01-9.42512322775237976202e+00i) -5.2109527443404709231e-1+3.8933200722399054908e-4i) (num-test (sinh -5.0e-01+9.42512322775237976202e+00i) 5.2109527443404709231e-1-3.8933200722399054908e-4i) (num-test (sinh -5.0e-01-9.42512322775237976202e+00i) 5.2109527443404709231e-1+3.8933200722399054908e-4i) (num-test (sinh 1.0e+00-3.45266983001243932001e-04i) 1.1752011235963524660e0-5.3277478472501939236e-4i) (num-test (sinh 1.0e+00+3.45266983001243932001e-04i) 1.1752011235963524660e0+5.3277478472501939236e-4i) (num-test (sinh -1.0e+00-3.45266983001243932001e-04i) -1.1752011235963524660e0-5.3277478472501939236e-4i) (num-test (sinh -1.0e+00+3.45266983001243932001e-04i) -1.1752011235963524660e0+5.3277478472501939236e-4i) (num-test (sinh 1.0e+00+1.57045105981189525579e+00i) 4.0575816248730593018e-4+1.5430805428404715942e0i) (num-test (sinh 1.0e+00-1.57045105981189525579e+00i) 4.0575816248730593018e-4-1.5430805428404715942e0i) (num-test (sinh -1.0e+00+1.57045105981189525579e+00i) -4.0575816248730593018e-4+1.5430805428404715942e0i) (num-test (sinh -1.0e+00-1.57045105981189525579e+00i) -4.0575816248730593018e-4-1.5430805428404715942e0i) (num-test (sinh 1.0e+00+1.57114159377789786021e+00i) -4.0575816248716200955e-4+1.5430805428404715942e0i) (num-test (sinh 1.0e+00-1.57114159377789786021e+00i) -4.0575816248716200955e-4-1.5430805428404715942e0i) (num-test (sinh -1.0e+00+1.57114159377789786021e+00i) 4.0575816248716200955e-4+1.5430805428404715942e0i) (num-test (sinh -1.0e+00-1.57114159377789786021e+00i) 4.0575816248716200955e-4-1.5430805428404715942e0i) (num-test (sinh 1.0e+00+3.14124738660679181379e+00i) -1.1752011235963524659e0+5.3277478472529828958e-4i) (num-test (sinh 1.0e+00-3.14124738660679181379e+00i) -1.1752011235963524659e0-5.3277478472529828958e-4i) (num-test (sinh -1.0e+00+3.14124738660679181379e+00i) 1.1752011235963524659e0+5.3277478472529828958e-4i) (num-test (sinh -1.0e+00-3.14124738660679181379e+00i) 1.1752011235963524659e0-5.3277478472529828958e-4i) (num-test (sinh 1.0e+00+3.14193792057279441821e+00i) -1.1752011235963524660e0-5.3277478472492034385e-4i) (num-test (sinh 1.0e+00-3.14193792057279441821e+00i) -1.1752011235963524660e0+5.3277478472492034385e-4i) (num-test (sinh -1.0e+00+3.14193792057279441821e+00i) 1.1752011235963524660e0-5.3277478472492034385e-4i) (num-test (sinh -1.0e+00-3.14193792057279441821e+00i) 1.1752011235963524660e0+5.3277478472492034385e-4i) (num-test (sinh 1.0e+00+4.71204371340168837179e+00i) -4.0575816248744985081e-4-1.5430805428404715941e0i) (num-test (sinh 1.0e+00-4.71204371340168837179e+00i) -4.0575816248744985081e-4+1.5430805428404715941e0i) (num-test (sinh -1.0e+00+4.71204371340168837179e+00i) 4.0575816248744985081e-4-1.5430805428404715941e0i) (num-test (sinh -1.0e+00-4.71204371340168837179e+00i) 4.0575816248744985081e-4+1.5430805428404715941e0i) (num-test (sinh 1.0e+00+4.71273424736769097620e+00i) 4.0575816248701808892e-4-1.5430805428404715943e0i) (num-test (sinh 1.0e+00-4.71273424736769097620e+00i) 4.0575816248701808892e-4+1.5430805428404715943e0i) (num-test (sinh -1.0e+00+4.71273424736769097620e+00i) -4.0575816248701808892e-4-1.5430805428404715943e0i) (num-test (sinh -1.0e+00-4.71273424736769097620e+00i) -4.0575816248701808892e-4+1.5430805428404715943e0i) (num-test (sinh 1.0e+00+6.28284004019658492979e+00i) 1.1752011235963524659e0-5.3277478472548726245e-4i) (num-test (sinh 1.0e+00-6.28284004019658492979e+00i) 1.1752011235963524659e0+5.3277478472548726245e-4i) (num-test (sinh -1.0e+00+6.28284004019658492979e+00i) -1.1752011235963524659e0-5.3277478472548726245e-4i) (num-test (sinh -1.0e+00-6.28284004019658492979e+00i) -1.1752011235963524659e0+5.3277478472548726245e-4i) (num-test (sinh 1.0e+00+6.28353057416258753420e+00i) 1.1752011235963524661e0+5.3277478472473137099e-4i) (num-test (sinh 1.0e+00-6.28353057416258753420e+00i) 1.1752011235963524661e0-5.3277478472473137099e-4i) (num-test (sinh -1.0e+00+6.28353057416258753420e+00i) -1.1752011235963524661e0+5.3277478472473137099e-4i) (num-test (sinh -1.0e+00-6.28353057416258753420e+00i) -1.1752011235963524661e0-5.3277478472473137099e-4i) (num-test (sinh 1.0e+00+9.42443269378637893396e+00i) -1.1752011235963524662e0+5.3277478472430570447e-4i) (num-test (sinh 1.0e+00-9.42443269378637893396e+00i) -1.1752011235963524662e0-5.3277478472430570447e-4i) (num-test (sinh -1.0e+00+9.42443269378637893396e+00i) 1.1752011235963524662e0+5.3277478472430570447e-4i) (num-test (sinh -1.0e+00-9.42443269378637893396e+00i) 1.1752011235963524662e0-5.3277478472430570447e-4i) (num-test (sinh 1.0e+00+9.42512322775237976202e+00i) -1.1752011235963524665e0-5.3277478472317186729e-4i) (num-test (sinh 1.0e+00-9.42512322775237976202e+00i) -1.1752011235963524665e0+5.3277478472317186729e-4i) (num-test (sinh -1.0e+00+9.42512322775237976202e+00i) 1.1752011235963524665e0-5.3277478472317186729e-4i) (num-test (sinh -1.0e+00-9.42512322775237976202e+00i) 1.1752011235963524665e0+5.3277478472317186729e-4i) (num-test (sinh 2.0e+00-3.45266983001243932001e-04i) 3.6268601916692946556e0-1.2989619299126701883e-3i) (num-test (sinh 2.0e+00+3.45266983001243932001e-04i) 3.6268601916692946556e0+1.2989619299126701883e-3i) (num-test (sinh -2.0e+00-3.45266983001243932001e-04i) -3.6268601916692946556e0-1.2989619299126701883e-3i) (num-test (sinh -2.0e+00+3.45266983001243932001e-04i) -3.6268601916692946556e0+1.2989619299126701883e-3i) (num-test (sinh 2.0e+00+1.57045105981189525579e+00i) 1.2522351259047577385e-3+3.7621954668392959445e0i) (num-test (sinh 2.0e+00-1.57045105981189525579e+00i) 1.2522351259047577385e-3-3.7621954668392959445e0i) (num-test (sinh -2.0e+00+1.57045105981189525579e+00i) -1.2522351259047577385e-3+3.7621954668392959445e0i) (num-test (sinh -2.0e+00-1.57045105981189525579e+00i) -1.2522351259047577385e-3-3.7621954668392959445e0i) (num-test (sinh 2.0e+00+1.57114159377789786021e+00i) -1.2522351259043135762e-3+3.7621954668392959447e0i) (num-test (sinh 2.0e+00-1.57114159377789786021e+00i) -1.2522351259043135762e-3-3.7621954668392959447e0i) (num-test (sinh -2.0e+00+1.57114159377789786021e+00i) 1.2522351259043135762e-3+3.7621954668392959447e0i) (num-test (sinh -2.0e+00-1.57114159377789786021e+00i) 1.2522351259043135762e-3-3.7621954668392959447e0i) (num-test (sinh 2.0e+00+3.14124738660679181379e+00i) -3.6268601916692946553e0+1.2989619299133501696e-3i) (num-test (sinh 2.0e+00-3.14124738660679181379e+00i) -3.6268601916692946553e0-1.2989619299133501696e-3i) (num-test (sinh -2.0e+00+3.14124738660679181379e+00i) 3.6268601916692946553e0+1.2989619299133501696e-3i) (num-test (sinh -2.0e+00-3.14124738660679181379e+00i) 3.6268601916692946553e0-1.2989619299133501696e-3i) (num-test (sinh 2.0e+00+3.14193792057279441821e+00i) -3.6268601916692946556e0-1.2989619299124286975e-3i) (num-test (sinh 2.0e+00-3.14193792057279441821e+00i) -3.6268601916692946556e0+1.2989619299124286975e-3i) (num-test (sinh -2.0e+00+3.14193792057279441821e+00i) 3.6268601916692946556e0-1.2989619299124286975e-3i) (num-test (sinh -2.0e+00-3.14193792057279441821e+00i) 3.6268601916692946556e0+1.2989619299124286975e-3i) (num-test (sinh 2.0e+00+4.71204371340168837179e+00i) -1.2522351259052019007e-3-3.7621954668392959444e0i) (num-test (sinh 2.0e+00-4.71204371340168837179e+00i) -1.2522351259052019007e-3+3.7621954668392959444e0i) (num-test (sinh -2.0e+00+4.71204371340168837179e+00i) 1.2522351259052019007e-3-3.7621954668392959444e0i) (num-test (sinh -2.0e+00-4.71204371340168837179e+00i) 1.2522351259052019007e-3+3.7621954668392959444e0i) (num-test (sinh 2.0e+00+4.71273424736769097620e+00i) 1.2522351259038694139e-3-3.7621954668392959448e0i) (num-test (sinh 2.0e+00-4.71273424736769097620e+00i) 1.2522351259038694139e-3+3.7621954668392959448e0i) (num-test (sinh -2.0e+00+4.71273424736769097620e+00i) -1.2522351259038694139e-3-3.7621954668392959448e0i) (num-test (sinh -2.0e+00-4.71273424736769097620e+00i) -1.2522351259038694139e-3+3.7621954668392959448e0i) (num-test (sinh 2.0e+00+6.28284004019658492979e+00i) 3.6268601916692946552e0-1.2989619299138109057e-3i) (num-test (sinh 2.0e+00-6.28284004019658492979e+00i) 3.6268601916692946552e0+1.2989619299138109057e-3i) (num-test (sinh -2.0e+00+6.28284004019658492979e+00i) -3.6268601916692946552e0-1.2989619299138109057e-3i) (num-test (sinh -2.0e+00-6.28284004019658492979e+00i) -3.6268601916692946552e0+1.2989619299138109057e-3i) (num-test (sinh 2.0e+00+6.28353057416258753420e+00i) 3.6268601916692946558e0+1.2989619299119679614e-3i) (num-test (sinh 2.0e+00-6.28353057416258753420e+00i) 3.6268601916692946558e0-1.2989619299119679614e-3i) (num-test (sinh -2.0e+00+6.28353057416258753420e+00i) -3.6268601916692946558e0+1.2989619299119679614e-3i) (num-test (sinh -2.0e+00-6.28353057416258753420e+00i) -3.6268601916692946558e0-1.2989619299119679614e-3i) (num-test (sinh 2.0e+00+9.42443269378637893396e+00i) -3.6268601916692946561e0+1.2989619299109301409e-3i) (num-test (sinh 2.0e+00-9.42443269378637893396e+00i) -3.6268601916692946561e0-1.2989619299109301409e-3i) (num-test (sinh -2.0e+00+9.42443269378637893396e+00i) 3.6268601916692946561e0+1.2989619299109301409e-3i) (num-test (sinh -2.0e+00-9.42443269378637893396e+00i) 3.6268601916692946561e0-1.2989619299109301409e-3i) (num-test (sinh 2.0e+00+9.42512322775237976202e+00i) -3.6268601916692946571e0-1.2989619299081657245e-3i) (num-test (sinh 2.0e+00-9.42512322775237976202e+00i) -3.6268601916692946571e0+1.2989619299081657245e-3i) (num-test (sinh -2.0e+00+9.42512322775237976202e+00i) 3.6268601916692946571e0-1.2989619299081657245e-3i) (num-test (sinh -2.0e+00-9.42512322775237976202e+00i) 3.6268601916692946571e0+1.2989619299081657245e-3i) (num-test (sinh 0+i) (* 0+i (sin 1))) (num-test (sinh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (sinh 1.110223024625156799999999999999999999997E-16) 1.110223024625156800000000000000002280754E-16) (num-test (sinh 1/9223372036854775807) 1.084202172485504434125002235952170462235E-19) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'sinh num (sinh num) val))) (vector (list 0 0) (list 1 1.1752011936438) (list 2 3.626860407847) (list 3 10.01787492741) (list -1 -1.1752011936438) (list -2 -3.626860407847) (list -3 -10.01787492741) (list 1/2 0.52109530549375) (list 1/3 0.33954055725615) (list -1/2 -0.52109530549375) (list -1/3 -0.33954055725615) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 1.1752011936438) (list 2.0 3.626860407847) (list -2.0 -3.626860407847) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 0+1i 0+0.8414709848079i) (list 0+2i -0+0.90929742682568i) (list 0-1i 0-0.8414709848079i) (list 1+1i 0.63496391478474+1.298457581416i) (list 1-1i 0.63496391478474-1.298457581416i) (list -1+1i -0.63496391478474+1.298457581416i) (list -1-1i -0.63496391478474-1.298457581416i) (list 0.1+0.1i 0.099666333492108+0.10033299984131i) (list 1e-16+1e-16i 1e-16+1e-16i) )) (test (sinh) 'error) (test (sinh "hi") 'error) (test (sinh 1.0+23.0i 1.0+23.0i) 'error) (test (sinh 0 1) 'error) (for-each (lambda (arg) (test (sinh arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; cosh ;;; -------------------------------------------------------------------------------- (num-test (cosh 0) 1.0) (num-test (cosh 1) 1.54308063481524) (num-test (cosh 2) 3.76219569108363) (num-test (cosh 3) 10.06766199577777) (num-test (cosh 10) 11013.23292010332261) (num-test (cosh 0/1) 1.0) (num-test (cosh 0/2) 1.0) (num-test (cosh 0/3) 1.0) (num-test (cosh 0/10) 1.0) (num-test (cosh 0/1234) 1.0) (num-test (cosh 0/500029) 1.0) (num-test (cosh 1/1) 1.54308063481524) (num-test (cosh 1/2) 1.12762596520638) (num-test (cosh -1/2) 1.12762596520638) (num-test (cosh 1/3) 1.05607186782994) (num-test (cosh -1/3) 1.05607186782994) (num-test (cosh 1/10) 1.00500416805580) (num-test (cosh -1/10) 1.00500416805580) (num-test (cosh 1/1234) 1.00000032835203) (num-test (cosh -1/1234) 1.00000032835203) (num-test (cosh 1/500029) 1.00000000000200) (num-test (cosh -1/500029) 1.00000000000200) (num-test (cosh 2/1) 3.76219569108363) (num-test (cosh 2/2) 1.54308063481524) (num-test (cosh 2/3) 1.23057558004363) (num-test (cosh 2/10) 1.02006675561908) (num-test (cosh -2/10) 1.02006675561908) (num-test (cosh 2/1234) 1.00000131340834) (num-test (cosh -2/1234) 1.00000131340834) (num-test (cosh 2/500029) 1.00000000000800) (num-test (cosh -2/500029) 1.00000000000800) (num-test (cosh 3/1) 10.06766199577777) (num-test (cosh 3/2) 2.35240961524325) (num-test (cosh 3/3) 1.54308063481524) (num-test (cosh 3/10) 1.04533851412886) (num-test (cosh -3/10) 1.04533851412886) (num-test (cosh 3/1234) 1.00000295516958) (num-test (cosh -3/1234) 1.00000295516958) (num-test (cosh 3/500029) 1.00000000001800) (num-test (cosh -3/500029) 1.00000000001800) (num-test (cosh 10/1) 11013.23292010332261) (num-test (cosh 10/2) 74.20994852478785) (num-test (cosh 10/3) 14.03364944393670) (num-test (cosh 10/10) 1.54308063481524) (num-test (cosh 10/1234) 1.00003283538113) (num-test (cosh -10/1234) 1.00003283538113) (num-test (cosh 10/500029) 1.00000000019998) (num-test (cosh -10/500029) 1.00000000019998) (num-test (cosh 1234/500029) 1.00000304516030) (num-test (cosh -1234/500029) 1.00000304516030) (num-test (cosh 500029/500029) 1.54308063481524) (num-test (cosh 0.0) 1.0) (num-test (cosh 0.00000001) 1.0) (num-test (cosh -0.00000001) 1.0) (num-test (cosh 1.0) 1.54308063481524) (num-test (cosh pi) 11.59195327552152) (num-test (cosh 0.0+0.0i) 1.0) (num-test (cosh -0.0+0.0i) 1.0) (num-test (cosh 0.0-0.0i) 1.0) (num-test (cosh -0.0-0.0i) 1.0) (num-test (cosh 0.0+0.00000001i) 1.0) (num-test (cosh -0.0+0.00000001i) 1.0) (num-test (cosh 0.0-0.00000001i) 1.0) (num-test (cosh -0.0-0.00000001i) 1.0) (num-test (cosh 0.0+1.0i) 0.54030230586814) (num-test (cosh -0.0+1.0i) 0.54030230586814) (num-test (cosh 0.0-1.0i) 0.54030230586814) (num-test (cosh 0.0+3.14159265358979i) -1.0) (num-test (cosh -0.0+3.14159265358979i) -1.0) (num-test (cosh 0.0-3.14159265358979i) -1.0) (num-test (cosh 0.00000001+0.0i) 1.0) (num-test (cosh -0.00000001+0.0i) 1.0) (num-test (cosh 0.00000001-0.0i) 1.0) (num-test (cosh -0.00000001-0.0i) 1.0) (num-test (cosh 0.00000001+0.00000001i) 1.0+1e-16i) ; maxima (num-test (cosh -0.00000001+0.00000001i) 1.0-1e-16i) (num-test (cosh 0.00000001-0.00000001i) 1.0-1e-16i) (num-test (cosh -0.00000001-0.00000001i) 1.0+1e-16i) (num-test (cosh 0.00000001+1.0i) 0.54030230586814+0.00000000841471i) (num-test (cosh 0.00000001-1.0i) 0.54030230586814-0.00000000841471i) (num-test (cosh 0.00000001+3.14159265358979i) -1.0-6.982889851335445E-23i) ;maxima -- stopped here (num-test (cosh 0.00000001-3.14159265358979i) -1.0-0.0i) (num-test (cosh 1.0+0.0i) 1.54308063481524) (num-test (cosh 1.0-0.0i) 1.54308063481524) (num-test (cosh 1.0+0.00000001i) 1.54308063481524+0.00000001175201i) (num-test (cosh 1.0-0.00000001i) 1.54308063481524-0.00000001175201i) (num-test (cosh 1.0+1.0i) 0.83373002513115+0.98889770576287i) (num-test (cosh 1.0-1.0i) 0.83373002513115-0.98889770576287i) (num-test (cosh 1.0+3.14159265358979i) -1.54308063481524+0.0i) (num-test (cosh 1.0-3.14159265358979i) -1.54308063481524-0.0i) (num-test (cosh 3.14159265358979+0.0i) 11.59195327552152) (num-test (cosh 3.14159265358979-0.0i) 11.59195327552152) (num-test (cosh 3.14159265358979+0.00000001i) 11.59195327552152+0.00000011548739i) (num-test (cosh 3.14159265358979-0.00000001i) 11.59195327552152-0.00000011548739i) (num-test (cosh 3.14159265358979+1.0i) 6.26315908428001+9.71792908024139i) (num-test (cosh 3.14159265358979-1.0i) 6.26315908428001-9.71792908024139i) (num-test (cosh 3.14159265358979+3.14159265358979i) -11.59195327552152+0.0i) (num-test (cosh 3.14159265358979-3.14159265358979i) -11.59195327552152-0.0i) (num-test (cosh -2/3) 1.230575580043636) (num-test (cosh -3/2) 2.352409615243247) (num-test (cosh -10/3) 14.03364944393623) (num-test (cosh 1234/3) 2.18155865313939E+178) (num-test (cosh 1234/10) 1.953930316004457E+53) (num-test (cosh 500029/1234) 4.77955809407816E+175) (num-test (cosh -3.14159265358979) 11.5919532755216) (num-test (cosh 0.00000001+1.0i) +0.5403023058681398+8.414709848078964E-9i) (num-test (cosh 0.00000001+3.14159265358979i) -1.0-6.982889851335445E-23i) (num-test (cosh 0.00000001+1234.0i) -0.7985506235875843+6.019276547624973E-9i) (num-test (cosh 1.0+0.00000001i) +1.543080634815244+1.1752011936438014E-8i) (num-test (cosh 1.0+3.14159265358979i) -1.543080634815244-8.206300488372603E-15i) (num-test (cosh 3.14159265358979+0.0i) 11.5919532755216) (num-test (cosh 3.14159265358979+0.00000001i) +11.5919532755216+1.154873935725783E-7i) (num-test (cosh 3.14159265358979+1.0i) +6.263159084280057+9.71792908024146i) (num-test (cosh 3.14159265358979+3.14159265358979i) -11.5919532755216-8.064357485351393E-14i) (num-test (cosh 3.14159265358979+1234.0i) -9.256761516765916+6.951505596777556i) (num-test (cosh 0.0e+00-3.45266983001243932001e-04i) 9.9999994039535581673e-1+0.0i) (num-test (cosh 0.0e+00+3.45266983001243932001e-04i) 9.9999994039535581673e-1+0.0i) (num-test (cosh 0.0e+00+1.57045105981189525579e+00i) 3.4526697614152485627e-4+0.0i) (num-test (cosh 0.0e+00-1.57045105981189525579e+00i) 3.4526697614152485627e-4+0.0i) (num-test (cosh 0.0e+00+1.57114159377789786021e+00i) -3.4526697614140239160e-4+0.0i) (num-test (cosh 0.0e+00-1.57114159377789786021e+00i) -3.4526697614140239160e-4+0.0i) (num-test (cosh 0.0e+00+3.14124738660679181379e+00i) -9.9999994039535581667e-1+0.0i) (num-test (cosh 0.0e+00-3.14124738660679181379e+00i) -9.9999994039535581667e-1+0.0i) (num-test (cosh 0.0e+00+3.14193792057279441821e+00i) -9.9999994039535581675e-1+0.0i) (num-test (cosh 0.0e+00-3.14193792057279441821e+00i) -9.9999994039535581675e-1+0.0i) (num-test (cosh 0.0e+00+4.71204371340168837179e+00i) -3.4526697614164732094e-4+0.0i) (num-test (cosh 0.0e+00-4.71204371340168837179e+00i) -3.4526697614164732094e-4+0.0i) (num-test (cosh 0.0e+00+4.71273424736769097620e+00i) 3.4526697614127992692e-4+0.0i) (num-test (cosh 0.0e+00-4.71273424736769097620e+00i) 3.4526697614127992692e-4+0.0i) (num-test (cosh 0.0e+00+6.28284004019658492979e+00i) 9.9999994039535581662e-1+0.0i) (num-test (cosh 0.0e+00-6.28284004019658492979e+00i) 9.9999994039535581662e-1+0.0i) (num-test (cosh 0.0e+00+6.28353057416258753420e+00i) 9.9999994039535581679e-1+0.0i) (num-test (cosh 0.0e+00-6.28353057416258753420e+00i) 9.9999994039535581679e-1+0.0i) (num-test (cosh 0.0e+00+9.42443269378637893396e+00i) -9.9999994039535581689e-1+0.0i) (num-test (cosh 0.0e+00-9.42443269378637893396e+00i) -9.9999994039535581689e-1+0.0i) (num-test (cosh 0.0e+00+9.42512322775237976202e+00i) -9.9999994039535581714e-1+0.0i) (num-test (cosh 0.0e+00-9.42512322775237976202e+00i) -9.9999994039535581714e-1+0.0i) (num-test (cosh 1.19209289550781250e-07-3.45266983001243932001e-04i) 9.9999994039536292216e-1-4.1159030931163569191e-11i) (num-test (cosh 1.19209289550781250e-07+3.45266983001243932001e-04i) 9.9999994039536292216e-1+4.1159030931163569191e-11i) (num-test (cosh -1.19209289550781250e-07-3.45266983001243932001e-04i) 9.9999994039536292216e-1+4.1159030931163569191e-11i) (num-test (cosh -1.19209289550781250e-07+3.45266983001243932001e-04i) 9.9999994039536292216e-1-4.1159030931163569191e-11i) (num-test (cosh 1.19209289550781250e-07+1.57045105981189525579e+00i) 3.4526697614152730954e-4+1.1920928244535424532e-7i) (num-test (cosh 1.19209289550781250e-07-1.57045105981189525579e+00i) 3.4526697614152730954e-4-1.1920928244535424532e-7i) (num-test (cosh -1.19209289550781250e-07+1.57045105981189525579e+00i) 3.4526697614152730954e-4-1.1920928244535424532e-7i) (num-test (cosh -1.19209289550781250e-07-1.57045105981189525579e+00i) 3.4526697614152730954e-4+1.1920928244535424532e-7i) (num-test (cosh 1.19209289550781250e-07+1.57114159377789786021e+00i) -3.4526697614140484486e-4+1.1920928244535424533e-7i) (num-test (cosh 1.19209289550781250e-07-1.57114159377789786021e+00i) -3.4526697614140484486e-4-1.1920928244535424533e-7i) (num-test (cosh -1.19209289550781250e-07+1.57114159377789786021e+00i) -3.4526697614140484486e-4-1.1920928244535424533e-7i) (num-test (cosh -1.19209289550781250e-07-1.57114159377789786021e+00i) -3.4526697614140484486e-4+1.1920928244535424533e-7i) (num-test (cosh 1.19209289550781250e-07+3.14124738660679181379e+00i) -9.9999994039536292209e-1+4.1159030931185115142e-11i) (num-test (cosh 1.19209289550781250e-07-3.14124738660679181379e+00i) -9.9999994039536292209e-1-4.1159030931185115142e-11i) (num-test (cosh -1.19209289550781250e-07+3.14124738660679181379e+00i) -9.9999994039536292209e-1-4.1159030931185115142e-11i) (num-test (cosh -1.19209289550781250e-07-3.14124738660679181379e+00i) -9.9999994039536292209e-1+4.1159030931185115142e-11i) (num-test (cosh 1.19209289550781250e-07+3.14193792057279441821e+00i) -9.9999994039536292218e-1-4.1159030931155917289e-11i) (num-test (cosh 1.19209289550781250e-07-3.14193792057279441821e+00i) -9.9999994039536292218e-1+4.1159030931155917289e-11i) (num-test (cosh -1.19209289550781250e-07+3.14193792057279441821e+00i) -9.9999994039536292218e-1+4.1159030931155917289e-11i) (num-test (cosh -1.19209289550781250e-07-3.14193792057279441821e+00i) -9.9999994039536292218e-1-4.1159030931155917289e-11i) (num-test (cosh 1.19209289550781250e-07+4.71204371340168837179e+00i) -3.4526697614164977421e-4-1.1920928244535424532e-7i) (num-test (cosh 1.19209289550781250e-07-4.71204371340168837179e+00i) -3.4526697614164977421e-4+1.1920928244535424532e-7i) (num-test (cosh -1.19209289550781250e-07+4.71204371340168837179e+00i) -3.4526697614164977421e-4+1.1920928244535424532e-7i) (num-test (cosh -1.19209289550781250e-07-4.71204371340168837179e+00i) -3.4526697614164977421e-4-1.1920928244535424532e-7i) (num-test (cosh 1.19209289550781250e-07+4.71273424736769097620e+00i) 3.4526697614128238019e-4-1.1920928244535424533e-7i) (num-test (cosh 1.19209289550781250e-07-4.71273424736769097620e+00i) 3.4526697614128238019e-4+1.1920928244535424533e-7i) (num-test (cosh -1.19209289550781250e-07+4.71273424736769097620e+00i) 3.4526697614128238019e-4+1.1920928244535424533e-7i) (num-test (cosh -1.19209289550781250e-07-4.71273424736769097620e+00i) 3.4526697614128238019e-4-1.1920928244535424533e-7i) (num-test (cosh 1.19209289550781250e-07+6.28284004019658492979e+00i) 9.9999994039536292205e-1-4.1159030931199714069e-11i) (num-test (cosh 1.19209289550781250e-07-6.28284004019658492979e+00i) 9.9999994039536292205e-1+4.1159030931199714069e-11i) (num-test (cosh -1.19209289550781250e-07+6.28284004019658492979e+00i) 9.9999994039536292205e-1+4.1159030931199714069e-11i) (num-test (cosh -1.19209289550781250e-07-6.28284004019658492979e+00i) 9.9999994039536292205e-1-4.1159030931199714069e-11i) (num-test (cosh 1.19209289550781250e-07+6.28353057416258753420e+00i) 9.9999994039536292222e-1+4.1159030931141318362e-11i) (num-test (cosh 1.19209289550781250e-07-6.28353057416258753420e+00i) 9.9999994039536292222e-1-4.1159030931141318362e-11i) (num-test (cosh -1.19209289550781250e-07+6.28353057416258753420e+00i) 9.9999994039536292222e-1-4.1159030931141318362e-11i) (num-test (cosh -1.19209289550781250e-07-6.28353057416258753420e+00i) 9.9999994039536292222e-1+4.1159030931141318362e-11i) (num-test (cosh 1.19209289550781250e-07+9.42443269378637893396e+00i) -9.9999994039536292231e-1+4.1159030931108433883e-11i) (num-test (cosh 1.19209289550781250e-07-9.42443269378637893396e+00i) -9.9999994039536292231e-1-4.1159030931108433883e-11i) (num-test (cosh -1.19209289550781250e-07+9.42443269378637893396e+00i) -9.9999994039536292231e-1-4.1159030931108433883e-11i) (num-test (cosh -1.19209289550781250e-07-9.42443269378637893396e+00i) -9.9999994039536292231e-1+4.1159030931108433883e-11i) (num-test (cosh 1.19209289550781250e-07+9.42512322775237976202e+00i) -9.9999994039536292257e-1-4.1159030931020840323e-11i) (num-test (cosh 1.19209289550781250e-07-9.42512322775237976202e+00i) -9.9999994039536292257e-1+4.1159030931020840323e-11i) (num-test (cosh -1.19209289550781250e-07+9.42512322775237976202e+00i) -9.9999994039536292257e-1+4.1159030931020840323e-11i) (num-test (cosh -1.19209289550781250e-07-9.42512322775237976202e+00i) -9.9999994039536292257e-1-4.1159030931020840323e-11i) (num-test (cosh 5.0e-01-3.45266983001243932001e-04i) 1.1276258979946363573e0-1.7991700040930800151e-4i) (num-test (cosh 5.0e-01+3.45266983001243932001e-04i) 1.1276258979946363573e0+1.7991700040930800151e-4i) (num-test (cosh -5.0e-01-3.45266983001243932001e-04i) 1.1276258979946363573e0+1.7991700040930800151e-4i) (num-test (cosh -5.0e-01+3.45266983001243932001e-04i) 1.1276258979946363573e0-1.7991700040930800151e-4i) (num-test (cosh 5.0e-01+1.57045105981189525579e+00i) 3.8933200722547541227e-4+5.2109527443404709207e-1i) (num-test (cosh 5.0e-01-1.57045105981189525579e+00i) 3.8933200722547541227e-4-5.2109527443404709207e-1i) (num-test (cosh -5.0e-01+1.57045105981189525579e+00i) 3.8933200722547541227e-4-5.2109527443404709207e-1i) (num-test (cosh -5.0e-01-1.57045105981189525579e+00i) 3.8933200722547541227e-4+5.2109527443404709207e-1i) (num-test (cosh 5.0e-01+1.57114159377789786021e+00i) -3.8933200722533731792e-4+5.2109527443404709209e-1i) (num-test (cosh 5.0e-01-1.57114159377789786021e+00i) -3.8933200722533731792e-4-5.2109527443404709209e-1i) (num-test (cosh -5.0e-01+1.57114159377789786021e+00i) -3.8933200722533731792e-4-5.2109527443404709209e-1i) (num-test (cosh -5.0e-01-1.57114159377789786021e+00i) -3.8933200722533731792e-4+5.2109527443404709209e-1i) (num-test (cosh 5.0e-01+3.14124738660679181379e+00i) -1.1276258979946363572e0+1.7991700040940218455e-4i) (num-test (cosh 5.0e-01-3.14124738660679181379e+00i) -1.1276258979946363572e0-1.7991700040940218455e-4i) (num-test (cosh -5.0e-01+3.14124738660679181379e+00i) -1.1276258979946363572e0-1.7991700040940218455e-4i) (num-test (cosh -5.0e-01-3.14124738660679181379e+00i) -1.1276258979946363572e0+1.7991700040940218455e-4i) (num-test (cosh 5.0e-01+3.14193792057279441821e+00i) -1.1276258979946363573e0-1.7991700040927455302e-4i) (num-test (cosh 5.0e-01-3.14193792057279441821e+00i) -1.1276258979946363573e0+1.7991700040927455302e-4i) (num-test (cosh -5.0e-01+3.14193792057279441821e+00i) -1.1276258979946363573e0+1.7991700040927455302e-4i) (num-test (cosh -5.0e-01-3.14193792057279441821e+00i) -1.1276258979946363573e0-1.7991700040927455302e-4i) (num-test (cosh 5.0e-01+4.71204371340168837179e+00i) -3.8933200722561350661e-4-5.2109527443404709205e-1i) (num-test (cosh 5.0e-01-4.71204371340168837179e+00i) -3.8933200722561350661e-4+5.2109527443404709205e-1i) (num-test (cosh -5.0e-01+4.71204371340168837179e+00i) -3.8933200722561350661e-4+5.2109527443404709205e-1i) (num-test (cosh -5.0e-01-4.71204371340168837179e+00i) -3.8933200722561350661e-4-5.2109527443404709205e-1i) (num-test (cosh 5.0e-01+4.71273424736769097620e+00i) 3.8933200722519922358e-4-5.2109527443404709212e-1i) (num-test (cosh 5.0e-01-4.71273424736769097620e+00i) 3.8933200722519922358e-4+5.2109527443404709212e-1i) (num-test (cosh -5.0e-01+4.71273424736769097620e+00i) 3.8933200722519922358e-4+5.2109527443404709212e-1i) (num-test (cosh -5.0e-01-4.71273424736769097620e+00i) 3.8933200722519922358e-4-5.2109527443404709212e-1i) (num-test (cosh 5.0e-01+6.28284004019658492979e+00i) 1.1276258979946363572e0-1.7991700040946600032e-4i) (num-test (cosh 5.0e-01-6.28284004019658492979e+00i) 1.1276258979946363572e0+1.7991700040946600032e-4i) (num-test (cosh -5.0e-01+6.28284004019658492979e+00i) 1.1276258979946363572e0+1.7991700040946600032e-4i) (num-test (cosh -5.0e-01-6.28284004019658492979e+00i) 1.1276258979946363572e0-1.7991700040946600032e-4i) (num-test (cosh 5.0e-01+6.28353057416258753420e+00i) 1.1276258979946363574e0+1.7991700040921073725e-4i) (num-test (cosh 5.0e-01-6.28353057416258753420e+00i) 1.1276258979946363574e0-1.7991700040921073725e-4i) (num-test (cosh -5.0e-01+6.28353057416258753420e+00i) 1.1276258979946363574e0-1.7991700040921073725e-4i) (num-test (cosh -5.0e-01-6.28353057416258753420e+00i) 1.1276258979946363574e0+1.7991700040921073725e-4i) (num-test (cosh 5.0e-01+9.42443269378637893396e+00i) -1.1276258979946363575e0+1.7991700040906699050e-4i) (num-test (cosh 5.0e-01-9.42443269378637893396e+00i) -1.1276258979946363575e0-1.7991700040906699050e-4i) (num-test (cosh -5.0e-01+9.42443269378637893396e+00i) -1.1276258979946363575e0-1.7991700040906699050e-4i) (num-test (cosh -5.0e-01-9.42443269378637893396e+00i) -1.1276258979946363575e0+1.7991700040906699050e-4i) (num-test (cosh 5.0e-01+9.42512322775237976202e+00i) -1.1276258979946363577e0-1.7991700040868409591e-4i) (num-test (cosh 5.0e-01-9.42512322775237976202e+00i) -1.1276258979946363577e0+1.7991700040868409591e-4i) (num-test (cosh -5.0e-01+9.42512322775237976202e+00i) -1.1276258979946363577e0+1.7991700040868409591e-4i) (num-test (cosh -5.0e-01-9.42512322775237976202e+00i) -1.1276258979946363577e0-1.7991700040868409591e-4i) (num-test (cosh 1.0e+00-3.45266983001243932001e-04i) 1.5430805428404715942e0-4.057581624871654840e-4i) (num-test (cosh 1.0e+00+3.45266983001243932001e-04i) 1.5430805428404715942e0+4.057581624871654840e-4i) (num-test (cosh -1.0e+00-3.45266983001243932001e-04i) 1.5430805428404715942e0+4.057581624871654840e-4i) (num-test (cosh -1.0e+00+3.45266983001243932001e-04i) 1.5430805428404715942e0-4.057581624871654840e-4i) (num-test (cosh 1.0e+00+1.57045105981189525579e+00i) 5.3277478472520380315e-4+1.1752011235963524659e0i) (num-test (cosh 1.0e+00-1.57045105981189525579e+00i) 5.3277478472520380315e-4-1.1752011235963524659e0i) (num-test (cosh -1.0e+00+1.57045105981189525579e+00i) 5.3277478472520380315e-4-1.1752011235963524659e0i) (num-test (cosh -1.0e+00-1.57045105981189525579e+00i) 5.3277478472520380315e-4+1.1752011235963524659e0i) (num-test (cosh 1.0e+00+1.57114159377789786021e+00i) -5.3277478472501483029e-4+1.1752011235963524660e0i) (num-test (cosh 1.0e+00-1.57114159377789786021e+00i) -5.3277478472501483029e-4-1.1752011235963524660e0i) (num-test (cosh -1.0e+00+1.57114159377789786021e+00i) -5.3277478472501483029e-4-1.1752011235963524660e0i) (num-test (cosh -1.0e+00-1.57114159377789786021e+00i) -5.3277478472501483029e-4+1.1752011235963524660e0i) (num-test (cosh 1.0e+00+3.14124738660679181379e+00i) -1.5430805428404715941e0+4.0575816248737789049e-4i) (num-test (cosh 1.0e+00-3.14124738660679181379e+00i) -1.5430805428404715941e0-4.0575816248737789049e-4i) (num-test (cosh -1.0e+00+3.14124738660679181379e+00i) -1.5430805428404715941e0-4.0575816248737789049e-4i) (num-test (cosh -1.0e+00-3.14124738660679181379e+00i) -1.5430805428404715941e0+4.0575816248737789049e-4i) (num-test (cosh 1.0e+00+3.14193792057279441821e+00i) -1.5430805428404715943e0-4.0575816248709004923e-4i) (num-test (cosh 1.0e+00-3.14193792057279441821e+00i) -1.5430805428404715943e0+4.0575816248709004923e-4i) (num-test (cosh -1.0e+00+3.14193792057279441821e+00i) -1.5430805428404715943e0+4.0575816248709004923e-4i) (num-test (cosh -1.0e+00-3.14193792057279441821e+00i) -1.5430805428404715943e0-4.0575816248709004923e-4i) (num-test (cosh 1.0e+00+4.71204371340168837179e+00i) -5.3277478472539277601e-4-1.1752011235963524659e0i) (num-test (cosh 1.0e+00-4.71204371340168837179e+00i) -5.3277478472539277601e-4+1.1752011235963524659e0i) (num-test (cosh -1.0e+00+4.71204371340168837179e+00i) -5.3277478472539277601e-4+1.1752011235963524659e0i) (num-test (cosh -1.0e+00-4.71204371340168837179e+00i) -5.3277478472539277601e-4-1.1752011235963524659e0i) (num-test (cosh 1.0e+00+4.71273424736769097620e+00i) 5.3277478472482585742e-4-1.1752011235963524660e0i) (num-test (cosh 1.0e+00-4.71273424736769097620e+00i) 5.3277478472482585742e-4+1.1752011235963524660e0i) (num-test (cosh -1.0e+00+4.71273424736769097620e+00i) 5.3277478472482585742e-4+1.1752011235963524660e0i) (num-test (cosh -1.0e+00-4.71273424736769097620e+00i) 5.3277478472482585742e-4-1.1752011235963524660e0i) (num-test (cosh 1.0e+00+6.28284004019658492979e+00i) 1.5430805428404715941e0-4.0575816248752181112e-4i) (num-test (cosh 1.0e+00-6.28284004019658492979e+00i) 1.5430805428404715941e0+4.0575816248752181112e-4i) (num-test (cosh -1.0e+00+6.28284004019658492979e+00i) 1.5430805428404715941e0+4.0575816248752181112e-4i) (num-test (cosh -1.0e+00-6.28284004019658492979e+00i) 1.5430805428404715941e0-4.0575816248752181112e-4i) (num-test (cosh 1.0e+00+6.28353057416258753420e+00i) 1.5430805428404715943e0+4.0575816248694612861e-4i) (num-test (cosh 1.0e+00-6.28353057416258753420e+00i) 1.5430805428404715943e0-4.0575816248694612861e-4i) (num-test (cosh -1.0e+00+6.28353057416258753420e+00i) 1.5430805428404715943e0-4.0575816248694612861e-4i) (num-test (cosh -1.0e+00-6.28353057416258753420e+00i) 1.5430805428404715943e0+4.0575816248694612861e-4i) (num-test (cosh 1.0e+00+9.42443269378637893396e+00i) -1.5430805428404715945e0+4.0575816248662194348e-4i) (num-test (cosh 1.0e+00-9.42443269378637893396e+00i) -1.5430805428404715945e0-4.0575816248662194348e-4i) (num-test (cosh -1.0e+00+9.42443269378637893396e+00i) -1.5430805428404715945e0-4.0575816248662194348e-4i) (num-test (cosh -1.0e+00-9.42443269378637893396e+00i) -1.5430805428404715945e0+4.0575816248662194348e-4i) (num-test (cosh 1.0e+00+9.42512322775237976202e+00i) -1.5430805428404715949e0-4.0575816248575841970e-4i) (num-test (cosh 1.0e+00-9.42512322775237976202e+00i) -1.5430805428404715949e0+4.0575816248575841970e-4i) (num-test (cosh -1.0e+00+9.42512322775237976202e+00i) -1.5430805428404715949e0+4.0575816248575841970e-4i) (num-test (cosh -1.0e+00-9.42512322775237976202e+00i) -1.5430805428404715949e0-4.0575816248575841970e-4i) (num-test (cosh 2.0e+00-3.45266983001243932001e-04i) 3.7621954668392959447e0-1.2522351259043242989e-3i) (num-test (cosh 2.0e+00+3.45266983001243932001e-04i) 3.7621954668392959447e0+1.2522351259043242989e-3i) (num-test (cosh -2.0e+00-3.45266983001243932001e-04i) 3.7621954668392959447e0+1.2522351259043242989e-3i) (num-test (cosh -2.0e+00+3.45266983001243932001e-04i) 3.7621954668392959447e0-1.2522351259043242989e-3i) (num-test (cosh 2.0e+00+1.57045105981189525579e+00i) 1.2989619299131198016e-3+3.6268601916692946554e0i) (num-test (cosh 2.0e+00-1.57045105981189525579e+00i) 1.2989619299131198016e-3-3.6268601916692946554e0i) (num-test (cosh -2.0e+00+1.57045105981189525579e+00i) 1.2989619299131198016e-3-3.6268601916692946554e0i) (num-test (cosh -2.0e+00-1.57045105981189525579e+00i) 1.2989619299131198016e-3+3.6268601916692946554e0i) (num-test (cosh 2.0e+00+1.57114159377789786021e+00i) -1.2989619299126590655e-3+3.6268601916692946556e0i) (num-test (cosh 2.0e+00-1.57114159377789786021e+00i) -1.2989619299126590655e-3-3.6268601916692946556e0i) (num-test (cosh -2.0e+00+1.57114159377789786021e+00i) -1.2989619299126590655e-3-3.6268601916692946556e0i) (num-test (cosh -2.0e+00-1.57114159377789786021e+00i) -1.2989619299126590655e-3+3.6268601916692946556e0i) (num-test (cosh 2.0e+00+3.14124738660679181379e+00i) -3.7621954668392959444e0+1.2522351259049798196e-3i) (num-test (cosh 2.0e+00-3.14124738660679181379e+00i) -3.7621954668392959444e0-1.2522351259049798196e-3i) (num-test (cosh -2.0e+00+3.14124738660679181379e+00i) -3.7621954668392959444e0-1.2522351259049798196e-3i) (num-test (cosh -2.0e+00-3.14124738660679181379e+00i) -3.7621954668392959444e0+1.2522351259049798196e-3i) (num-test (cosh 2.0e+00+3.14193792057279441821e+00i) -3.7621954668392959448e0-1.2522351259040914950e-3i) (num-test (cosh 2.0e+00-3.14193792057279441821e+00i) -3.7621954668392959448e0+1.2522351259040914950e-3i) (num-test (cosh -2.0e+00+3.14193792057279441821e+00i) -3.7621954668392959448e0+1.2522351259040914950e-3i) (num-test (cosh -2.0e+00-3.14193792057279441821e+00i) -3.7621954668392959448e0-1.2522351259040914950e-3i) (num-test (cosh 2.0e+00+4.71204371340168837179e+00i) -1.2989619299135805376e-3-3.6268601916692946552e0i) (num-test (cosh 2.0e+00-4.71204371340168837179e+00i) -1.2989619299135805376e-3+3.6268601916692946552e0i) (num-test (cosh -2.0e+00+4.71204371340168837179e+00i) -1.2989619299135805376e-3+3.6268601916692946552e0i) (num-test (cosh -2.0e+00-4.71204371340168837179e+00i) -1.2989619299135805376e-3-3.6268601916692946552e0i) (num-test (cosh 2.0e+00+4.71273424736769097620e+00i) 1.2989619299121983294e-3-3.6268601916692946557e0i) (num-test (cosh 2.0e+00-4.71273424736769097620e+00i) 1.2989619299121983294e-3+3.6268601916692946557e0i) (num-test (cosh -2.0e+00+4.71273424736769097620e+00i) 1.2989619299121983294e-3+3.6268601916692946557e0i) (num-test (cosh -2.0e+00-4.71273424736769097620e+00i) 1.2989619299121983294e-3-3.6268601916692946557e0i) (num-test (cosh 2.0e+00+6.28284004019658492979e+00i) 3.7621954668392959443e0-1.2522351259054239819e-3i) (num-test (cosh 2.0e+00-6.28284004019658492979e+00i) 3.7621954668392959443e0+1.2522351259054239819e-3i) (num-test (cosh -2.0e+00+6.28284004019658492979e+00i) 3.7621954668392959443e0+1.2522351259054239819e-3i) (num-test (cosh -2.0e+00-6.28284004019658492979e+00i) 3.7621954668392959443e0-1.2522351259054239819e-3i) (num-test (cosh 2.0e+00+6.28353057416258753420e+00i) 3.7621954668392959449e0+1.2522351259036473328e-3i) (num-test (cosh 2.0e+00-6.28353057416258753420e+00i) 3.7621954668392959449e0-1.2522351259036473328e-3i) (num-test (cosh -2.0e+00+6.28353057416258753420e+00i) 3.7621954668392959449e0-1.2522351259036473328e-3i) (num-test (cosh -2.0e+00-6.28353057416258753420e+00i) 3.7621954668392959449e0+1.2522351259036473328e-3i) (num-test (cosh 2.0e+00+9.42443269378637893396e+00i) -3.7621954668392959453e0+1.2522351259026468452e-3i) (num-test (cosh 2.0e+00-9.42443269378637893396e+00i) -3.7621954668392959453e0-1.2522351259026468452e-3i) (num-test (cosh -2.0e+00+9.42443269378637893396e+00i) -3.7621954668392959453e0-1.2522351259026468452e-3i) (num-test (cosh -2.0e+00-9.42443269378637893396e+00i) -3.7621954668392959453e0+1.2522351259026468452e-3i) (num-test (cosh 2.0e+00+9.42512322775237976202e+00i) -3.7621954668392959462e0-1.2522351258999818715e-3i) (num-test (cosh 2.0e+00-9.42512322775237976202e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i) (num-test (cosh -2.0e+00+9.42512322775237976202e+00i) -3.7621954668392959462e0+1.2522351258999818715e-3i) (num-test (cosh -2.0e+00-9.42512322775237976202e+00i) -3.7621954668392959462e0-1.2522351258999818715e-3i) (num-test (cosh (log (/ (+ 1 (sqrt 5)) 2))) (/ (sqrt 5) 2)) (num-test (/ (+ (cos (/ 10)) (cosh (/ 10)) (* 2 (cos (/ (sqrt 2) 20)) (cosh (/ (sqrt 2) 20)))) 4) 1.0000000000002480) (num-test (cosh -2.225073858507201399999999999999999999996E-308) 1.000E0) (num-test (cosh 1.110223024625156799999999999999999999997E-16) 1.000000000000000000000000000000006162976E0) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'cosh num (cosh num) val))) (vector (list 0 1) (list 1 1.5430806348152) (list 2 3.7621956910836) (list 3 10.067661995778) (list -1 1.5430806348152) (list -2 3.7621956910836) (list -3 10.067661995778) (list 1/2 1.1276259652064) (list 1/3 1.0560718678299) (list -1/2 1.1276259652064) (list -1/3 1.0560718678299) (list 1/9223372036854775807 1.0) (list 0.0 1.0) (list 1.0 1.5430806348152) (list 2.0 3.7621956910836) (list -2.0 3.7621956910836) (list 1.000000000000000000000000000000000000002E-309 1.000E0) (list 0+1i 0.54030230586814) (list 0+2i -0.41614683654714) (list 0-1i 0.54030230586814) (list 1+1i 0.83373002513115+0.98889770576287i) (list 1-1i 0.83373002513115-0.98889770576287i) (list -1+1i 0.83373002513115-0.98889770576287i) (list -1-1i 0.83373002513115+0.98889770576287i) (list 0.1+0.1i 0.9999833333373+0.0099999888888898i) (list 1e-16+1e-16i 1+1e-32i) )) (when with-bignums (let ((max-s-error 0.0) (max-s-error-case 0) (max-sh-error 0.0) (max-sh-error-case 0)) (do ((x 0.10000000000000000000000 (+ x 0.1000000000000000000000))) ((> x (* 2 pi))) (let ((s (sin x)) (sh (sinh x)) (c (cos x)) (ch (cosh x))) (let ((err (magnitude (- (+ (* s s) (* c c)) 1)))) (if (> err max-s-error) (begin (set! max-s-error err) (set! max-s-error-case x)))) (let ((err (magnitude (+ (- (* sh sh) (* ch ch)) 1)))) (if (> err max-sh-error) (begin (set! max-sh-error err) (set! max-sh-error-case x)))))) (if (> max-s-error 1e-35) (format #t "s^2 + c^2 error: ~A at ~A~%" max-s-error max-s-error-case)) (if (> max-sh-error 1e-33) (format #t "sh^2 + ch^2 error: ~A at ~A~%" max-sh-error max-sh-error-case))) (num-test (sinh 1000.0) 9.850355570085234969444396761216615626576E433) (num-test (cosh 1000.0) 9.850355570085234969444396761216615626576E433)) (test (cosh) 'error) (test (cosh "hi") 'error) (test (cosh 1.0+23.0i 1.0+23.0i) 'error) (test (cosh 0 1) 'error) (num-test (cosh 1/9223372036854775807) 1.000000000000000000000000000000000000006E0) (for-each (lambda (arg) (test (cosh arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; tanh ;;; -------------------------------------------------------------------------------- (num-test (tanh 0) 0.0) (num-test (tanh 1) 0.76159415595576) (num-test (tanh -1) -0.76159415595576) (num-test (tanh 2) 0.96402758007582) (num-test (tanh -2) -0.96402758007582) (num-test (tanh 3) 0.99505475368673) (num-test (tanh -3) -0.99505475368673) (num-test (tanh 10) 0.99999999587769) (num-test (tanh -10) -0.99999999587769) (num-test (tanh 0/1) 0.0) (num-test (tanh 0/2) 0.0) (num-test (tanh 0/3) 0.0) (num-test (tanh 0/10) 0.0) (num-test (tanh 0/1234) 0.0) (num-test (tanh 0/500029) 0.0) (num-test (tanh 1/1) 0.76159415595576) (num-test (tanh -1/1) -0.76159415595576) (num-test (tanh 1/2) 0.46211715726001) (num-test (tanh -1/2) -0.46211715726001) (num-test (tanh 1/3) 0.32151273753163) (num-test (tanh -1/3) -0.32151273753163) (num-test (tanh 1/10) 0.09966799462496) (num-test (tanh -1/10) -0.09966799462496) (num-test (tanh 1/1234) 0.00081037259408) (num-test (tanh -1/1234) -0.00081037259408) (num-test (tanh 1/500029) 0.00000199988401) (num-test (tanh -1/500029) -0.00000199988401) (num-test (tanh 2/1) 0.96402758007582) (num-test (tanh -2/1) -0.96402758007582) (num-test (tanh 2/2) 0.76159415595576) (num-test (tanh -2/2) -0.76159415595576) (num-test (tanh 2/3) 0.58278294534791) (num-test (tanh -2/3) -0.58278294534791) (num-test (tanh 2/10) 0.19737532022490) (num-test (tanh -2/10) -0.19737532022490) (num-test (tanh 2/1234) 0.00162074412382) (num-test (tanh -2/1234) -0.00162074412382) (num-test (tanh 2/500029) 0.00000399976801) (num-test (tanh -2/500029) -0.00000399976801) (num-test (tanh 3/1) 0.99505475368673) (num-test (tanh -3/1) -0.99505475368673) (num-test (tanh 3/2) 0.90514825364487) (num-test (tanh -3/2) -0.90514825364487) (num-test (tanh 3/3) 0.76159415595576) (num-test (tanh -3/3) -0.76159415595576) (num-test (tanh 3/10) 0.29131261245159) (num-test (tanh -3/10) -0.29131261245159) (num-test (tanh 3/1234) 0.00243111352486) (num-test (tanh -3/1234) -0.00243111352486) (num-test (tanh 3/500029) 0.00000599965202) (num-test (tanh -3/500029) -0.00000599965202) (num-test (tanh 10/1) 0.99999999587769) (num-test (tanh -10/1) -0.99999999587769) (num-test (tanh 10/2) 0.99990920426260) (num-test (tanh -10/2) -0.99990920426260) (num-test (tanh 10/3) 0.99745796747384) (num-test (tanh -10/3) -0.99745796747384) (num-test (tanh 10/10) 0.76159415595576) (num-test (tanh -10/10) -0.76159415595576) (num-test (tanh 10/1234) 0.00810355032772) (num-test (tanh -10/1234) -0.00810355032772) (num-test (tanh 10/500029) 0.00001999884006) (num-test (tanh -10/500029) -0.00001999884006) (num-test (tanh 1234/10) 1.0) (num-test (tanh -1234/10) -1.0) (num-test (tanh 1234/500029) 0.00246785185430) (num-test (tanh -1234/500029) -0.00246785185430) (num-test (tanh 500029/500029) 0.76159415595576) (num-test (tanh -500029/500029) -0.76159415595576) (num-test (tanh 0.0) 0.0) (num-test (tanh 0.00000001) 0.00000001) (num-test (tanh -0.00000001) -0.00000001) (num-test (tanh 1.0) 0.76159415595576) (num-test (tanh -1.0) -0.76159415595576) (num-test (tanh pi) 0.99627207622075) (num-test (tanh -3.14159265358979) -0.99627207622075) (num-test (tanh 0.0+0.0i) 0.0) (num-test (tanh -0.0+0.0i) 0.0) (num-test (tanh 0.0-0.0i) 0.0) (num-test (tanh -0.0-0.0i) 0.0) (num-test (tanh 0.0+0.00000001i) 0.0+0.00000001i) (num-test (tanh -0.0+0.00000001i) 0.0+0.00000001i) (num-test (tanh 0.0-0.00000001i) 0.0-0.00000001i) (num-test (tanh -0.0-0.00000001i) -0.0-0.00000001i) (num-test (tanh 0.0+1.0i) 0.0+1.55740772465490i) (num-test (tanh -0.0+1.0i) 0.0+1.55740772465490i) (num-test (tanh 0.0-1.0i) 0.0-1.55740772465490i) (num-test (tanh -0.0-1.0i) -0.0-1.55740772465490i) (num-test (tanh 0.00000001+0.0i) 0.00000001) (num-test (tanh -0.00000001+0.0i) -0.00000001) (num-test (tanh 0.00000001-0.0i) 0.00000001) (num-test (tanh -0.00000001-0.0i) -0.00000001) (num-test (tanh 0.00000001+0.00000001i) 0.00000001+0.00000001i) (num-test (tanh -0.00000001+0.00000001i) -0.00000001+0.00000001i) (num-test (tanh 0.00000001-0.00000001i) 0.00000001-0.00000001i) (num-test (tanh -0.00000001-0.00000001i) -0.00000001-0.00000001i) (num-test (tanh 0.00000001+1.0i) 0.00000003425519+1.55740772465490i) (num-test (tanh -0.00000001+1.0i) -0.00000003425519+1.55740772465490i) (num-test (tanh 0.00000001-1.0i) 0.00000003425519-1.55740772465490i) (num-test (tanh -0.00000001-1.0i) -0.00000003425519-1.55740772465490i) (num-test (tanh 1.0+0.0i) 0.76159415595576) (num-test (tanh -1.0+0.0i) -0.76159415595576) (num-test (tanh 1.0-0.0i) 0.76159415595576) (num-test (tanh -1.0-0.0i) -0.76159415595576) (num-test (tanh 1.0+0.00000001i) 0.76159415595576+0.00000000419974i) (num-test (tanh -1.0+0.00000001i) -0.76159415595576+0.00000000419974i) (num-test (tanh 1.0-0.00000001i) 0.76159415595576-0.00000000419974i) (num-test (tanh -1.0-0.00000001i) -0.76159415595576-0.00000000419974i) (num-test (tanh 1.0+1.0i) 1.08392332733869+0.27175258531951i) (num-test (tanh -1.0+1.0i) -1.08392332733869+0.27175258531951i) (num-test (tanh 1.0-1.0i) 1.08392332733869-0.27175258531951i) (num-test (tanh -1.0-1.0i) -1.08392332733869-0.27175258531951i) (num-test (tanh 3.14159265358979+0.0i) 0.99627207622075) (num-test (tanh -3.14159265358979+0.0i) -0.99627207622075) (num-test (tanh 3.14159265358979-0.0i) 0.99627207622075) (num-test (tanh -3.14159265358979-0.0i) -0.99627207622075) (num-test (tanh 3.14159265358979+0.00000001i) 0.99627207622075+0.00000000007442i) (num-test (tanh -3.14159265358979+0.00000001i) -0.99627207622075+0.00000000007442i) (num-test (tanh 3.14159265358979-0.00000001i) 0.99627207622075-0.00000000007442i) (num-test (tanh -3.14159265358979-0.00000001i) -0.99627207622075-0.00000000007442i) (num-test (tanh 3.14159265358979+1.0i) 1.00154968930275+0.00340139653674i) (num-test (tanh -3.14159265358979+1.0i) -1.00154968930275+0.00340139653674i) (num-test (tanh 3.14159265358979-1.0i) 1.00154968930275-0.00340139653674i) (num-test (tanh -3.14159265358979-1.0i) -1.00154968930275-0.00340139653674i) (num-test (tanh 1234/3) 1.0) (num-test (tanh 500029/2) 1.0) (num-test (tanh 500029/3) 1.0) (num-test (tanh 500029/10) 1.0) (num-test (tanh 500029/1234) 1.0) (num-test (tanh 0.0+3.14159265358979i) 0.0+6.982889851335445E-15i) (num-test (tanh 0.00000001+3.14159265358979i) 1.0e-8+6.982889851335444E-15i) (num-test (tanh 0.00000001+1234.0i) 1.5681770497896427E-8-0.7537751984442328i) (num-test (tanh 1.0+3.14159265358979i) +0.7615941559557649+2.932634567877868E-15i) (num-test (tanh 3.14159265358979+3.14159265358979i) +0.99627207622075+5.196631812627532E-17i) (num-test (tanh 3.14159265358979+1234.0i) .9989656315245496-0.003586791196867043i) (num-test (tanh 1234.0+0.00000001i) +1.0+8.077935669463161E-28i) (num-test (tanh 1234.0+3.14159265358979i) 1.0) (num-test (tanh 0.0e+00-3.45266983001243932001e-04i) 0-3.4526699672092183585e-4i) (num-test (tanh 0.0e+00+3.45266983001243932001e-04i) 0+3.4526699672092183585e-4i) (num-test (tanh 0.0e+00+1.57045105981189525579e+00i) 0+2.8963092606501007060e3i) (num-test (tanh 0.0e+00-1.57045105981189525579e+00i) 0-2.8963092606501007060e3i) (num-test (tanh 0.0e+00+1.57114159377789786021e+00i) 0-2.8963092606511280143e3i) (num-test (tanh 0.0e+00-1.57114159377789786021e+00i) 0+2.8963092606511280143e3i) (num-test (tanh 0.0e+00+3.14124738660679181379e+00i) 0-3.4526699672110257641e-4i) (num-test (tanh 0.0e+00-3.14124738660679181379e+00i) 0+3.4526699672110257641e-4i) (num-test (tanh 0.0e+00+3.14193792057279441821e+00i) 0+3.4526699672085764703e-4i) (num-test (tanh 0.0e+00-3.14193792057279441821e+00i) 0-3.4526699672085764703e-4i) (num-test (tanh 0.0e+00+4.71204371340168837179e+00i) 0+2.8963092606490733978e3i) (num-test (tanh 0.0e+00-4.71204371340168837179e+00i) 0-2.8963092606490733978e3i) (num-test (tanh 0.0e+00+4.71273424736769097620e+00i) 0-2.8963092606521553225e3i) (num-test (tanh 0.0e+00-4.71273424736769097620e+00i) 0+2.8963092606521553225e3i) (num-test (tanh 0.0e+00+6.28284004019658492979e+00i) 0-3.4526699672122504111e-4i) (num-test (tanh 0.0e+00-6.28284004019658492979e+00i) 0+3.4526699672122504111e-4i) (num-test (tanh 0.0e+00+6.28353057416258753420e+00i) 0+3.4526699672073518233e-4i) (num-test (tanh 0.0e+00-6.28353057416258753420e+00i) 0-3.4526699672073518233e-4i) (num-test (tanh 0.0e+00+9.42443269378637893396e+00i) 0-3.4526699672045932728e-4i) (num-test (tanh 0.0e+00-9.42443269378637893396e+00i) 0+3.4526699672045932728e-4i) (num-test (tanh 0.0e+00+9.42512322775237976202e+00i) 0+3.4526699671972453911e-4i) (num-test (tanh 0.0e+00-9.42512322775237976202e+00i) 0-3.4526699671972453911e-4i) (num-test (tanh 1.19209289550781250e-07-3.45266983001243932001e-04i) 1.1920930376163652989e-7-3.4526699672091692931e-4i) (num-test (tanh 1.19209289550781250e-07+3.45266983001243932001e-04i) 1.1920930376163652989e-7+3.4526699672091692931e-4i) (num-test (tanh -1.19209289550781250e-07-3.45266983001243932001e-04i) -1.1920930376163652989e-7-3.4526699672091692931e-4i) (num-test (tanh -1.19209289550781250e-07+3.45266983001243932001e-04i) -1.1920930376163652989e-7+3.4526699672091692931e-4i) (num-test (tanh 1.19209289550781250e-07+1.57045105981189525579e+00i) 9.9999992052646305569e-1+2.8963089153831588642e3i) (num-test (tanh 1.19209289550781250e-07-1.57045105981189525579e+00i) 9.9999992052646305569e-1-2.8963089153831588642e3i) (num-test (tanh -1.19209289550781250e-07+1.57045105981189525579e+00i) -9.9999992052646305569e-1+2.8963089153831588642e3i) (num-test (tanh -1.19209289550781250e-07-1.57045105981189525579e+00i) -9.9999992052646305569e-1-2.8963089153831588642e3i) (num-test (tanh 1.19209289550781250e-07+1.57114159377789786021e+00i) 9.9999992052717244672e-1-2.8963089153841861720e3i) (num-test (tanh 1.19209289550781250e-07-1.57114159377789786021e+00i) 9.9999992052717244672e-1+2.8963089153841861720e3i) (num-test (tanh -1.19209289550781250e-07+1.57114159377789786021e+00i) -9.9999992052717244672e-1-2.8963089153841861720e3i) (num-test (tanh -1.19209289550781250e-07-1.57114159377789786021e+00i) -9.9999992052717244672e-1+2.8963089153841861720e3i) (num-test (tanh 1.19209289550781250e-07+3.14124738660679181379e+00i) 1.1920930376163652991e-7-3.4526699672109766987e-4i) (num-test (tanh 1.19209289550781250e-07-3.14124738660679181379e+00i) 1.1920930376163652991e-7+3.4526699672109766987e-4i) (num-test (tanh -1.19209289550781250e-07+3.14124738660679181379e+00i) -1.1920930376163652991e-7-3.4526699672109766987e-4i) (num-test (tanh -1.19209289550781250e-07-3.14124738660679181379e+00i) -1.1920930376163652991e-7+3.4526699672109766987e-4i) (num-test (tanh 1.19209289550781250e-07+3.14193792057279441821e+00i) 1.1920930376163652989e-7+3.4526699672085274049e-4i) (num-test (tanh 1.19209289550781250e-07-3.14193792057279441821e+00i) 1.1920930376163652989e-7-3.4526699672085274049e-4i) (num-test (tanh -1.19209289550781250e-07+3.14193792057279441821e+00i) -1.1920930376163652989e-7+3.4526699672085274049e-4i) (num-test (tanh -1.19209289550781250e-07-3.14193792057279441821e+00i) -1.1920930376163652989e-7-3.4526699672085274049e-4i) (num-test (tanh 1.19209289550781250e-07+4.71204371340168837179e+00i) 9.9999992052575366466e-1+2.8963089153821315563e3i) (num-test (tanh 1.19209289550781250e-07-4.71204371340168837179e+00i) 9.9999992052575366466e-1-2.8963089153821315563e3i) (num-test (tanh -1.19209289550781250e-07+4.71204371340168837179e+00i) -9.9999992052575366466e-1+2.8963089153821315563e3i) (num-test (tanh -1.19209289550781250e-07-4.71204371340168837179e+00i) -9.9999992052575366466e-1-2.8963089153821315563e3i) (num-test (tanh 1.19209289550781250e-07+4.71273424736769097620e+00i) 9.9999992052788183776e-1-2.8963089153852134799e3i) (num-test (tanh 1.19209289550781250e-07-4.71273424736769097620e+00i) 9.9999992052788183776e-1+2.8963089153852134799e3i) (num-test (tanh -1.19209289550781250e-07+4.71273424736769097620e+00i) -9.9999992052788183776e-1-2.8963089153852134799e3i) (num-test (tanh -1.19209289550781250e-07-4.71273424736769097620e+00i) -9.9999992052788183776e-1+2.8963089153852134799e3i) (num-test (tanh 1.19209289550781250e-07+6.28284004019658492979e+00i) 1.1920930376163652992e-7-3.4526699672122013457e-4i) (num-test (tanh 1.19209289550781250e-07-6.28284004019658492979e+00i) 1.1920930376163652992e-7+3.4526699672122013457e-4i) (num-test (tanh -1.19209289550781250e-07+6.28284004019658492979e+00i) -1.1920930376163652992e-7-3.4526699672122013457e-4i) (num-test (tanh -1.19209289550781250e-07-6.28284004019658492979e+00i) -1.1920930376163652992e-7+3.4526699672122013457e-4i) (num-test (tanh 1.19209289550781250e-07+6.28353057416258753420e+00i) 1.1920930376163652988e-7+3.4526699672073027579e-4i) (num-test (tanh 1.19209289550781250e-07-6.28353057416258753420e+00i) 1.1920930376163652988e-7-3.4526699672073027579e-4i) (num-test (tanh -1.19209289550781250e-07+6.28353057416258753420e+00i) -1.1920930376163652988e-7+3.4526699672073027579e-4i) (num-test (tanh -1.19209289550781250e-07-6.28353057416258753420e+00i) -1.1920930376163652988e-7-3.4526699672073027579e-4i) (num-test (tanh 1.19209289550781250e-07+9.42443269378637893396e+00i) 1.1920930376163652985e-7-3.4526699672045442074e-4i) (num-test (tanh 1.19209289550781250e-07-9.42443269378637893396e+00i) 1.1920930376163652985e-7+3.4526699672045442074e-4i) (num-test (tanh -1.19209289550781250e-07+9.42443269378637893396e+00i) -1.1920930376163652985e-7-3.4526699672045442074e-4i) (num-test (tanh -1.19209289550781250e-07-9.42443269378637893396e+00i) -1.1920930376163652985e-7+3.4526699672045442074e-4i) (num-test (tanh 1.19209289550781250e-07+9.42512322775237976202e+00i) 1.1920930376163652979e-7+3.4526699671971963257e-4i) (num-test (tanh 1.19209289550781250e-07-9.42512322775237976202e+00i) 1.1920930376163652979e-7-3.4526699671971963257e-4i) (num-test (tanh -1.19209289550781250e-07+9.42512322775237976202e+00i) -1.1920930376163652979e-7+3.4526699671971963257e-4i) (num-test (tanh -1.19209289550781250e-07-9.42512322775237976202e+00i) -1.1920930376163652979e-7-3.4526699671971963257e-4i) (num-test (tanh 5.0e-01-3.45266983001243932001e-04i) 4.6211720058436229979e-1-2.7153443992655805934e-4i) (num-test (tanh 5.0e-01+3.45266983001243932001e-04i) 4.6211720058436229979e-1+2.7153443992655805934e-4i) (num-test (tanh -5.0e-01-3.45266983001243932001e-04i) -4.6211720058436229979e-1-2.7153443992655805934e-4i) (num-test (tanh -5.0e-01+3.45266983001243932001e-04i) -4.6211720058436229979e-1+2.7153443992655805934e-4i) (num-test (tanh 5.0e-01+1.57045105981189525579e+00i) 2.1639524637389325996e0+1.2715121175455623363e-3i) (num-test (tanh 5.0e-01-1.57045105981189525579e+00i) 2.1639524637389325996e0-1.2715121175455623363e-3i) (num-test (tanh -5.0e-01+1.57045105981189525579e+00i) -2.1639524637389325996e0+1.2715121175455623363e-3i) (num-test (tanh -5.0e-01-1.57045105981189525579e+00i) -2.1639524637389325996e0-1.2715121175455623363e-3i) (num-test (tanh 5.0e-01+1.57114159377789786021e+00i) 2.1639524637389326002e0-1.2715121175451113370e-3i) (num-test (tanh 5.0e-01-1.57114159377789786021e+00i) 2.1639524637389326002e0+1.2715121175451113370e-3i) (num-test (tanh -5.0e-01+1.57114159377789786021e+00i) -2.1639524637389326002e0-1.2715121175451113370e-3i) (num-test (tanh -5.0e-01-1.57114159377789786021e+00i) -2.1639524637389326002e0+1.2715121175451113370e-3i) (num-test (tanh 5.0e-01+3.14124738660679181379e+00i) 4.6211720058436229984e-1-2.7153443992670020234e-4i) (num-test (tanh 5.0e-01-3.14124738660679181379e+00i) 4.6211720058436229984e-1+2.7153443992670020234e-4i) (num-test (tanh -5.0e-01+3.14124738660679181379e+00i) -4.6211720058436229984e-1-2.7153443992670020234e-4i) (num-test (tanh -5.0e-01-3.14124738660679181379e+00i) -4.6211720058436229984e-1+2.7153443992670020234e-4i) (num-test (tanh 5.0e-01+3.14193792057279441821e+00i) 4.6211720058436229978e-1+2.7153443992650757820e-4i) (num-test (tanh 5.0e-01-3.14193792057279441821e+00i) 4.6211720058436229978e-1-2.7153443992650757820e-4i) (num-test (tanh -5.0e-01+3.14193792057279441821e+00i) -4.6211720058436229978e-1+2.7153443992650757820e-4i) (num-test (tanh -5.0e-01-3.14193792057279441821e+00i) -4.6211720058436229978e-1-2.7153443992650757820e-4i) (num-test (tanh 5.0e-01+4.71204371340168837179e+00i) 2.1639524637389325989e0+1.2715121175460133355e-3i) (num-test (tanh 5.0e-01-4.71204371340168837179e+00i) 2.1639524637389325989e0-1.2715121175460133355e-3i) (num-test (tanh -5.0e-01+4.71204371340168837179e+00i) -2.1639524637389325989e0+1.2715121175460133355e-3i) (num-test (tanh -5.0e-01-4.71204371340168837179e+00i) -2.1639524637389325989e0-1.2715121175460133355e-3i) (num-test (tanh 5.0e-01+4.71273424736769097620e+00i) 2.1639524637389326009e0-1.2715121175446603377e-3i) (num-test (tanh 5.0e-01-4.71273424736769097620e+00i) 2.1639524637389326009e0+1.2715121175446603377e-3i) (num-test (tanh -5.0e-01+4.71273424736769097620e+00i) -2.1639524637389326009e0-1.2715121175446603377e-3i) (num-test (tanh -5.0e-01-4.71273424736769097620e+00i) -2.1639524637389326009e0+1.2715121175446603377e-3i) (num-test (tanh 5.0e-01+6.28284004019658492979e+00i) 4.6211720058436229987e-1-2.7153443992679651442e-4i) (num-test (tanh 5.0e-01-6.28284004019658492979e+00i) 4.6211720058436229987e-1+2.7153443992679651442e-4i) (num-test (tanh -5.0e-01+6.28284004019658492979e+00i) -4.6211720058436229987e-1-2.7153443992679651442e-4i) (num-test (tanh -5.0e-01-6.28284004019658492979e+00i) -4.6211720058436229987e-1+2.7153443992679651442e-4i) (num-test (tanh 5.0e-01+6.28353057416258753420e+00i) 4.6211720058436229974e-1+2.7153443992641126612e-4i) (num-test (tanh 5.0e-01-6.28353057416258753420e+00i) 4.6211720058436229974e-1-2.7153443992641126612e-4i) (num-test (tanh -5.0e-01+6.28353057416258753420e+00i) -4.6211720058436229974e-1+2.7153443992641126612e-4i) (num-test (tanh -5.0e-01-6.28353057416258753420e+00i) -4.6211720058436229974e-1-2.7153443992641126612e-4i) (num-test (tanh 5.0e-01+9.42443269378637893396e+00i) 4.6211720058436229968e-1-2.7153443992619432056e-4i) (num-test (tanh 5.0e-01-9.42443269378637893396e+00i) 4.6211720058436229968e-1+2.7153443992619432056e-4i) (num-test (tanh -5.0e-01+9.42443269378637893396e+00i) -4.6211720058436229968e-1-2.7153443992619432056e-4i) (num-test (tanh -5.0e-01-9.42443269378637893396e+00i) -4.6211720058436229968e-1+2.7153443992619432056e-4i) (num-test (tanh 5.0e-01+9.42512322775237976202e+00i) 4.6211720058436229949e-1+2.7153443992561644811e-4i) (num-test (tanh 5.0e-01-9.42512322775237976202e+00i) 4.6211720058436229949e-1-2.7153443992561644811e-4i) (num-test (tanh -5.0e-01+9.42512322775237976202e+00i) -4.6211720058436229949e-1+2.7153443992561644811e-4i) (num-test (tanh -5.0e-01-9.42512322775237976202e+00i) -4.6211720058436229949e-1-2.7153443992561644811e-4i) (num-test (tanh 1.0e+00-3.45266983001243932001e-04i) 7.6159419408485704836e-1-1.4500326960274960880e-4i) (num-test (tanh 1.0e+00+3.45266983001243932001e-04i) 7.6159419408485704836e-1+1.4500326960274960880e-4i) (num-test (tanh -1.0e+00-3.45266983001243932001e-04i) -7.6159419408485704836e-1-1.4500326960274960880e-4i) (num-test (tanh -1.0e+00+3.45266983001243932001e-04i) -7.6159419408485704836e-1+1.4500326960274960880e-4i) (num-test (tanh 1.0e+00+1.57045105981189525579e+00i) 1.3130351721648674823e0+2.4999454374276273814e-4i) (num-test (tanh 1.0e+00-1.57045105981189525579e+00i) 1.3130351721648674823e0-2.4999454374276273814e-4i) (num-test (tanh -1.0e+00+1.57045105981189525579e+00i) -1.3130351721648674823e0+2.4999454374276273814e-4i) (num-test (tanh -1.0e+00-1.57045105981189525579e+00i) -1.3130351721648674823e0-2.4999454374276273814e-4i) (num-test (tanh 1.0e+00+1.57114159377789786021e+00i) 1.3130351721648674824e0-2.4999454374267406620e-4i) (num-test (tanh 1.0e+00-1.57114159377789786021e+00i) 1.3130351721648674824e0+2.4999454374267406620e-4i) (num-test (tanh -1.0e+00+1.57114159377789786021e+00i) -1.3130351721648674824e0-2.4999454374267406620e-4i) (num-test (tanh -1.0e+00-1.57114159377789786021e+00i) -1.3130351721648674824e0+2.4999454374267406620e-4i) (num-test (tanh 1.0e+00+3.14124738660679181379e+00i) 7.6159419408485704840e-1-1.4500326960282551519e-4i) (num-test (tanh 1.0e+00-3.14124738660679181379e+00i) 7.6159419408485704840e-1+1.4500326960282551519e-4i) (num-test (tanh -1.0e+00+3.14124738660679181379e+00i) -7.6159419408485704840e-1-1.4500326960282551519e-4i) (num-test (tanh -1.0e+00-3.14124738660679181379e+00i) -7.6159419408485704840e-1+1.4500326960282551519e-4i) (num-test (tanh 1.0e+00+3.14193792057279441821e+00i) 7.6159419408485704835e-1+1.4500326960272265115e-4i) (num-test (tanh 1.0e+00-3.14193792057279441821e+00i) 7.6159419408485704835e-1-1.4500326960272265115e-4i) (num-test (tanh -1.0e+00+3.14193792057279441821e+00i) -7.6159419408485704835e-1+1.4500326960272265115e-4i) (num-test (tanh -1.0e+00-3.14193792057279441821e+00i) -7.6159419408485704835e-1-1.4500326960272265115e-4i) (num-test (tanh 1.0e+00+4.71204371340168837179e+00i) 1.3130351721648674822e0+2.4999454374285141007e-4i) (num-test (tanh 1.0e+00-4.71204371340168837179e+00i) 1.3130351721648674822e0-2.4999454374285141007e-4i) (num-test (tanh -1.0e+00+4.71204371340168837179e+00i) -1.3130351721648674822e0+2.4999454374285141007e-4i) (num-test (tanh -1.0e+00-4.71204371340168837179e+00i) -1.3130351721648674822e0-2.4999454374285141007e-4i) (num-test (tanh 1.0e+00+4.71273424736769097620e+00i) 1.3130351721648674825e0-2.4999454374258539427e-4i) (num-test (tanh 1.0e+00-4.71273424736769097620e+00i) 1.3130351721648674825e0+2.4999454374258539427e-4i) (num-test (tanh -1.0e+00+4.71273424736769097620e+00i) -1.3130351721648674825e0-2.4999454374258539427e-4i) (num-test (tanh -1.0e+00-4.71273424736769097620e+00i) -1.3130351721648674825e0+2.4999454374258539427e-4i) (num-test (tanh 1.0e+00+6.28284004019658492979e+00i) 7.6159419408485704843e-1-1.4500326960287694721e-4i) (num-test (tanh 1.0e+00-6.28284004019658492979e+00i) 7.6159419408485704843e-1+1.4500326960287694721e-4i) (num-test (tanh -1.0e+00+6.28284004019658492979e+00i) -7.6159419408485704843e-1-1.4500326960287694721e-4i) (num-test (tanh -1.0e+00-6.28284004019658492979e+00i) -7.6159419408485704843e-1+1.4500326960287694721e-4i) (num-test (tanh 1.0e+00+6.28353057416258753420e+00i) 7.6159419408485704832e-1+1.4500326960267121913e-4i) (num-test (tanh 1.0e+00-6.28353057416258753420e+00i) 7.6159419408485704832e-1-1.4500326960267121913e-4i) (num-test (tanh -1.0e+00+6.28353057416258753420e+00i) -7.6159419408485704832e-1+1.4500326960267121913e-4i) (num-test (tanh -1.0e+00-6.28353057416258753420e+00i) -7.6159419408485704832e-1-1.4500326960267121913e-4i) (num-test (tanh 1.0e+00+9.42443269378637893396e+00i) 7.6159419408485704826e-1-1.4500326960255536711e-4i) (num-test (tanh 1.0e+00-9.42443269378637893396e+00i) 7.6159419408485704826e-1+1.4500326960255536711e-4i) (num-test (tanh -1.0e+00+9.42443269378637893396e+00i) -7.6159419408485704826e-1-1.4500326960255536711e-4i) (num-test (tanh -1.0e+00-9.42443269378637893396e+00i) -7.6159419408485704826e-1+1.4500326960255536711e-4i) (num-test (tanh 1.0e+00+9.42512322775237976202e+00i) 7.6159419408485704810e-1+1.450032696022467750e-4i) (num-test (tanh 1.0e+00-9.42512322775237976202e+00i) 7.6159419408485704810e-1-1.450032696022467750e-4i) (num-test (tanh -1.0e+00+9.42512322775237976202e+00i) -7.6159419408485704810e-1+1.450032696022467750e-4i) (num-test (tanh -1.0e+00-9.42512322775237976202e+00i) -7.6159419408485704810e-1-1.450032696022467750e-4i) (num-test (tanh 2.0e+00-3.45266983001243932001e-04i) 9.6402758819508310556e-1-2.4393395410435306874e-5i) (num-test (tanh 2.0e+00+3.45266983001243932001e-04i) 9.6402758819508310556e-1+2.4393395410435306874e-5i) (num-test (tanh -2.0e+00-3.45266983001243932001e-04i) -9.6402758819508310556e-1-2.4393395410435306874e-5i) (num-test (tanh -2.0e+00+3.45266983001243932001e-04i) -9.6402758819508310556e-1+2.4393395410435306874e-5i) (num-test (tanh 2.0e+00+1.57045105981189525579e+00i) 1.0373147113268752620e0+2.6247825506572821595e-5i) (num-test (tanh 2.0e+00-1.57045105981189525579e+00i) 1.0373147113268752620e0-2.6247825506572821595e-5i) (num-test (tanh -2.0e+00+1.57045105981189525579e+00i) -1.0373147113268752620e0+2.6247825506572821595e-5i) (num-test (tanh -2.0e+00-1.57045105981189525579e+00i) -1.0373147113268752620e0-2.6247825506572821595e-5i) (num-test (tanh 2.0e+00+1.57114159377789786021e+00i) 1.0373147113268752620e0-2.6247825506563511609e-5i) (num-test (tanh 2.0e+00-1.57114159377789786021e+00i) 1.0373147113268752620e0+2.6247825506563511609e-5i) (num-test (tanh -2.0e+00+1.57114159377789786021e+00i) -1.0373147113268752620e0-2.6247825506563511609e-5i) (num-test (tanh -2.0e+00-1.57114159377789786021e+00i) -1.0373147113268752620e0+2.6247825506563511609e-5i) (num-test (tanh 2.0e+00+3.14124738660679181379e+00i) 9.6402758819508310557e-1-2.4393395410448076340e-5i) (num-test (tanh 2.0e+00-3.14124738660679181379e+00i) 9.6402758819508310557e-1+2.4393395410448076340e-5i) (num-test (tanh -2.0e+00+3.14124738660679181379e+00i) -9.6402758819508310557e-1-2.4393395410448076340e-5i) (num-test (tanh -2.0e+00-3.14124738660679181379e+00i) -9.6402758819508310557e-1+2.4393395410448076340e-5i) (num-test (tanh 2.0e+00+3.14193792057279441821e+00i) 9.6402758819508310556e-1+2.4393395410430771882e-5i) (num-test (tanh 2.0e+00-3.14193792057279441821e+00i) 9.6402758819508310556e-1-2.4393395410430771882e-5i) (num-test (tanh -2.0e+00+3.14193792057279441821e+00i) -9.6402758819508310556e-1+2.4393395410430771882e-5i) (num-test (tanh -2.0e+00-3.14193792057279441821e+00i) -9.6402758819508310556e-1-2.4393395410430771882e-5i) (num-test (tanh 2.0e+00+4.71204371340168837179e+00i) 1.0373147113268752620e0+2.6247825506582131582e-5i) (num-test (tanh 2.0e+00-4.71204371340168837179e+00i) 1.0373147113268752620e0-2.6247825506582131582e-5i) (num-test (tanh -2.0e+00+4.71204371340168837179e+00i) -1.0373147113268752620e0+2.6247825506582131582e-5i) (num-test (tanh -2.0e+00-4.71204371340168837179e+00i) -1.0373147113268752620e0-2.6247825506582131582e-5i) (num-test (tanh 2.0e+00+4.71273424736769097620e+00i) 1.0373147113268752620e0-2.6247825506554201622e-5i) (num-test (tanh 2.0e+00-4.71273424736769097620e+00i) 1.0373147113268752620e0+2.6247825506554201622e-5i) (num-test (tanh -2.0e+00+4.71273424736769097620e+00i) -1.0373147113268752620e0-2.6247825506554201622e-5i) (num-test (tanh -2.0e+00-4.71273424736769097620e+00i) -1.0373147113268752620e0+2.6247825506554201622e-5i) (num-test (tanh 2.0e+00+6.28284004019658492979e+00i) 9.6402758819508310558e-1-2.4393395410456728569e-5i) (num-test (tanh 2.0e+00-6.28284004019658492979e+00i) 9.6402758819508310558e-1+2.4393395410456728569e-5i) (num-test (tanh -2.0e+00+6.28284004019658492979e+00i) -9.6402758819508310558e-1-2.4393395410456728569e-5i) (num-test (tanh -2.0e+00-6.28284004019658492979e+00i) -9.6402758819508310558e-1+2.4393395410456728569e-5i) (num-test (tanh 2.0e+00+6.28353057416258753420e+00i) 9.6402758819508310555e-1+2.4393395410422119654e-5i) (num-test (tanh 2.0e+00-6.28353057416258753420e+00i) 9.6402758819508310555e-1-2.4393395410422119654e-5i) (num-test (tanh -2.0e+00+6.28353057416258753420e+00i) -9.6402758819508310555e-1+2.4393395410422119654e-5i) (num-test (tanh -2.0e+00-6.28353057416258753420e+00i) -9.6402758819508310555e-1-2.4393395410422119654e-5i) (num-test (tanh 2.0e+00+9.42443269378637893396e+00i) 9.6402758819508310554e-1-2.4393395410402630273e-5i) (num-test (tanh 2.0e+00-9.42443269378637893396e+00i) 9.6402758819508310554e-1+2.4393395410402630273e-5i) (num-test (tanh -2.0e+00+9.42443269378637893396e+00i) -9.6402758819508310554e-1-2.4393395410402630273e-5i) (num-test (tanh -2.0e+00-9.42443269378637893396e+00i) -9.6402758819508310554e-1+2.4393395410402630273e-5i) (num-test (tanh 2.0e+00+9.42512322775237976202e+00i) 9.6402758819508310550e-1+2.439339541035071690e-5i) (num-test (tanh 2.0e+00-9.42512322775237976202e+00i) 9.6402758819508310550e-1-2.439339541035071690e-5i) (num-test (tanh -2.0e+00+9.42512322775237976202e+00i) -9.6402758819508310550e-1+2.439339541035071690e-5i) (num-test (tanh -2.0e+00-9.42512322775237976202e+00i) -9.6402758819508310550e-1-2.439339541035071690e-5i) (num-test (tanh 50) 1.0) (num-test (tanh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (tanh 1.110223024625156799999999999999999999997E-16) 1.110223024625156799999999999999995438476E-16) (test (nan? (tanh 1/0)) #t) ;(test (nan? (tanh 1/0+i)) #t) ;(test (nan? (tanh 1/0+1/0i)) #t) (test (nan? (tanh 1+1/0i)) #t) (test (nan? (tanh 0+1/0i)) #t) ;(test (nan? (tanh 1/0+0i)) #t) (num-test (tanh (complex -400.0 1.0)) -1.0) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'tanh num (tanh num) val))) (vector (list 0 0) (list 1 0.76159415595576) (list 2 0.96402758007582) (list 3 0.99505475368673) (list -1 -0.76159415595576) (list -2 -0.96402758007582) (list -3 -0.99505475368673) (list 9223372036854775807 1.0) (list -9223372036854775808 -1.0) (list 1/2 0.46211715726001) (list 1/3 0.32151273753163) (list -1/2 -0.46211715726001) (list -1/3 -0.32151273753163) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 0.76159415595576) (list 2.0 0.96402758007582) (list -2.0 -0.96402758007582) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 1e+16 1.0) (list +inf.0 1.0) (list -inf.0 -1.0) (list 0+1i 0+1.5574077246549i) (list 0+2i 0-2.1850398632615i) (list 0-1i 0-1.5574077246549i) (list 1+1i 1.0839233273387+0.27175258531951i) (list 1-1i 1.0839233273387-0.27175258531951i) (list -1+1i -1.0839233273387+0.27175258531951i) (list -1-1i -1.0839233273387-0.27175258531951i) (list 0.1+0.1i 0.10066129051146+0.099328043521656i) (list 1e+16+1e+16i 1.0) (list 1e-16+1e-16i 1e-16+1e-16i) )) (test (tanh) 'error) (test (tanh "hi") 'error) (test (tanh 1.0+23.0i 1.0+23.0i) 'error) (test (tanh 0 1) 'error) (for-each (lambda (arg) (test (tanh arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; asinh ;;; -------------------------------------------------------------------------------- (num-test (asinh 0) 0.0) (num-test (asinh 1) 0.88137358701954) (num-test (asinh -1) -0.88137358701954) (num-test (asinh 2) 1.44363547517881) (num-test (asinh -2) -1.44363547517881) (num-test (asinh 3) 1.81844645923207) (num-test (asinh -3) -1.81844645923207) (num-test (asinh 10) 2.99822295029797) (num-test (asinh -10) -2.99822295029798) (num-test (asinh 1234) 7.81116354920125) (num-test (asinh -1234) -7.81116354896171) (num-test (asinh 500029) 13.81556855628334) (num-test (asinh 0/1) 0.0) (num-test (asinh 0/2) 0.0) (num-test (asinh 0/3) 0.0) (num-test (asinh 0/10) 0.0) (num-test (asinh 0/1234) 0.0) (num-test (asinh 0/500029) 0.0) (num-test (asinh 1/1) 0.88137358701954) (num-test (asinh -1/1) -0.88137358701954) (num-test (asinh 1/2) 0.48121182505960) (num-test (asinh -1/2) -0.48121182505960) (num-test (asinh 1/3) 0.32745015023726) (num-test (asinh -1/3) -0.32745015023726) (num-test (asinh 1/10) 0.09983407889921) (num-test (asinh -1/10) -0.09983407889921) (num-test (asinh 1/1234) 0.00081037268278) (num-test (asinh -1/1234) -0.00081037268278) (num-test (asinh 1/500029) 0.00000199988401) (num-test (asinh -1/500029) -0.00000199988401) (num-test (asinh 2/1) 1.44363547517881) (num-test (asinh -2/1) -1.44363547517881) (num-test (asinh 2/2) 0.88137358701954) (num-test (asinh -2/2) -0.88137358701954) (num-test (asinh 2/3) 0.62514511725042) (num-test (asinh -2/3) -0.62514511725042) (num-test (asinh 2/10) 0.19869011034924) (num-test (asinh -2/10) -0.19869011034924) (num-test (asinh 2/1234) 0.00162074483338) (num-test (asinh -2/1234) -0.00162074483338) (num-test (asinh 2/500029) 0.00000399976801) (num-test (asinh -2/500029) -0.00000399976801) (num-test (asinh 3/1) 1.81844645923207) (num-test (asinh -3/1) -1.81844645923207) (num-test (asinh 3/2) 1.19476321728711) (num-test (asinh -3/2) -1.19476321728711) (num-test (asinh 3/3) 0.88137358701954) (num-test (asinh -3/3) -0.88137358701954) (num-test (asinh 3/10) 0.29567304756342) (num-test (asinh -3/10) -0.29567304756342) (num-test (asinh 3/1234) 0.00243111591964) (num-test (asinh -3/1234) -0.00243111591964) (num-test (asinh 3/500029) 0.00000599965202) (num-test (asinh -3/500029) -0.00000599965202) (num-test (asinh 10/1) 2.99822295029797) (num-test (asinh -10/1) -2.99822295029798) (num-test (asinh 10/2) 2.31243834127275) (num-test (asinh -10/2) -2.31243834127276) (num-test (asinh 10/3) 1.91889647209853) (num-test (asinh -10/3) -1.91889647209853) (num-test (asinh 10/10) 0.88137358701954) (num-test (asinh -10/10) -0.88137358701954) (num-test (asinh 10/1234) 0.00810363902153) (num-test (asinh -10/1234) -0.00810363902153) (num-test (asinh 10/500029) 0.00001999884007) (num-test (asinh -10/500029) -0.00001999884007) (num-test (asinh 1234/1) 7.81116354920125) (num-test (asinh -1234/1) -7.81116354896171) (num-test (asinh 1234/2) 7.11801686116871) (num-test (asinh -1234/2) -7.11801686109890) (num-test (asinh 1234/3) 6.71255257393796) (num-test (asinh -1234/3) -6.71255257391934) (num-test (asinh 1234/10) 5.50859470922766) (num-test (asinh -1234/10) -5.50859470922637) (num-test (asinh 1234/500029) 0.00246785435930) (num-test (asinh -1234/500029) -0.00246785435930) (num-test (asinh 500029/1) 13.81556855628334) (num-test (asinh 500029/2) 13.12242137572639) (num-test (asinh 500029/3) 12.71695626762323) (num-test (asinh -500029/3) -12.71695626762323) (num-test (asinh 500029/10) 11.51298346338828) (num-test (asinh -500029/10) -11.51298333576987) (num-test (asinh 500029/1234) 6.69755387439290) (num-test (asinh -500029/1234) -6.69755387437470) (num-test (asinh 500029/500029) 0.88137358701954) (num-test (asinh -500029/500029) -0.88137358701954) (num-test (asinh 0.0) 0.0) (num-test (asinh 0.00000001) 0.00000001) (num-test (asinh -0.00000001) -0.00000001) (num-test (asinh 1.0) 0.88137358701954) (num-test (asinh -1.0) -0.88137358701954) (num-test (asinh pi) 1.86229574331085) (num-test (asinh -3.14159265358979) -1.86229574331085) (num-test (asinh 1234.0) 7.81116354920125) (num-test (asinh -1234.0) -7.81116354896171) (num-test (asinh 0.0+0.0i) 0.0) (num-test (asinh -0.0+0.0i) 0.0) (num-test (asinh 0.0-0.0i) 0.0) (num-test (asinh -0.0-0.0i) 0.0) (num-test (asinh 0.0+0.00000001i) 0.0+0.00000001i) (num-test (asinh -0.0+0.00000001i) 0.0+0.00000001i) (num-test (asinh 0.0-0.00000001i) 0.0-0.00000001i) (num-test (asinh -0.0-0.00000001i) 0.0-0.00000001i) (num-test (asinh 0.0+1.0i) 0.0+1.57079632679490i) (num-test (asinh -0.0+1.0i) 0.0+1.57079632679490i) (num-test (asinh 0.0-1.0i) 0.0-1.57079632679490i) (num-test (asinh -0.0-1.0i) 0.0-1.57079632679490i) (num-test (asinh 0.0+3.14159265358979i) 1.81152627246085+1.57079632679490i) (num-test (asinh -0.0+3.14159265358979i) 1.81152627246085+1.57079632679490i) (num-test (asinh 0.0-3.14159265358979i) 1.81152627246085-1.57079632679490i) (num-test (asinh -0.0-3.14159265358979i) -1.81152627246085-1.57079632679490i) (num-test (asinh 0.0+1234.0i) 7.81116322084923+1.57079632679490i) (num-test (asinh -0.0+1234.0i) 7.81116322084923+1.57079632679490i) (num-test (asinh 0.0-1234.0i) 7.81116322084923-1.57079632679490i) (num-test (asinh -0.0-1234.0i) -7.81116322068415-1.57079632679490i) (num-test (asinh 0.00000001+0.0i) 0.00000001) (num-test (asinh -0.00000001+0.0i) -0.00000001) (num-test (asinh 0.00000001-0.0i) 0.00000001) (num-test (asinh -0.00000001-0.0i) -0.00000001) (num-test (asinh 0.00000001+0.00000001i) 0.00000001+0.00000001i) (num-test (asinh -0.00000001+0.00000001i) -0.00000001+0.00000001i) (num-test (asinh 0.00000001-0.00000001i) 0.00000001-0.00000001i) (num-test (asinh -0.00000001-0.00000001i) -0.00000001-0.00000001i) (num-test (asinh 0.00000001+1.0i) 0.00010000000008+1.57069632679498i) (num-test (asinh -0.00000001+1.0i) -0.00010000000008+1.57069632679498i) (num-test (asinh 0.00000001-1.0i) 0.00010000000008-1.57069632679498i) (num-test (asinh -0.00000001-1.0i) -0.00010000000008-1.57069632679498i) (num-test (asinh 0.00000001+3.14159265358979i) 1.81152627246085+1.57079632343715i) (num-test (asinh -0.00000001+3.14159265358979i) -1.81152627246085+1.57079632343715i) (num-test (asinh 0.00000001-3.14159265358979i) 1.81152627246085-1.57079632343715i) (num-test (asinh -0.00000001-3.14159265358979i) -1.81152627246085-1.57079632343715i) (num-test (asinh 0.00000001+1234.0i) 7.81116322084923+1.57079632678679i) (num-test (asinh -0.00000001+1234.0i) -7.81116322068415+1.57079632678679i) (num-test (asinh 0.00000001-1234.0i) 7.81116322084923-1.57079632678679i) (num-test (asinh -0.00000001-1234.0i) -7.81116322068415-1.57079632678679i) (num-test (asinh 1.0+0.0i) 0.88137358701954) (num-test (asinh -1.0+0.0i) -0.88137358701954) (num-test (asinh 1.0-0.0i) 0.88137358701954) (num-test (asinh -1.0-0.0i) -0.88137358701954) (num-test (asinh 1.0+0.00000001i) 0.88137358701954+0.00000000707107i) (num-test (asinh -1.0+0.00000001i) -0.88137358701954+0.00000000707107i) (num-test (asinh 1.0-0.00000001i) 0.88137358701954-0.00000000707107i) (num-test (asinh -1.0-0.00000001i) -0.88137358701954-0.00000000707107i) (num-test (asinh 1.0+1.0i) 1.06127506190504+0.66623943249252i) (num-test (asinh -1.0+1.0i) -1.06127506190504+0.66623943249252i) (num-test (asinh 1.0-1.0i) 1.06127506190504-0.66623943249252i) (num-test (asinh -1.0-1.0i) -1.06127506190504-0.66623943249252i) (num-test (asinh 1.0+3.14159265358979i) 1.86711439316026+1.24854303281344i) (num-test (asinh -1.0+3.14159265358979i) -1.86711439316026+1.24854303281344i) (num-test (asinh 1.0-3.14159265358979i) 1.86711439316026-1.24854303281344i) (num-test (asinh -1.0-3.14159265358979i) -1.86711439316026-1.24854303281344i) (num-test (asinh 1.0+1234.0i) 7.81116354920146+1.56998595393473i) (num-test (asinh -1.0+1234.0i) -7.81116354944842+1.56998595393442i) (num-test (asinh 1.0-1234.0i) 7.81116354920146-1.56998595393473i) (num-test (asinh -1.0-1234.0i) -7.81116354944842-1.56998595393442i) (num-test (asinh 3.14159265358979+0.0i) 1.86229574331085) (num-test (asinh -3.14159265358979+0.0i) -1.86229574331085) (num-test (asinh 3.14159265358979-0.0i) 1.86229574331085) (num-test (asinh -3.14159265358979-0.0i) -1.86229574331085) (num-test (asinh 3.14159265358979+0.00000001i) 1.86229574331085+0.00000000303314i) (num-test (asinh -3.14159265358979+0.00000001i) -1.86229574331085+0.00000000303314i) (num-test (asinh 3.14159265358979-0.00000001i) 1.86229574331085-0.00000000303314i) (num-test (asinh -3.14159265358979-0.00000001i) -1.86229574331085-0.00000000303314i) (num-test (asinh 3.14159265358979+1.0i) 1.90462768697066+0.29558503421163i) (num-test (asinh -3.14159265358979+1.0i) -1.90462768697066+0.29558503421163i) (num-test (asinh 3.14159265358979-1.0i) 1.90462768697066-0.29558503421163i) (num-test (asinh -3.14159265358979-1.0i) -1.90462768697066-0.29558503421163i) (num-test (asinh 3.14159265358979+3.14159265358979i) 2.18469104082751+0.77273977912748i) (num-test (asinh -3.14159265358979+3.14159265358979i) -2.18469104082751+0.77273977912748i) (num-test (asinh 3.14159265358979-3.14159265358979i) 2.18469104082751-0.77273977912748i) (num-test (asinh -3.14159265358979-3.14159265358979i) -2.18469104082751-0.77273977912748i) (num-test (asinh 3.14159265358979+1234.0i) 7.81116646154641+1.56825047031367i) (num-test (asinh -3.14159265358979+1234.0i) -7.81116646138554+1.56825047031506i) (num-test (asinh 3.14159265358979-1234.0i) 7.81116646154641-1.56825047031367i) (num-test (asinh -3.14159265358979-1234.0i) -7.81116646138554-1.56825047031506i) (num-test (asinh 1234.0+0.0i) 7.81116354920125) (num-test (asinh -1234.0+0.0i) -7.81116354896171) (num-test (asinh 1234.0-0.0i) 7.81116354920125) (num-test (asinh -1234.0-0.0i) -7.81116354896171) (num-test (asinh 1234.0+0.00000001i) 7.81116354920125+0.00000000000810i) (num-test (asinh -1234.0+0.00000001i) -7.81116354896171+0.00000000000810i) (num-test (asinh 1234.0-0.00000001i) 7.81116354920125-0.00000000000810i) (num-test (asinh -1234.0-0.00000001i) -7.81116354896171-0.00000000000810i) (num-test (asinh 1234.0+1.0i) 7.81116387755283+0.00081037232800i) (num-test (asinh -1234.0+1.0i) -7.81116387772663+0.00081037232806i) (num-test (asinh 1234.0-1.0i) 7.81116387755283-0.00081037232800i) (num-test (asinh -1234.0-1.0i) -7.81116387772663-0.00081037232806i) (num-test (asinh 1234.0+3.14159265358979i) 7.81116678989204+0.00254585480937i) (num-test (asinh -1234.0+3.14159265358979i) -7.81116678966949+0.00254585480900i) (num-test (asinh 1234.0-3.14159265358979i) 7.81116678989204-0.00254585480937i) (num-test (asinh -1234.0-3.14159265358979i) -7.81116678966949-0.00254585480900i) (num-test (asinh 1234.0+1234.0i) 8.15773697530526+0.78539808130944i) (num-test (asinh -1234.0+1234.0i) -8.15773697538346+0.78539808146835i) (num-test (asinh 1234.0-1234.0i) 8.15773697530526-0.78539808130944i) (num-test (asinh -1234.0-1234.0i) -8.15773697538346-0.78539808146835i) (num-test (asinh -500029/2) -13.12242137572639) (num-test (asinh 0.0e+00+0.0e+00i) 0e0+0.0i) (num-test (asinh 0.0e+00+1.19209289550781250e-07i) 0+1.1920928955078153234e-7i) (num-test (asinh 0.0e+00-1.19209289550781250e-07i) 0-1.1920928955078153234e-7i) (num-test (asinh 0.0e+00+5.0e-01i) 0+5.2359877559829887308e-1i) (num-test (asinh 0.0e+00-5.0e-01i) 0-5.2359877559829887308e-1i) (num-test (asinh 0.0e+00+1.0e+00i) 0+1.5707963267948966192e0i) (num-test (asinh 0.0e+00-1.0e+00i) 0-1.5707963267948966192e0i) (num-test (asinh 0.0e+00+2.0e+00i) 1.3169578969248167086e0+1.5707963267948966192e0i) (num-test (asinh 0.0e+00-2.0e+00i) -1.3169578969248167086e0-1.5707963267948966192e0i) (num-test (asinh 0.0e+00+8.3886080e+06i) 1.6635532333438683873e1+1.5707963267948966192e0i) (num-test (asinh 0.0e+00-8.3886080e+06i) -1.6635532333438683873e1-1.5707963267948966192e0i) (num-test (asinh 1.19209289550781250e-07+0.0e+00i) 1.1920928955078096766e-7+0.0i) (num-test (asinh -1.19209289550781250e-07+0.0e+00i) -1.1920928955078096766e-7+0.0i) (num-test (asinh 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078181469e-7+1.1920928955078068531e-7i) (num-test (asinh 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078181469e-7-1.1920928955078068531e-7i) (num-test (asinh -1.19209289550781250e-07+1.19209289550781250e-07i) -1.1920928955078181469e-7+1.1920928955078068531e-7i) (num-test (asinh -1.19209289550781250e-07-1.19209289550781250e-07i) -1.1920928955078181469e-7-1.1920928955078068531e-7i) (num-test (asinh 1.19209289550781250e-07+5.0e-01i) 1.3765103082409432364e-7+5.2359877559829340332e-1i) (num-test (asinh 1.19209289550781250e-07-5.0e-01i) 1.3765103082409432364e-7-5.2359877559829340332e-1i) (num-test (asinh -1.19209289550781250e-07+5.0e-01i) -1.3765103082409432364e-7+5.2359877559829340332e-1i) (num-test (asinh -1.19209289550781250e-07-5.0e-01i) -1.3765103082409432364e-7-5.2359877559829340332e-1i) (num-test (asinh 1.19209289550781250e-07+1.0e+00i) 3.4526698643116312881e-4+1.5704510598153252947e0i) (num-test (asinh 1.19209289550781250e-07-1.0e+00i) 3.4526698643116312881e-4-1.5704510598153252947e0i) (num-test (asinh -1.19209289550781250e-07+1.0e+00i) -3.4526698643116312881e-4+1.5704510598153252947e0i) (num-test (asinh -1.19209289550781250e-07-1.0e+00i) -3.4526698643116312881e-4-1.5704510598153252947e0i) (num-test (asinh 1.19209289550781250e-07+2.0e+00i) 1.3169578969248194435e0+1.5707962579693812072e0i) (num-test (asinh 1.19209289550781250e-07-2.0e+00i) 1.3169578969248194435e0-1.5707962579693812072e0i) (num-test (asinh -1.19209289550781250e-07+2.0e+00i) -1.3169578969248194435e0+1.5707962579693812072e0i) (num-test (asinh -1.19209289550781250e-07-2.0e+00i) -1.3169578969248194435e0-1.5707962579693812072e0i) (num-test (asinh 1.19209289550781250e-07+8.3886080e+06i) 1.6635532333438683873e1+1.5707963267948824084e0i) (num-test (asinh 1.19209289550781250e-07-8.3886080e+06i) 1.6635532333438683873e1-1.5707963267948824084e0i) (num-test (asinh -1.19209289550781250e-07+8.3886080e+06i) -1.6635532333438683873e1+1.5707963267948824084e0i) (num-test (asinh -1.19209289550781250e-07-8.3886080e+06i) -1.6635532333438683873e1-1.5707963267948824084e0i) (num-test (asinh 5.0e-01+0.0e+00i) 4.8121182505960344750e-1+0.0i) (num-test (asinh -5.0e-01+0.0e+00i) -4.8121182505960344750e-1+0.0i) (num-test (asinh 5.0e-01+1.19209289550781250e-07i) 4.8121182505960598961e-1+1.0662402999400097805e-7i) (num-test (asinh 5.0e-01-1.19209289550781250e-07i) 4.8121182505960598961e-1-1.0662402999400097805e-7i) (num-test (asinh -5.0e-01+1.19209289550781250e-07i) -4.8121182505960598961e-1+1.0662402999400097805e-7i) (num-test (asinh -5.0e-01-1.19209289550781250e-07i) -4.8121182505960598961e-1-1.0662402999400097805e-7i) (num-test (asinh 5.0e-01+5.0e-01i) 5.3063753095251782602e-1+4.5227844715119068206e-1i) (num-test (asinh 5.0e-01-5.0e-01i) 5.3063753095251782602e-1-4.5227844715119068206e-1i) (num-test (asinh -5.0e-01+5.0e-01i) -5.3063753095251782602e-1+4.5227844715119068206e-1i) (num-test (asinh -5.0e-01-5.0e-01i) -5.3063753095251782602e-1-4.5227844715119068206e-1i) (num-test (asinh 5.0e-01+1.0e+00i) 7.3285767597364526089e-1+8.9590748120889023907e-1i) (num-test (asinh 5.0e-01-1.0e+00i) 7.3285767597364526089e-1-8.9590748120889023907e-1i) (num-test (asinh -5.0e-01+1.0e+00i) -7.3285767597364526089e-1+8.9590748120889023907e-1i) (num-test (asinh -5.0e-01-1.0e+00i) -7.3285767597364526089e-1-8.9590748120889023907e-1i) (num-test (asinh 5.0e-01+2.0e+00i) 1.3618009008578457882e0+1.2930420702371826591e0i) (num-test (asinh 5.0e-01-2.0e+00i) 1.3618009008578457882e0-1.2930420702371826591e0i) (num-test (asinh -5.0e-01+2.0e+00i) -1.3618009008578457882e0+1.2930420702371826591e0i) (num-test (asinh -5.0e-01-2.0e+00i) -1.3618009008578457882e0-1.2930420702371826591e0i) (num-test (asinh 5.0e-01+8.3886080e+06i) 1.6635532333438685650e1+1.5707962671902518438e0i) (num-test (asinh 5.0e-01-8.3886080e+06i) 1.6635532333438685650e1-1.5707962671902518438e0i) (num-test (asinh -5.0e-01+8.3886080e+06i) -1.6635532333438685650e1+1.5707962671902518438e0i) (num-test (asinh -5.0e-01-8.3886080e+06i) -1.6635532333438685650e1-1.5707962671902518438e0i) (num-test (asinh 1.0e+00+0.0e+00i) 8.8137358701954302523e-1+0.0i) (num-test (asinh -1.0e+00+0.0e+00i) -8.8137358701954302523e-1+0.0i) (num-test (asinh 1.0e+00+1.19209289550781250e-07i) 8.8137358701954553738e-1+8.4293697021788013662e-8i) (num-test (asinh 1.0e+00-1.19209289550781250e-07i) 8.8137358701954553738e-1-8.4293697021788013662e-8i) (num-test (asinh -1.0e+00+1.19209289550781250e-07i) -8.8137358701954553738e-1+8.4293697021788013662e-8i) (num-test (asinh -1.0e+00-1.19209289550781250e-07i) -8.8137358701954553738e-1-8.4293697021788013662e-8i) (num-test (asinh 1.0e+00+5.0e-01i) 9.2613303135018242455e-1+3.4943906285721329363e-1i) (num-test (asinh 1.0e+00-5.0e-01i) 9.2613303135018242455e-1-3.4943906285721329363e-1i) (num-test (asinh -1.0e+00+5.0e-01i) -9.2613303135018242455e-1+3.4943906285721329363e-1i) (num-test (asinh -1.0e+00-5.0e-01i) -9.2613303135018242455e-1-3.4943906285721329363e-1i) (num-test (asinh 1.0e+00+1.0e+00i) 1.0612750619050356520e0+6.6623943249251525510e-1i) (num-test (asinh 1.0e+00-1.0e+00i) 1.0612750619050356520e0-6.6623943249251525510e-1i) (num-test (asinh -1.0e+00+1.0e+00i) -1.0612750619050356520e0+6.6623943249251525510e-1i) (num-test (asinh -1.0e+00-1.0e+00i) -1.0612750619050356520e0-6.6623943249251525510e-1i) (num-test (asinh 1.0e+00+2.0e+00i) 1.4693517443681852733e0+1.0634400235777520562e0i) (num-test (asinh 1.0e+00-2.0e+00i) 1.4693517443681852733e0-1.0634400235777520562e0i) (num-test (asinh -1.0e+00+2.0e+00i) -1.4693517443681852733e0+1.0634400235777520562e0i) (num-test (asinh -1.0e+00-2.0e+00i) -1.4693517443681852733e0-1.0634400235777520562e0i) (num-test (asinh 1.0e+00+8.3886080e+06i) 1.6635532333438690979e1+1.5707962075856070684e0i) (num-test (asinh 1.0e+00-8.3886080e+06i) 1.6635532333438690979e1-1.5707962075856070684e0i) (num-test (asinh -1.0e+00+8.3886080e+06i) -1.6635532333438690979e1+1.5707962075856070684e0i) (num-test (asinh -1.0e+00-8.3886080e+06i) -1.6635532333438690979e1-1.5707962075856070684e0i) (num-test (asinh 2.0e+00+0.0e+00i) 1.4436354751788103425e0+0.0i) (num-test (asinh -2.0e+00+0.0e+00i) -1.4436354751788103425e0+0.0i) (num-test (asinh 2.0e+00+1.19209289550781250e-07i) 1.4436354751788116136e0+5.3312014997000413263e-8i) (num-test (asinh 2.0e+00-1.19209289550781250e-07i) 1.4436354751788116136e0-5.3312014997000413263e-8i) (num-test (asinh -2.0e+00+1.19209289550781250e-07i) -1.4436354751788116136e0+5.3312014997000413263e-8i) (num-test (asinh -2.0e+00-1.19209289550781250e-07i) -1.4436354751788116136e0-5.3312014997000413263e-8i) (num-test (asinh 2.0e+00+5.0e-01i) 1.4657153519472905218e0+2.2101863562288385890e-1i) (num-test (asinh 2.0e+00-5.0e-01i) 1.4657153519472905218e0-2.2101863562288385890e-1i) (num-test (asinh -2.0e+00+5.0e-01i) -1.4657153519472905218e0+2.2101863562288385890e-1i) (num-test (asinh -2.0e+00-5.0e-01i) -1.4657153519472905218e0-2.2101863562288385890e-1i) (num-test (asinh 2.0e+00+1.0e+00i) 1.5285709194809981613e0+4.2707858639247612548e-1i) (num-test (asinh 2.0e+00-1.0e+00i) 1.5285709194809981613e0-4.2707858639247612548e-1i) (num-test (asinh -2.0e+00+1.0e+00i) -1.5285709194809981613e0+4.2707858639247612548e-1i) (num-test (asinh -2.0e+00-1.0e+00i) -1.5285709194809981613e0-4.2707858639247612548e-1i) (num-test (asinh 2.0e+00+2.0e+00i) 1.7343245214879664480e0+7.5424914469804604071e-1i) (num-test (asinh 2.0e+00-2.0e+00i) 1.7343245214879664480e0-7.5424914469804604071e-1i) (num-test (asinh -2.0e+00+2.0e+00i) -1.7343245214879664480e0+7.5424914469804604071e-1i) (num-test (asinh -2.0e+00-2.0e+00i) -1.7343245214879664480e0-7.5424914469804604071e-1i) (num-test (asinh 2.0e+00+8.3886080e+06i) 1.6635532333438712295e1+1.5707960883763175177e0i) (num-test (asinh 2.0e+00-8.3886080e+06i) 1.6635532333438712295e1-1.5707960883763175177e0i) (num-test (asinh -2.0e+00+8.3886080e+06i) -1.6635532333438712295e1+1.5707960883763175177e0i) (num-test (asinh -2.0e+00-8.3886080e+06i) -1.6635532333438712295e1-1.5707960883763175177e0i) (num-test (asinh 8.3886080e+06+0.0e+00i) 1.6635532333438690979e1+0.0i) (num-test (asinh -8.3886080e+06+0.0e+00i) -1.6635532333438690979e1+0.0i) (num-test (asinh 8.3886080e+06+1.19209289550781250e-07i) 1.6635532333438690979e1+1.4210854715201902743e-14i) (num-test (asinh 8.3886080e+06-1.19209289550781250e-07i) 1.6635532333438690979e1-1.4210854715201902743e-14i) (num-test (asinh -8.3886080e+06+1.19209289550781250e-07i) -1.6635532333438690979e1+1.4210854715201902743e-14i) (num-test (asinh -8.3886080e+06-1.19209289550781250e-07i) -1.6635532333438690979e1-1.4210854715201902743e-14i) (num-test (asinh 8.3886080e+06+5.0e-01i) 1.6635532333438692755e1+5.9604644775390130897e-8i) (num-test (asinh 8.3886080e+06-5.0e-01i) 1.6635532333438692755e1-5.9604644775390130897e-8i) (num-test (asinh -8.3886080e+06+5.0e-01i) -1.6635532333438692755e1+5.9604644775390130897e-8i) (num-test (asinh -8.3886080e+06-5.0e-01i) -1.6635532333438692755e1-5.9604644775390130897e-8i) (num-test (asinh 8.3886080e+06+1.0e+00i) 1.6635532333438698084e1+1.1920928955077983828e-7i) (num-test (asinh 8.3886080e+06-1.0e+00i) 1.6635532333438698084e1-1.1920928955077983828e-7i) (num-test (asinh -8.3886080e+06+1.0e+00i) -1.6635532333438698084e1+1.1920928955077983828e-7i) (num-test (asinh -8.3886080e+06-1.0e+00i) -1.6635532333438698084e1-1.1920928955077983828e-7i) (num-test (asinh 8.3886080e+06+2.0e+00i) 1.663553233343871940e1+2.3841857910155628843e-7i) (num-test (asinh 8.3886080e+06-2.0e+00i) 1.663553233343871940e1-2.3841857910155628843e-7i) (num-test (asinh -8.3886080e+06+2.0e+00i) -1.663553233343871940e1+2.3841857910155628843e-7i) (num-test (asinh -8.3886080e+06-2.0e+00i) -1.663553233343871940e1-2.3841857910155628843e-7i) (num-test (asinh 8.3886080e+06+8.3886080e+06i) 1.6982105923718660081e1+7.8539816339744653326e-1i) (num-test (asinh 8.3886080e+06-8.3886080e+06i) 1.6982105923718660081e1-7.8539816339744653326e-1i) (num-test (asinh -8.3886080e+06+8.3886080e+06i) -1.6982105923718660081e1+7.8539816339744653326e-1i) (num-test (asinh -8.3886080e+06-8.3886080e+06i) -1.6982105923718660081e1-7.8539816339744653326e-1i) (num-test (asinh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (asinh 1.110223024625156799999999999999999999997E-16) 1.11022302462515679999999999999999771924E-16) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'asinh num (asinh num) val))) (vector (list 0 0) (list 1 0.88137358701954) (list 2 1.4436354751788) (list 3 1.8184464592321) (list -1 -0.88137358701954) (list -2 -1.4436354751788) (list -3 -1.8184464592321) (list 9223372036854775807 44.361419555836) (list -9223372036854775808 -44.361419555836) (list 1/2 0.4812118250596) (list 1/3 0.32745015023726) (list -1/2 -0.4812118250596) (list -1/3 -0.32745015023726) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 1.0 0.88137358701954) (list 2.0 1.4436354751788) (list -2.0 -1.4436354751788) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 1e+16 37.534508668465) (list 0+1i 0+1.5707963267949i) (list 0+2i 1.3169578969248+1.5707963267949i) (list 0-1i 0-1.5707963267949i) (list 1+1i 1.061275061905+0.66623943249252i) (list 1-1i 1.061275061905-0.66623943249252i) (list -1+1i -1.061275061905+0.66623943249252i) (list -1-1i -1.061275061905-0.66623943249252i) (list 0.1+0.1i 0.10033029811221+0.099663702859795i) (list 1e+16+1e+16i 37.881082258745+0.78539816339745i) (list 1e-16+1e-16i 0+1e-16i) )) (test (asinh) 'error) (test (asinh "hi") 'error) (test (asinh 1.0+23.0i 1.0+23.0i) 'error) (test (asinh 0 1) 'error) (for-each (lambda (arg) (test (asinh arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; acosh ;;; -------------------------------------------------------------------------------- (num-test (acosh 0) 0.0+1.57079632679490i) (num-test (acosh 1) 0.0) (num-test (acosh -1) 0.0+3.14159265358979i) (num-test (acosh 2) 1.31695789692482) (num-test (acosh -2) 1.31695789692482+3.14159265358979i) (num-test (acosh 3) 1.76274717403909) (num-test (acosh -3) 1.76274717403909+3.14159265358979i) (num-test (acosh 10) 2.99322284612638) (num-test (acosh -10) 2.99322284612638+3.14159265358979i) (num-test (acosh 1234) 7.81116322084923) (num-test (acosh -1234) 7.81116322084923+3.14159265358979i) (num-test (acosh 500029) 13.81556855628134) (num-test (acosh -500029) 13.81556855628134+3.14159265358979i) (num-test (acosh 0/1) 0.0+1.57079632679490i) (num-test (acosh 0/2) 0.0+1.57079632679490i) (num-test (acosh 0/3) 0.0+1.57079632679490i) (num-test (acosh 0/10) 0.0+1.57079632679490i) (num-test (acosh 0/1234) 0.0+1.57079632679490i) (num-test (acosh 0/500029) 0.0+1.57079632679490i) (num-test (acosh 1/1) 0.0) (num-test (acosh -1/1) 0.0+3.14159265358979i) (num-test (acosh 1/2) 0.0+1.04719755119660i) (num-test (acosh -1/2) 0.0+2.09439510239320i) (num-test (acosh 1/3) 0.0+1.23095941734077i) (num-test (acosh -1/3) 0.0+1.91063323624902i) (num-test (acosh 1/10) 0.0+1.47062890563334i) (num-test (acosh -1/10) 0.0+1.67096374795646i) (num-test (acosh 1/1234) 0.0+1.56998595393473i) (num-test (acosh -1/1234) 0.0+1.57160669965507i) (num-test (acosh 1/500029) 0.0+1.57079432691089i) (num-test (acosh -1/500029) 0.0+1.57079832667890i) (num-test (acosh 2/1) 1.31695789692482) (num-test (acosh -2/1) 1.31695789692482+3.14159265358979i) (num-test (acosh 2/2) 0.0) (num-test (acosh -2/2) 0.0+3.14159265358979i) (num-test (acosh 2/3) 0.0+0.84106867056793i) (num-test (acosh -2/3) 0.0+2.30052398302186i) (num-test (acosh 2/10) 0.0+1.36943840600457i) (num-test (acosh -2/10) 0.0+1.77215424758523i) (num-test (acosh 2/1234) 0.0+1.56917558054238i) (num-test (acosh -2/1234) 0.0+1.57241707304741i) (num-test (acosh 2/500029) 0.0+1.57079232702688i) (num-test (acosh -2/500029) 0.0+1.57080032656291i) (num-test (acosh 3/1) 1.76274717403909) (num-test (acosh -3/1) 1.76274717403909+3.14159265358979i) (num-test (acosh 3/2) 0.96242365011921) (num-test (acosh -3/2) 0.96242365011921+3.14159265358979i) (num-test (acosh 3/3) 0.0) (num-test (acosh -3/3) 0.0+3.14159265358979i) (num-test (acosh 3/10) 0.0+1.26610367277950i) (num-test (acosh -3/10) 0.0+1.87548898081029i) (num-test (acosh 3/1234) 0.0+1.56836520608568i) (num-test (acosh -3/1234) 0.0+1.57322744750412i) (num-test (acosh 3/500029) 0.0+1.57079032714288i) (num-test (acosh -3/500029) 0.0+1.57080232644692i) (num-test (acosh 10/1) 2.99322284612638) (num-test (acosh -10/1) 2.99322284612638+3.14159265358979i) (num-test (acosh 10/2) 2.29243166956118) (num-test (acosh -10/2) 2.29243166956118+3.14159265358979i) (num-test (acosh 10/3) 1.87382024252741) (num-test (acosh -10/3) 1.87382024252741+3.14159265358979i) (num-test (acosh 10/10) 0.0) (num-test (acosh -10/10) 0.0+3.14159265358979i) (num-test (acosh 10/1234) 0.0+1.56269251038168i) (num-test (acosh -10/1234) 0.0+1.57890014320811i) (num-test (acosh 10/500029) 0.0+1.57077632795483i) (num-test (acosh -10/500029) 0.0+1.57081632563497i) (num-test (acosh 1234/1) 7.81116322084923) (num-test (acosh -1234/1) 7.81116322084923+3.14159265358979i) (num-test (acosh 1234/2) 7.11801554776066) (num-test (acosh -1234/2) 7.11801554776066+3.14159265358979i) (num-test (acosh 1234/3) 6.71254961876983) (num-test (acosh -1234/3) 6.71254961876983+3.14159265358979i) (num-test (acosh 1234/10) 5.50856187402619) (num-test (acosh -1234/10) 5.50856187402619+3.14159265358979i) (num-test (acosh 1234/500029) 0.0+1.56832846742558i) (num-test (acosh -1234/500029) 0.0+1.57326418616421i) (num-test (acosh 500029/1) 13.81556855628134) (num-test (acosh -500029/1) 13.81556855628134+3.14159265358979i) (num-test (acosh 500029/2) 13.12242137571839) (num-test (acosh -500029/2) 13.12242137571839+3.14159265358979i) (num-test (acosh 500029/3) 12.71695626760523) (num-test (acosh -500029/3) 12.71695626760523+3.14159265358979i) (num-test (acosh 500029/10) 11.51298346318831) (num-test (acosh -500029/10) 11.51298346318831+3.14159265358979i) (num-test (acosh 500029/1234) 6.69755082923415) (num-test (acosh -500029/1234) 6.69755082923415+3.14159265358979i) (num-test (acosh 500029/500029) 0.0) (num-test (acosh -500029/500029) 0.0+3.14159265358979i) (num-test (acosh 0.0) 0.0+1.57079632679490i) (num-test (acosh 0.00000001) 0.0+1.57079631679490i) (num-test (acosh -0.00000001) 0.0+1.57079633679490i) (num-test (acosh 1.0) 0.0) (num-test (acosh -1.0) 0.0+3.14159265358979i) (num-test (acosh pi) 1.81152627246085) (num-test (acosh -3.14159265358979) 1.81152627246085+3.14159265358979i) (num-test (acosh 1234.0) 7.81116322084923) (num-test (acosh -1234.0) 7.81116322084923+3.14159265358979i) (num-test (acosh 0.0+0.0i) 0.0+1.57079632679490i) (num-test (acosh -0.0+0.0i) 0.0+1.57079632679490i) (num-test (acosh 0.0-0.0i) 0.0+1.57079632679490i) (num-test (acosh -0.0-0.0i) 0.0+1.57079632679490i) (num-test (acosh 0.0+0.00000001i) 0.00000001+1.57079632679490i) (num-test (acosh -0.0+0.00000001i) 0.00000001+1.57079632679490i) (num-test (acosh 0.0-0.00000001i) 0.00000001-1.57079632679490i) (num-test (acosh -0.0-0.00000001i) 0.00000001-1.57079632679490i) (num-test (acosh 0.0+1.0i) 0.88137358701954+1.57079632679490i) (num-test (acosh -0.0+1.0i) 0.88137358701954+1.57079632679490i) (num-test (acosh 0.0-1.0i) 0.88137358701954-1.57079632679490i) (num-test (acosh -0.0-1.0i) 0.88137358701954-1.57079632679490i) (num-test (acosh 0.0+3.14159265358979i) 1.86229574331085+1.57079632679490i) (num-test (acosh -0.0+3.14159265358979i) 1.86229574331085+1.57079632679490i) (num-test (acosh 0.0-3.14159265358979i) 1.86229574331085-1.57079632679490i) (num-test (acosh -0.0-3.14159265358979i) 1.86229574331085-1.57079632679490i) (num-test (acosh 0.0+1234.0i) 7.81116354920125+1.57079632679490i) (num-test (acosh -0.0+1234.0i) 7.81116354920125+1.57079632679490i) (num-test (acosh 0.0-1234.0i) 7.81116354920125-1.57079632679490i) (num-test (acosh -0.0-1234.0i) 7.81116354896171-1.57079632679490i) (num-test (acosh 0.00000001+0.0i) 0.0+1.57079631679490i) (num-test (acosh -0.00000001+0.0i) 0.0+1.57079633679490i) (num-test (acosh 0.00000001-0.0i) 0.0+1.57079631679490i) (num-test (acosh -0.00000001-0.0i) 0.0+1.57079633679490i) (num-test (acosh 0.00000001+0.00000001i) 0.00000001+1.57079631679490i) (num-test (acosh -0.00000001+0.00000001i) 0.00000001+1.57079633679490i) (num-test (acosh 0.00000001-0.00000001i) 0.00000001-1.57079631679490i) (num-test (acosh -0.00000001-0.00000001i) 0.00000001-1.57079633679490i) (num-test (acosh 0.00000001+1.0i) 0.88137358701954+1.57079631972383i) (num-test (acosh -0.00000001+1.0i) 0.88137358701954+1.57079633386596i) (num-test (acosh 0.00000001-1.0i) 0.88137358701954-1.57079631972383i) (num-test (acosh -0.00000001-1.0i) 0.88137358701954-1.57079633386596i) (num-test (acosh 0.00000001+3.14159265358979i) 1.86229574331085+1.57079632376175i) (num-test (acosh -0.00000001+3.14159265358979i) 1.86229574331085+1.57079632982804i) (num-test (acosh 0.00000001-3.14159265358979i) 1.86229574331085-1.57079632376175i) (num-test (acosh -0.00000001-3.14159265358979i) 1.86229574331085-1.57079632982804i) (num-test (acosh 0.00000001+1234.0i) 7.81116354920125+1.57079632678679i) (num-test (acosh -0.00000001+1234.0i) 7.81116354920125+1.57079632680300i) (num-test (acosh 0.00000001-1234.0i) 7.81116354920125-1.57079632678679i) (num-test (acosh -0.00000001-1234.0i) 7.81116354920125-1.57079632680300i) (num-test (acosh 1.0+0.0i) 0.0) (num-test (acosh -1.0+0.0i) 0.0+3.14159265358979i) (num-test (acosh 1.0-0.0i) 0.0) (num-test (acosh -1.0-0.0i) 0.0+3.14159265358979i) (num-test (acosh 1.0+0.00000001i) 0.00010000000008+0.00009999999992i) (num-test (acosh -1.0+0.00000001i) 0.00010000000008+3.14149265358988i) (num-test (acosh 1.0-0.00000001i) 0.00010000000008-0.00009999999992i) (num-test (acosh -1.0-0.00000001i) 0.00010000000008-3.14149265358988i) (num-test (acosh 1.0+1.0i) 1.06127506190504+0.90455689430238i) (num-test (acosh -1.0+1.0i) 1.06127506190504+2.23703575928741i) (num-test (acosh 1.0-1.0i) 1.06127506190504-0.90455689430238i) (num-test (acosh -1.0-1.0i) 1.06127506190504-2.23703575928741i) (num-test (acosh 1.0+3.14159265358979i) 1.90462768697066+1.27521129258327i) (num-test (acosh -1.0+3.14159265358979i) 1.90462768697066+1.86638136100653i) (num-test (acosh 1.0-3.14159265358979i) 1.90462768697066-1.27521129258327i) (num-test (acosh -1.0-3.14159265358979i) 1.90462768697066-1.86638136100653i) (num-test (acosh 1.0+1234.0i) 7.81116387755283+1.56998595446690i) (num-test (acosh -1.0+1234.0i) 7.81116387755283+1.57160669912289i) (num-test (acosh 1.0-1234.0i) 7.81116387755283-1.56998595446690i) (num-test (acosh -1.0-1234.0i) 7.81116387755283-1.57160669912289i) (num-test (acosh 3.14159265358979+0.0i) 1.81152627246085) (num-test (acosh -3.14159265358979+0.0i) 1.81152627246085+3.14159265358979i) (num-test (acosh 3.14159265358979-0.0i) 1.81152627246085) (num-test (acosh -3.14159265358979-0.0i) 1.81152627246085+3.14159265358979i) (num-test (acosh 3.14159265358979+0.00000001i) 1.81152627246085+0.00000000335775i) (num-test (acosh -3.14159265358979+0.00000001i) 1.81152627246085+3.14159265023205i) (num-test (acosh 3.14159265358979-0.00000001i) 1.81152627246085-0.00000000335775i) (num-test (acosh -3.14159265358979-0.00000001i) 1.81152627246085-3.14159265023205i) (num-test (acosh 3.14159265358979+1.0i) 1.86711439316026+0.32225329398146i) (num-test (acosh -3.14159265358979+1.0i) 1.86711439316026+2.81933935960833i) (num-test (acosh 3.14159265358979-1.0i) 1.86711439316026-0.32225329398146i) (num-test (acosh -3.14159265358979-1.0i) 1.86711439316026-2.81933935960833i) (num-test (acosh 3.14159265358979+3.14159265358979i) 2.18469104082751+0.79805654766741i) (num-test (acosh -3.14159265358979+3.14159265358979i) 2.18469104082751+2.34353610592238i) (num-test (acosh 3.14159265358979-3.14159265358979i) 2.18469104082751-0.79805654766741i) (num-test (acosh -3.14159265358979-3.14159265358979i) 2.18469104082751-2.34353610592238i) (num-test (acosh 3.14159265358979+1234.0i) 7.81116678989204+1.56825047198552i) (num-test (acosh -3.14159265358979+1234.0i) 7.81116678989204+1.57334218160427i) (num-test (acosh 3.14159265358979-1234.0i) 7.81116678989204-1.56825047198552i) (num-test (acosh -3.14159265358979-1234.0i) 7.81116678989204-1.57334218160427i) (num-test (acosh 1234.0+0.0i) 7.81116322084923) (num-test (acosh -1234.0+0.0i) 7.81116322084923+3.14159265358979i) (num-test (acosh 1234.0-0.0i) 7.81116322084923) (num-test (acosh -1234.0-0.0i) 7.81116322084923+3.14159265358979i) (num-test (acosh 1234.0+0.00000001i) 7.81116322084923+0.00000000000810i) (num-test (acosh -1234.0+0.00000001i) 7.81116322084923+3.14159265358169i) (num-test (acosh 1234.0-0.00000001i) 7.81116322084923-0.00000000000810i) (num-test (acosh -1234.0-0.00000001i) 7.81116322084923-3.14159265358169i) (num-test (acosh 1234.0+1.0i) 7.81116354920146+0.00081037286017i) (num-test (acosh -1234.0+1.0i) 7.81116354920146+3.14078228072962i) (num-test (acosh 1234.0-1.0i) 7.81116354920146-0.00081037286017i) (num-test (acosh -1234.0-1.0i) 7.81116354920146-3.14078228072962i) (num-test (acosh 1234.0+3.14159265358979i) 7.81116646154641+0.00254585648123i) (num-test (acosh -1234.0+3.14159265358979i) 7.81116646154641+3.13904679710856i) (num-test (acosh 1234.0-3.14159265358979i) 7.81116646154641-0.00254585648123i) (num-test (acosh -1234.0-3.14159265358979i) 7.81116646154641-3.13904679710856i) (num-test (acosh 1234.0+1234.0i) 8.15773697530526+0.78539824548545i) (num-test (acosh -1234.0+1234.0i) 8.15773697530526+2.35619440810434i) (num-test (acosh 1234.0-1234.0i) 8.15773697530526-0.78539824548545i) (num-test (acosh -1234.0-1234.0i) 8.15773697530526-2.35619440810434i) (num-test (acosh 0) 0+1.570796326794897i) (num-test (acosh 1) 0) (num-test (acosh -1) 0+3.141592653589793i) (num-test (acosh -1.0e+01) 2.9932228461263808979e0+3.1415926535897932385e0i) (num-test (acosh -2.0e+00) 1.3169578969248167086e0+3.1415926535897932385e0i) (num-test (acosh -1.0e+00) 0+3.1415926535897932385e0i) (num-test (acosh -7.50e-01) 0+2.4188584057763776273e0i) (num-test (acosh -5.0e-01) 0+2.0943951023931954923e0i) (num-test (acosh -1.250e-01) 0+1.6961241579629620161e0i) (num-test (acosh -3.45266983001243932001e-04) 0+1.5711415937847577022e0i) (num-test (acosh -1.19209289550781250e-07) 0+1.570796446004186170e0i) (num-test (acosh 0.0e+00) 0+1.5707963267948966192e0i) (num-test (acosh 1.19209289550781250e-07) 0+1.5707962075856070684e0i) (num-test (acosh 3.45266983001243932001e-04) 0+1.5704510598050355363e0i) (num-test (acosh 1.250e-01) 0+1.4454684956268312224e0i) (num-test (acosh 5.0e-01) 0+1.0471975511965977462e0i) (num-test (acosh 7.50e-01) 0+7.2273424781341561118e-1i) (num-test (acosh 1.0e+00) 0e0+0.0i) (num-test (acosh 2.0e+00) 1.3169578969248167086e0+0.0i) (num-test (acosh 1.0e+01) 2.9932228461263808979e0+0.0i) (num-test (acosh 0.0e+00+0.0e+00i) 0+1.5707963267948966192e0i) (num-test (acosh 0.0e+00+1.19209289550781250e-07i) 1.1920928955078096766e-7+1.5707963267948966192e0i) (num-test (acosh 0.0e+00-1.19209289550781250e-07i) 1.1920928955078096766e-7-1.5707963267948966192e0i) (num-test (acosh 0.0e+00+5.0e-01i) 4.8121182505960344750e-1+1.5707963267948966192e0i) (num-test (acosh 0.0e+00-5.0e-01i) 4.8121182505960344750e-1-1.5707963267948966192e0i) (num-test (acosh 0.0e+00+1.0e+00i) 8.8137358701954302523e-1+1.5707963267948966192e0i) (num-test (acosh 0.0e+00-1.0e+00i) 8.8137358701954302523e-1-1.5707963267948966192e0i) (num-test (acosh 0.0e+00+2.0e+00i) 1.4436354751788103425e0+1.5707963267948966192e0i) (num-test (acosh 0.0e+00-2.0e+00i) 1.4436354751788103425e0-1.5707963267948966192e0i) (num-test (acosh 0.0e+00+8.3886080e+06i) 1.6635532333438690979e1+1.5707963267948966192e0i) (num-test (acosh 0.0e+00-8.3886080e+06i) 1.6635532333438690979e1-1.5707963267948966192e0i) (num-test (acosh 1.19209289550781250e-07+0.0e+00i) 0+1.5707962075856070684e0i) (num-test (acosh -1.19209289550781250e-07+0.0e+00i) 0+1.570796446004186170e0i) (num-test (acosh 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078181469e-7+1.5707962075856070685e0i) (num-test (acosh 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078181469e-7-1.5707962075856070685e0i) (num-test (acosh -1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078181469e-7+1.570796446004186170e0i) (num-test (acosh -1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078181469e-7-1.570796446004186170e0i) (num-test (acosh 1.19209289550781250e-07+5.0e-01i) 4.8121182505960598961e-1+1.5707962201708666252e0i) (num-test (acosh 1.19209289550781250e-07-5.0e-01i) 4.8121182505960598961e-1-1.5707962201708666252e0i) (num-test (acosh -1.19209289550781250e-07+5.0e-01i) 4.8121182505960598961e-1+1.5707964334189266132e0i) (num-test (acosh -1.19209289550781250e-07-5.0e-01i) 4.8121182505960598961e-1-1.5707964334189266132e0i) (num-test (acosh 1.19209289550781250e-07+1.0e+00i) 8.8137358701954553738e-1+1.5707962425011995974e0i) (num-test (acosh 1.19209289550781250e-07-1.0e+00i) 8.8137358701954553738e-1-1.5707962425011995974e0i) (num-test (acosh -1.19209289550781250e-07+1.0e+00i) 8.8137358701954553738e-1+1.5707964110885936410e0i) (num-test (acosh -1.19209289550781250e-07-1.0e+00i) 8.8137358701954553738e-1-1.5707964110885936410e0i) (num-test (acosh 1.19209289550781250e-07+2.0e+00i) 1.4436354751788116136e0+1.5707962734828816222e0i) (num-test (acosh 1.19209289550781250e-07-2.0e+00i) 1.4436354751788116136e0-1.5707962734828816222e0i) (num-test (acosh -1.19209289550781250e-07+2.0e+00i) 1.4436354751788116136e0+1.5707963801069116162e0i) (num-test (acosh -1.19209289550781250e-07-2.0e+00i) 1.4436354751788116136e0-1.5707963801069116162e0i) (num-test (acosh 1.19209289550781250e-07+8.3886080e+06i) 1.6635532333438690979e1+1.5707963267948824084e0i) (num-test (acosh 1.19209289550781250e-07-8.3886080e+06i) 1.6635532333438690979e1-1.5707963267948824084e0i) (num-test (acosh -1.19209289550781250e-07+8.3886080e+06i) 1.6635532333438690979e1+1.5707963267949108301e0i) (num-test (acosh -1.19209289550781250e-07-8.3886080e+06i) 1.6635532333438690979e1-1.5707963267949108301e0i) (num-test (acosh 5.0e-01+0.0e+00i) 0+1.0471975511965977462e0i) (num-test (acosh -5.0e-01+0.0e+00i) 0+2.0943951023931954923e0i) (num-test (acosh 5.0e-01+1.19209289550781250e-07i) 1.3765103082409432364e-7+1.0471975511966032159e0i) (num-test (acosh 5.0e-01-1.19209289550781250e-07i) 1.3765103082409432364e-7-1.0471975511966032159e0i) (num-test (acosh -5.0e-01+1.19209289550781250e-07i) 1.3765103082409432364e-7+2.0943951023931900225e0i) (num-test (acosh -5.0e-01-1.19209289550781250e-07i) 1.3765103082409432364e-7-2.0943951023931900225e0i) (num-test (acosh 5.0e-01+5.0e-01i) 5.3063753095251782602e-1+1.1185178796437059372e0i) (num-test (acosh 5.0e-01-5.0e-01i) 5.3063753095251782602e-1-1.1185178796437059372e0i) (num-test (acosh -5.0e-01+5.0e-01i) 5.3063753095251782602e-1+2.0230747739460873013e0i) (num-test (acosh -5.0e-01-5.0e-01i) 5.3063753095251782602e-1-2.0230747739460873013e0i) (num-test (acosh 5.0e-01+1.0e+00i) 9.2613303135018242455e-1+1.2213572639376833256e0i) (num-test (acosh 5.0e-01-1.0e+00i) 9.2613303135018242455e-1-1.2213572639376833256e0i) (num-test (acosh -5.0e-01+1.0e+00i) 9.2613303135018242455e-1+1.9202353896521099129e0i) (num-test (acosh -5.0e-01-1.0e+00i) 9.2613303135018242455e-1-1.9202353896521099129e0i) (num-test (acosh 5.0e-01+2.0e+00i) 1.4657153519472905218e0+1.3497776911720127603e0i) (num-test (acosh 5.0e-01-2.0e+00i) 1.4657153519472905218e0-1.3497776911720127603e0i) (num-test (acosh -5.0e-01+2.0e+00i) 1.4657153519472905218e0+1.7918149624177804781e0i) (num-test (acosh -5.0e-01-2.0e+00i) 1.4657153519472905218e0-1.7918149624177804781e0i) (num-test (acosh 5.0e-01+8.3886080e+06i) 1.6635532333438692755e1+1.5707962671902518438e0i) (num-test (acosh 5.0e-01-8.3886080e+06i) 1.6635532333438692755e1-1.5707962671902518438e0i) (num-test (acosh -5.0e-01+8.3886080e+06i) 1.6635532333438692755e1+1.5707963863995413946e0i) (num-test (acosh -5.0e-01-8.3886080e+06i) 1.6635532333438692755e1-1.5707963863995413946e0i) (num-test (acosh 1.0e+00+0.0e+00i) 0e0+0.0i) (num-test (acosh -1.0e+00+0.0e+00i) 0+3.1415926535897932385e0i) (num-test (acosh 1.0e+00+1.19209289550781250e-07i) 3.4526698643116312881e-4+3.4526697957132450399e-4i) (num-test (acosh 1.0e+00-1.19209289550781250e-07i) 3.4526698643116312881e-4-3.4526697957132450399e-4i) (num-test (acosh -1.0e+00+1.19209289550781250e-07i) 3.4526698643116312881e-4+3.1412473866102219140e0i) (num-test (acosh -1.0e+00-1.19209289550781250e-07i) 3.4526698643116312881e-4-3.1412473866102219140e0i) (num-test (acosh 1.0e+00+5.0e-01i) 7.3285767597364526089e-1+6.7488884558600638016e-1i) (num-test (acosh 1.0e+00-5.0e-01i) 7.3285767597364526089e-1-6.7488884558600638016e-1i) (num-test (acosh -1.0e+00+5.0e-01i) 7.3285767597364526089e-1+2.4667038080037868583e0i) (num-test (acosh -1.0e+00-5.0e-01i) 7.3285767597364526089e-1-2.4667038080037868583e0i) (num-test (acosh 1.0e+00+1.0e+00i) 1.0612750619050356520e0+9.0455689430238136413e-1i) (num-test (acosh 1.0e+00-1.0e+00i) 1.0612750619050356520e0-9.0455689430238136413e-1i) (num-test (acosh -1.0e+00+1.0e+00i) 1.0612750619050356520e0+2.2370357592874118743e0i) (num-test (acosh -1.0e+00-1.0e+00i) 1.0612750619050356520e0-2.2370357592874118743e0i) (num-test (acosh 1.0e+00+2.0e+00i) 1.5285709194809981613e0+1.1437177404024204938e0i) (num-test (acosh 1.0e+00-2.0e+00i) 1.5285709194809981613e0-1.1437177404024204938e0i) (num-test (acosh -1.0e+00+2.0e+00i) 1.5285709194809981613e0+1.9978749131873727447e0i) (num-test (acosh -1.0e+00-2.0e+00i) 1.5285709194809981613e0-1.9978749131873727447e0i) (num-test (acosh 1.0e+00+8.3886080e+06i) 1.6635532333438698084e1+1.5707962075856070685e0i) (num-test (acosh 1.0e+00-8.3886080e+06i) 1.6635532333438698084e1-1.5707962075856070685e0i) (num-test (acosh -1.0e+00+8.3886080e+06i) 1.6635532333438698084e1+1.570796446004186170e0i) (num-test (acosh -1.0e+00-8.3886080e+06i) 1.6635532333438698084e1-1.570796446004186170e0i) (num-test (acosh 2.0e+00+0.0e+00i) 1.3169578969248167086e0+0.0i) (num-test (acosh -2.0e+00+0.0e+00i) 1.3169578969248167086e0+3.1415926535897932385e0i) (num-test (acosh 2.0e+00+1.19209289550781250e-07i) 1.3169578969248194435e0+6.8825515412047433504e-8i) (num-test (acosh 2.0e+00-1.19209289550781250e-07i) 1.3169578969248194435e0-6.8825515412047433504e-8i) (num-test (acosh -2.0e+00+1.19209289550781250e-07i) 1.3169578969248194435e0+3.1415925847642778264e0i) (num-test (acosh -2.0e+00-1.19209289550781250e-07i) 1.3169578969248194435e0-3.1415925847642778264e0i) (num-test (acosh 2.0e+00+5.0e-01i) 1.3618009008578457882e0+2.7775425655771396018e-1i) (num-test (acosh 2.0e+00-5.0e-01i) 1.3618009008578457882e0-2.7775425655771396018e-1i) (num-test (acosh -2.0e+00+5.0e-01i) 1.3618009008578457882e0+2.8638383970320792783e0i) (num-test (acosh -2.0e+00-5.0e-01i) 1.3618009008578457882e0-2.8638383970320792783e0i) (num-test (acosh 2.0e+00+1.0e+00i) 1.4693517443681852733e0+5.0735630321714456304e-1i) (num-test (acosh 2.0e+00-1.0e+00i) 1.4693517443681852733e0-5.0735630321714456304e-1i) (num-test (acosh -2.0e+00+1.0e+00i) 1.4693517443681852733e0+2.6342363503726486754e0i) (num-test (acosh -2.0e+00-1.0e+00i) 1.4693517443681852733e0-2.6342363503726486754e0i) (num-test (acosh 2.0e+00+2.0e+00i) 1.7343245214879664480e0+8.1654718209685057852e-1i) (num-test (acosh 2.0e+00-2.0e+00i) 1.7343245214879664480e0-8.1654718209685057852e-1i) (num-test (acosh -2.0e+00+2.0e+00i) 1.7343245214879664480e0+2.3250454714929426599e0i) (num-test (acosh -2.0e+00-2.0e+00i) 1.7343245214879664480e0-2.3250454714929426599e0i) (num-test (acosh 2.0e+00+8.3886080e+06i) 1.663553233343871940e1+1.5707960883763175177e0i) (num-test (acosh 2.0e+00-8.3886080e+06i) 1.663553233343871940e1-1.5707960883763175177e0i) (num-test (acosh -2.0e+00+8.3886080e+06i) 1.663553233343871940e1+1.5707965652134757208e0i) (num-test (acosh -2.0e+00-8.3886080e+06i) 1.663553233343871940e1-1.5707965652134757208e0i) (num-test (acosh 8.3886080e+06+0.0e+00i) 1.6635532333438683873e1+0.0i) (num-test (acosh -8.3886080e+06+0.0e+00i) 1.6635532333438683873e1+3.1415926535897932385e0i) (num-test (acosh 8.3886080e+06+1.19209289550781250e-07i) 1.6635532333438683873e1+1.4210854715202104692e-14i) (num-test (acosh 8.3886080e+06-1.19209289550781250e-07i) 1.6635532333438683873e1-1.4210854715202104692e-14i) (num-test (acosh -8.3886080e+06+1.19209289550781250e-07i) 1.6635532333438683873e1+3.1415926535897790276e0i) (num-test (acosh -8.3886080e+06-1.19209289550781250e-07i) 1.6635532333438683873e1-3.1415926535897790276e0i) (num-test (acosh 8.3886080e+06+5.0e-01i) 1.6635532333438685650e1+5.9604644775390977930e-8i) (num-test (acosh 8.3886080e+06-5.0e-01i) 1.6635532333438685650e1-5.9604644775390977930e-8i) (num-test (acosh -8.3886080e+06+5.0e-01i) 1.6635532333438685650e1+3.1415925939851484631e0i) (num-test (acosh -8.3886080e+06-5.0e-01i) 1.6635532333438685650e1-3.1415925939851484631e0i) (num-test (acosh 8.3886080e+06+1.0e+00i) 1.6635532333438690979e1+1.1920928955078153234e-7i) (num-test (acosh 8.3886080e+06-1.0e+00i) 1.6635532333438690979e1-1.1920928955078153234e-7i) (num-test (acosh -8.3886080e+06+1.0e+00i) 1.6635532333438690979e1+3.1415925343805036877e0i) (num-test (acosh -8.3886080e+06-1.0e+00i) 1.6635532333438690979e1-3.1415925343805036877e0i) (num-test (acosh 8.3886080e+06+2.0e+00i) 1.6635532333438712295e1+2.3841857910155967656e-7i) (num-test (acosh 8.3886080e+06-2.0e+00i) 1.6635532333438712295e1-2.3841857910155967656e-7i) (num-test (acosh -8.3886080e+06+2.0e+00i) 1.6635532333438712295e1+3.1415924151712141369e0i) (num-test (acosh -8.3886080e+06-2.0e+00i) 1.6635532333438712295e1-3.1415924151712141369e0i) (num-test (acosh 8.3886080e+06+8.3886080e+06i) 1.6982105923718660081e1+7.8539816339745008597e-1i) (num-test (acosh 8.3886080e+06-8.3886080e+06i) 1.6982105923718660081e1-7.8539816339745008597e-1i) (num-test (acosh -8.3886080e+06+8.3886080e+06i) 1.6982105923718660081e1+2.3561944901923431525e0i) (num-test (acosh -8.3886080e+06-8.3886080e+06i) 1.6982105923718660081e1-2.3561944901923431525e0i) (num-test (acosh -2.225073858507201399999999999999999999996E-308) 0.0+1.570796326794896619231321691639751442098E0i) (num-test (acosh 1.110223024625156799999999999999999999997E-16) 0.0+1.570796326794896508209019229124071442098E0i) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'acosh num (acosh num) val))) (vector (list 0 0+1.5707963267949i) (list 1 0) (list 2 1.3169578969248) (list 3 1.7627471740391) (list -1 0+3.1415926535898i) (list -2 1.3169578969248+3.1415926535898i) (list -3 1.7627471740391+3.1415926535898i) (list 9223372036854775807 44.361419555836) (list -9223372036854775808 44.361419555836+3.1415926535898i) (list 1/2 0+1.0471975511966i) (list 1/3 0+1.2309594173408i) (list -1/2 0+2.0943951023932i) (list -1/3 0+1.910633236249i) (list 1/9223372036854775807 0+1.5707963267949i) (list 0.0 0+1.5707963267949i) (list 1.0 0.0) (list 2.0 1.3169578969248) (list -2.0 1.3169578969248+3.1415926535898i) (list 1.000000000000000000000000000000000000002E-309 0.0+1.570796326794896619231321691639751442098E0i) (list 1e+16 37.534508668465) (list 0+1i 0.88137358701954+1.5707963267949i) (list 0+2i 1.4436354751788+1.5707963267949i) (list 0-1i 0.88137358701954-1.5707963267949i) (list 1+1i 1.061275061905+0.90455689430238i) (list 1-1i 1.061275061905-0.90455689430238i) (list -1+1i 1.061275061905+2.2370357592874i) (list -1-1i 1.061275061905-2.2370357592874i) (list 0.1+0.1i 0.10033029811221+1.4711326239351i) (list 1e+16+1e+16i 37.881082258745+0.78539816339745i) (list 1e-16+1e-16i 0+1.5707963267949i) )) (test (acosh) 'error) (test (acosh "hi") 'error) (test (acosh 1.0+23.0i 1.0+23.0i) 'error) (test (acosh 0 1) 'error) (for-each (lambda (arg) (test (acosh arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; atanh ;;; -------------------------------------------------------------------------------- (num-test (atanh 0) 0.0) (num-test (atanh 2) 0.54930614433405+1.57079632679490i) (num-test (atanh -2) -0.54930614433405+1.57079632679490i) (num-test (atanh 3) 0.34657359027997+1.57079632679490i) (num-test (atanh -3) -0.34657359027997+1.57079632679490i) (num-test (atanh 10) 0.10033534773108+1.57079632679490i) (num-test (atanh -10) -0.10033534773108+1.57079632679490i) (num-test (atanh 1234) 0.00081037294887+1.57079632679490i) (num-test (atanh -1234) -0.00081037294887+1.57079632679490i) (num-test (atanh 500029) 0.00000199988401+1.57079632679490i) (num-test (atanh -500029) -0.00000199988401+1.57079632679490i) (num-test (atanh 0/1) 0.0) (num-test (atanh 0/2) 0.0) (num-test (atanh 0/3) 0.0) (num-test (atanh 0/10) 0.0) (num-test (atanh 0/1234) 0.0) (num-test (atanh 0/500029) 0.0) (num-test (atanh 1/2) 0.54930614433405) (num-test (atanh -1/2) -0.54930614433405) (num-test (atanh 1/3) 0.34657359027997) (num-test (atanh -1/3) -0.34657359027997) (num-test (atanh 1/10) 0.10033534773108) (num-test (atanh -1/10) -0.10033534773108) (num-test (atanh 1/1234) 0.00081037294887) (num-test (atanh -1/1234) -0.00081037294887) (num-test (atanh 1/500029) 0.00000199988401) (num-test (atanh -1/500029) -0.00000199988401) (num-test (atanh 2/1) 0.54930614433405+1.57079632679490i) (num-test (atanh -2/1) -0.54930614433405+1.57079632679490i) (num-test (atanh 2/3) 0.80471895621705) (num-test (atanh -2/3) -0.80471895621705) (num-test (atanh 2/10) 0.20273255405408) (num-test (atanh -2/10) -0.20273255405408) (num-test (atanh 2/1234) 0.00162074696209) (num-test (atanh -2/1234) -0.00162074696209) (num-test (atanh 2/500029) 0.00000399976801) (num-test (atanh -2/500029) -0.00000399976801) (num-test (atanh 3/1) 0.34657359027997+1.57079632679490i) (num-test (atanh -3/1) -0.34657359027997+1.57079632679490i) (num-test (atanh 3/2) 0.80471895621705+1.57079632679490i) (num-test (atanh -3/2) -0.80471895621705+1.57079632679490i) (num-test (atanh 3/10) 0.30951960420311) (num-test (atanh -3/10) -0.30951960420311) (num-test (atanh 3/1234) 0.00243112310402) (num-test (atanh -3/1234) -0.00243112310402) (num-test (atanh 3/500029) 0.00000599965202) (num-test (atanh -3/500029) -0.00000599965202) (num-test (atanh 10/1) 0.10033534773108+1.57079632679490i) (num-test (atanh -10/1) -0.10033534773108+1.57079632679490i) (num-test (atanh 10/2) 0.20273255405408+1.57079632679490i) (num-test (atanh -10/2) -0.20273255405408+1.57079632679490i) (num-test (atanh 10/3) 0.30951960420311+1.57079632679490i) (num-test (atanh -10/3) -0.30951960420311+1.57079632679490i) (num-test (atanh 10/1234) 0.00810390511343) (num-test (atanh -10/1234) -0.00810390511343) (num-test (atanh 10/500029) 0.00001999884007) (num-test (atanh -10/500029) -0.00001999884007) (num-test (atanh 1234/1) 0.00081037294887+1.57079632679490i) (num-test (atanh -1234/1) -0.00081037294887+1.57079632679490i) (num-test (atanh 1234/2) 0.00162074696209+1.57079632679490i) (num-test (atanh -1234/2) -0.00162074696209+1.57079632679490i) (num-test (atanh 1234/3) 0.00243112310402+1.57079632679490i) (num-test (atanh -1234/3) -0.00243112310402+1.57079632679490i) (num-test (atanh 1234/10) 0.00810390511343+1.57079632679490i) (num-test (atanh -1234/10) -0.00810390511343+1.57079632679490i) (num-test (atanh 1234/500029) 0.00246786187433) (num-test (atanh -1234/500029) -0.00246786187433) (num-test (atanh 500029/1) 0.00000199988401+1.57079632679490i) (num-test (atanh -500029/1) -0.00000199988401+1.57079632679490i) (num-test (atanh 500029/2) 0.00000399976801+1.57079632679490i) (num-test (atanh -500029/2) -0.00000399976801+1.57079632679490i) (num-test (atanh 500029/3) 0.00000599965202+1.57079632679490i) (num-test (atanh -500029/3) -0.00000599965202+1.57079632679490i) (num-test (atanh 500029/10) 0.00001999884007+1.57079632679490i) (num-test (atanh -500029/10) -0.00001999884007+1.57079632679490i) (num-test (atanh 500029/1234) 0.00246786187433+1.57079632679490i) (num-test (atanh -500029/1234) -0.00246786187433+1.57079632679490i) (num-test (atanh 0.0) 0.0) (num-test (atanh 0.00000001) 0.00000001) (num-test (atanh -0.00000001) -0.00000001) (num-test (atanh pi) 0.32976531495670+1.57079632679490i) (num-test (atanh -3.14159265358979) -0.32976531495670+1.57079632679490i) (num-test (atanh 1234.0) 0.00081037294887+1.57079632679490i) (num-test (atanh -1234.0) -0.00081037294887+1.57079632679490i) (num-test (atanh 0.0+0.0i) 0.0) (num-test (atanh -0.0+0.0i) 0.0) (num-test (atanh 0.0-0.0i) 0.0) (num-test (atanh -0.0-0.0i) 0.0) (num-test (atanh 0.0+0.00000001i) 0.0+0.00000001i) (num-test (atanh -0.0+0.00000001i) 0.0+0.00000001i) (num-test (atanh 0.0-0.00000001i) 0.0-0.00000001i) (num-test (atanh -0.0-0.00000001i) 0.0-0.00000001i) (num-test (atanh 0.0+1.0i) -0.0+0.78539816339745i) (num-test (atanh -0.0+1.0i) -0.0+0.78539816339745i) (num-test (atanh 0.0-1.0i) -0.0-0.78539816339745i) (num-test (atanh -0.0-1.0i) -0.0-0.78539816339745i) (num-test (atanh 0.0+3.14159265358979i) -0.0+1.26262725567891i) (num-test (atanh -0.0+3.14159265358979i) -0.0+1.26262725567891i) (num-test (atanh 0.0-3.14159265358979i) -0.0-1.26262725567891i) (num-test (atanh -0.0-3.14159265358979i) -0.0-1.26262725567891i) (num-test (atanh 0.0+1234.0i) 0.0+1.56998595420081i) (num-test (atanh -0.0+1234.0i) 0.0+1.56998595420081i) (num-test (atanh 0.0-1234.0i) 0.0-1.56998595420081i) (num-test (atanh -0.0-1234.0i) 0.0-1.56998595420081i) (num-test (atanh 0.00000001+0.0i) 0.00000001) (num-test (atanh -0.00000001+0.0i) -0.00000001) (num-test (atanh 0.00000001-0.0i) 0.00000001) (num-test (atanh -0.00000001-0.0i) -0.00000001) (num-test (atanh 0.00000001+0.00000001i) 0.00000001+0.00000001i) (num-test (atanh -0.00000001+0.00000001i) -0.00000001+0.00000001i) (num-test (atanh 0.00000001-0.00000001i) 0.00000001-0.00000001i) (num-test (atanh -0.00000001-0.00000001i) -0.00000001-0.00000001i) (num-test (atanh 0.00000001+1.0i) 0.00000000500000+0.78539816339745i) (num-test (atanh -0.00000001+1.0i) -0.00000000500000+0.78539816339745i) (num-test (atanh 0.00000001-1.0i) 0.00000000500000-0.78539816339745i) (num-test (atanh -0.00000001-1.0i) -0.00000000500000-0.78539816339745i) (num-test (atanh 0.00000001+3.14159265358979i) 0.00000000092000+1.26262725567891i) (num-test (atanh -0.00000001+3.14159265358979i) -0.00000000092000+1.26262725567891i) (num-test (atanh 0.00000001-3.14159265358979i) 0.00000000092000-1.26262725567891i) (num-test (atanh -0.00000001-3.14159265358979i) -0.00000000092000-1.26262725567891i) (num-test (atanh 0.00000001+1234.0i) 0.00000000000001+1.56998595420081i) (num-test (atanh -0.00000001+1234.0i) -0.00000000000001+1.56998595420081i) (num-test (atanh 0.00000001-1234.0i) 0.00000000000001-1.56998595420081i) (num-test (atanh -0.00000001-1234.0i) -0.00000000000001-1.56998595420081i) (num-test (atanh 1.0+0.00000001i) 9.55691396225616+0.78539816589745i) (num-test (atanh -1.0+0.00000001i) -9.55691396225615+0.78539816589745i) (num-test (atanh 1.0-0.00000001i) 9.55691396225616-0.78539816589745i) (num-test (atanh -1.0-0.00000001i) -9.55691396225615-0.78539816589745i) (num-test (atanh 1.0+1.0i) 0.40235947810853+1.01722196789785i) (num-test (atanh -1.0+1.0i) -0.40235947810853+1.01722196789785i) (num-test (atanh 1.0-1.0i) 0.40235947810853-1.01722196789785i) (num-test (atanh -1.0-1.0i) -0.40235947810853-1.01722196789785i) (num-test (atanh 1.0+3.14159265358979i) 0.08505998507745+1.28734057432439i) (num-test (atanh -1.0+3.14159265358979i) -0.08505998507745+1.28734057432439i) (num-test (atanh 1.0-3.14159265358979i) 0.08505998507745-1.28734057432439i) (num-test (atanh -1.0-3.14159265358979i) -0.08505998507745-1.28734057432439i) (num-test (atanh 1.0+1234.0i) 0.00000065670317+1.56998595473299i) (num-test (atanh -1.0+1234.0i) -0.00000065670317+1.56998595473299i) (num-test (atanh 1.0-1234.0i) 0.00000065670317-1.56998595473299i) (num-test (atanh -1.0-1234.0i) -0.00000065670317-1.56998595473299i) (num-test (atanh 3.14159265358979+0.0i) 0.32976531495670+1.57079632679490i) (num-test (atanh -3.14159265358979+0.0i) -0.32976531495670+1.57079632679490i) (num-test (atanh 3.14159265358979-0.0i) 0.32976531495670+1.57079632679490i) (num-test (atanh -3.14159265358979-0.0i) -0.32976531495670+1.57079632679490i) (num-test (atanh 3.14159265358979+0.00000001i) 0.32976531495670+1.57079632566745i) (num-test (atanh -3.14159265358979+0.00000001i) -0.32976531495670+1.57079632566745i) (num-test (atanh 3.14159265358979-0.00000001i) 0.32976531495670-1.57079632566745i) (num-test (atanh -3.14159265358979-0.00000001i) -0.32976531495670-1.57079632566745i) (num-test (atanh 3.14159265358979+1.0i) 0.29462144034086+1.47082882591946i) (num-test (atanh -3.14159265358979+1.0i) -0.29462144034086+1.47082882591946i) (num-test (atanh 3.14159265358979-1.0i) 0.29462144034086-1.47082882591946i) (num-test (atanh -3.14159265358979-1.0i) -0.29462144034086-1.47082882591946i) (num-test (atanh 3.14159265358979+3.14159265358979i) 0.15638868878130+1.40903828502376i) (num-test (atanh -3.14159265358979+3.14159265358979i) -0.15638868878130+1.40903828502376i) (num-test (atanh 3.14159265358979-3.14159265358979i) 0.15638868878130-1.40903828502376i) (num-test (atanh -3.14159265358979-3.14159265358979i) -0.15638868878130-1.40903828502376i) (num-test (atanh 3.14159265358979+1234.0i) 0.00000206308183+1.56998595945313i) (num-test (atanh -3.14159265358979+1234.0i) -0.00000206308183+1.56998595945313i) (num-test (atanh 3.14159265358979-1234.0i) 0.00000206308183-1.56998595945313i) (num-test (atanh -3.14159265358979-1234.0i) -0.00000206308183-1.56998595945313i) (num-test (atanh 1234.0+0.0i) 0.00081037294887+1.57079632679490i) (num-test (atanh -1234.0+0.0i) -0.00081037294887+1.57079632679490i) (num-test (atanh 1234.0-0.0i) 0.00081037294887+1.57079632679490i) (num-test (atanh -1234.0-0.0i) -0.00081037294887+1.57079632679490i) (num-test (atanh 1234.0+0.00000001i) 0.00081037294887+1.57079632679489i) (num-test (atanh -1234.0+0.00000001i) -0.00081037294887+1.57079632679489i) (num-test (atanh 1234.0-0.00000001i) 0.00081037294887-1.57079632679489i) (num-test (atanh -1234.0-0.00000001i) -0.00081037294887-1.57079632679489i) (num-test (atanh 1234.0+1.0i) 0.00081037241669+1.57079567009087i) (num-test (atanh -1234.0+1.0i) -0.00081037241669+1.57079567009087i) (num-test (atanh 1234.0-1.0i) 0.00081037241669-1.57079567009087i) (num-test (atanh -1234.0-1.0i) -0.00081037241669-1.57079567009087i) (num-test (atanh 1234.0+3.14159265358979i) 0.00081036769654+1.57079426371036i) (num-test (atanh -1234.0+3.14159265358979i) -0.00081036769654+1.57079426371036i) (num-test (atanh 1234.0-3.14159265358979i) 0.00081036769654-1.57079426371036i) (num-test (atanh -1234.0-3.14159265358979i) -0.00081036769654-1.57079426371036i) (num-test (atanh 1234.0+1234.0i) 0.00040518634139+1.57039114036481i) (num-test (atanh -1234.0+1234.0i) -0.00040518634139+1.57039114036481i) (num-test (atanh 1234.0-1234.0i) 0.00040518634139-1.57039114036481i) (num-test (atanh -1234.0-1234.0i) -0.00040518634139-1.57039114036481i) (num-test (atanh -1.0e+01) -1.0033534773107558064e-1+1.5707963267948966192e0i) (num-test (atanh -2.0e+00) -5.4930614433405484570e-1+1.5707963267948966192e0i) (num-test (atanh -7.50e-01) -9.7295507452765665255e-1+0.0i) (num-test (atanh -5.0e-01) -5.4930614433405484570e-1+0.0i) (num-test (atanh -1.250e-01) -1.2565721414045303884e-1+0.0i) (num-test (atanh -3.45266983001243932001e-04) -3.4526699672092216295e-4+0.0i) (num-test (atanh -1.19209289550781250e-07) -1.1920928955078181469e-7+0.0i) (num-test (atanh 0.0e+00) 0e0+0.0i) (num-test (atanh 1.19209289550781250e-07) 1.1920928955078181469e-7+0.0i) (num-test (atanh 3.45266983001243932001e-04) 3.4526699672092216295e-4+0.0i) (num-test (atanh 1.250e-01) 1.2565721414045303884e-1+0.0i) (num-test (atanh 5.0e-01) 5.4930614433405484570e-1+0.0i) (num-test (atanh 7.50e-01) 9.7295507452765665255e-1+0.0i) (num-test (atanh 2.0e+00) 5.4930614433405484570e-1-1.5707963267948966192e0i) (num-test (atanh 1.0e+01) 1.0033534773107558064e-1-1.5707963267948966192e0i) (num-test (atanh 2.8147497671066e+14) 3.552713678800501e-15-1.570796326794897i) (num-test (atanh 0.0e+00+0.0e+00i) 0e0+0.0i) (num-test (atanh 0.0e+00+1.19209289550781250e-07i) 0+1.1920928955078068531e-7i) (num-test (atanh 0.0e+00-1.19209289550781250e-07i) 0-1.1920928955078068531e-7i) (num-test (atanh 0.0e+00+5.0e-01i) 0+4.6364760900080611621e-1i) (num-test (atanh 0.0e+00-5.0e-01i) 0-4.6364760900080611621e-1i) (num-test (atanh 0.0e+00+1.0e+00i) 0+7.8539816339744830962e-1i) (num-test (atanh 0.0e+00-1.0e+00i) 0-7.8539816339744830962e-1i) (num-test (atanh 0.0e+00+2.0e+00i) 0+1.1071487177940905030e0i) (num-test (atanh 0.0e+00-2.0e+00i) 0-1.1071487177940905030e0i) (num-test (atanh 0.0e+00+8.3886080e+06i) 0+1.5707962075856070685e0i) (num-test (atanh 0.0e+00-8.3886080e+06i) 0-1.5707962075856070685e0i) (num-test (atanh 1.19209289550781250e-07+0.0e+00i) 1.1920928955078181469e-7+0.0i) (num-test (atanh -1.19209289550781250e-07+0.0e+00i) -1.1920928955078181469e-7+0.0i) (num-test (atanh 1.19209289550781250e-07+1.19209289550781250e-07i) 1.1920928955078012062e-7+1.1920928955078237938e-7i) (num-test (atanh 1.19209289550781250e-07-1.19209289550781250e-07i) 1.1920928955078012062e-7-1.1920928955078237938e-7i) (num-test (atanh -1.19209289550781250e-07+1.19209289550781250e-07i) -1.1920928955078012062e-7+1.1920928955078237938e-7i) (num-test (atanh -1.19209289550781250e-07-1.19209289550781250e-07i) -1.1920928955078012062e-7-1.1920928955078237938e-7i) (num-test (atanh 1.19209289550781250e-07+5.0e-01i) 9.5367431640625072280e-8+4.6364760900081066369e-1i) (num-test (atanh 1.19209289550781250e-07-5.0e-01i) 9.5367431640625072280e-8-4.6364760900081066369e-1i) (num-test (atanh -1.19209289550781250e-07+5.0e-01i) -9.5367431640625072280e-8+4.6364760900081066369e-1i) (num-test (atanh -1.19209289550781250e-07-5.0e-01i) -9.5367431640625072280e-8-4.6364760900081066369e-1i) (num-test (atanh 1.19209289550781250e-07+1.0e+00i) 5.9604644775390483828e-8+7.8539816339745186233e-1i) (num-test (atanh 1.19209289550781250e-07-1.0e+00i) 5.9604644775390483828e-8-7.8539816339745186233e-1i) (num-test (atanh -1.19209289550781250e-07+1.0e+00i) -5.9604644775390483828e-8+7.8539816339745186233e-1i) (num-test (atanh -1.19209289550781250e-07-1.0e+00i) -5.9604644775390483828e-8-7.8539816339745186233e-1i) (num-test (atanh 1.19209289550781250e-07+2.0e+00i) 2.3841857910156200307e-8+1.1071487177940916399e0i) (num-test (atanh 1.19209289550781250e-07-2.0e+00i) 2.3841857910156200307e-8-1.1071487177940916399e0i) (num-test (atanh -1.19209289550781250e-07+2.0e+00i) -2.3841857910156200307e-8+1.1071487177940916399e0i) (num-test (atanh -1.19209289550781250e-07-2.0e+00i) -2.3841857910156200307e-8-1.1071487177940916399e0i) (num-test (atanh 1.19209289550781250e-07+8.3886080e+06i) 1.6940658945085766040e-21+1.5707962075856070685e0i) (num-test (atanh 1.19209289550781250e-07-8.3886080e+06i) 1.6940658945085766040e-21-1.5707962075856070685e0i) (num-test (atanh -1.19209289550781250e-07+8.3886080e+06i) -1.6940658945085766040e-21+1.5707962075856070685e0i) (num-test (atanh -1.19209289550781250e-07-8.3886080e+06i) -1.6940658945085766040e-21-1.5707962075856070685e0i) (num-test (atanh 5.0e-01+0.0e+00i) 5.4930614433405484570e-1+0.0i) (num-test (atanh -5.0e-01+0.0e+00i) -5.4930614433405484570e-1+0.0i) (num-test (atanh 5.0e-01+1.19209289550781250e-07i) 5.4930614433404221383e-1+1.5894571940103932425e-7i) (num-test (atanh 5.0e-01-1.19209289550781250e-07i) 5.4930614433404221383e-1-1.5894571940103932425e-7i) (num-test (atanh -5.0e-01+1.19209289550781250e-07i) -5.4930614433404221383e-1+1.5894571940103932425e-7i) (num-test (atanh -5.0e-01-1.19209289550781250e-07i) -5.4930614433404221383e-1-1.5894571940103932425e-7i) (num-test (atanh 5.0e-01+5.0e-01i) 4.0235947810852509365e-1+5.5357435889704525151e-1i) (num-test (atanh 5.0e-01-5.0e-01i) 4.0235947810852509365e-1-5.5357435889704525151e-1i) (num-test (atanh -5.0e-01+5.0e-01i) -4.0235947810852509365e-1+5.5357435889704525151e-1i) (num-test (atanh -5.0e-01-5.0e-01i) -4.0235947810852509365e-1-5.5357435889704525151e-1i) (num-test (atanh 5.0e-01+1.0e+00i) 2.3887786125685909036e-1+8.4757566067082902713e-1i) (num-test (atanh 5.0e-01-1.0e+00i) 2.3887786125685909036e-1-8.4757566067082902713e-1i) (num-test (atanh -5.0e-01+1.0e+00i) -2.3887786125685909036e-1+8.4757566067082902713e-1i) (num-test (atanh -5.0e-01-1.0e+00i) -2.3887786125685909036e-1-8.4757566067082902713e-1i) (num-test (atanh 5.0e-01+2.0e+00i) 9.6415620202996167238e-2+1.1265564408348223487e0i) (num-test (atanh 5.0e-01-2.0e+00i) 9.6415620202996167238e-2-1.1265564408348223487e0i) (num-test (atanh -5.0e-01+2.0e+00i) -9.6415620202996167238e-2+1.1265564408348223487e0i) (num-test (atanh -5.0e-01-2.0e+00i) -9.6415620202996167238e-2-1.1265564408348223487e0i) (num-test (atanh 5.0e-01+8.3886080e+06i) 7.1054273576008756410e-15+1.5707962075856070685e0i) (num-test (atanh 5.0e-01-8.3886080e+06i) 7.1054273576008756410e-15-1.5707962075856070685e0i) (num-test (atanh -5.0e-01+8.3886080e+06i) -7.1054273576008756410e-15+1.5707962075856070685e0i) (num-test (atanh -5.0e-01-8.3886080e+06i) -7.1054273576008756410e-15-1.5707962075856070685e0i) (num-test (atanh 1.0e+00+1.19209289550781250e-07i) 8.3177661667193446012e0+7.8539819319977069731e-1i) (num-test (atanh 1.0e+00-1.19209289550781250e-07i) 8.3177661667193446012e0-7.8539819319977069731e-1i) (num-test (atanh -1.0e+00+1.19209289550781250e-07i) -8.3177661667193446012e0+7.8539819319977069731e-1i) (num-test (atanh -1.0e+00-1.19209289550781250e-07i) -8.3177661667193446012e0-7.8539819319977069731e-1i) (num-test (atanh 1.0e+00+5.0e-01i) 7.0830333601405402006e-1+9.0788749496088038670e-1i) (num-test (atanh 1.0e+00-5.0e-01i) 7.0830333601405402006e-1-9.0788749496088038670e-1i) (num-test (atanh -1.0e+00+5.0e-01i) -7.0830333601405402006e-1+9.0788749496088038670e-1i) (num-test (atanh -1.0e+00-5.0e-01i) -7.0830333601405402006e-1-9.0788749496088038670e-1i) (num-test (atanh 1.0e+00+1.0e+00i) 4.0235947810852509365e-1+1.0172219678978513677e0i) (num-test (atanh 1.0e+00-1.0e+00i) 4.0235947810852509365e-1-1.0172219678978513677e0i) (num-test (atanh -1.0e+00+1.0e+00i) -4.0235947810852509365e-1+1.0172219678978513677e0i) (num-test (atanh -1.0e+00-1.0e+00i) -4.0235947810852509365e-1-1.0172219678978513677e0i) (num-test (atanh 1.0e+00+2.0e+00i) 1.7328679513998632735e-1+1.1780972450961724644e0i) (num-test (atanh 1.0e+00-2.0e+00i) 1.7328679513998632735e-1-1.1780972450961724644e0i) (num-test (atanh -1.0e+00+2.0e+00i) -1.7328679513998632735e-1+1.1780972450961724644e0i) (num-test (atanh -1.0e+00-2.0e+00i) -1.7328679513998632735e-1-1.1780972450961724644e0i) (num-test (atanh 1.0e+00+8.3886080e+06i) 1.4210854715201599821e-14+1.5707962075856070685e0i) (num-test (atanh 1.0e+00-8.3886080e+06i) 1.4210854715201599821e-14-1.5707962075856070685e0i) (num-test (atanh -1.0e+00+8.3886080e+06i) -1.4210854715201599821e-14+1.5707962075856070685e0i) (num-test (atanh -1.0e+00-8.3886080e+06i) -1.4210854715201599821e-14-1.5707962075856070685e0i) (num-test (atanh 2.0e+00+0.0e+00i) 5.4930614433405484570e-1-1.5707963267948966192e0i) (num-test (atanh -2.0e+00+0.0e+00i) -5.4930614433405484570e-1+1.5707963267948966192e0i) (num-test (atanh 2.0e+00+1.19209289550781250e-07i) 5.4930614433405168773e-1+1.5707962870584667690e0i) (num-test (atanh 2.0e+00-1.19209289550781250e-07i) 5.4930614433405168773e-1-1.5707962870584667690e0i) (num-test (atanh -2.0e+00+1.19209289550781250e-07i) -5.4930614433405168773e-1+1.5707962870584667690e0i) (num-test (atanh -2.0e+00-1.19209289550781250e-07i) -5.4930614433405168773e-1-1.5707962870584667690e0i) (num-test (atanh 2.0e+00+5.0e-01i) 5.0037000005253101744e-1+1.4215468610018069803e0i) (num-test (atanh 2.0e+00-5.0e-01i) 5.0037000005253101744e-1-1.4215468610018069803e0i) (num-test (atanh -2.0e+00+5.0e-01i) -5.0037000005253101744e-1+1.4215468610018069803e0i) (num-test (atanh -2.0e+00-5.0e-01i) -5.0037000005253101744e-1-1.4215468610018069803e0i) (num-test (atanh 2.0e+00+1.0e+00i) 4.0235947810852509365e-1+1.3389725222944935611e0i) (num-test (atanh 2.0e+00-1.0e+00i) 4.0235947810852509365e-1-1.3389725222944935611e0i) (num-test (atanh -2.0e+00+1.0e+00i) -4.0235947810852509365e-1+1.3389725222944935611e0i) (num-test (atanh -2.0e+00-1.0e+00i) -4.0235947810852509365e-1-1.3389725222944935611e0i) (num-test (atanh 2.0e+00+2.0e+00i) 2.3887786125685909036e-1+1.3112232696716351433e0i) (num-test (atanh 2.0e+00-2.0e+00i) 2.3887786125685909036e-1-1.3112232696716351433e0i) (num-test (atanh -2.0e+00+2.0e+00i) -2.3887786125685909036e-1+1.3112232696716351433e0i) (num-test (atanh -2.0e+00-2.0e+00i) -2.3887786125685909036e-1-1.3112232696716351433e0i) (num-test (atanh 2.0e+00+8.3886080e+06i) 2.8421709430401987951e-14+1.5707962075856070685e0i) (num-test (atanh 2.0e+00-8.3886080e+06i) 2.8421709430401987951e-14-1.5707962075856070685e0i) (num-test (atanh -2.0e+00+8.3886080e+06i) -2.8421709430401987951e-14+1.5707962075856070685e0i) (num-test (atanh -2.0e+00-8.3886080e+06i) -2.8421709430401987951e-14-1.5707962075856070685e0i) (num-test (atanh 8.3886080e+06+0.0e+00i) 1.1920928955078181469e-7-1.5707963267948966192e0i) (num-test (atanh -8.3886080e+06+0.0e+00i) -1.1920928955078181469e-7+1.5707963267948966192e0i) (num-test (atanh 8.3886080e+06+1.19209289550781250e-07i) 1.1920928955078181469e-7+1.5707963267948966192e0i) (num-test (atanh 8.3886080e+06-1.19209289550781250e-07i) 1.1920928955078181469e-7-1.5707963267948966192e0i) (num-test (atanh -8.3886080e+06+1.19209289550781250e-07i) -1.1920928955078181469e-7+1.5707963267948966192e0i) (num-test (atanh -8.3886080e+06-1.19209289550781250e-07i) -1.1920928955078181469e-7-1.5707963267948966192e0i) (num-test (atanh 8.3886080e+06+5.0e-01i) 1.1920928955078139117e-7+1.5707963267948895138e0i) (num-test (atanh 8.3886080e+06-5.0e-01i) 1.1920928955078139117e-7-1.5707963267948895138e0i) (num-test (atanh -8.3886080e+06+5.0e-01i) -1.1920928955078139117e-7+1.5707963267948895138e0i) (num-test (atanh -8.3886080e+06-5.0e-01i) -1.1920928955078139117e-7-1.5707963267948895138e0i) (num-test (atanh 8.3886080e+06+1.0e+00i) 1.1920928955078012062e-7+1.5707963267948824084e0i) (num-test (atanh 8.3886080e+06-1.0e+00i) 1.1920928955078012062e-7-1.5707963267948824084e0i) (num-test (atanh -8.3886080e+06+1.0e+00i) -1.1920928955078012062e-7+1.5707963267948824084e0i) (num-test (atanh -8.3886080e+06-1.0e+00i) -1.1920928955078012062e-7-1.5707963267948824084e0i) (num-test (atanh 8.3886080e+06+2.0e+00i) 1.1920928955077503843e-7+1.5707963267948681975e0i) (num-test (atanh 8.3886080e+06-2.0e+00i) 1.1920928955077503843e-7-1.5707963267948681975e0i) (num-test (atanh -8.3886080e+06+2.0e+00i) -1.1920928955077503843e-7+1.5707963267948681975e0i) (num-test (atanh -8.3886080e+06-2.0e+00i) -1.1920928955077503843e-7-1.5707963267948681975e0i) (num-test (atanh 8.3886080e+06+8.3886080e+06i) 5.9604644775390483828e-8+1.5707962671902518438e0i) (num-test (atanh 8.3886080e+06-8.3886080e+06i) 5.9604644775390483828e-8-1.5707962671902518438e0i) (num-test (atanh -8.3886080e+06+8.3886080e+06i) -5.9604644775390483828e-8+1.5707962671902518438e0i) (num-test (atanh -8.3886080e+06-8.3886080e+06i) -5.9604644775390483828e-8-1.5707962671902518438e0i) (num-test (atanh -2.225073858507201399999999999999999999996E-308) -2.225073858507201399999999999999999999996E-308) (num-test (atanh 1.110223024625156799999999999999999999997E-16) 1.110223024625156800000000000000004561517E-16) (when with-bignums (num-test (atanh 9223372036854775/9223372036854776) 1.872683213842718135862772724835833552118E1) (num-test (atanh 92233720368547758/92233720368547757) 1.987812468492420421418925039646711911969E1+1.570796326794896619231321691639751442098E0i) (num-test (atanh 9223372036854775806/9223372036854775807) 2.218070977791824990127011272372523734584E1) (num-test (atanh 9223372036854775807/9223372036854775806) 2.218070977791824990127013919350483904273E1+1.570796326794896619231321691639751442098E0i)) (test (atanh) 'error) (test (atanh "hi") 'error) (test (atanh 1.0+23.0i 1.0+23.0i) 'error) (test (atanh 0 1) 'error) (for-each (lambda (arg) (test (atanh arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x 1.0 (+ x .1))) ((= i 100)) (let ((y (abs (- x (cosh (acosh x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-14) (format #t ";(cosh (acosh ~A)) error: ~A~%" mx err))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x 1.0+i (+ x 0.1-0.1i))) ((= i 100)) (let ((y (magnitude (- x (cosh (acosh x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-14) (format #t ";(cosh (acosh ~A)) error: ~A~%" mx err))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x 1.0 (+ x .1))) ((= i 100)) (let ((y (abs (- x (sinh (asinh x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-14) (format #t ";(sinh (asinh ~A)) error: ~A~%" mx err))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x 1.0-i (+ x -0.1+i))) ((= i 100)) (let ((y (magnitude (- x (sinh (asinh x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-9) (format #t ";(sinh (asinh ~A)) error: ~A~%" mx err))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x 0.0 (+ x .1))) ((= i 100)) (let ((y (magnitude (- x (tanh (atanh x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-12) (format #t ";(tanh (atanh ~A)) error: ~A~%" mx err))) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'atanh num (atanh num) val))) (vector (list 0 0) (list 2 0.54930614433405+1.5707963267949i) (list 3 0.34657359027997+1.5707963267949i) (list -2 -0.54930614433405+1.5707963267949i) (list -3 -0.34657359027997+1.5707963267949i) (list 9223372036854775807 -1.6740081543176e-15+1.5707963267949i) (list -9223372036854775808 -1.6740081543176e-15+1.5707963267949i) (list 1/2 0.54930614433405) (list 1/3 0.34657359027997) (list -1/2 -0.54930614433405) (list -1/3 -0.34657359027997) (list 1/9223372036854775807 1.0842021724855e-19) (list 0.0 0.0) (list 2.0 0.54930614433405+1.5707963267949i) (list -2.0 -0.54930614433405+1.5707963267949i) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309) (list 1e+16 1.7676832220204e-15+1.5707963267949i) (list +inf.0 0+1.5707963267949i) (list -inf.0 -0+1.5707963267949i) (list 0+1i -5.8004816227974e-18+0.78539816339745i) (list 0+2i -2.320192649119e-17+1.1071487177941i) (list 0-1i -5.8004816227974e-18-0.78539816339745i) (list 1+1i 0.40235947810853+1.0172219678979i) (list 1-1i 0.40235947810853-1.0172219678979i) (list -1+1i -0.40235947810853+1.0172219678979i) (list -1-1i -0.40235947810853-1.0172219678979i) (list 0.1+0.1i 0.099325449367251+0.10065855418732i) (list 1e+16+1e+16i -1.3183898417424e-15+1.5707963267949i) (list 1e-16+1e-16i 1.1102230246252e-16+1e-16i) )) ;; this abs case is useless: abs symbol_id is not zero (let () (define (hi) (let ((e (sublet (curlet) :abs (lambda (a) (- a 1))))) (with-let e (abs -1)))) (test (hi) -2)) (let () (define (hi) (let ((e (openlet (inlet :abs (lambda (a) (- a 1)))))) (with-let e (abs -1)))) (test (hi) -2)) ;; so try atanh (let () (define (hi) (let ((e (openlet (inlet :atanh (lambda (a) (- a 1)))))) (with-let e (atanh 2)))) (test (hi) 1)) ;0.549+1.570 if with-let ignored ;;; -------------------------------------------------------------------------------- ;;; sqrt ;;; -------------------------------------------------------------------------------- (num-test (sqrt 0) 0) (num-test (sqrt 1) 1) (num-test (sqrt -1) 0.0+1.0i) (num-test (sqrt 2) 1.41421356237310) (num-test (sqrt -2) 0.0+1.41421356237310i) (num-test (sqrt 3) 1.73205080756888) (num-test (sqrt -3) 0.0+1.73205080756888i) (num-test (sqrt 10) 3.16227766016838) (num-test (sqrt -10) 0.0+3.16227766016838i) (num-test (sqrt 1234) 35.12833614050059) (num-test (sqrt -1234) 0.0+35.12833614050059i) (num-test (sqrt 500029) 707.12728698587216) (num-test (sqrt -500029) 0.0+707.12728698587216i) (num-test (sqrt 0/1) 0) (num-test (sqrt 0/2) 0) (num-test (sqrt 0/3) 0) (num-test (sqrt 0/10) 0) (num-test (sqrt 0/1234) 0) (num-test (sqrt 0/500029) 0) (num-test (sqrt 1/1) 1) (num-test (sqrt -1/1) 0.0+1.0i) (num-test (sqrt 1/2) 0.70710678118655) (num-test (sqrt -1/2) 0.0+0.70710678118655i) (num-test (sqrt 1/3) 0.57735026918963) (num-test (sqrt -1/3) 0.0+0.57735026918963i) (num-test (sqrt 1/10) 0.31622776601684) (num-test (sqrt -1/10) 0.0+0.31622776601684i) (num-test (sqrt 1/1234) 0.02846704711548) (num-test (sqrt -1/1234) 0.0+0.02846704711548i) (num-test (sqrt 1/500029) 0.00141417255196) (num-test (sqrt -1/500029) 0.0+0.00141417255196i) (num-test (sqrt 2/1) 1.41421356237310) (num-test (sqrt -2/1) 0.0+1.41421356237310i) (num-test (sqrt 2/2) 1) (num-test (sqrt -2/2) 0.0+1.0i) (num-test (sqrt 2/3) 0.81649658092773) (num-test (sqrt -2/3) 0.0+0.81649658092773i) (num-test (sqrt 2/10) 0.44721359549996) (num-test (sqrt -2/10) 0.0+0.44721359549996i) (num-test (sqrt 2/1234) 0.04025848411142) (num-test (sqrt -2/1234) 0.0+0.04025848411142i) (num-test (sqrt 2/500029) 0.00199994200252) (num-test (sqrt -2/500029) 0.0+0.00199994200252i) (num-test (sqrt 3/1) 1.73205080756888) (num-test (sqrt -3/1) 0.0+1.73205080756888i) (num-test (sqrt 3/2) 1.22474487139159) (num-test (sqrt -3/2) 0.0+1.22474487139159i) (num-test (sqrt 3/3) 1) (num-test (sqrt -3/3) 0.0+1.0i) (num-test (sqrt 3/10) 0.54772255750517) (num-test (sqrt -3/10) 0.0+0.54772255750517i) (num-test (sqrt 3/1234) 0.04930637194547) (num-test (sqrt -3/1234) 0.0+0.04930637194547i) (num-test (sqrt 3/500029) 0.00244941871067) (num-test (sqrt -3/500029) 0.0+0.00244941871067i) (num-test (sqrt 10/1) 3.16227766016838) (num-test (sqrt -10/1) 0.0+3.16227766016838i) (num-test (sqrt 10/2) 2.23606797749979) (num-test (sqrt -10/2) 0.0+2.23606797749979i) (num-test (sqrt 10/3) 1.82574185835055) (num-test (sqrt -10/3) 0.0+1.82574185835055i) (num-test (sqrt 10/10) 1) (num-test (sqrt -10/10) 0.0+1.0i) (num-test (sqrt 10/1234) 0.09002070714424) (num-test (sqrt -10/1234) 0.0+0.09002070714424i) (num-test (sqrt 10/500029) 0.00447200626870) (num-test (sqrt -10/500029) 0.0+0.00447200626870i) (num-test (sqrt 1234/1) 35.12833614050059) (num-test (sqrt -1234/1) 0.0+35.12833614050059i) (num-test (sqrt 1234/2) 24.83948469674844) (num-test (sqrt -1234/2) 0.0+24.83948469674844i) (num-test (sqrt 1234/3) 20.28135432690167) (num-test (sqrt -1234/3) 0.0+20.28135432690167i) (num-test (sqrt 1234/10) 11.10855526159905) (num-test (sqrt -1234/10) 0.0+11.10855526159905i) (num-test (sqrt 1234/500029) 0.04967752876605) (num-test (sqrt -1234/500029) 0.0+0.04967752876605i) (num-test (sqrt 500029/1) 707.12728698587216) (num-test (sqrt -500029/1) 0.0+707.12728698587216i) (num-test (sqrt 500029/2) 500.01449978975609) (num-test (sqrt -500029/2) 0.0+500.01449978975609i) (num-test (sqrt 500029/3) 408.26012949262304) (num-test (sqrt -500029/3) 0.0+408.26012949262304i) (num-test (sqrt 500029/10) 223.61328225308978) (num-test (sqrt -500029/10) 0.0+223.61328225308978i) (num-test (sqrt 500029/1234) 20.12982579526738) (num-test (sqrt -500029/1234) 0.0+20.12982579526738i) (num-test (sqrt 500029/500029) 1) (num-test (sqrt -500029/500029) 0.0+1.0i) (num-test (sqrt 0.0) 0.0) (num-test (sqrt 0.00000001) 0.00010000000000) (num-test (sqrt -0.00000001) 0.0+0.00010000000000i) (num-test (sqrt 1.0) 1.0) (num-test (sqrt -1.0) 0.0+1.0i) (num-test (sqrt pi) 1.77245385090552) (num-test (sqrt -3.14159265358979) 0.0+1.77245385090552i) (num-test (sqrt 1234.0) 35.12833614050059) (num-test (sqrt -1234.0) 0.0+35.12833614050059i) (num-test (sqrt 0.0+0.0i) 0.0) (num-test (sqrt -0.0+0.0i) 0.0) (num-test (sqrt 0.0-0.0i) 0.0) (num-test (sqrt -0.0-0.0i) 0.0) (num-test (sqrt 0.0+0.00000001i) 0.00007071067812+0.00007071067812i) (num-test (sqrt -0.0+0.00000001i) 0.00007071067812+0.00007071067812i) (num-test (sqrt 0.0-0.00000001i) 0.00007071067812-0.00007071067812i) (num-test (sqrt -0.0-0.00000001i) 0.00007071067812-0.00007071067812i) (num-test (sqrt 0.0+1.0i) 0.70710678118655+0.70710678118655i) (num-test (sqrt -0.0+1.0i) 0.70710678118655+0.70710678118655i) (num-test (sqrt 0.0-1.0i) 0.70710678118655-0.70710678118655i) (num-test (sqrt -0.0-1.0i) 0.70710678118655-0.70710678118655i) (num-test (sqrt 0.0+3.14159265358979i) 1.25331413731550+1.25331413731550i) (num-test (sqrt -0.0+3.14159265358979i) 1.25331413731550+1.25331413731550i) (num-test (sqrt 0.0-3.14159265358979i) 1.25331413731550-1.25331413731550i) (num-test (sqrt -0.0-3.14159265358979i) 1.25331413731550-1.25331413731550i) (num-test (sqrt 0.0+1234.0i) 24.83948469674844+24.83948469674844i) (num-test (sqrt -0.0+1234.0i) 24.83948469674844+24.83948469674844i) (num-test (sqrt 0.0-1234.0i) 24.83948469674844-24.83948469674844i) (num-test (sqrt -0.0-1234.0i) 24.83948469674844-24.83948469674844i) (num-test (sqrt 0.00000001+0.0i) 0.00010000000000) (num-test (sqrt -0.00000001+0.0i) 0.0+0.00010000000000i) (num-test (sqrt 0.00000001-0.0i) 0.00010000000000) (num-test (sqrt -0.00000001-0.0i) 0.0+0.00010000000000i) (num-test (sqrt 0.00000001+0.00000001i) 0.00010986841135+0.00004550898606i) (num-test (sqrt -0.00000001+0.00000001i) 0.00004550898606+0.00010986841135i) (num-test (sqrt 0.00000001-0.00000001i) 0.00010986841135-0.00004550898606i) (num-test (sqrt -0.00000001-0.00000001i) 0.00004550898606-0.00010986841135i) (num-test (sqrt 0.00000001+1.0i) 0.70710678472208+0.70710677765101i) (num-test (sqrt -0.00000001+1.0i) 0.70710677765101+0.70710678472208i) (num-test (sqrt 0.00000001-1.0i) 0.70710678472208-0.70710677765101i) (num-test (sqrt -0.00000001-1.0i) 0.70710677765101-0.70710678472208i) (num-test (sqrt 0.00000001+3.14159265358979i) 1.25331413931021+1.25331413532079i) (num-test (sqrt -0.00000001+3.14159265358979i) 1.25331413532079+1.25331413931021i) (num-test (sqrt 0.00000001-3.14159265358979i) 1.25331413931021-1.25331413532079i) (num-test (sqrt -0.00000001-3.14159265358979i) 1.25331413532079-1.25331413931021i) (num-test (sqrt 0.00000001+1234.0i) 24.83948469684909+24.83948469664779i) (num-test (sqrt -0.00000001+1234.0i) 24.83948469664779+24.83948469684909i) (num-test (sqrt 0.00000001-1234.0i) 24.83948469684909-24.83948469664779i) (num-test (sqrt -0.00000001-1234.0i) 24.83948469664779-24.83948469684909i) (num-test (sqrt 1.0+0.0i) 1.0) (num-test (sqrt -0.0) 0.0) (num-test (sqrt -1.0+0.0i) 0.0+1.0i) (num-test (sqrt 1.0-0.0i) 1.0) (num-test (sqrt -1.0-0.0i) 0.0+1.0i) (num-test (sqrt 1.0+0.00000001i) 1.0+0.00000000500000i) (num-test (sqrt -1.0+0.00000001i) 0.00000000500000+1.0i) (num-test (sqrt 1.0-0.00000001i) 1.0-0.00000000500000i) (num-test (sqrt -1.0-0.00000001i) 0.00000000500000-1.0i) (num-test (sqrt 1.0+1.0i) 1.09868411346781+0.45508986056223i) (num-test (sqrt -1.0+1.0i) 0.45508986056223+1.09868411346781i) (num-test (sqrt 1.0-1.0i) 1.09868411346781-0.45508986056223i) (num-test (sqrt -1.0-1.0i) 0.45508986056223-1.09868411346781i) (num-test (sqrt 1.0+3.14159265358979i) 1.46576060621706+1.07165953303174i) (num-test (sqrt -1.0+3.14159265358979i) 1.07165953303174+1.46576060621706i) (num-test (sqrt 1.0-3.14159265358979i) 1.46576060621706-1.07165953303174i) (num-test (sqrt -1.0-3.14159265358979i) 1.07165953303174-1.46576060621706i) (num-test (sqrt 1.0+1234.0i) 24.84955135597340+24.82942211557006i) (num-test (sqrt -1.0+1234.0i) 24.82942211557006+24.84955135597340i) (num-test (sqrt 1.0-1234.0i) 24.84955135597340-24.82942211557006i) (num-test (sqrt -1.0-1234.0i) 24.82942211557006-24.84955135597340i) (num-test (sqrt 3.14159265358979+0.0i) 1.77245385090552) (num-test (sqrt -3.14159265358979+0.0i) 0.0+1.77245385090552i) (num-test (sqrt 3.14159265358979-0.0i) 1.77245385090552) (num-test (sqrt -3.14159265358979-0.0i) 0.0+1.77245385090552i) (num-test (sqrt 3.14159265358979+0.00000001i) 1.77245385090552+0.00000000282095i) (num-test (sqrt -3.14159265358979+0.00000001i) 0.00000000282095+1.77245385090552i) (num-test (sqrt 3.14159265358979-0.00000001i) 1.77245385090552-0.00000000282095i) (num-test (sqrt -3.14159265358979-0.00000001i) 0.00000000282095-1.77245385090552i) (num-test (sqrt 3.14159265358979+1.0i) 1.79422698718214+0.27867154132224i) (num-test (sqrt -3.14159265358979+1.0i) 0.27867154132224+1.79422698718214i) (num-test (sqrt 3.14159265358979-1.0i) 1.79422698718214-0.27867154132224i) (num-test (sqrt -3.14159265358979-1.0i) 0.27867154132224-1.79422698718214i) (num-test (sqrt 3.14159265358979+3.14159265358979i) 1.94736688784473+0.80662577586157i) (num-test (sqrt -3.14159265358979+3.14159265358979i) 0.80662577586157+1.94736688784473i) (num-test (sqrt 3.14159265358979-3.14159265358979i) 1.94736688784473-0.80662577586157i) (num-test (sqrt -3.14159265358979-3.14159265358979i) 0.80662577586157-1.94736688784473i) (num-test (sqrt 3.14159265358979+1234.0i) 24.87112373493049+24.80788590719961i) (num-test (sqrt -3.14159265358979+1234.0i) 24.80788590719961+24.87112373493049i) (num-test (sqrt 3.14159265358979-1234.0i) 24.87112373493049-24.80788590719961i) (num-test (sqrt -3.14159265358979-1234.0i) 24.80788590719961-24.87112373493049i) (num-test (sqrt 1234.0+0.0i) 35.12833614050059) (num-test (sqrt -1234.0+0.0i) 0.0+35.12833614050059i) (num-test (sqrt 1234.0-0.0i) 35.12833614050059) (num-test (sqrt -1234.0-0.0i) 0.0+35.12833614050059i) (num-test (sqrt 1234.0+0.00000001i) 35.12833614050059+0.00000000014234i) (num-test (sqrt -1234.0+0.00000001i) 0.00000000014234+35.12833614050059i) (num-test (sqrt 1234.0-0.00000001i) 35.12833614050059-0.00000000014234i) (num-test (sqrt -1234.0-0.00000001i) 0.00000000014234-35.12833614050059i) (num-test (sqrt 1234.0+1.0i) 35.12833902411499+0.01423352238934i) (num-test (sqrt -1234.0+1.0i) 0.01423352238934+35.12833902411499i) (num-test (sqrt 1234.0-1.0i) 35.12833902411499-0.01423352238934i) (num-test (sqrt -1234.0-1.0i) 0.01423352238934-35.12833902411499i) (num-test (sqrt 1234.0+3.14159265358979i) 35.12836460058208+0.04471589681601i) (num-test (sqrt -1234.0+3.14159265358979i) 0.04471589681601+35.12836460058208i) (num-test (sqrt 1234.0-3.14159265358979i) 35.12836460058208-0.04471589681601i) (num-test (sqrt -1234.0-3.14159265358979i) 0.04471589681601-35.12836460058208i) (num-test (sqrt 1234.0+1234.0i) 38.59494485012512+15.98654959596347i) (num-test (sqrt -1234.0+1234.0i) 15.98654959596347+38.59494485012512i) (num-test (sqrt 1234.0-1234.0i) 38.59494485012512-15.98654959596347i) (num-test (sqrt -1234.0-1234.0i) 15.98654959596347-38.59494485012512i) (num-test (sqrt 2.2250739e-308) 1.4916681e-154) (num-test (sqrt 1.7976931e+308) 1.3407808e+154) (num-test (sqrt 0.0e+00+0.0e+00i) 0e0+0.0i) (num-test (sqrt 0.0e+00+1.19209289550781250e-07i) 2.44140625e-4+2.44140625e-4i) (num-test (sqrt 0.0e+00-1.19209289550781250e-07i) 2.44140625e-4-2.44140625e-4i) (num-test (sqrt 0.0e+00+5.0e-01i) 5e-1+5e-1i) (num-test (sqrt 0.0e+00-5.0e-01i) 5e-1-5e-1i) (num-test (sqrt 0.0e+00+1.0e+00i) 7.0710678118654752440e-1+7.0710678118654752440e-1i) (num-test (sqrt 0.0e+00-1.0e+00i) 7.0710678118654752440e-1-7.0710678118654752440e-1i) (num-test (sqrt 0.0e+00+2.0e+00i) 1+1i) (num-test (sqrt 0.0e+00-2.0e+00i) 1-1i) (num-test (sqrt 0.0e+00+8.3886080e+06i) 2048+2048i) (num-test (sqrt 0.0e+00-8.3886080e+06i) 2048-2048i) (num-test (sqrt 1.19209289550781250e-07+0.0e+00i) 3.4526698300124390840e-4+0.0i) (num-test (sqrt -1.19209289550781250e-07+0.0e+00i) 0+3.4526698300124390840e-4i) (num-test (sqrt 1.19209289550781250e-07+1.19209289550781250e-07i) 3.7933934912842707699e-4+1.5712750315077700799e-4i) (num-test (sqrt 1.19209289550781250e-07-1.19209289550781250e-07i) 3.7933934912842707699e-4-1.5712750315077700799e-4i) (num-test (sqrt -1.19209289550781250e-07+1.19209289550781250e-07i) 1.5712750315077700799e-4+3.7933934912842707699e-4i) (num-test (sqrt -1.19209289550781250e-07-1.19209289550781250e-07i) 1.5712750315077700799e-4-3.7933934912842707699e-4i) (num-test (sqrt 1.19209289550781250e-07+5.0e-01i) 5.0000005960464832810e-1+4.9999994039535877732e-1i) (num-test (sqrt 1.19209289550781250e-07-5.0e-01i) 5.0000005960464832810e-1-4.9999994039535877732e-1i) (num-test (sqrt -1.19209289550781250e-07+5.0e-01i) 4.9999994039535877732e-1+5.0000005960464832810e-1i) (num-test (sqrt -1.19209289550781250e-07-5.0e-01i) 4.9999994039535877732e-1-5.0000005960464832810e-1i) (num-test (sqrt 1.19209289550781250e-07+1.0e+00i) 7.0710682333339729137e-1+7.0710673903970026958e-1i) (num-test (sqrt 1.19209289550781250e-07-1.0e+00i) 7.0710682333339729137e-1-7.0710673903970026958e-1i) (num-test (sqrt -1.19209289550781250e-07+1.0e+00i) 7.0710673903970026958e-1+7.0710682333339729137e-1i) (num-test (sqrt -1.19209289550781250e-07-1.0e+00i) 7.0710673903970026958e-1-7.0710682333339729137e-1i) (num-test (sqrt 1.19209289550781250e-07+2.0e+00i) 1.0000000298023228318e0+9.9999997019767805639e-1i) (num-test (sqrt 1.19209289550781250e-07-2.0e+00i) 1.0000000298023228318e0-9.9999997019767805639e-1i) (num-test (sqrt -1.19209289550781250e-07+2.0e+00i) 9.9999997019767805639e-1+1.0000000298023228318e0i) (num-test (sqrt -1.19209289550781250e-07-2.0e+00i) 9.9999997019767805639e-1-1.0000000298023228318e0i) (num-test (sqrt 1.19209289550781250e-07+8.3886080e+06i) 2.0480000000000145519e3+2.0479999999999854481e3i) (num-test (sqrt 1.19209289550781250e-07-8.3886080e+06i) 2.0480000000000145519e3-2.0479999999999854481e3i) (num-test (sqrt -1.19209289550781250e-07+8.3886080e+06i) 2.0479999999999854481e3+2.0480000000000145519e3i) (num-test (sqrt -1.19209289550781250e-07-8.3886080e+06i) 2.0479999999999854481e3-2.0480000000000145519e3i) (num-test (sqrt 5.0e-01+0.0e+00i) 7.0710678118654752440e-1+0.0i) (num-test (sqrt -5.0e-01+0.0e+00i) 0+7.0710678118654752440e-1i) (num-test (sqrt 5.0e-01+1.19209289550781250e-07i) 7.0710678118655254870e-1+8.4293697021787464631e-8i) (num-test (sqrt 5.0e-01-1.19209289550781250e-07i) 7.0710678118655254870e-1-8.4293697021787464631e-8i) (num-test (sqrt -5.0e-01+1.19209289550781250e-07i) 8.4293697021787464631e-8+7.0710678118655254870e-1i) (num-test (sqrt -5.0e-01-1.19209289550781250e-07i) 8.4293697021787464631e-8-7.0710678118655254870e-1i) (num-test (sqrt 5.0e-01+5.0e-01i) 7.7688698701501865367e-1+3.2179712645279131237e-1i) (num-test (sqrt 5.0e-01-5.0e-01i) 7.7688698701501865367e-1-3.2179712645279131237e-1i) (num-test (sqrt -5.0e-01+5.0e-01i) 3.2179712645279131237e-1+7.7688698701501865367e-1i) (num-test (sqrt -5.0e-01-5.0e-01i) 3.2179712645279131237e-1-7.7688698701501865367e-1i) (num-test (sqrt 5.0e-01+1.0e+00i) 8.9945371997393363613e-1+5.5589297025142117199e-1i) (num-test (sqrt 5.0e-01-1.0e+00i) 8.9945371997393363613e-1-5.5589297025142117199e-1i) (num-test (sqrt -5.0e-01+1.0e+00i) 5.5589297025142117199e-1+8.9945371997393363613e-1i) (num-test (sqrt -5.0e-01-1.0e+00i) 5.5589297025142117199e-1-8.9945371997393363613e-1i) (num-test (sqrt 5.0e-01+2.0e+00i) 1.1317139242778694103e0+8.8361553087551326576e-1i) (num-test (sqrt 5.0e-01-2.0e+00i) 1.1317139242778694103e0-8.8361553087551326576e-1i) (num-test (sqrt -5.0e-01+2.0e+00i) 8.8361553087551326576e-1+1.1317139242778694103e0i) (num-test (sqrt -5.0e-01-2.0e+00i) 8.8361553087551326576e-1-1.1317139242778694103e0i) (num-test (sqrt 5.0e-01+8.3886080e+06i) 2.0480000610351571595e3+2.0479999389648446595e3i) (num-test (sqrt 5.0e-01-8.3886080e+06i) 2.0480000610351571595e3-2.0479999389648446595e3i) (num-test (sqrt -5.0e-01+8.3886080e+06i) 2.0479999389648446595e3+2.0480000610351571595e3i) (num-test (sqrt -5.0e-01-8.3886080e+06i) 2.0479999389648446595e3-2.0480000610351571595e3i) (num-test (sqrt 1.0e+00+0.0e+00i) 1e0+0.0i) (num-test (sqrt -1.0e+00+0.0e+00i) 0+1i) (num-test (sqrt 1.0e+00+1.19209289550781250e-07i) 1.0000000000000017764e0+5.9604644775390519121e-8i) (num-test (sqrt 1.0e+00-1.19209289550781250e-07i) 1.0000000000000017764e0-5.9604644775390519121e-8i) (num-test (sqrt -1.0e+00+1.19209289550781250e-07i) 5.9604644775390519121e-8+1.0000000000000017764e0i) (num-test (sqrt -1.0e+00-1.19209289550781250e-07i) 5.9604644775390519121e-8-1.0000000000000017764e0i) (num-test (sqrt 1.0e+00+5.0e-01i) 1.0290855136357461252e0+2.4293413587832283909e-1i) (num-test (sqrt 1.0e+00-5.0e-01i) 1.0290855136357461252e0-2.4293413587832283909e-1i) (num-test (sqrt -1.0e+00+5.0e-01i) 2.4293413587832283909e-1+1.0290855136357461252e0i) (num-test (sqrt -1.0e+00-5.0e-01i) 2.4293413587832283909e-1-1.0290855136357461252e0i) (num-test (sqrt 1.0e+00+1.0e+00i) 1.0986841134678099660e0+4.5508986056222734130e-1i) (num-test (sqrt 1.0e+00-1.0e+00i) 1.0986841134678099660e0-4.5508986056222734130e-1i) (num-test (sqrt -1.0e+00+1.0e+00i) 4.5508986056222734130e-1+1.0986841134678099660e0i) (num-test (sqrt -1.0e+00-1.0e+00i) 4.5508986056222734130e-1-1.0986841134678099660e0i) (num-test (sqrt 1.0e+00+2.0e+00i) 1.2720196495140689643e0+7.8615137775742328607e-1i) (num-test (sqrt 1.0e+00-2.0e+00i) 1.2720196495140689643e0-7.8615137775742328607e-1i) (num-test (sqrt -1.0e+00+2.0e+00i) 7.8615137775742328607e-1+1.2720196495140689643e0i) (num-test (sqrt -1.0e+00-2.0e+00i) 7.8615137775742328607e-1-1.2720196495140689643e0i) (num-test (sqrt 1.0e+00+8.3886080e+06i) 2.0480001220703161380e3+2.0479998779296911380e3i) (num-test (sqrt 1.0e+00-8.3886080e+06i) 2.0480001220703161380e3-2.0479998779296911380e3i) (num-test (sqrt -1.0e+00+8.3886080e+06i) 2.0479998779296911380e3+2.0480001220703161380e3i) (num-test (sqrt -1.0e+00-8.3886080e+06i) 2.0479998779296911380e3-2.0480001220703161380e3i) (num-test (sqrt 2.0e+00+0.0e+00i) 1.4142135623730950488e0+0.0i) (num-test (sqrt -2.0e+00+0.0e+00i) 0+1.4142135623730950488e0i) (num-test (sqrt 2.0e+00+1.19209289550781250e-07i) 1.4142135623730956768e0+4.2146848510894013070e-8i) (num-test (sqrt 2.0e+00-1.19209289550781250e-07i) 1.4142135623730956768e0-4.2146848510894013070e-8i) (num-test (sqrt -2.0e+00+1.19209289550781250e-07i) 4.2146848510894013070e-8+1.4142135623730956768e0i) (num-test (sqrt -2.0e+00-1.19209289550781250e-07i) 4.2146848510894013070e-8-1.4142135623730956768e0i) (num-test (sqrt 2.0e+00+5.0e-01i) 1.4250531240639470060e0+1.7543205637629383228e-1i) (num-test (sqrt 2.0e+00-5.0e-01i) 1.4250531240639470060e0-1.7543205637629383228e-1i) (num-test (sqrt -2.0e+00+5.0e-01i) 1.7543205637629383228e-1+1.4250531240639470060e0i) (num-test (sqrt -2.0e+00-5.0e-01i) 1.7543205637629383228e-1-1.4250531240639470060e0i) (num-test (sqrt 2.0e+00+1.0e+00i) 1.4553466902253548081e0+3.4356074972251246414e-1i) (num-test (sqrt 2.0e+00-1.0e+00i) 1.4553466902253548081e0-3.4356074972251246414e-1i) (num-test (sqrt -2.0e+00+1.0e+00i) 3.4356074972251246414e-1+1.4553466902253548081e0i) (num-test (sqrt -2.0e+00-1.0e+00i) 3.4356074972251246414e-1-1.4553466902253548081e0i) (num-test (sqrt 2.0e+00+2.0e+00i) 1.5537739740300373073e0+6.4359425290558262474e-1i) (num-test (sqrt 2.0e+00-2.0e+00i) 1.5537739740300373073e0-6.4359425290558262474e-1i) (num-test (sqrt -2.0e+00+2.0e+00i) 6.4359425290558262474e-1+1.5537739740300373073e0i) (num-test (sqrt -2.0e+00-2.0e+00i) 6.4359425290558262474e-1-1.5537739740300373073e0i) (num-test (sqrt 2.0e+00+8.3886080e+06i) 2.0480002441406395519e3+2.0479997558593895519e3i) (num-test (sqrt 2.0e+00-8.3886080e+06i) 2.0480002441406395519e3-2.0479997558593895519e3i) (num-test (sqrt -2.0e+00+8.3886080e+06i) 2.0479997558593895519e3+2.0480002441406395519e3i) (num-test (sqrt -2.0e+00-8.3886080e+06i) 2.0479997558593895519e3-2.0480002441406395519e3i) (num-test (sqrt 8.3886080e+06+0.0e+00i) 2.8963093757400986599e3+0.0i) (num-test (sqrt -8.3886080e+06+0.0e+00i) 0+2.8963093757400986599e3i) (num-test (sqrt 8.3886080e+06+1.19209289550781250e-07i) 2.8963093757400986599e3+2.0579515874459976458e-11i) (num-test (sqrt 8.3886080e+06-1.19209289550781250e-07i) 2.8963093757400986599e3-2.0579515874459976458e-11i) (num-test (sqrt -8.3886080e+06+1.19209289550781250e-07i) 2.0579515874459976458e-11+2.8963093757400986599e3i) (num-test (sqrt -8.3886080e+06-1.19209289550781250e-07i) 2.0579515874459976458e-11-2.8963093757400986599e3i) (num-test (sqrt 8.3886080e+06+5.0e-01i) 2.8963093757400999462e3+8.6316745750310938767e-5i) (num-test (sqrt 8.3886080e+06-5.0e-01i) 2.8963093757400999462e3-8.6316745750310938767e-5i) (num-test (sqrt -8.3886080e+06+5.0e-01i) 8.6316745750310938767e-5+2.8963093757400999462e3i) (num-test (sqrt -8.3886080e+06-5.0e-01i) 8.6316745750310938767e-5-2.8963093757400999462e3i) (num-test (sqrt 8.3886080e+06+1.0e+00i) 2.8963093757401038048e3+1.7263349150062164754e-4i) (num-test (sqrt 8.3886080e+06-1.0e+00i) 2.8963093757401038048e3-1.7263349150062164754e-4i) (num-test (sqrt -8.3886080e+06+1.0e+00i) 1.7263349150062164754e-4+2.8963093757401038048e3i) (num-test (sqrt -8.3886080e+06-1.0e+00i) 1.7263349150062164754e-4-2.8963093757401038048e3i) (num-test (sqrt 8.3886080e+06+2.0e+00i) 2.8963093757401192395e3+3.4526698300124145513e-4i) (num-test (sqrt 8.3886080e+06-2.0e+00i) 2.8963093757401192395e3-3.4526698300124145513e-4i) (num-test (sqrt -8.3886080e+06+2.0e+00i) 3.4526698300124145513e-4+2.8963093757401192395e3i) (num-test (sqrt -8.3886080e+06-2.0e+00i) 3.4526698300124145513e-4-2.8963093757401192395e3i) (num-test (sqrt 8.3886080e+06+8.3886080e+06i) 3.1821290988135164054e3+1.3180810299506332155e3i) (num-test (sqrt 8.3886080e+06-8.3886080e+06i) 3.1821290988135164054e3-1.3180810299506332155e3i) (num-test (sqrt -8.3886080e+06+8.3886080e+06i) 1.3180810299506332155e3+3.1821290988135164054e3i) (num-test (sqrt -8.3886080e+06-8.3886080e+06i) 1.3180810299506332155e3-3.1821290988135164054e3i) (num-test (sqrt -1.0e+01) 0+3.1622776601683793320e0i) (num-test (sqrt -2.0e+00) 0+1.4142135623730950488e0i) (num-test (sqrt -1.0e+00) 0+1i) (num-test (sqrt -7.50e-01) 0+8.6602540378443864676e-1i) (num-test (sqrt -5.0e-01) 0+7.0710678118654752440e-1i) (num-test (sqrt -1.250e-01) 0+3.5355339059327376220e-1i) (num-test (sqrt -3.45266983001243932001e-04) 0+1.8581361171917517303e-2i) (num-test (sqrt -1.19209289550781250e-07) 0+3.4526698300124390840e-4i) (num-test (sqrt 0.0e+00) 0e0+0.0i) (num-test (sqrt 1.19209289550781250e-07) 3.4526698300124390840e-4+0.0i) (num-test (sqrt 3.45266983001243932001e-04) 1.8581361171917517303e-2+0.0i) (num-test (sqrt 1.250e-01) 3.5355339059327376220e-1+0.0i) (num-test (sqrt 5.0e-01) 7.0710678118654752440e-1+0.0i) (num-test (sqrt 7.50e-01) 8.6602540378443864676e-1+0.0i) (num-test (sqrt 1.0e+00) 1e0+0.0i) (num-test (sqrt 2.0e+00) 1.4142135623730950488e0+0.0i) (num-test (sqrt 1.0e+01) 3.1622776601683793320e0+0.0i) (num-test (sqrt 9) 3) (num-test (sqrt -9.0) 0.0+3.0i) (num-test (sqrt (sqrt (sqrt 256))) 2) (num-test (sqrt (sqrt (sqrt 1/256))) 1/2) (num-test (sqrt 0.1-111i) 7.4531887486175-7.4464771887462i) (num-test (sqrt -2.225073858507201399999999999999999999996E-308) 0.0+1.49166814624004135432626585974344862306E-154i) (num-test (sqrt -9223372036854775808) 0.0+3.037000499976049692451388530026308346744E9i) (num-test (sqrt 1.110223024625156799999999999999999999997E-16) 1.053671212772350917851343014434652692451E-8) (num-test (sqrt 9223372036854775807) 3.037000499976049692286752403030628535068E9) (num-test (sqrt (* 64686/26264 64686/26264)) 32343/13132) (num-test (sqrt (* 64812/61611 64812/61611)) 1964/1867) (num-test (sqrt (* 38868/48261 38868/48261)) 12956/16087) (num-test (sqrt (* 39537/63628 39537/63628)) 39537/63628) (num-test (sqrt (* 1238/47077 1238/47077)) 1238/47077) (num-test (sqrt (* 51490/46936 51490/46936)) 25745/23468) (num-test (sqrt (* 35778/34583 35778/34583)) 35778/34583) (num-test (sqrt (* 19920/16774 19920/16774)) 9960/8387) (num-test (sqrt (* 29100/37656 29100/37656)) 2425/3138) (num-test (sqrt (* 64906/58229 64906/58229)) 64906/58229) (num-test (sqrt 144) 12) (num-test (sqrt 9000000000000000000) 3000000000) ;; but unfortunately in non-gmp, 9400000000000000000 -> -9046744073709551616 (test (and (integer? (sqrt 9007199136250226)) (exact? (sqrt 9007199136250226))) #f) (test (and (integer? (sqrt 9007199136250225)) (exact? (sqrt 9007199136250225))) #t) (test (sqrt 1/4) 1/2) (test (sqrt 256/81) 16/9) (test (rational? (sqrt 256/81)) #t) (when (integer? (sqrt 4)) (for-each (lambda (n sqn) (if (positive? n) ; in case 32 bit int (let ((val (sqrt n))) (if (or (not (integer? val)) (not (eqv? sqn val))) (format #t ";(sqrt ~A) expected ~A but got ~A~%" n sqn val))))) (list 9 491401 19439281 1248844921 235565593201) (list 3 701 4409 35339 485351)) (for-each (lambda (n) (if (positive? n) (let ((val (sqrt n))) (if (or (integer? val) (> (abs (- (* val val) n)) .001)) (format #t ";(sqrt ~A) expected ~A but got ~A~%" n (sqrt (* 1.0 n)) val))))) (list 10 491400 19439282 1248844920 235565593200)) (test (eqv? (expt 2 3) 8) #t) ;(test (eqv? (log 8 2) 3) #t) ; optimization in C (-O2) changes this (num-test (log 8 2) 3) (num-test (log 1/8 2) -3) (unless (provided? '32-bit) (test (eqv? (expt 701 2) 491401) #t) (test (eqv? (log 491401 701) 2) #t))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x -10.0 (+ x .1))) ((= i 200)) (let ((y (magnitude (- x (* (sqrt x) (sqrt x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-14) (format #t ";(sqr (sqrt ~A)) error: ~A~%" mx err))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x -10.0+i (+ x .1+i))) ((= i 200)) (let ((y (magnitude (- x (* (sqrt x) (sqrt x)))))) (if (> y err) (begin (set! mx x) (set! err y))))) (if (> err 1e-12) (format #t ";(sqr (sqrt ~A)) error: ~A~%" mx err))) (num-test (* (/ 4 (sqrt 522)) (log (* (expt (/ (+ 5 (sqrt 29)) (sqrt 2)) 3) (+ (* 5 (sqrt 29)) (* 11 (sqrt 6))) (expt (+ (sqrt (/ (+ 9 (* 3 (sqrt 6))) 4)) (sqrt (/ (+ 5 (* 3 (sqrt 6))) 4))) 6)))) ;31 digits pi) (num-test (let* ((N 3502) (D (* 1/2 (+ 1071 (* 184 (sqrt 34))))) (E (* 1/2 (+ 1553 (* 266 (sqrt 34))))) (F (+ 429 (* 304 (sqrt 2)))) (G (* 1/2 (+ 627 (* 442 (sqrt 2))))) (d1 (+ D (sqrt (- (* D D) 1)))) (e1 (+ E (sqrt (- (* E E) 1)))) (f1 (+ F (sqrt (- (* F F) 1)))) (g1 (+ G (sqrt (- (* G G) 1)))) (defg (* 2 d1 e1 f1 g1))) (* (/ (sqrt N)) (- (log (expt defg -6))))) pi) (num-test (let* ((N 2737) (D (* 1/2 (+ 621 (* 49 (sqrt 161))))) (E (* 1/4 (+ 321 (* 25 (sqrt 161))))) (F (* 1/4 (+ 393 (* 31 (sqrt 161))))) (G (* 1/4 (+ 2529 (* 199 (sqrt 161))))) (d (+ D (sqrt (- (* D D) 1)))) (e (+ E (sqrt (- (* E E) 1)))) (f (+ F (sqrt (- (* F F) 1)))) (g (+ G (sqrt (- (* G G) 1)))) (defg (* 2 d e f g))) (* (/ (sqrt N)) (- (log (abs (* -1 (expt defg -6))))))) pi) ; Newman and Shanks "On a Sequence Arising in Series for pi" (num-test (let* ((an (sqrt 2)) ; Borwein and Borwein "AGM Mean and Fast Computation" (bn 0) (pn (+ 2 (sqrt 2)))) (do ((i 0 (+ i 1))) ((= i 4) pn) (let* ((sqa (sqrt an)) (an1 (* 1/2 (+ sqa (/ 1.0 sqa)))) (bn1 (* sqa (/ (+ bn 1) (+ bn an)))) (pn1 (* pn bn1 (/ (+ an1 1) (+ bn1 1))))) (set! pn pn1) (set! bn bn1) (set! an an1)))) pi) (when with-bignums (num-test (sqrt 340282366920938463463374607431768211456) 18446744073709551616) (num-test (sqrt 32317006071311007300714876688669951960444102669715484032130345427524655138867890893197201411522913463688717960921898019494119559150490921095088152386448283120630877367300996091750197750389652106796057638384067568276792218642619756161838094338476170470581645852036305042887575891541065808607552399123930385521914333389668342420684974786564569494856176035326322058077805659331026192708460314150258592864177116725943603718461857357598351152301645904403697613233287231227125684710820209725157101726931323469678542580656697935045997268352998638215525166389437335543602135433229604645318478604952148193555853611059596230656) 179769313486231590772930519078902473361797697894230657273430081157732675805500963132708477322407536021120113879871393357658789768814416622492847430639474124377767893424865485276302219601246094119453082952085005768838150682342462881473913110540827237163350510684586298239947245938479716304835356329624224137216) (num-test (sqrt 1208925819614629174706176/717897987691852588770249) 1099511627776/847288609443) (num-test (sqrt (/ (* 1.0 (expt 2 80)) (expt 3 50))) 1.297682531692252029863335918836296060669E0) (num-test (sqrt -340282366920938463463374607431768211456) 0.0+1.8446744073709551616E19i) (num-test (sqrt 0+340282366920938463463374607431768211456i) 1.304381782533278221234957180625250836888E19+1.304381782533278221234957180625250836888E19i)) (test (sqrt) 'error) (test (sqrt "hi") 'error) (test (sqrt 1.0+23.0i 1.0+23.0i) 'error) (for-each (lambda (arg) (test (sqrt arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (num-test (sqrt 1/1073741824) 1/32768) (num-test (sqrt 1/274877906944) 1/524288) (num-test (sqrt 9223372030926249001) 3037000499) (num-test (sqrt 1/1099511627776) 1/1048576) (num-test (sqrt 1/4398046511104) (sqrt (/ (expt 2 42)))) (num-test (sqrt 1/4611686018427387904) 1/2147483648) (num-test (sqrt 1/1152921504606846976) 1/1073741824) (num-test (sqrt 1/9223372030926249001) 1/3037000499) (num-test (sqrt 0+i) (/ 1+i (sqrt 2))) (num-test (+ 0-i(sqrt 00)) 0-i) (num-test (sqrt (* 1.2345e-127 1.2345e-127)) 1.2345e-127) (num-test (sqrt (* 1.2345e-27 1.2345e-27)) 1.2345e-27) (num-test (sqrt 13) (do ((i 1 (+ i 1)) (prod 1.0 (* prod (tan (/ (* i pi) 13))))) ((= i 7) prod))) (num-test (* 768 (sqrt (- 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 (sqrt (+ 2 1))))))))))))))))))) 3.1415904632368) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'sqrt num (sqrt num) val))) (vector (list 0 0) (list 1 1) (list 2 1.4142135623731) (list 3 1.7320508075689) (list -1 0+1i) (list -2 0+1.4142135623731i) (list -3 0+1.7320508075689i) (list 9223372036854775807 3037000499.976) (list -9223372036854775808 0+3037000499.976i) (list 1/2 0.70710678118655) (list 1/3 0.57735026918963) (list -1/2 0+0.70710678118655i) (list -1/3 0+0.57735026918963i) (list 1/9223372036854775807 3.2927225399136e-10) (list 0.0 0.0) (list 1.0 1.0) (list 2.0 1.4142135623731) (list -2.0 0+1.4142135623731i) (list 1.000000000000000000000000000000000000002E-309 3.162277660168379331998893544432718533725E-155) (list 1e+16 100000000.0) (list 0+1i 0.70710678118655+0.70710678118655i) (list 0+2i 1+1i) (list 0-1i 0.70710678118655-0.70710678118655i) (list 1+1i 1.0986841134678+0.45508986056223i) (list 1-1i 1.0986841134678-0.45508986056223i) (list -1+1i 0.45508986056223+1.0986841134678i) (list -1-1i 0.45508986056223-1.0986841134678i) (list 0.1+0.1i 0.34743442276012+0.14391204994251i) (list 1e+16+1e+16i 109868411.34678+45508986.056223i) (list 1e-16+1e-16i 1.0986841134678e-08+4.5508986056223e-09i) )) (let ((sqrts (list 1.00000000000000000000000000000000000000000000000000000000000000000000 1.41421356237309504880168872420969807856967187537694807317667973799073 1.73205080756887729352744634150587236694280525381038062805580697945193 2.00000000000000000000000000000000000000000000000000000000000000000000 2.23606797749978969640917366873127623544061835961152572427089724541052 2.44948974278317809819728407470589139196594748065667012843269256725096 2.64575131106459059050161575363926042571025918308245018036833445920106 2.82842712474619009760337744841939615713934375075389614635335947598146 3.00000000000000000000000000000000000000000000000000000000000000000000 3.16227766016837933199889354443271853371955513932521682685750485279259 3.31662479035539984911493273667068668392708854558935359705868214611648 3.46410161513775458705489268301174473388561050762076125611161395890386 3.60555127546398929311922126747049594625129657384524621271045305622716 3.74165738677394138558374873231654930175601980777872694630374546732003 3.87298334620741688517926539978239961083292170529159082658757376611348 4.00000000000000000000000000000000000000000000000000000000000000000000 4.12310562561766054982140985597407702514719922537362043439863357309495 4.24264068711928514640506617262909423570901562613084421953003921397219 4.35889894354067355223698198385961565913700392523244493689034413815955 4.47213595499957939281834733746255247088123671922305144854179449082104 4.58257569495584000658804719372800848898445657676797190260724212390686 4.69041575982342955456563011354446628058822835341173715360570189101702 4.79583152331271954159743806416269391999670704190412934648530911444825 4.89897948556635619639456814941178278393189496131334025686538513450192 5.00000000000000000000000000000000000000000000000000000000000000000000 5.09901951359278483002822410902278198956377094609959640758497080442593 5.19615242270663188058233902451761710082841576143114188416742093835579 5.29150262212918118100323150727852085142051836616490036073666891840213 5.38516480713450403125071049154032955629512016164478883768038867001664 5.47722557505166113456969782800802133952744694997983254226894449732493 5.56776436283002192211947129891854952047639337757041430396843258560358 5.65685424949238019520675489683879231427868750150779229270671895196292 5.74456264653802865985061146821892931822026445798279236769987747056590 5.83095189484530047087415287754558307652139833488597195445000674486781 5.91607978309961604256732829156161704841550123079434032287971966914282 6.00000000000000000000000000000000000000000000000000000000000000000000 6.08276253029821968899968424520206706208497009478641118641915304648633 6.16441400296897645025019238145424422523562402344457454487457207245839 6.24499799839839820584689312093979446107295997799165630845297193060961 6.32455532033675866399778708886543706743911027865043365371500970558518))) (let ((mxerr 0.0)) (do ((i 1 (+ i 1))) ((> i 40)) (let ((err (abs (- (sqrt i) (list-ref sqrts (- i 1)))))) (if (> err mxerr) (set! mxerr err)))) (if (> mxerr 1e-12) (format #t "sqrt err: ~A~%" mxerr)))) (when with-bignums (num-test (/ (sqrt (* 1.2345e-170 1.2345e-170))) 8.100445524503847216161209708816501953798E169) (num-test (sqrt (expt 2 32)) 65536) (num-test (sqrt -1.797693134862315699999999999999999999998E308) 0.0+1.34078079299425963249160560140156653105E154i) (num-test (exp (* pi (sqrt (bignum "163")))) 2.625374126407687439999999999992500725895E17) (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((sqrts (list ; table[Sqrt[k/10], {k, 0, 30}] 0.00000000000000000000000000000000000000000000000000000000000000000000e0 0.31622776601683793319988935444327185337195551393252168268575048527925 0.44721359549995793928183473374625524708812367192230514485417944908210 0.54772255750516611345696978280080213395274469499798325422689444973249 0.63245553203367586639977870888654370674391102786504336537150097055851 0.70710678118654752440084436210484903928483593768847403658833986899536 0.77459666924148337703585307995647992216658434105831816531751475322269 0.83666002653407554797817202578518748939281536929867219981119154308041 0.89442719099991587856366946749251049417624734384461028970835889816420 0.94868329805051379959966806332981556011586654179756504805725145583777 1.00000000000000000000000000000000000000000000000000000000000000000000 1.04880884817015154699145351367993759847527185768150398487575576358000 1.09544511501033222691393956560160426790548938999596650845378889946498 1.14017542509913797913604902556675447907600531091641037529746941724956 1.18321595661992320851346565831232340968310024615886806457594393382856 1.22474487139158904909864203735294569598297374032833506421634628362548 1.26491106406735173279955741777308741348782205573008673074300194111703 1.30384048104052974291659431148583688330561875578201309179007936989676 1.34164078649987381784550420123876574126437101576691543456253834724631 1.37840487520902217679559125529341754271981635583990014790642120179806 1.41421356237309504880168872420969807856967187537694807317667973799073 1.44913767461894385737186641571697717231401328747589730886959248071181 1.48323969741913258974227948816014261219598086381950031974652465286876 1.51657508881031011085136508725641431090992842790349245064524200355844 1.54919333848296675407170615991295984433316868211663633063502950644539 1.58113883008418966599944677221635926685977756966260841342875242639629 1.61245154965970993047332264606075422622687926112171467758731847785277 1.64316767251549834037090934840240640185823408499394976268068334919747 1.67332005306815109595634405157037497878563073859734439962238308616083 1.70293863659264011661333218238773227063897151909784216273026969624657 1.73205080756887729352744634150587236694280525381038062805580697945193))) (do ((i 0 (+ i 1))) ((= i 30)) (let ((val (sqrt (bignum (/ i 10))))) (if (> (magnitude (- val (list-ref sqrts i))) 1e-36) (format #t ";(sqrt ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref sqrts i) (magnitude (- val (list-ref sqrts i)))))))))) ;;; -------------------------------------------------------------------------------- ;;; exp ;;; -------------------------------------------------------------------------------- (num-test (exp 0) 1.0) (num-test (exp -1) 0.36787944117144) (num-test (exp 2) 7.38905609893065) (num-test (exp -2) 0.13533528323661) (num-test (exp 3) 20.08553692318767) (num-test (exp -3) 0.04978706836786) (num-test (exp 10) 22026.46579480671789) (num-test (exp -10) 0.00004539992976) (num-test (exp 0/1) 1.0) (num-test (exp 0/2) 1.0) (num-test (exp 0/3) 1.0) (num-test (exp 0/10) 1.0) (num-test (exp 0/1234) 1.0) (num-test (exp 0/500029) 1.0) (num-test (exp -1/1) 0.36787944117144) (num-test (exp 1/2) 1.64872127070013) (num-test (exp -1/2) 0.60653065971263) (num-test (exp 1/3) 1.39561242508609) (num-test (exp -1/3) 0.71653131057379) (num-test (exp 1/10) 1.10517091807565) (num-test (exp -1/10) 0.90483741803596) (num-test (exp 1/1234) 1.00081070121220) (num-test (exp -1/1234) 0.99918995549186) (num-test (exp 1/500029) 1.00000199988601) (num-test (exp -1/500029) 0.99999800011799) (num-test (exp 2/1) 7.38905609893065) (num-test (exp -2/1) 0.13533528323661) (num-test (exp -2/2) 0.36787944117144) (num-test (exp 2/3) 1.94773404105468) (num-test (exp -2/3) 0.51341711903259) (num-test (exp 2/10) 1.22140275816017) (num-test (exp -2/10) 0.81873075307798) (num-test (exp 2/1234) 1.00162205966086) (num-test (exp -2/1234) 0.99838056715583) (num-test (exp 2/500029) 1.00000399977601) (num-test (exp -2/500029) 0.99999600023999) (num-test (exp 3/1) 20.08553692318767) (num-test (exp -3/1) 0.04978706836786) (num-test (exp 3/2) 4.48168907033806) (num-test (exp -3/2) 0.22313016014843) (num-test (exp -3/3) 0.36787944117144) (num-test (exp 3/10) 1.34985880757600) (num-test (exp -3/10) 0.74081822068172) (num-test (exp 3/1234) 1.00243407587880) (num-test (exp -3/1234) 0.99757183446037) (num-test (exp 3/500029) 1.00000599967002) (num-test (exp -3/500029) 0.99999400036598) (num-test (exp 10/1) 22026.46579480671789) (num-test (exp -10/1) 0.00004539992976) (num-test (exp 10/2) 148.41315910257660) (num-test (exp -10/2) 0.00673794699909) (num-test (exp 10/3) 28.03162489452614) (num-test (exp -10/3) 0.03567399334725) (num-test (exp -10/10) 0.36787944117144) (num-test (exp 10/1234) 1.00813665179201) (num-test (exp -10/1234) 0.99192901897025) (num-test (exp 10/500029) 1.00001999904005) (num-test (exp -10/500029) 0.99998000135991) (num-test (exp 1234/500029) 1.00247090452960) (num-test (exp -1234/500029) 0.99753518579099) (num-test (exp -500029/500029) 0.36787944117144) (num-test (exp 0.0) 1.0) (num-test (exp 0.00000001) 1.00000001) (num-test (exp -0.00000001) 0.99999999000000) (num-test (exp -1.0) 0.36787944117144) (num-test (exp pi) 23.14069263277927) (num-test (exp -3.14159265358979) 0.04321391826377) (num-test (exp 2.71828182845905) 15.15426224147926) (num-test (exp -2.71828182845905) 0.06598803584531) (num-test (exp 0.0+0.0i) 1.0) (num-test (exp -0.0+0.0i) 1.0) (num-test (exp 0.0-0.0i) 1.0) (num-test (exp -0.0-0.0i) 1.0) (num-test (exp 0.0+0.00000001i) 1.0+0.00000001i) (num-test (exp -0.0+0.00000001i) 1.0+0.00000001i) (num-test (exp 0.0-0.00000001i) 1.0-0.00000001i) (num-test (exp -0.0-0.00000001i) 1.0-0.00000001i) (num-test (exp 0.0+1.0i) 0.54030230586814+0.84147098480790i) (num-test (exp -0.0+1.0i) 0.54030230586814+0.84147098480790i) (num-test (exp 0.0-1.0i) 0.54030230586814-0.84147098480790i) (num-test (exp -0.0-1.0i) 0.54030230586814-0.84147098480790i) (num-test (exp 0.0+3.14159265358979i) -1.0+0.0i) (num-test (exp -0.0+3.14159265358979i) -1.0+0.0i) (num-test (exp 0.0-3.14159265358979i) -1.0-0.0i) (num-test (exp -0.0-3.14159265358979i) -1.0-0.0i) (num-test (exp 0.0+2.71828182845905i) -0.91173391478697+0.41078129050291i) (num-test (exp -0.0+2.71828182845905i) -0.91173391478697+0.41078129050291i) (num-test (exp 0.0-2.71828182845905i) -0.91173391478697-0.41078129050291i) (num-test (exp -0.0-2.71828182845905i) -0.91173391478697-0.41078129050291i) (num-test (exp 0.00000001+0.0i) 1.00000001) (num-test (exp -0.00000001+0.0i) 0.99999999000000) (num-test (exp 0.00000001-0.0i) 1.00000001) (num-test (exp -0.00000001-0.0i) 0.99999999000000) (num-test (exp 0.00000001+0.00000001i) 1.00000001+0.00000001i) (num-test (exp -0.00000001+0.00000001i) 0.99999999000000+0.00000001i) (num-test (exp 0.00000001-0.00000001i) 1.00000001-0.00000001i) (num-test (exp -0.00000001-0.00000001i) 0.99999999000000-0.00000001i) (num-test (exp 0.00000001+1.0i) 0.54030231127116+0.84147099322261i) (num-test (exp -0.00000001+1.0i) 0.54030230046512+0.84147097639319i) (num-test (exp 0.00000001-1.0i) 0.54030231127116-0.84147099322261i) (num-test (exp -0.00000001-1.0i) 0.54030230046512-0.84147097639319i) (num-test (exp 0.00000001+3.14159265358979i) -1.00000001+0.0i) (num-test (exp -0.00000001+3.14159265358979i) -0.99999999000000+0.0i) (num-test (exp 0.00000001-3.14159265358979i) -1.00000001-0.0i) (num-test (exp -0.00000001-3.14159265358979i) -0.99999999000000-0.0i) (num-test (exp 0.00000001+2.71828182845905i) -0.91173392390430+0.41078129461072i) (num-test (exp -0.00000001+2.71828182845905i) -0.91173390566963+0.41078128639510i) (num-test (exp 0.00000001-2.71828182845905i) -0.91173392390430-0.41078129461072i) (num-test (exp -0.00000001-2.71828182845905i) -0.91173390566963-0.41078128639510i) (num-test (exp 1.0+0.0i) 2.71828182845905) (num-test (exp -1.0+0.0i) 0.36787944117144) (num-test (exp 1.0-0.0i) 2.71828182845905) (num-test (exp -1.0-0.0i) 0.36787944117144) (num-test (exp 1.0+0.00000001i) 2.71828182845905+0.00000002718282i) (num-test (exp -1.0+0.00000001i) 0.36787944117144+0.00000000367879i) (num-test (exp 1.0-0.00000001i) 2.71828182845905-0.00000002718282i) (num-test (exp -1.0-0.00000001i) 0.36787944117144-0.00000000367879i) (num-test (exp 1.0+1.0i) 1.46869393991589+2.28735528717884i) (num-test (exp -1.0+1.0i) 0.19876611034641+0.30955987565311i) (num-test (exp 1.0-1.0i) 1.46869393991589-2.28735528717884i) (num-test (exp -1.0-1.0i) 0.19876611034641-0.30955987565311i) (num-test (exp 1.0+3.14159265358979i) -2.71828182845905+0.0i) (num-test (exp -1.0+3.14159265358979i) -0.36787944117144+0.0i) (num-test (exp 1.0-3.14159265358979i) -2.71828182845905-0.0i) (num-test (exp -1.0-3.14159265358979i) -0.36787944117144-0.0i) (num-test (exp 1.0+2.71828182845905i) -2.47834973295523+1.11661931744501i) (num-test (exp -1.0+2.71828182845905i) -0.33540816306888+0.15111799159389i) (num-test (exp 1.0-2.71828182845905i) -2.47834973295523-1.11661931744501i) (num-test (exp -1.0-2.71828182845905i) -0.33540816306888-0.15111799159389i) (num-test (exp 3.14159265358979+0.0i) 23.14069263277927) (num-test (exp -3.14159265358979+0.0i) 0.04321391826377) (num-test (exp 3.14159265358979-0.0i) 23.14069263277927) (num-test (exp -3.14159265358979-0.0i) 0.04321391826377) (num-test (exp 3.14159265358979+0.00000001i) 23.14069263277926+0.00000023140693i) (num-test (exp -3.14159265358979+0.00000001i) 0.04321391826377+0.00000000043214i) (num-test (exp 3.14159265358979-0.00000001i) 23.14069263277926-0.00000023140693i) (num-test (exp -3.14159265358979-0.00000001i) 0.04321391826377-0.00000000043214i) (num-test (exp 3.14159265358979+1.0i) 12.50296958887651+19.47222141884161i) (num-test (exp -3.14159265358979+1.0i) 0.02334857968351+0.03636325835882i) (num-test (exp 3.14159265358979-1.0i) 12.50296958887651-19.47222141884161i) (num-test (exp -3.14159265358979-1.0i) 0.02334857968351-0.03636325835882i) (num-test (exp 3.14159265358979+3.14159265358979i) -23.14069263277927+0.0i) (num-test (exp -3.14159265358979+3.14159265358979i) -0.04321391826377+0.0i) (num-test (exp 3.14159265358979-3.14159265358979i) -23.14069263277927-0.0i) (num-test (exp -3.14159265358979-3.14159265358979i) -0.04321391826377-0.0i) (num-test (exp 3.14159265358979+2.71828182845905i) -21.09815428496572+9.50576358282422i) (num-test (exp -3.14159265358979+2.71828182845905i) -0.03939959487191+0.01775146911208i) (num-test (exp 3.14159265358979-2.71828182845905i) -21.09815428496572-9.50576358282422i) (num-test (exp -3.14159265358979-2.71828182845905i) -0.03939959487191-0.01775146911208i) (num-test (exp 2.71828182845905+0.0i) 15.15426224147926) (num-test (exp -2.71828182845905+0.0i) 0.06598803584531) (num-test (exp 2.71828182845905-0.0i) 15.15426224147926) (num-test (exp -2.71828182845905-0.0i) 0.06598803584531) (num-test (exp 2.71828182845905+0.00000001i) 15.15426224147926+0.00000015154262i) (num-test (exp 2.71828182845905-0.00000001i) 15.15426224147926-0.00000015154262i) (num-test (exp -2.71828182845905-0.00000001i) 0.06598803584531-0.00000000065988i) (num-test (exp 2.71828182845905+1.0i) 8.18788283280173+12.75187197237468i) (num-test (exp -2.71828182845905+1.0i) 0.03565348792693+0.05552701750829i) (num-test (exp 2.71828182845905-1.0i) 8.18788283280173-12.75187197237468i) (num-test (exp -2.71828182845905-1.0i) 0.03565348792693-0.05552701750829i) (num-test (exp 2.71828182845905+3.14159265358979i) -15.15426224147926+0.0i) (num-test (exp -2.71828182845905+3.14159265358979i) -0.06598803584531+0.0i) (num-test (exp 2.71828182845905-3.14159265358979i) -15.15426224147926-0.0i) (num-test (exp -2.71828182845905-3.14159265358979i) -0.06598803584531-0.0i) (num-test (exp 2.71828182845905+2.71828182845905i) -13.81665483913218+6.22508740017436i) (num-test (exp -2.71828182845905+2.71828182845905i) -0.06016353025035+0.02710665052229i) (num-test (exp 2.71828182845905-2.71828182845905i) -13.81665483913218-6.22508740017436i) (num-test (exp -2.71828182845905-2.71828182845905i) -0.06016353025035-0.02710665052229i) (num-test (exp -1234.0+0.0i) 0.0) (num-test (exp -1234.0-0.0i) 0.0) (num-test (exp -1234.0+0.00000001i) 0.0) (num-test (exp -1234.0-0.00000001i) 0.0) (num-test (exp -1234.0+3.14159265358979i) 0.0) (num-test (exp -1234.0-3.14159265358979i) 0.0) (num-test (exp 10.0) 22026.46579480672) (num-test (exp 100.0) 2.688117141816135E+43) (num-test (exp -10.0) 4.5399929762484853E-5) (num-test (exp -100.0) 3.720075976020836E-44) (num-test (exp -7.080000e+02) 3.307553e-308) (num-test (exp 7.090000e+02) 8.218407461554972189241372386597816393254E307) (num-test (exp 0.00000001+1234.0i) -0.7985506315730906+0.601927660781774i) (num-test (exp 3.14159265358979+1234.0i) -18.47901453215463+13.92902284602872i) (num-test (exp 0.0e+00-3.45266983001243932001e-04i) 9.9999994039535581673e-1-3.4526697614140534807e-4i) (num-test (exp 0.0e+00+3.45266983001243932001e-04i) 9.9999994039535581673e-1+3.4526697614140534807e-4i) (num-test (exp 0.0e+00+1.57045105981189525579e+00i) 3.4526697614152485627e-4+9.9999994039535581669e-1i) (num-test (exp 0.0e+00-1.57045105981189525579e+00i) 3.4526697614152485627e-4-9.9999994039535581669e-1i) (num-test (exp 0.0e+00+1.57114159377789786021e+00i) -3.4526697614140239160e-4+9.9999994039535581673e-1i) (num-test (exp 0.0e+00-1.57114159377789786021e+00i) -3.4526697614140239160e-4-9.9999994039535581673e-1i) (num-test (exp 0.0e+00+3.14124738660679181379e+00i) -9.9999994039535581667e-1+3.4526697614158608860e-4i) (num-test (exp 0.0e+00-3.14124738660679181379e+00i) -9.9999994039535581667e-1-3.4526697614158608860e-4i) (num-test (exp 0.0e+00+3.14193792057279441821e+00i) -9.9999994039535581675e-1-3.4526697614134115926e-4i) (num-test (exp 0.0e+00-3.14193792057279441821e+00i) -9.9999994039535581675e-1+3.4526697614134115926e-4i) (num-test (exp 0.0e+00+4.71204371340168837179e+00i) -3.4526697614164732094e-4-9.9999994039535581664e-1i) (num-test (exp 0.0e+00-4.71204371340168837179e+00i) -3.4526697614164732094e-4+9.9999994039535581664e-1i) (num-test (exp 0.0e+00+4.71273424736769097620e+00i) 3.4526697614127992692e-4-9.9999994039535581677e-1i) (num-test (exp 0.0e+00-4.71273424736769097620e+00i) 3.4526697614127992692e-4+9.9999994039535581677e-1i) (num-test (exp 0.0e+00+6.28284004019658492979e+00i) 9.9999994039535581662e-1-3.4526697614170855328e-4i) (num-test (exp 0.0e+00-6.28284004019658492979e+00i) 9.9999994039535581662e-1+3.4526697614170855328e-4i) (num-test (exp 0.0e+00+6.28353057416258753420e+00i) 9.9999994039535581679e-1+3.4526697614121869459e-4i) (num-test (exp 0.0e+00-6.28353057416258753420e+00i) 9.9999994039535581679e-1-3.4526697614121869459e-4i) (num-test (exp 0.0e+00+9.42443269378637893396e+00i) -9.9999994039535581689e-1+3.4526697614094283958e-4i) (num-test (exp 0.0e+00-9.42443269378637893396e+00i) -9.9999994039535581689e-1-3.4526697614094283958e-4i) (num-test (exp 0.0e+00+9.42512322775237976202e+00i) -9.9999994039535581714e-1-3.4526697614020805155e-4i) (num-test (exp 0.0e+00-9.42512322775237976202e+00i) -9.9999994039535581714e-1+3.4526697614020805155e-4i) (num-test (exp 1.19209289550781250e-07-3.45266983001243932001e-04i) 1.0000000596046453675e0-3.4526701730043873250e-4i) (num-test (exp 1.19209289550781250e-07+3.45266983001243932001e-04i) 1.0000000596046453675e0+3.4526701730043873250e-4i) (num-test (exp -1.19209289550781250e-07-3.45266983001243932001e-04i) 9.9999982118608047680e-1-3.4526693498237687017e-4i) (num-test (exp -1.19209289550781250e-07+3.45266983001243932001e-04i) 9.9999982118608047680e-1+3.4526693498237687017e-4i) (num-test (exp 1.19209289550781250e-07+1.57045105981189525579e+00i) 3.4526701730055824072e-4+1.0000000596046453675e0i) (num-test (exp 1.19209289550781250e-07-1.57045105981189525579e+00i) 3.4526701730055824072e-4-1.0000000596046453675e0i) (num-test (exp -1.19209289550781250e-07+1.57045105981189525579e+00i) 3.4526693498249637836e-4+9.9999982118608047676e-1i) (num-test (exp -1.19209289550781250e-07-1.57045105981189525579e+00i) 3.4526693498249637836e-4-9.9999982118608047676e-1i) (num-test (exp 1.19209289550781250e-07+1.57114159377789786021e+00i) -3.4526701730043577603e-4+1.0000000596046453675e0i) (num-test (exp 1.19209289550781250e-07-1.57114159377789786021e+00i) -3.4526701730043577603e-4-1.0000000596046453675e0i) (num-test (exp -1.19209289550781250e-07+1.57114159377789786021e+00i) -3.4526693498237391370e-4+9.9999982118608047680e-1i) (num-test (exp -1.19209289550781250e-07-1.57114159377789786021e+00i) -3.4526693498237391370e-4-9.9999982118608047680e-1i) (num-test (exp 1.19209289550781250e-07+3.14124738660679181379e+00i) -1.0000000596046453674e0+3.4526701730061947306e-4i) (num-test (exp 1.19209289550781250e-07-3.14124738660679181379e+00i) -1.0000000596046453674e0-3.4526701730061947306e-4i) (num-test (exp -1.19209289550781250e-07+3.14124738660679181379e+00i) -9.9999982118608047674e-1+3.4526693498255761069e-4i) (num-test (exp -1.19209289550781250e-07-3.14124738660679181379e+00i) -9.9999982118608047674e-1-3.4526693498255761069e-4i) (num-test (exp 1.19209289550781250e-07+3.14193792057279441821e+00i) -1.0000000596046453675e0-3.4526701730037454368e-4i) (num-test (exp 1.19209289550781250e-07-3.14193792057279441821e+00i) -1.0000000596046453675e0+3.4526701730037454368e-4i) (num-test (exp -1.19209289550781250e-07+3.14193792057279441821e+00i) -9.9999982118608047682e-1-3.4526693498231268137e-4i) (num-test (exp -1.19209289550781250e-07-3.14193792057279441821e+00i) -9.9999982118608047682e-1+3.4526693498231268137e-4i) (num-test (exp 1.19209289550781250e-07+4.71204371340168837179e+00i) -3.4526701730068070540e-4-1.0000000596046453674e0i) (num-test (exp 1.19209289550781250e-07-4.71204371340168837179e+00i) -3.4526701730068070540e-4+1.0000000596046453674e0i) (num-test (exp -1.19209289550781250e-07+4.71204371340168837179e+00i) -3.4526693498261884302e-4-9.9999982118608047672e-1i) (num-test (exp -1.19209289550781250e-07-4.71204371340168837179e+00i) -3.4526693498261884302e-4+9.9999982118608047672e-1i) (num-test (exp 1.19209289550781250e-07+4.71273424736769097620e+00i) 3.4526701730031331134e-4-1.0000000596046453676e0i) (num-test (exp 1.19209289550781250e-07-4.71273424736769097620e+00i) 3.4526701730031331134e-4+1.0000000596046453676e0i) (num-test (exp -1.19209289550781250e-07+4.71273424736769097620e+00i) 3.4526693498225144904e-4-9.9999982118608047684e-1i) (num-test (exp -1.19209289550781250e-07-4.71273424736769097620e+00i) 3.4526693498225144904e-4+9.9999982118608047684e-1i) (num-test (exp 1.19209289550781250e-07+6.28284004019658492979e+00i) 1.0000000596046453674e0-3.4526701730074193775e-4i) (num-test (exp 1.19209289550781250e-07-6.28284004019658492979e+00i) 1.0000000596046453674e0+3.4526701730074193775e-4i) (num-test (exp -1.19209289550781250e-07+6.28284004019658492979e+00i) 9.9999982118608047670e-1-3.4526693498268007535e-4i) (num-test (exp -1.19209289550781250e-07-6.28284004019658492979e+00i) 9.9999982118608047670e-1+3.4526693498268007535e-4i) (num-test (exp 1.19209289550781250e-07+6.28353057416258753420e+00i) 1.0000000596046453676e0+3.452670173002520790e-4i) (num-test (exp 1.19209289550781250e-07-6.28353057416258753420e+00i) 1.0000000596046453676e0-3.452670173002520790e-4i) (num-test (exp -1.19209289550781250e-07+6.28353057416258753420e+00i) 9.9999982118608047687e-1+3.4526693498219021671e-4i) (num-test (exp -1.19209289550781250e-07-6.28353057416258753420e+00i) 9.9999982118608047687e-1-3.4526693498219021671e-4i) (num-test (exp 1.19209289550781250e-07+9.42443269378637893396e+00i) -1.0000000596046453677e0+3.4526701729997622396e-4i) (num-test (exp 1.19209289550781250e-07-9.42443269378637893396e+00i) -1.0000000596046453677e0-3.4526701729997622396e-4i) (num-test (exp -1.19209289550781250e-07+9.42443269378637893396e+00i) -9.9999982118608047696e-1+3.4526693498191436174e-4i) (num-test (exp -1.19209289550781250e-07-9.42443269378637893396e+00i) -9.9999982118608047696e-1-3.4526693498191436174e-4i) (num-test (exp 1.19209289550781250e-07+9.42512322775237976202e+00i) -1.0000000596046453679e0-3.4526701729924143584e-4i) (num-test (exp 1.19209289550781250e-07-9.42512322775237976202e+00i) -1.0000000596046453679e0+3.4526701729924143584e-4i) (num-test (exp -1.19209289550781250e-07+9.42512322775237976202e+00i) -9.9999982118608047721e-1-3.4526693498117957380e-4i) (num-test (exp -1.19209289550781250e-07-9.42512322775237976202e+00i) -9.9999982118608047721e-1+3.4526693498117957380e-4i) (num-test (exp 5.0e-01-3.45266983001243932001e-04i) 1.6487211724286834494e0-5.6924900763464865323e-4i) (num-test (exp 5.0e-01+3.45266983001243932001e-04i) 1.6487211724286834494e0+5.6924900763464865323e-4i) (num-test (exp -5.0e-01-3.45266983001243932001e-04i) 6.0653062356058926519e-1-2.0941500681603265022e-4i) (num-test (exp -5.0e-01+3.45266983001243932001e-04i) 6.0653062356058926519e-1+2.0941500681603265022e-4i) (num-test (exp 5.0e-01+1.57045105981189525579e+00i) 5.6924900763484568894e-4+1.6487211724286834493e0i) (num-test (exp 5.0e-01-1.57045105981189525579e+00i) 5.6924900763484568894e-4-1.6487211724286834493e0i) (num-test (exp -5.0e-01+1.57045105981189525579e+00i) 2.0941500681610513560e-4+6.0653062356058926516e-1i) (num-test (exp -5.0e-01-1.57045105981189525579e+00i) 2.0941500681610513560e-4-6.0653062356058926516e-1i) (num-test (exp 5.0e-01+1.57114159377789786021e+00i) -5.6924900763464377883e-4+1.6487211724286834494e0i) (num-test (exp 5.0e-01-1.57114159377789786021e+00i) -5.6924900763464377883e-4-1.6487211724286834494e0i) (num-test (exp -5.0e-01+1.57114159377789786021e+00i) -2.0941500681603085702e-4+6.0653062356058926519e-1i) (num-test (exp -5.0e-01-1.57114159377789786021e+00i) -2.0941500681603085702e-4-6.0653062356058926519e-1i) (num-test (exp 5.0e-01+3.14124738660679181379e+00i) -1.6487211724286834493e0+5.6924900763494664399e-4i) (num-test (exp 5.0e-01-3.14124738660679181379e+00i) -1.6487211724286834493e0-5.6924900763494664399e-4i) (num-test (exp -5.0e-01+3.14124738660679181379e+00i) -6.0653062356058926515e-1+2.0941500681614227489e-4i) (num-test (exp -5.0e-01-3.14124738660679181379e+00i) -6.0653062356058926515e-1-2.0941500681614227489e-4i) (num-test (exp 5.0e-01+3.14193792057279441821e+00i) -1.6487211724286834494e0-5.6924900763454282377e-4i) (num-test (exp 5.0e-01-3.14193792057279441821e+00i) -1.6487211724286834494e0+5.6924900763454282377e-4i) (num-test (exp -5.0e-01+3.14193792057279441821e+00i) -6.0653062356058926520e-1-2.0941500681599371773e-4i) (num-test (exp -5.0e-01-3.14193792057279441821e+00i) -6.0653062356058926520e-1+2.0941500681599371773e-4i) (num-test (exp 5.0e-01+4.71204371340168837179e+00i) -5.6924900763504759905e-4-1.6487211724286834492e0i) (num-test (exp 5.0e-01-4.71204371340168837179e+00i) -5.6924900763504759905e-4+1.6487211724286834492e0i) (num-test (exp -5.0e-01+4.71204371340168837179e+00i) -2.0941500681617941418e-4-6.0653062356058926514e-1i) (num-test (exp -5.0e-01-4.71204371340168837179e+00i) -2.0941500681617941418e-4+6.0653062356058926514e-1i) (num-test (exp 5.0e-01+4.71273424736769097620e+00i) 5.6924900763444186872e-4-1.6487211724286834494e0i) (num-test (exp 5.0e-01-4.71273424736769097620e+00i) 5.6924900763444186872e-4+1.6487211724286834494e0i) (num-test (exp -5.0e-01+4.71273424736769097620e+00i) 2.0941500681595657844e-4-6.0653062356058926521e-1i) (num-test (exp -5.0e-01-4.71273424736769097620e+00i) 2.0941500681595657844e-4+6.0653062356058926521e-1i) (num-test (exp 5.0e-01+6.28284004019658492979e+00i) 1.6487211724286834492e0-5.6924900763514855410e-4i) (num-test (exp 5.0e-01-6.28284004019658492979e+00i) 1.6487211724286834492e0+5.6924900763514855410e-4i) (num-test (exp -5.0e-01+6.28284004019658492979e+00i) 6.0653062356058926512e-1-2.0941500681621655347e-4i) (num-test (exp -5.0e-01-6.28284004019658492979e+00i) 6.0653062356058926512e-1+2.0941500681621655347e-4i) (num-test (exp 5.0e-01+6.28353057416258753420e+00i) 1.6487211724286834495e0+5.6924900763434091366e-4i) (num-test (exp 5.0e-01-6.28353057416258753420e+00i) 1.6487211724286834495e0-5.6924900763434091366e-4i) (num-test (exp -5.0e-01+6.28353057416258753420e+00i) 6.0653062356058926523e-1+2.0941500681591943916e-4i) (num-test (exp -5.0e-01-6.28353057416258753420e+00i) 6.0653062356058926523e-1-2.0941500681591943916e-4i) (num-test (exp 5.0e-01+9.42443269378637893396e+00i) -1.6487211724286834496e0+5.6924900763388610565e-4i) (num-test (exp 5.0e-01-9.42443269378637893396e+00i) -1.6487211724286834496e0-5.6924900763388610565e-4i) (num-test (exp -5.0e-01+9.42443269378637893396e+00i) -6.0653062356058926528e-1+2.0941500681575212464e-4i) (num-test (exp -5.0e-01-9.42443269378637893396e+00i) -6.0653062356058926528e-1-2.0941500681575212464e-4i) (num-test (exp 5.0e-01+9.42512322775237976202e+00i) -1.6487211724286834501e0-5.6924900763267464498e-4i) (num-test (exp 5.0e-01-9.42512322775237976202e+00i) -1.6487211724286834501e0+5.6924900763267464498e-4i) (num-test (exp -5.0e-01+9.42512322775237976202e+00i) -6.0653062356058926544e-1-2.0941500681530645317e-4i) (num-test (exp -5.0e-01-9.42512322775237976202e+00i) -6.0653062356058926544e-1+2.0941500681530645317e-4i) (num-test (exp -1.0e+00-3.45266983001243932001e-04i) 3.6787941924411912823e-1-1.2701662223785390836e-4i) (num-test (exp -1.0e+00+3.45266983001243932001e-04i) 3.6787941924411912823e-1+1.2701662223785390836e-4i) (num-test (exp -1.0e+00+1.57045105981189525579e+00i) 1.2701662223789787297e-4+3.6787941924411912822e-1i) (num-test (exp -1.0e+00-1.57045105981189525579e+00i) 1.2701662223789787297e-4-3.6787941924411912822e-1i) (num-test (exp -1.0e+00+1.57114159377789786021e+00i) -1.2701662223785282074e-4+3.6787941924411912823e-1i) (num-test (exp -1.0e+00-1.57114159377789786021e+00i) -1.2701662223785282074e-4-3.6787941924411912823e-1i) (num-test (exp -1.0e+00+3.14124738660679181379e+00i) -3.6787941924411912821e-1+1.2701662223792039909e-4i) (num-test (exp -1.0e+00-3.14124738660679181379e+00i) -3.6787941924411912821e-1-1.2701662223792039909e-4i) (num-test (exp -1.0e+00+3.14193792057279441821e+00i) -3.6787941924411912824e-1-1.2701662223783029462e-4i) (num-test (exp -1.0e+00-3.14193792057279441821e+00i) -3.6787941924411912824e-1+1.2701662223783029462e-4i) (num-test (exp -1.0e+00+4.71204371340168837179e+00i) -1.2701662223794292521e-4-3.6787941924411912820e-1i) (num-test (exp -1.0e+00-4.71204371340168837179e+00i) -1.2701662223794292521e-4+3.6787941924411912820e-1i) (num-test (exp -1.0e+00+4.71273424736769097620e+00i) 1.2701662223780776850e-4-3.6787941924411912825e-1i) (num-test (exp -1.0e+00-4.71273424736769097620e+00i) 1.2701662223780776850e-4+3.6787941924411912825e-1i) (num-test (exp -1.0e+00+6.28284004019658492979e+00i) 3.6787941924411912819e-1-1.2701662223796545132e-4i) (num-test (exp -1.0e+00-6.28284004019658492979e+00i) 3.6787941924411912819e-1+1.2701662223796545132e-4i) (num-test (exp -1.0e+00+6.28353057416258753420e+00i) 3.6787941924411912825e-1+1.2701662223778524238e-4i) (num-test (exp -1.0e+00-6.28353057416258753420e+00i) 3.6787941924411912825e-1-1.2701662223778524238e-4i) (num-test (exp -1.0e+00+9.42443269378637893396e+00i) -3.6787941924411912829e-1+1.270166222376837610e-4i) (num-test (exp -1.0e+00-9.42443269378637893396e+00i) -3.6787941924411912829e-1-1.270166222376837610e-4i) (num-test (exp -1.0e+00+9.42512322775237976202e+00i) -3.6787941924411912838e-1-1.2701662223741344759e-4i) (num-test (exp -1.0e+00-9.42512322775237976202e+00i) -3.6787941924411912838e-1+1.2701662223741344759e-4i) (num-test (exp 2.0e+00-3.45266983001243932001e-04i) 7.3890556585085906002e0-2.5511970558169944872e-3i) (num-test (exp 2.0e+00+3.45266983001243932001e-04i) 7.3890556585085906002e0+2.5511970558169944872e-3i) (num-test (exp -2.0e+00-3.45266983001243932001e-04i) 1.3533527517000128913e-1-4.6726804008345889445e-5i) (num-test (exp -2.0e+00+3.45266983001243932001e-04i) 1.3533527517000128913e-1+4.6726804008345889445e-5i) (num-test (exp 2.0e+00+1.57045105981189525579e+00i) 2.551197055817877540e-3+7.3890556585085905999e0i) (num-test (exp 2.0e+00-1.57045105981189525579e+00i) 2.551197055817877540e-3-7.3890556585085905999e0i) (num-test (exp -2.0e+00+1.57045105981189525579e+00i) 4.6726804008362063122e-5+1.3533527517000128913e-1i) (num-test (exp -2.0e+00-1.57045105981189525579e+00i) 4.6726804008362063122e-5-1.3533527517000128913e-1i) (num-test (exp 2.0e+00+1.57114159377789786021e+00i) -2.5511970558169726417e-3+7.3890556585085906002e0i) (num-test (exp 2.0e+00-1.57114159377789786021e+00i) -2.5511970558169726417e-3-7.3890556585085906002e0i) (num-test (exp -2.0e+00+1.57114159377789786021e+00i) -4.6726804008345489330e-5+1.3533527517000128913e-1i) (num-test (exp -2.0e+00-1.57114159377789786021e+00i) -4.6726804008345489330e-5-1.3533527517000128913e-1i) (num-test (exp 2.0e+00+3.14124738660679181379e+00i) -7.3890556585085905998e0+2.5511970558183299892e-3i) (num-test (exp 2.0e+00-3.14124738660679181379e+00i) -7.3890556585085905998e0-2.5511970558183299892e-3i) (num-test (exp -2.0e+00+3.14124738660679181379e+00i) -1.3533527517000128912e-1+4.6726804008370350017e-5i) (num-test (exp -2.0e+00-3.14124738660679181379e+00i) -1.3533527517000128912e-1-4.6726804008370350017e-5i) (num-test (exp 2.0e+00+3.14193792057279441821e+00i) -7.3890556585085906004e0-2.5511970558165201925e-3i) (num-test (exp 2.0e+00-3.14193792057279441821e+00i) -7.3890556585085906004e0+2.5511970558165201925e-3i) (num-test (exp -2.0e+00+3.14193792057279441821e+00i) -1.3533527517000128914e-1-4.6726804008337202435e-5i) (num-test (exp -2.0e+00-3.14193792057279441821e+00i) -1.3533527517000128914e-1+4.6726804008337202435e-5i) (num-test (exp 2.0e+00+4.71204371340168837179e+00i) -2.5511970558187824384e-3-7.3890556585085905996e0i) (num-test (exp 2.0e+00-4.71204371340168837179e+00i) -2.5511970558187824384e-3+7.3890556585085905996e0i) (num-test (exp -2.0e+00+4.71204371340168837179e+00i) -4.6726804008378636913e-5-1.3533527517000128912e-1i) (num-test (exp -2.0e+00-4.71204371340168837179e+00i) -4.6726804008378636913e-5+1.3533527517000128912e-1i) (num-test (exp 2.0e+00+4.71273424736769097620e+00i) 2.5511970558160677434e-3-7.3890556585085906006e0i) (num-test (exp 2.0e+00-4.71273424736769097620e+00i) 2.5511970558160677434e-3+7.3890556585085906006e0i) (num-test (exp -2.0e+00+4.71273424736769097620e+00i) 4.6726804008328915539e-5-1.3533527517000128914e-1i) (num-test (exp -2.0e+00-4.71273424736769097620e+00i) 4.6726804008328915539e-5+1.3533527517000128914e-1i) (num-test (exp 2.0e+00+6.28284004019658492979e+00i) 7.3890556585085905995e0-2.5511970558192348875e-3i) (num-test (exp 2.0e+00-6.28284004019658492979e+00i) 7.3890556585085905995e0+2.5511970558192348875e-3i) (num-test (exp -2.0e+00+6.28284004019658492979e+00i) 1.3533527517000128912e-1-4.6726804008386923808e-5i) (num-test (exp -2.0e+00-6.28284004019658492979e+00i) 1.3533527517000128912e-1+4.6726804008386923808e-5i) (num-test (exp 2.0e+00+6.28353057416258753420e+00i) 7.3890556585085906007e0+2.5511970558156152942e-3i) (num-test (exp 2.0e+00-6.28353057416258753420e+00i) 7.3890556585085906007e0-2.5511970558156152942e-3i) (num-test (exp -2.0e+00+6.28353057416258753420e+00i) 1.3533527517000128914e-1+4.6726804008320628644e-5i) (num-test (exp -2.0e+00-6.28353057416258753420e+00i) 1.3533527517000128914e-1-4.6726804008320628644e-5i) (num-test (exp 2.0e+00+9.42443269378637893396e+00i) -7.3890556585085906014e0+2.5511970558135769861e-3i) (num-test (exp 2.0e+00-9.42443269378637893396e+00i) -7.3890556585085906014e0-2.5511970558135769861e-3i) (num-test (exp -2.0e+00+9.42443269378637893396e+00i) -1.3533527517000128916e-1+4.6726804008283295729e-5i) (num-test (exp -2.0e+00-9.42443269378637893396e+00i) -1.3533527517000128916e-1-4.6726804008283295729e-5i) (num-test (exp 2.0e+00+9.42512322775237976202e+00i) -7.3890556585085906033e0-2.5511970558081475961e-3i) (num-test (exp 2.0e+00-9.42512322775237976202e+00i) -7.3890556585085906033e0+2.5511970558081475961e-3i) (num-test (exp -2.0e+00+9.42512322775237976202e+00i) -1.3533527517000128919e-1-4.6726804008183852982e-5i) (num-test (exp -2.0e+00-9.42512322775237976202e+00i) -1.3533527517000128919e-1+4.6726804008183852982e-5i) (num-test (exp -1000) 0.0) (num-test (exp -1000000) 0.0) (num-test (exp (complex 0.0 (* 0.5 pi))) 0+i) (num-test (exp (complex 0.0 pi)) -1) (num-test (exp 100.0) 2.688117141816135e43) (num-test (exp 500.0) 1.40359221785284E+217) (num-test (exp -500.0) 7.12457640674129E-218) (num-test (exp 5e-10) 1.000000000500000000125000031161629077797E0) (num-test (- (expt (exp 5e-8) 2e7) (exp 1)) 0.0) (num-test (exp -2.225073858507201399999999999999999999996E-308) 1.000E0) (num-test (exp 1.110223024625156799999999999999999999997E-16) 1.000000000000000111022302462515686162976E0) (num-test (exp 1/9223372036854775807) 1.000000000000000000108420217248550443418E0) (num-test (exp -1/9223372036854775807) 9.999999999999999998915797827514495565934E-1) (num-test (exp (* pi (sqrt 163))) 262537412640768743.999999999999) (num-test (exp (* pi (sqrt 17))) 422150.99767568) (num-test (exp (* pi (sqrt 18))) 614551.992885619) (num-test (exp (* pi (sqrt 22))) 2508951.998257424) (num-test (exp (* pi (sqrt 6))) 2197.9908695437) (num-test (exp (* pi (sqrt 719))) 3.8426143735395488914902942778058291929999e+36) (num-test (exp (complex 0.0 pi)) -1.0) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'exp num (exp num) val))) (vector (list 0 1) (list 1 2.718281828459) (list 2 7.3890560989307) (list 3 20.085536923188) (list -1 0.36787944117144) (list -2 0.13533528323661) (list -3 0.049787068367864) (list -9223372036854775808 0.0) (list 1/2 1.6487212707001) (list 1/3 1.3956124250861) (list -1/2 0.60653065971263) (list -1/3 0.71653131057379) (list 1/9223372036854775807 1.0) (list 1.000000000000000000000000000000000000002E-309 1.000E0) (list -inf.0 0.0) (list 0+1i 0.54030230586814+0.8414709848079i) (list 0+2i -0.41614683654714+0.90929742682568i) (list 0-1i 0.54030230586814-0.8414709848079i) (list 1+1i 1.4686939399159+2.2873552871788i) (list 1-1i 1.4686939399159-2.2873552871788i) (list -1+1i 0.19876611034641+0.30955987565311i) (list -1-1i 0.19876611034641-0.30955987565311i) (list 0.1+0.1i 1.0996496668294+0.1103329887302i) (list 1e-16+1e-16i 1+1e-16i) )) (test (exp) 'error) (test (exp "hi") 'error) (test (exp 1.0+23.0i 1.0+23.0i) 'error) (for-each (lambda (arg) (test (exp arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (unless with-bignums (test (infinite? (exp (expt 2 16))) #t) (test (infinite? (exp (expt 2 54))) #t) (test (infinite? (exp (exp 1e3))) #t)) (when with-bignums (let ((val1 (* 1000 (- (exp 30) 10686474581524))) (val2 (* 1000 (- (exp (bignum "30")) 10686474581524)))) (if (> (abs (- val1 val2)) 1) (format #t "(exp 30): ~A ~A~%" val1 val2))) (num-test (exp (* 172.60813659204 (log 172.60813659204))) 1.364508485146898675293943657160611234948E386) ; not inf! (num-test (exp 800.0) 2.726374572112566567364779546367269757963E347) (num-test (exp -800.0) 3.667874584177687213455495654260798215465E-348) (num-test (exp 100) 2.688117141816135448412625551580013587359E43) (num-test (exp 50.0) 5.184705528587072464087453322933485384827E21) (num-test (tan (exp 123)) 1.07218279264703679896051391152400627987E0) (num-test (tan (exp (bignum 123))) 1.07218279264703679896051391152400627987E0) (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((exps (list ; table[Exp[k/10], {k, 0, 30}] 1.00000000000000000000000000000000000000000000000000000000000000000000 1.10517091807564762481170782649024666822454719473751871879286328944096 1.22140275816016983392107199463967417030758094152050364127342509859920 1.34985880757600310398374431332800733037829969735936580304991798993961 1.49182469764127031782485295283722228064328277393742528159563315007236 1.64872127070012814684865078781416357165377610071014801157507931164066 1.82211880039050897487536766816286451338223880854643538632054747658881 2.01375270747047652162454938858306527001754239414586731156898930087978 2.22554092849246760457953753139507675705363413504848459611858395555662 2.45960311115694966380012656360247069542177230644008302074854573665746 2.71828182845904523536028747135266249775724709369995957496696762772407 3.00416602394643311205840795358867239328268102601627276212975286052863 3.32011692273654748953076742960164432007363176479282675728202180154077 3.66929666761924422045748991601148625143151888455755146725622649459660 4.05519996684467458722410889522862025216756114168404107165223289450693 4.48168907033806482260205546011927581900574986836966705677265008278593 4.95303242439511480365428635642396425641303112355664964787158190112430 5.47394739172719976079086266300909670070076114490748605875498633804484 6.04964746441294608373102395302772533816116344511729126161486476549696 6.68589444227926941607253072769286145380311864710852264561241990317501 7.38905609893065022723042746057500781318031557055184732408712782252257 8.16616991256765007344972741047863128518315260430523695926385375737882 9.02501349943412092647177716688866402972021659669817926079803719255720 9.97418245481472073995761515690885800147870119368402956369142191697585 11.02317638064160165223793976966780200851716306933940388430829005877357 12.18249396070347343807017595116796618318276779006316131156039834183818 13.46373803500169039775082533258411724479408609657822907153993787261197 14.87973172487283411186899301946839578068879752075547683852481232002013 16.44464677109704987149801601092501556372435769719962288653996273295166 18.17414536944306094267625657412806698753309200930534632364757918918540 20.08553692318766774092852965458171789698790783855415014437893422969884))) (do ((i 0 (+ i 1))) ((= i 30)) (let ((val (exp (bignum (/ i 10))))) (if (> (magnitude (- val (list-ref exps i))) 1e-36) (format #t ";(exp ~A) -> ~A ~A~%[~A]~%" (/ i 10) val (list-ref exps i) (magnitude (- val (list-ref exps i)))))))))) ;;; -------------------------------------------------------------------------------- ;;; log ;;; -------------------------------------------------------------------------------- (num-test (* 0-2i (log 0+i)) pi) (num-test (* 2 0+i (log (/ 1-i 1+i))) pi) (num-test (+ 100 (expt 10.0 15) (- (expt 10.0 15))) 100.0) (num-test (/ (log -1) (sqrt -1)) pi) (num-test (/ (log -8) (log 2)) 3+4.5323601418272i) (num-test (/ 53453 (log 53453)) 4910.0000012208) (num-test (exp (log (expt 10.0 -16))) 1e-16) (num-test (exp (log (expt 10.0 -36))) 1e-36) (num-test (exp (log (expt 10.0 16))) 1e16) (num-test (exp (log (expt 10.0 36))) 1e36) (num-test (exp (log 1000)) 1000.0) (num-test (exp (log 1000000)) 1000000.0) (num-test (exp (log 1000000000)) 1000000000.0) (num-test (exp (log 8)) 8.0) (num-test (expt (+ 1 1e-10) (log 100.0 (+ 1 1e-10))) 100.0) (num-test (expt (+ 1 1e-15) (log 100.0 (+ 1 1e-15))) 100.0) ; 16 doesn't work if not gmp (num-test (expt -2.0 0.13926097063622-0.63118087262379i) 8.0) (num-test (expt -2.0 0.26160508088635-0.052598406051983i) 1.0+i) (num-test (expt 1.0+i 0.97790391649038-2.2161063668189i) 8.0) (num-test (log (/ (+ 1 (sqrt 5)) 2)) (acosh (/ (sqrt 5) 2))) (num-test (log (exp 0.0000001)) 0.0000001) (num-test (log (exp 0.0001)) 0.0001) (num-test (log (exp 0.1)) 0.1) (num-test (log (exp 8)) 8.0) (num-test (log (expt 2 1022)) 7.083964185322641062244112281302564525734E2) (num-test (log (expt 2 125)) 8.664339756999316367715401518227207100938E1) (num-test (log (expt 3/2 10) 3/2) 10.0) (num-test (log (log (log -1))) 0.66457192224882+0.9410294873126i) (num-test (log (sqrt (- (expt 10 17) 1))) 1.957197329044938830915292736481709573957E1) (num-test (log (sqrt (- (expt 10 20) 1))) 2.302585092994045684017491454684364207599E1) (num-test (log (sqrt (- (expt 10 9) 1))) 1.036163291797320557783096154591297226743E1) (num-test (log (sqrt -2) -2) 0.5) (num-test (log (sqrt 1+i) 1+i) 0.5) (num-test (log (sqrt 2) 2) 0.5) (num-test (log -0.0+0.00000001i) -18.42068074395237+1.57079632679490i) (num-test (log -0.0+1.0i) 0.0+1.57079632679490i) (num-test (log -0.0+1234.0i) 7.11801620446533+1.57079632679490i) (num-test (log -0.0+3.14159265358979i) 1.14472988584940+1.57079632679490i) (num-test (log -0.0-0.00000001i) -18.42068074395237-1.57079632679490i) (num-test (log -0.0-1.0i) 0.0-1.57079632679490i) (num-test (log -0.0-1234.0i) 7.11801620446533-1.57079632679490i) (num-test (log -0.0-3.14159265358979i) 1.14472988584940-1.57079632679490i) (num-test (log -0.00000001) -18.42068074395237+3.14159265358979i) (num-test (log -0.00000001+0.00000001i) -18.07410715367239+2.35619449019234i) (num-test (log -0.00000001+0.0i) -18.42068074395237+3.14159265358979i) (num-test (log -0.00000001+1.0i) 0.0+1.57079633679490i) (num-test (log -0.00000001+1234.0i) 7.11801620446533+1.57079632680300i) (num-test (log -0.00000001+3.14159265358979i) 1.14472988584940+1.57079632997800i) (num-test (log -0.00000001-0.00000001i) -18.07410715367239-2.35619449019234i) (num-test (log -0.00000001-0.0i) -18.42068074395237+3.14159265358979i) (num-test (log -0.00000001-1.0i) 0.0-1.57079633679490i) (num-test (log -0.00000001-1234.0i) 7.11801620446533-1.57079632680300i) (num-test (log -0.00000001-3.14159265358979i) 1.14472988584940-1.57079632997800i) (num-test (log -0.1e001) (complex 0.0 pi)) (num-test (log -1 -1) 1.0) (num-test (log -1) 0.0+3.141592653589793238462643383279502884197169399375105820974944592307816406286198E0i) (num-test (log -1) 0.0+3.14159265358979i) (num-test (log -1.0) 0.0+3.14159265358979i) (num-test (log -1.0+0.00000001i) 0.0+3.14159264358979i) (num-test (log -1.0+0.0i) 0.0+3.14159265358979i) (num-test (log -1.0+1.0i) 0.34657359027997+2.35619449019234i) (num-test (log -1.0+1234.0i) 7.11801653281724+1.57160669938898i) (num-test (log -1.0+3.14159265358979i) 1.19298515341341+1.87896539791088i) (num-test (log -1.0-0.00000001i) 0.0-3.14159264358979i) (num-test (log -1.0-0.0i) 0.0+3.14159265358979i) (num-test (log -1.0-1.0i) 0.34657359027997-2.35619449019234i) (num-test (log -1.0-1234.0i) 7.11801653281724-1.57160669938898i) (num-test (log -1.0-3.14159265358979i) 1.19298515341341-1.87896539791088i) (num-test (log -1.0e+00+0.0e+00i) 0+3.1415926535897932385e0i) (num-test (log -1.0e+00+1.0e+00i) 3.4657359027997265471e-1+2.3561944901923449288e0i) (num-test (log -1.0e+00+1.19209289550781250e-07i) 7.1054273576009513716e-15+3.1415925343805036877e0i) (num-test (log -1.0e+00+2.0e+00i) 8.0471895621705018730e-1+2.0344439357957027354e0i) (num-test (log -1.0e+00+5.0e-01i) 1.1157177565710487788e-1+2.6779450445889871222e0i) (num-test (log -1.0e+00+8.3886080e+06i) 1.5942385152878749222e1+1.570796446004186170e0i) (num-test (log -1.0e+00-1.0e+00i) 3.4657359027997265471e-1-2.3561944901923449288e0i) (num-test (log -1.0e+00-1.19209289550781250e-07i) 7.1054273576009513716e-15-3.1415925343805036877e0i) (num-test (log -1.0e+00-2.0e+00i) 8.0471895621705018730e-1-2.0344439357957027354e0i) (num-test (log -1.0e+00-5.0e-01i) 1.1157177565710487788e-1-2.6779450445889871222e0i) (num-test (log -1.0e+00-8.3886080e+06i) 1.5942385152878749222e1-1.570796446004186170e0i) (num-test (log -1.19209289550781250e-07+1.0e+00i) 7.1054273576009513716e-15+1.570796446004186170e0i) (num-test (log -1.19209289550781250e-07+1.19209289550781250e-07i) -1.5595811562598769462e1+2.3561944901923449288e0i) (num-test (log -1.19209289550781250e-07+2.0e+00i) 6.9314718055994708577e-1+1.5707963863995413946e0i) (num-test (log -1.19209289550781250e-07+5.0e-01i) -6.9314718055991688771e-1+1.5707965652134757208e0i) (num-test (log -1.19209289550781250e-07+8.3886080e+06i) 1.5942385152878742117e1+1.5707963267949108301e0i) (num-test (log -1.19209289550781250e-07-1.0e+00i) 7.1054273576009513716e-15-1.570796446004186170e0i) (num-test (log -1.19209289550781250e-07-1.19209289550781250e-07i) -1.5595811562598769462e1-2.3561944901923449288e0i) (num-test (log -1.19209289550781250e-07-2.0e+00i) 6.9314718055994708577e-1-1.5707963863995413946e0i) (num-test (log -1.19209289550781250e-07-5.0e-01i) -6.9314718055991688771e-1-1.5707965652134757208e0i) (num-test (log -1.19209289550781250e-07-8.3886080e+06i) 1.5942385152878742117e1-1.5707963267949108301e0i) (num-test (log -1/1) 0.0+3.14159265358979i) (num-test (log -1/10) -2.30258509299405+3.14159265358979i) (num-test (log -1/1234) -7.11801620446533+3.14159265358979i) (num-test (log -1/2) -0.69314718055995+3.14159265358979i) (num-test (log -1/3) -1.09861228866811+3.14159265358979i) (num-test (log -1/500029) -13.12242137572239+3.14159265358979i) (num-test (log -10) 2.30258509299405+3.14159265358979i) (num-test (log -10/1) 2.30258509299405+3.14159265358979i) (num-test (log -10/10) 0.0+3.14159265358979i) (num-test (log -10/1234) -4.81543111147129+3.14159265358979i) (num-test (log -10/2) 1.60943791243410+3.14159265358979i) (num-test (log -10/3) 1.20397280432594+3.14159265358979i) (num-test (log -10/500029) -10.81983628272835+3.14159265358979i) (num-test (log -1234) 7.11801620446533+3.14159265358979i) (num-test (log -1234.0) 7.11801620446533+3.14159265358979i) (num-test (log -1234.0+0.00000001i) 7.11801620446533+3.14159265358169i) (num-test (log -1234.0+0.0i) 7.11801620446533+3.14159265358979i) (num-test (log -1234.0+1.0i) 7.11801653281724+3.14078228099571i) (num-test (log -1234.0+1234.0i) 7.46458979474531+2.35619449019234i) (num-test (log -1234.0+3.14159265358979i) 7.11801944515932+3.13904679794449i) (num-test (log -1234.0-0.00000001i) 7.11801620446533-3.14159265358169i) (num-test (log -1234.0-0.0i) 7.11801620446533+3.14159265358979i) (num-test (log -1234.0-1.0i) 7.11801653281724-3.14078228099571i) (num-test (log -1234.0-1234.0i) 7.46458979474531-2.35619449019234i) (num-test (log -1234.0-3.14159265358979i) 7.11801944515932-3.13904679794449i) (num-test (log -1234/1) 7.11801620446533+3.14159265358979i) (num-test (log -1234/10) 4.81543111147129+3.14159265358979i) (num-test (log -1234/2) 6.42486902390539+3.14159265358979i) (num-test (log -1234/3) 6.01940391579722+3.14159265358979i) (num-test (log -1234/500029) -6.00440517125706+3.14159265358979i) (num-test (log -2 -2) 1) (num-test (log -2) 0.69314718055995+3.14159265358979i) (num-test (log -2.0e+00+0.0e+00i) 6.9314718055994530942e-1+3.1415926535897932385e0i) (num-test (log -2.0e+00+1.0e+00i) 8.0471895621705018730e-1+2.6779450445889871222e0i) (num-test (log -2.0e+00+1.19209289550781250e-07i) 6.9314718055994708577e-1+3.1415925939851484631e0i) (num-test (log -2.0e+00+2.0e+00i) 1.0397207708399179641e0+2.3561944901923449288e0i) (num-test (log -2.0e+00+5.0e-01i) 7.2345949146816273071e-1+2.8966139904629290843e0i) (num-test (log -2.0e+00+8.3886080e+06i) 1.5942385152878770538e1+1.5707965652134757208e0i) (num-test (log -2.0e+00-1.0e+00i) 8.0471895621705018730e-1-2.6779450445889871222e0i) (num-test (log -2.0e+00-1.19209289550781250e-07i) 6.9314718055994708577e-1-3.1415925939851484631e0i) (num-test (log -2.0e+00-2.0e+00i) 1.0397207708399179641e0-2.3561944901923449288e0i) (num-test (log -2.0e+00-5.0e-01i) 7.2345949146816273071e-1-2.8966139904629290843e0i) (num-test (log -2.0e+00-8.3886080e+06i) 1.5942385152878770538e1-1.5707965652134757208e0i) (num-test (log -2/1) 0.69314718055995+3.14159265358979i) (num-test (log -2/10) -1.60943791243410+3.14159265358979i) (num-test (log -2/1234) -6.42486902390539+3.14159265358979i) (num-test (log -2/2) 0.0+3.14159265358979i) (num-test (log -2/3) -0.40546510810816+3.14159265358979i) (num-test (log -2/500029) -12.42927419516245+3.14159265358979i) (num-test (log -3) 1.09861228866811+3.14159265358979i) (num-test (log -3.14159265358979) 1.14472988584940+3.14159265358979i) (num-test (log -3.14159265358979+0.00000001i) 1.14472988584940+3.14159265040669i) (num-test (log -3.14159265358979+0.0i) 1.14472988584940+3.14159265358979i) (num-test (log -3.14159265358979+1.0i) 1.19298515341341+2.83342358247381i) (num-test (log -3.14159265358979+1234.0i) 7.11801944515932+1.57334218244020i) (num-test (log -3.14159265358979+3.14159265358979i) 1.49130347612937+2.35619449019234i) (num-test (log -3.14159265358979-0.00000001i) 1.14472988584940-3.14159265040669i) (num-test (log -3.14159265358979-0.0i) 1.14472988584940+3.14159265358979i) (num-test (log -3.14159265358979-1.0i) 1.19298515341341-2.83342358247381i) (num-test (log -3.14159265358979-1234.0i) 7.11801944515932-1.57334218244020i) (num-test (log -3.14159265358979-3.14159265358979i) 1.49130347612937-2.35619449019234i) (num-test (log -3/1) 1.09861228866811+3.14159265358979i) (num-test (log -3/10) -1.20397280432594+3.14159265358979i) (num-test (log -3/1234) -6.01940391579722+3.14159265358979i) (num-test (log -3/2) 0.40546510810816+3.14159265358979i) (num-test (log -3/3) 0.0+3.14159265358979i) (num-test (log -3/500029) -12.02380908705428+3.14159265358979i) (num-test (log -5.0e-01+0.0e+00i) -6.9314718055994530942e-1+3.1415926535897932385e0i) (num-test (log -5.0e-01+1.0e+00i) 1.1157177565710487788e-1+2.0344439357957027354e0i) (num-test (log -5.0e-01+1.19209289550781250e-07i) -6.9314718055991688771e-1+3.1415924151712141369e0i) (num-test (log -5.0e-01+2.0e+00i) 7.2345949146816273071e-1+1.8157749899217607734e0i) (num-test (log -5.0e-01+5.0e-01i) -3.4657359027997265471e-1+2.3561944901923449288e0i) (num-test (log -5.0e-01+8.3886080e+06i) 1.5942385152878743893e1+1.5707963863995413946e0i) (num-test (log -5.0e-01-1.0e+00i) 1.1157177565710487788e-1-2.0344439357957027354e0i) (num-test (log -5.0e-01-1.19209289550781250e-07i) -6.9314718055991688771e-1-3.1415924151712141369e0i) (num-test (log -5.0e-01-2.0e+00i) 7.2345949146816273071e-1-1.8157749899217607734e0i) (num-test (log -5.0e-01-5.0e-01i) -3.4657359027997265471e-1-2.3561944901923449288e0i) (num-test (log -5.0e-01-8.3886080e+06i) 1.5942385152878743893e1-1.5707963863995413946e0i) (num-test (log -500029) 13.12242137572239+3.14159265358979i) (num-test (log -500029/1) 13.12242137572239+3.14159265358979i) (num-test (log -500029/10) 10.81983628272835+3.14159265358979i) (num-test (log -500029/1234) 6.00440517125706+3.14159265358979i) (num-test (log -500029/2) 12.42927419516245+3.14159265358979i) (num-test (log -500029/3) 12.02380908705428+3.14159265358979i) (num-test (log -500029/500029) 0.0+3.14159265358979i) (num-test (log -8.3886080e+06+1.0e+00i) 1.5942385152878749222e1+3.1415925343805036877e0i) (num-test (log -8.3886080e+06+1.19209289550781250e-07i) 1.5942385152878742117e1+3.1415926535897790276e0i) (num-test (log -8.3886080e+06+2.0e+00i) 1.5942385152878770538e1+3.1415924151712141369e0i) (num-test (log -8.3886080e+06+5.0e-01i) 1.5942385152878743893e1+3.1415925939851484631e0i) (num-test (log -8.3886080e+06+8.3886080e+06i) 1.6288958743158714771e1+2.3561944901923449288e0i) (num-test (log -8.3886080e+06-1.0e+00i) 1.5942385152878749222e1-3.1415925343805036877e0i) (num-test (log -8.3886080e+06-1.19209289550781250e-07i) 1.5942385152878742117e1-3.1415926535897790276e0i) (num-test (log -8.3886080e+06-2.0e+00i) 1.5942385152878770538e1-3.1415924151712141369e0i) (num-test (log -8.3886080e+06-5.0e-01i) 1.5942385152878743893e1-3.1415925939851484631e0i) (num-test (log -8.3886080e+06-8.3886080e+06i) 1.6288958743158714771e1-2.3561944901923449288e0i) (num-test (log -9223372036854775808) 4.366827237527655449328562365186512378885E1+3.141592653589793238462643383279502884195E0i) (num-test (log .3678794411714423) -1.0) (num-test (log 0+i) (complex 0.0 (* 0.5 pi))) (num-test (log 0-i) (complex 0.0 (* -0.5 pi))) (num-test (log 0.0+0.00000001i) -18.42068074395237+1.57079632679490i) (num-test (log 0.0+1.0i) 0.0+1.57079632679490i) (num-test (log 0.0+1234.0i) 7.11801620446533+1.57079632679490i) (num-test (log 0.0+3.14159265358979i) 1.14472988584940+1.57079632679490i) (num-test (log 0.0-0.00000001i) -18.42068074395237-1.57079632679490i) (num-test (log 0.0-1.0i) 0.0-1.57079632679490i) (num-test (log 0.0-1234.0i) 7.11801620446533-1.57079632679490i) (num-test (log 0.0-3.14159265358979i) 1.14472988584940-1.57079632679490i) (num-test (log 0.00000001) -18.42068074395237) (num-test (log 0.00000001+0.00000001i) -18.07410715367239+0.78539816339745i) (num-test (log 0.00000001+0.0i) -18.42068074395237) (num-test (log 0.00000001+1.0i) 0.0+1.57079631679490i) (num-test (log 0.00000001+1234.0i) 7.11801620446533+1.57079632678679i) (num-test (log 0.00000001+3.14159265358979i) 1.14472988584940+1.57079632361180i) (num-test (log 0.00000001-0.00000001i) -18.07410715367239-0.78539816339745i) (num-test (log 0.00000001-0.0i) -18.42068074395237) (num-test (log 0.00000001-1.0i) 0.0-1.57079631679490i) (num-test (log 0.00000001-1234.0i) 7.11801620446533-1.57079632678679i) (num-test (log 0.00000001-3.14159265358979i) 1.14472988584940-1.57079632361180i) (num-test (log 0.0e+00+1.0e+00i) 0+1.5707963267948966192e0i) (num-test (log 0.0e+00+1.19209289550781250e-07i) -1.5942385152878742117e1+1.5707963267948966192e0i) (num-test (log 0.0e+00+2.0e+00i) 6.9314718055994530942e-1+1.5707963267948966192e0i) (num-test (log 0.0e+00+5.0e-01i) -6.9314718055994530942e-1+1.5707963267948966192e0i) (num-test (log 0.0e+00+8.3886080e+06i) 1.5942385152878742117e1+1.5707963267948966192e0i) (num-test (log 0.0e+00-1.0e+00i) 0-1.5707963267948966192e0i) (num-test (log 0.0e+00-1.19209289550781250e-07i) -1.5942385152878742117e1-1.5707963267948966192e0i) (num-test (log 0.0e+00-2.0e+00i) 6.9314718055994530942e-1-1.5707963267948966192e0i) (num-test (log 0.0e+00-5.0e-01i) -6.9314718055994530942e-1-1.5707963267948966192e0i) (num-test (log 0.0e+00-8.3886080e+06i) 1.5942385152878742117e1-1.5707963267948966192e0i) (num-test (log 1 -1) 0.0) (num-test (log 1) 0.0) (num-test (log 1.0) 0.0) (num-test (log 1.0+0.00000001i) 0.0+0.00000001i) (num-test (log 1.0+0.0i) 0.0) (num-test (log 1.0+1.0i) 0.34657359027997+0.78539816339745i) (num-test (log 1.0+1234.0i) 7.11801653281724+1.56998595420081i) (num-test (log 1.0+3.14159265358979i) 1.19298515341341+1.26262725567891i) (num-test (log 1.0+i -2.0) 0.26160508088635-0.052598406051983i) (num-test (log 1.0-0.00000001i) 0.0-0.00000001i) (num-test (log 1.0-0.0i) 0.0) (num-test (log 1.0-1.0i) 0.34657359027997-0.78539816339745i) (num-test (log 1.0-1234.0i) 7.11801653281724-1.56998595420081i) (num-test (log 1.0-3.14159265358979i) 1.19298515341341-1.26262725567891i) (num-test (log 1.0e+00+0.0e+00i) 0e0+0.0i) (num-test (log 1.0e+00+1.0e+00i) 3.4657359027997265471e-1+7.8539816339744830962e-1i) (num-test (log 1.0e+00+1.19209289550781250e-07i) 7.1054273576009513716e-15+1.1920928955078068531e-7i) (num-test (log 1.0e+00+2.0e+00i) 8.0471895621705018730e-1+1.1071487177940905030e0i) (num-test (log 1.0e+00+5.0e-01i) 1.1157177565710487788e-1+4.6364760900080611621e-1i) (num-test (log 1.0e+00+8.3886080e+06i) 1.5942385152878749222e1+1.5707962075856070685e0i) (num-test (log 1.0e+00-1.0e+00i) 3.4657359027997265471e-1-7.8539816339744830962e-1i) (num-test (log 1.0e+00-1.19209289550781250e-07i) 7.1054273576009513716e-15-1.1920928955078068531e-7i) (num-test (log 1.0e+00-2.0e+00i) 8.0471895621705018730e-1-1.1071487177940905030e0i) (num-test (log 1.0e+00-5.0e-01i) 1.1157177565710487788e-1-4.6364760900080611621e-1i) (num-test (log 1.0e+00-8.3886080e+06i) 1.5942385152878749222e1-1.5707962075856070685e0i) (num-test (log 1.0e-12) -27.63102111592855) (num-test (log 1.0e-8) -18.42068074395237) (num-test (log 1.110223024625156799999999999999999999997E-16) -3.673680056967710116530769529852882544059E1) (num-test (log 1.19209289550781250e-07+0.0e+00i) -1.5942385152878742117e1+0.0i) (num-test (log 1.19209289550781250e-07+1.0e+00i) 7.1054273576009513716e-15+1.5707962075856070685e0i) (num-test (log 1.19209289550781250e-07+1.19209289550781250e-07i) -1.5595811562598769462e1+7.8539816339744830962e-1i) (num-test (log 1.19209289550781250e-07+2.0e+00i) 6.9314718055994708577e-1+1.5707962671902518438e0i) (num-test (log 1.19209289550781250e-07+5.0e-01i) -6.9314718055991688771e-1+1.5707960883763175177e0i) (num-test (log 1.19209289550781250e-07+8.3886080e+06i) 1.5942385152878742117e1+1.5707963267948824084e0i) (num-test (log 1.19209289550781250e-07-1.0e+00i) 7.1054273576009513716e-15-1.5707962075856070685e0i) (num-test (log 1.19209289550781250e-07-1.19209289550781250e-07i) -1.5595811562598769462e1-7.8539816339744830962e-1i) (num-test (log 1.19209289550781250e-07-2.0e+00i) 6.9314718055994708577e-1-1.5707962671902518438e0i) (num-test (log 1.19209289550781250e-07-5.0e-01i) -6.9314718055991688771e-1-1.5707960883763175177e0i) (num-test (log 1.19209289550781250e-07-8.3886080e+06i) 1.5942385152878742117e1-1.5707963267948824084e0i) (num-test (log 1.5 -1) 0-0.12906355241341i) (num-test (log 1.7976931e+308) 709.78271287399) (num-test (log 1/1) 0.0) (num-test (log 1/10) -2.30258509299405) (num-test (log 1/1073741824 2) -30) (num-test (log 1/1152921504606846976 8) -20) (num-test (log 1/1234) -7.11801620446533) (num-test (log 1/16777216 2) -24) (num-test (log 1/18014398509481984 512) -6) (num-test (log 1/2 1/4) 1/2) (num-test (log 1/2 1/8) 1/3) (num-test (log 1/2 8) -1/3) (num-test (log 1/2) -0.69314718055995) (num-test (log 1/2147483648 2) -31) (num-test (log 1/256 2) -8) (num-test (log 1/3) -1.09861228866811) (num-test (log 1/4 1/2) 2) (num-test (log 1/500029) -13.12242137572239) (num-test (log 1/65536 2) -16) (num-test (log 1/8192 2) -13) ;(num-test (log 10 (real-part (log 0))) 0.0) ; ??? -- this returns -nan-nani in clang, 0.0 in gcc (num-test (log 10) 2.30258509299405) (num-test (log 10.0 (exp -1)) (- (log 10.0))) (num-test (log 10.0 (exp 1)) (log 10.0)) (num-test (log 10.0 -0.001) -0.27620436338394-0.12561556740966i) (num-test (log 10.0 0.001) -0.33333333333333) (num-test (log 10.0 100.0) 0.5) (num-test (log 10.0 1e-20) -0.05) (num-test (log 10.0 1e20) 0.05) (num-test (log 10.0 2124008553358849/781379079653017) 2.302585092994045684017991454684419658469E0) (num-test (log 10/1) 2.30258509299405) (num-test (log 10/10) 0.0) (num-test (log 10/1234) -4.81543111147129) (num-test (log 10/2) 1.60943791243410) (num-test (log 10/3) 1.20397280432594) (num-test (log 10/500029) -10.81983628272835) (num-test (log 12/8 3/2) 1.0) (num-test (log 1234) 7.11801620446533) (num-test (log 1234.0) 7.11801620446533) (num-test (log 1234.0+0.00000001i) 7.11801620446533+0.00000000000810i) (num-test (log 1234.0+0.0i) 7.11801620446533) (num-test (log 1234.0+1.0i) 7.11801653281724+0.00081037259408i) (num-test (log 1234.0+1234.0i) 7.46458979474531+0.78539816339745i) (num-test (log 1234.0+3.14159265358979i) 7.11801944515932+0.00254585564530i) (num-test (log 1234.0-0.00000001i) 7.11801620446533-0.00000000000810i) (num-test (log 1234.0-0.0i) 7.11801620446533) (num-test (log 1234.0-1.0i) 7.11801653281724-0.00081037259408i) (num-test (log 1234.0-1234.0i) 7.46458979474531-0.78539816339745i) (num-test (log 1234.0-3.14159265358979i) 7.11801944515932-0.00254585564530i) (num-test (log 1234/1) 7.11801620446533) (num-test (log 1234/10) 4.81543111147129) (num-test (log 1234/2) 6.42486902390539) (num-test (log 1234/3) 6.01940391579722) (num-test (log 1234/500029) -6.00440517125706) (num-test (log 15693/12583 24271/35566) -5.78025354982372501902371206100042173188E-1) (num-test (log 1e-100) -2.302585092994045684017991454684364207602E2) (num-test (log 1e-18) -4.144653167389282231232384618431855573682E1) (num-test (log 1e-300) -6.907755278982137052053974364053092622806E2) (num-test (log 1e-50 10) -50.0) (num-test (log 1e100) 2.302585092994045684017991454684364207602E2) (num-test (log 1e18) 4.144653167389282231232384618431855573682E1) (num-test (log 1e300) 6.907755278982137052053974364053092622806E2) (num-test (log 1e50 10) 50.0) (num-test (log 2 1/8) -1/3) (num-test (log 2 2) 1) (num-test (log 2 8) 1/3) (num-test (log 2) 0.69314718055995) (num-test (log 2.0e+00+0.0e+00i) 6.9314718055994530942e-1+0.0i) (num-test (log 2.0e+00+1.0e+00i) 8.0471895621705018730e-1+4.6364760900080611621e-1i) (num-test (log 2.0e+00+1.19209289550781250e-07i) 6.9314718055994708577e-1+5.9604644775390554414e-8i) (num-test (log 2.0e+00+2.0e+00i) 1.0397207708399179641e0+7.8539816339744830962e-1i) (num-test (log 2.0e+00+5.0e-01i) 7.2345949146816273071e-1+2.4497866312686415417e-1i) (num-test (log 2.0e+00+8.3886080e+06i) 1.5942385152878770538e1+1.5707960883763175177e0i) (num-test (log 2.0e+00-1.0e+00i) 8.0471895621705018730e-1-4.6364760900080611621e-1i) (num-test (log 2.0e+00-1.19209289550781250e-07i) 6.9314718055994708577e-1-5.9604644775390554414e-8i) (num-test (log 2.0e+00-2.0e+00i) 1.0397207708399179641e0-7.8539816339744830962e-1i) (num-test (log 2.0e+00-5.0e-01i) 7.2345949146816273071e-1-2.4497866312686415417e-1i) (num-test (log 2.0e+00-8.3886080e+06i) 1.5942385152878770538e1-1.5707960883763175177e0i) (num-test (log 2.2250739e-308) -708.39641851362) (num-test (log 2.688117141816135E+43) 100.0) (num-test (log 2/1) 0.69314718055995) (num-test (log 2/10) -1.60943791243410) (num-test (log 2/1234) -6.42486902390539) (num-test (log 2/2) 0.0) (num-test (log 2/3) -0.40546510810816) (num-test (log 2/500029) -12.42927419516245) (num-test (log 22026.46579480672) 10.0) (num-test (log 24998/50401 24728/63453) 7.441028498776462417495086765025452881649E-1) (num-test (log 25438/28960 36472/54817) 3.182468797561633550530828023298618520944E-1) (num-test (log 2921/7914 2921/7914) 1) (num-test (log 3) 1.09861228866811) (num-test (log 3.14159265358979+0.00000001i) 1.14472988584940+0.00000000318310i) (num-test (log 3.14159265358979+0.0i) 1.14472988584940) (num-test (log 3.14159265358979+1.0i) 1.19298515341341+0.30816907111598i) (num-test (log 3.14159265358979+1234.0i) 7.11801944515932+1.56825047114960i) (num-test (log 3.14159265358979+3.14159265358979i) 1.49130347612937+0.78539816339745i) (num-test (log 3.14159265358979-0.00000001i) 1.14472988584940-0.00000000318310i) (num-test (log 3.14159265358979-0.0i) 1.14472988584940) (num-test (log 3.14159265358979-1.0i) 1.19298515341341-0.30816907111598i) (num-test (log 3.14159265358979-1234.0i) 7.11801944515932-1.56825047114960i) (num-test (log 3.14159265358979-3.14159265358979i) 1.49130347612937-0.78539816339745i) (num-test (log 3.720075976020836E-44) -100.0) (num-test (log 3/1) 1.09861228866811) (num-test (log 3/10) -1.20397280432594) (num-test (log 3/1234) -6.01940391579722) (num-test (log 3/2) 0.40546510810816) (num-test (log 3/3) 0.0) (num-test (log 3/500029) -12.02380908705428) (num-test (log 4 1/2) -2) (num-test (log 4.5399929762484853E-5) -10.0) (num-test (log 42665/30784 48270/29769) 6.752638664357152674138191677370820431573E-1) (num-test (log 43340/27863 27919/48593) -7.971826992064755184257579917033070384525E-1) (num-test (log 43686/40844 3924/13265) -5.522724914533037935994124583907811339125E-2) (num-test (log 46770/6899 56965/50618) 1.620137763694524415676013256791616662615E1) (num-test (log 5.0e-01+0.0e+00i) -6.9314718055994530942e-1+0.0i) (num-test (log 5.0e-01+1.0e+00i) 1.1157177565710487788e-1+1.1071487177940905030e0i) (num-test (log 5.0e-01+1.19209289550781250e-07i) -6.9314718055991688771e-1+2.3841857910155798249e-7i) (num-test (log 5.0e-01+2.0e+00i) 7.2345949146816273071e-1+1.3258176636680324651e0i) (num-test (log 5.0e-01+5.0e-01i) -3.4657359027997265471e-1+7.8539816339744830962e-1i) (num-test (log 5.0e-01+8.3886080e+06i) 1.5942385152878743893e1+1.5707962671902518438e0i) (num-test (log 5.0e-01-1.0e+00i) 1.1157177565710487788e-1-1.1071487177940905030e0i) (num-test (log 5.0e-01-1.19209289550781250e-07i) -6.9314718055991688771e-1-2.3841857910155798249e-7i) (num-test (log 5.0e-01-2.0e+00i) 7.2345949146816273071e-1-1.3258176636680324651e0i) (num-test (log 5.0e-01-5.0e-01i) -3.4657359027997265471e-1-7.8539816339744830962e-1i) (num-test (log 5.0e-01-8.3886080e+06i) 1.5942385152878743893e1-1.5707962671902518438e0i) (num-test (log 500029) 13.12242137572239) (num-test (log 500029/1) 13.12242137572239) (num-test (log 500029/10) 10.81983628272835) (num-test (log 500029/1234) 6.00440517125706) (num-test (log 500029/2) 12.42927419516245) (num-test (log 500029/3) 12.02380908705428) (num-test (log 500029/500029) 0.0) (num-test (log 54595/38975 21029/18267) 2.393514540234982342775959084446190967875E0) (num-test (log 55510/63095 55510/63095) 1) (num-test (log 60726/29873 34251/53142) -1.615057368690198504993598764304726754524E0) (num-test (log 62092/33540 1958/6237) -5.315823311016084206705945306286559292707E-1) (num-test (log 8.0 -2.0) 0.13926097063622-0.63118087262379i) (num-test (log 8.0 1.0+i) 0.97790391649038-2.2161063668189i) (num-test (log 8.0 2) 3.0) (num-test (log 8.3886080e+06+0.0e+00i) 1.5942385152878742117e1+0.0i) (num-test (log 8.3886080e+06+1.0e+00i) 1.5942385152878749222e1+1.1920928955078068531e-7i) (num-test (log 8.3886080e+06+1.19209289550781250e-07i) 1.5942385152878742117e1+1.4210854715202003717e-14i) (num-test (log 8.3886080e+06+2.0e+00i) 1.5942385152878770538e1+2.3841857910155798249e-7i) (num-test (log 8.3886080e+06+5.0e-01i) 1.5942385152878743893e1+5.9604644775390554414e-8i) (num-test (log 8.3886080e+06+8.3886080e+06i) 1.6288958743158714771e1+7.8539816339744830962e-1i) (num-test (log 8.3886080e+06-1.0e+00i) 1.5942385152878749222e1-1.1920928955078068531e-7i) (num-test (log 8.3886080e+06-1.19209289550781250e-07i) 1.5942385152878742117e1-1.4210854715202003717e-14i) (num-test (log 8.3886080e+06-2.0e+00i) 1.5942385152878770538e1-2.3841857910155798249e-7i) (num-test (log 8.3886080e+06-5.0e-01i) 1.5942385152878743893e1-5.9604644775390554414e-8i) (num-test (log 8.3886080e+06-8.3886080e+06i) 1.6288958743158714771e1-7.8539816339744830962e-1i) (num-test (log 9.0 3.0) 2.0) (num-test (log 9223372036854775807) 4.366827237527655449317720343461657334526E1) (num-test (log pi) 1.14472988584940) (num-test (log (/ 1+i)) (log (/ 1 1+i))) (test (< (real-part (log 0.0)) (real-part (- (log 0.0)))) #t) (test (infinite? (random (log 0.0))) #t) (test (infinite? (random +inf.0)) #t) (unless with-bignums (num-test (log 1 1) 0)) ; (expt 1 0) is 1 but so is (expt 1 1) -- an ambiguous case (returns NaN in gmp) (unless with-bignums (num-test (log 1.0 1.0) 0.0)) (num-test (log 2 1) +inf.0) (test (nan? (log +nan.0)) #t) (test (nan? (log +nan.0 1)) #t) (test (nan? (log +nan.0 1+i)) #t) (num-test (log (log 16 2) 2) 2) (num-test (log 2/3 4/9) 1/2) (num-test (log 8/27 2/3) 3) (when with-bignums ;(test (nan? (log +nan.0 (bignum +inf.0))) #t) (num-test (log 8/27 (bignum 2/3)) 3) (num-test (log -inf.0) +inf.0+3.141592653589793i) (num-test (log +inf.0-nan.0i (bignum 1+i)) +nan.0) (test (nan? (log (bignum 9223372036854775806) +inf.0-nan.0i)) #t) (num-test (log (bignum +inf.0-nan.0i) (bignum 1+i)) +nan.0)) (test (nan? (log 9223372036854775806 +inf.0-nan.0i)) #t) (num-test (log -1) (complex 0 pi)) (num-test (log (expt 2 14) (expt 2 13)) 14/13) ; (expt (expt 2 13) 14/13) is (expt 2 14) modulo floating point foolishness (do ((i 0 (+ i 1)) (n 1 (* n 2))) ((= i 60)) (let ((x (log n 2))) (if (not (= (expt 2 i) n)) (format *stderr* "(log ~D 2): ~A~%" n x)))) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 'log num (log num) val))) (vector (list 1 0.0) (list 2 0.69314718055995) (list 3 1.0986122886681) (list -1 0+3.1415926535898i) (list -2 0.69314718055995+3.1415926535898i) (list -3 1.0986122886681+3.1415926535898i) (list 9223372036854775807 43.668272375277) (list -9223372036854775808 43.668272375277+3.1415926535898i) (list 1/2 -0.69314718055995) (list 1/3 -1.0986122886681) (list -1/2 -0.69314718055995+3.1415926535898i) (list -1/3 -1.0986122886681+3.1415926535898i) (list 1/9223372036854775807 -43.668272375277) (list 1.0 0.0) (list 2.0 0.69314718055995) (list -2.0 0.69314718055995+3.1415926535898i) (list 1.000000000000000000000000000000000000002E-309 -7.114987937351601163615593594974685401477E2) (list 1e+16 36.841361487905) (list 0+1i 0+1.5707963267949i) (list 0+2i 0.69314718055995+1.5707963267949i) (list 0-1i 0-1.5707963267949i) (list 1+1i 0.34657359027997+0.78539816339745i) (list 1-1i 0.34657359027997-0.78539816339745i) (list -1+1i 0.34657359027997+2.3561944901923i) (list -1-1i 0.34657359027997-2.3561944901923i) (list 0.1+0.1i -1.9560115027141+0.78539816339745i) (list 1e+16+1e+16i 37.187935078185+0.78539816339745i) (list 1e-16+1e-16i -36.494787897625+0.78539816339745i) )) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x -10.0 (+ x .1))) ((= i 200)) (if (not (zero? x)) (let ((y (magnitude (- x (exp (log x)))))) (if (> y err) (begin (set! mx x) (set! err y)))))) (if (> err 1e-14) (format #t ";(exp (log ~A)) error: ~A~%" mx err))) (let ((err 0.0) (mx 0.0)) (do ((i 0 (+ i 1)) (x -10.0+i (+ x 0.1-0.1i))) ((= i 200)) (if (not (zero? x)) (let ((y (magnitude (- x (exp (log x)))))) (if (> y err) (begin (set! err y) (set! mx x)))))) (if (> err 1e-14) (format #t ";(exp (log ~A)) error: ~A~%" mx err))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (+ .001 (random 100.0))) (base (+ 2 (random 20)))) (num-test (log val base) (/ (log val) (log base))))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (+ .001 (random 10000.0))) (base (+ 1.0 (random 20.0)))) (num-test (log val base) (/ (log val) (log base))))) (let ((val1 (catch #t (lambda () (log 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (log -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (+ .001 (random 100.0))) (base (+ 2 (random 20)))) (if (> (random 1.0) 0.5) (set! val (- val))) (if (> (random 1.0) 0.5) (set! base (- base))) (num-test (log val base) (/ (log val) (log base))))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (+ .001 (random 10000.0))) (base (+ 1.0 (random 20.0)))) (if (> (random 1.0) 0.5) (set! val (- val))) (if (> (random 1.0) 0.5) (set! base (- base))) (num-test (log val base) (/ (log val) (log base))))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val1 (+ .001 (random 10000.0))) (val2 (+ .001 (random 10000.0))) (base1 (+ 1.0 (random 20.0))) (base2 (+ 1.0 (random 20.0)))) (if (> (random 1.0) 0.5) (set! val1 (- val1))) (if (> (random 1.0) 0.5) (set! val2 (- val2))) (if (> (random 1.0) 0.5) (set! base1 (- base1))) (if (> (random 1.0) 0.5) (set! base2 (- base2))) (let ((val (complex val1 val2)) (base (complex base1 base2))) (num-test (log val base) (/ (log val) (log base)))))) (if (not with-bignums) (num-test (log 1 0) 0)) ; since (expt 0 0) is 1 (when with-bignums (num-test (log (expt 2 16382)) 1.135513711193302405887309661372784853823E4) (num-test (log -1.797693134862315699999999999999999999998E308) 7.097827128933839967276924307167005609752E2+3.141592653589793238462643383279502884195E0i) (num-test (log -2.225073858507201399999999999999999999996E-308) -7.083964185322641062168115849912137186655E2+3.141592653589793238462643383279502884195E0i) (num-test (log 69720375229712477164533808935312303556800) 9.40453112293573922460049312446069272415E1) (num-test (log 100.0 (+ 1.0 (bignum "1e-16"))) 4.605170185988091598294419229104461919985E16) (num-test (expt (+ 1.0 (bignum "1e-16")) 4.605170185988091598294419229104461919985E16) 100.0) (num-test (log 100.0 (+ 1.0 (bignum "1e-34"))) 4.60520221864866031976806443342804401709E34) (num-test (expt (+ 1.0 (bignum "1e-34")) 4.60520221864866031976806443342804401709E34) 100.0) (num-test (expt (+ 1 1e-16) (log 100.0 (+ 1 1e-16))) 100.0) (num-test (+ 100 (expt 10.0 35) (- (expt 10.0 35))) 100.0) (num-test (log 1/9223372036854775808 2) -63) (num-test (log 9223372036854775808 2) 63) (num-test (log 9223372036854775807/9223372036854775806 9223372036854775806/9223372036854775807) -9.999999999999999999999999999999999999647E-1) (test (let ((z (log 0+0/0i))) (and (nan? z) (complex? z))) #t) (test (let ((z (bignum (log 0+0/0i)))) (and (nan? z) (complex? z))) #t)) (let ((logs-1 (list -4.60517018598809136803598290936872841520220297725754595206665580193514 -3.91202300542814605861875078791055184712670284289729069794597579244175 -3.50655789731998167664073767244620271055471241943479650033196146829765 -3.21887582486820074920151866645237527905120270853703544382529578294835 -2.99573227355399099343522357614254077567660162298902823015400791046096 -2.81341071676003636722350555098802614247921228507454124621128145880425 -2.65926003693277806293063016592554868556511824767568476360726565199756 -2.52572864430825543978428654499419871097570257417678018970461577345496 -2.40794560865187198524549243552367700590722186161204704859726713466015 -2.30258509299404568401799145468436420760110148862877297603332790096757 -2.20727491318972082397403933140359911538049612332012877684808809280457 -2.12026353620009105780627342952984957440371215071428599209060144931086 -2.04022082852655463198249546780340981039693503249733883564761029127168 -1.96611285637283275351339804446737211748961811331542950948658564250417 -1.89711998488588130203997833922001507102911106516627877841931357682347 -1.83258146374831013036705442353602214290020243981652493558393576396157 -1.77195684193187528778644829149560187961399996467180116476941806405285 -1.71479842809192667582826031406550043783172172725179179447658712516676 -1.66073120682165090802695547748087487796482371595841713352869556552585 -1.60943791243410037460075933322618763952560135426851772191264789147417)) (logs-2 (list 2.30258509299404568401799145468436420760110148862877297603332790096757 2.99573227355399099343522357614254077567660162298902823015400791046096 3.40119738166215537541323669160688991224859204645152242776802223460506 3.68887945411393630285245569760071734375210175734928348427468791995435 3.91202300542814605861875078791055184712670284289729069794597579244175 4.09434456222210068483046881306506648032409218081177768188870224409846 4.24849524204935898912334419812754393723818621821063416449271805090515 4.38202663467388161226968781905889391182760189170953873839536792944775 4.49980967033026506680848192852941561689608260427427187950271656824256 4.60517018598809136803598290936872841520220297725754595206665580193514 4.70048036579241622807993503264949350742280834256619015125189561009814 4.78749174278204599424770093452324304839959231517203293600938225359185 4.86753445045558242007147889624968281240636943338898009245237341163103 4.94164242260930429854057631958572050531368635257088941861339806039854 5.01063529409625575001399602483307755177419340072004014968067012607924 5.07517381523382692168691994051707047990310202606979399251604793894114 5.13579843705026176426752607255749074318930450121451776333056563884986 5.19295685089021037622571404998759218497158273863452713362339657773595 5.24702407216048614402701888657221774483848074992790179457128813737686 5.29831736654803667745321503082690498327770311161780120618733581142853))) (let ((mxerr 0.0)) (do ((i 0 (+ i 1)) (x 0.01 (+ x 0.01)) (y 10.0 (+ y 10.0))) ((= i 20)) (let ((err (max (abs (- (log x) (list-ref logs-1 i))) (abs (- (log y) (list-ref logs-2 i)))))) (if (> err mxerr) (set! mxerr err)))) (if (> mxerr 1e-12) (format #t "log err: ~A~%" mxerr)))) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 500)) (let ((logs (list ; table[Log[k/10 + 1.0], {k, 0, 30}] 0.00000000000000000000000000000000000000000000000000000000000000000000e0 0.09531017980432486004395212328076509222060536530864419918523980816300 0.18232155679395462621171802515451463319738933791448698394272645165670 0.26236426446749105203549598688095439720416645613143414038571760969589 0.33647223662121293050459341021699209011148337531334346654674225846340 0.40546510810816438197801311546434913657199042346249419761401432414410 0.47000362924573555365093703114834206470089904881224804044939213700600 0.53062825106217039623154316318876232798710152395697181126390983691471 0.58778666490211900818973114061886376976937976137698118155674077580080 0.64185388617239477599103597720348932963627777267035584250463233544172 0.69314718055994530941723212145817656807550013436025525412068000949339 0.74193734472937731248260652568134122668347379877583766416075658260750 0.78845736036427016946118424473894166029610549966889945330591981765639 0.83290912293510400678876137712583191084127882621166276596530747651542 0.87546873735389993562895014661269120127288947227474223806340646115010 0.91629073187415506518352721176801107145010121990826246779196788198078 0.95551144502743636145272810833913096527966659049168939450639761918928 0.99325177301028339016774425608321290634137018483947537917075509994491 1.02961941718115823992182553167516865818698350967359872066742226795679 1.06471073699242834316528057767754739789341142529397110288834245067520 1.09861228866810969139524523692252570464749055782274945173469433363749 1.13140211149110056191117286985799300284883744185181899572339017150740 1.16315080980568086306816915260651863277639918317250329457007214649939 1.19392246847243455143919736020329079686809592313139365091993414180049 1.22377543162211570564877528464693889606260165831722706538458984640811 1.25276296849536799568812062198500316156158459522160593433871014044418 1.28093384546206431760696326207704033784487989573723643567742078529420 1.30833281965017876035010421634708295629897609853886318761158478022541 1.33500106673234008540826809866166589771177790703061109662531234493511 1.36097655313560074343074122380348010185165701395418359212041194333338 1.38629436111989061883446424291635313615100026872051050824136001898678))) (do ((i 0 (+ i 1))) ((= i 30)) (let ((val (log (+ (bignum (/ i 10)) (bignum "1.0"))))) (if (> (magnitude (- val (list-ref logs i))) 1e-36) (format #t ";(log ~A) -> ~A ~A~%[~A]~%" (+ 1.0 (/ i 10)) val (list-ref logs i) (magnitude (- val (list-ref logs i)))))))))) (test (log) 'error) (test (log "hi") 'error) (test (log 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error) (test (log "hi" (expt 2 30)) 'error) (test (log (expt 2 30) #t) 'error) (test (log 0 0) 'error) (test (log 3 0) 'error) (for-each (lambda (arg) (test (log arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (for-each (lambda (arg) (test (log arg +nan.0) 'error) (test (log +nan.0 arg) 'error) (test (log arg +inf.0) 'error) (test (log +inf.0 arg) 'error) (test (log 10 arg) 'error) (test (log arg 10) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; expt ;;; -------------------------------------------------------------------------------- (num-test (* (/ (expt 2 11) (+ (expt 2 10) 1)) (/ (+ (expt 2 11) 1) (expt 2 10))) 4098/1025) (num-test (* (/ (expt 2 21) (+ (expt 2 20) 1)) (/ (+ (expt 2 21) 1) (expt 2 20))) 4194306/1048577) (num-test (* (sqrt 2) (sqrt (- 31 (* 4 (sqrt (sqrt 3)) (sqrt (sqrt 5)))))) (+ (* (expt 3 1/4) (expt 5 3/4)) (- (* 2 (sqrt 5))) (* (expt 3 3/4) (expt 5 1/4)) (* 2 (sqrt 3)))) (num-test (* 1/18014398509481984 1/2) (expt 2 -55)) (num-test (+ (/ (expt 2 11) (+ (expt 2 10) 1)) (/ (+ (expt 2 11) 1) (expt 2 10))) 4197377/1049600) (num-test (+ (/ (expt 2 21) (+ (expt 2 20) 1)) (/ (+ (expt 2 21) 1) (expt 2 20))) 4398049656833/1099512676352) (num-test (+ (/ (expt 2 28)) (/ (expt 3 17)) 1/7 1/29) 1247968828249346465/7037157104192323584) (num-test (+ (/ (expt 2 28)) (/ (expt 3 17)) 1/7 1/31) 1317300430901043787/7522478283791794176) (num-test (+ (/ (expt 2 29)) (/ (expt 3 18)) 1/31) 207994819909949399/6447838528964395008) (num-test (+ (/ (expt 2 30)) (/ (expt 3 18)) 1/13) 415989601508942005/5407864572679815168) (num-test (+ (/ (expt 2 30)) (/ (expt 3 18)) 1/5) 415989589819643501/2079947912569159680) (num-test (+ (/ (expt 2 30)) (/ (expt 3 20))) 4560526225/3743906242624487424) (num-test (+ (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 4503601775902721/1099512676352) (num-test (+ (expt (+ 1/2 (/ (sqrt 69) 18)) 1/3) (/ (expt (+ 1/2 (/ (sqrt 69) 18)) -1/3) 3)) (* (/ (* 2 (sqrt 3)) 3) (cos (/ (acos (/ (* 3 (sqrt 3)) 2)) 3)))) (num-test (+ (expt 2 5) (expt 298 5) (expt 351 5) (expt 474 5) (expt 500 5)) (expt 575 5)) (num-test (+ (expt 2230 4) (expt 3196 4) (expt 5620 4) (expt 6995 4)) (expt 7703 4)) (num-test (+ (expt 415280564497/348671682660 3) (expt 676702467503/348671682660 3)) 9) (num-test (+ (expt 510 3) (expt 580 3)) (+ (expt 300 3) (expt 670 3))) (num-test (+ 1 (expt 2 54)) 18014398509481985) (num-test (+ 10000000000000000 1) 10000000000000001) (num-test (+ 2 (expt 276694819753963/226588 1/158)) pi) ; 23 digits (num-test (- (/ (expt 2 11) (+ (expt 2 10) 1)) (/ (+ (expt 2 11) 1) (expt 2 10))) -3073/1049600) (num-test (- (/ (expt 2 21) (+ (expt 2 20) 1)) (/ (+ (expt 2 21) 1) (expt 2 20))) -3145729/1099512676352) (num-test (- (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) -2148532225/1099512676352) (num-test (- (expt 2 54) 18014398509481983) 1) (num-test (- (expt 2 54) 18014398509481984) 0) (num-test (- 10000000000000000 9999999999999999) 1) (num-test (/ (/ (expt 2 11) (+ (expt 2 10) 1)) (/ (+ (expt 2 11) 1) (expt 2 10))) 2097152/2100225) (num-test (/ (/ (expt 2 21) (+ (expt 2 20) 1)) (/ (+ (expt 2 21) 1) (expt 2 20))) 2199023255552/2199026401281) (num-test (/ (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 2251799813685248/2251801962217473) (num-test (/ (expt 10 -20) (expt 10 -20)) 1) (num-test (/ (expt 10 -200) (expt 10 -200)) 1) (num-test (/ (expt 2 -53) 2) (expt 2 -54)) (num-test (/ (expt 2.3 50) (expt 2.3 49)) 2.3) (num-test (/ (sqrt (* 7 (- 2 (expt 2 1/7)))) (expt 2 1/14)) (+ -1 (* 2 (expt 2 1/7)) (expt 2 3/7) (expt 2 5/7) (- (expt 2 6/7)))) (num-test (do ((i 1 (+ i 1)) (sum 0.0 (+ sum (expt (sin (/ (* pi i) (* 2 10))) 4)))) ((= i 11) sum)) 4.25) (num-test (expt (+ (cos (/ (* 2 pi) 20)) (* 0+i (sin (/ (* 2 pi) 20)))) 20) 1.0) (num-test (expt (+ pi 20) 0+i) -0.99999999924368-3.8892669402222e-05i) (num-test (expt (- (expt 2 1/3) 1) 1/3) (+ (expt 1/9 1/3) (- (expt 2/9 1/3)) (expt 4/9 1/3))) (num-test (expt (- (expt 3 3/5) (expt 2 1/5)) 1/3) (/ (+ (- (* (expt 2 1/5) (expt 3 3/5))) (* (expt 2 3/5) (expt 3 2/5)) (expt 3 1/5) (expt 2 2/5)) (expt 5 2/3))) (num-test (expt (/ (+ 1 (sqrt 5)) 2) 5) (/ (+ 11 (* 5 (sqrt 5))) 2)) (num-test (expt (/ (log (+ (expt 640320 3) 744)) pi) 2) 163.0) ; rest is 2.32167e-29 (num-test (expt (expt -1 -1/2) -2) -1) (num-test (expt (expt -1 1/123) 123) -1) (num-test (expt (expt -1/2 -1/2) -2) -1/2) (num-test (expt (expt -1/2 1/2) 2) -1/2) (num-test (expt (expt -1/3 -1/2) -2) -1/3) (num-test (expt (expt -1/3 1/2) 2) -1/3) (num-test (expt (expt -1/3 1/3) 3) -1/3) (num-test (expt (expt -2 -1/2) -2) -2) (num-test (expt (expt -2 1/2) 2) -2) (num-test (expt (expt 0+i -1/2) -2) 0+i) (num-test (expt (expt 0+i -1/3) -3) 0+i) (num-test (expt (expt 0+i -1/4) -4) 0+i) (num-test (expt (expt 0+i 0.5) 2) 0+i) (num-test (expt (expt 0+i 1/10) 10) 0+i) (num-test (expt (expt 0+i 1/3) 3) 0+i) (num-test (expt (expt 0+i 1/4) 4) 0+i) (num-test (expt (expt 1 -1/2) -2) 1) (num-test (expt (expt 1 1/123) 123) 1) (num-test (expt (expt 1+i 1/2) 2) 1+i) (num-test (expt (expt 1+i 1/3) 3) 1+i) (num-test (expt (expt 1+i 1/4) 4) 1+i) (num-test (expt (expt 1-i 1/2) 2) 1-i) (num-test (expt (expt 1-i 1/3) 3) 1-i) (num-test (expt (expt 1-i 1/4) 4) 1-i) (num-test (expt (expt 1/2 -1/2) -2) 1/2) (num-test (expt (expt 2 0+i) (/ 0+i)) 2) (num-test (expt (expt 2 1/10) 10) 2) (num-test (expt (expt 2 1/30) 30) 2) (num-test (expt (expt 2 30) 1/30) 2) (num-test (expt (expt 2 50) 1/50) 2) (num-test (expt (expt 20 10) 1/10) 20) (num-test (expt (expt 40 10) 1/10) 40) (num-test (expt -0 -0) 1) (num-test (expt -0.0 -0.0) 0.0) (num-test (expt -0.0 0) 0.0) (num-test (expt -0.0 0-i) 0.0) (num-test (expt -0.0 0.00000001) 0.0) (num-test (expt -0.0 1.0) 0.0) (num-test (expt -0.0 1234.0) 0.0) (num-test (expt -0.0 pi) 0.0) (num-test (expt -0.00000001 -0.0) 1.0) (num-test (expt -0.00000001 -0.00000001) 1.00000018420682-0.00000003141593i) (num-test (expt -0.00000001 -1) -100000000.00000017881393-0.00000001224606i) (num-test (expt -0.00000001 -1.0) -100000000.00000017881393-0.00000001224606i) (num-test (expt -0.00000001 0) 1.0) (num-test (expt -0.00000001 0.0) 1.0) (num-test (expt -0.00000001 0.00000001) 0.99999981579321+0.00000003141592i) (num-test (expt -0.00000001 1) -0.00000001+0.0i) (num-test (expt -0.00000001 1.0) -0.00000001+0.0i) (num-test (expt -0.00000001 10) 1e-80) (num-test (expt -0.00000001 1234) 0.0) (num-test (expt -0.00000001 1234.0) 0.0) (num-test (expt -0.00000001 2) 1e-16) (num-test (expt -0.00000001 3) -1e-24) (num-test (expt -0.00000001 500029) 0.0) (num-test (expt -0.00000001 pi) -6.6495946361558e-26-3.1697962381573e-26i) (num-test (expt -0.00000001+0.00000001i 1.0-0.0i) -0.00000001+0.00000001i) (num-test (expt -0.00000001+0.0i 0.00000001-0.00000001i) 0.99999984720911+0.00000021562270i) (num-test (expt -0.00000001-0.00000001i -1.0-0.0i) -50000000.00000003725290+50000000.00000004470348i) (num-test (expt -0.00000001-0.0i -0.00000001-0.00000001i) 1.00000021562275+0.00000015279091i) (num-test (expt -1 (+ 1 (expt 2 32))) -1) (num-test (expt -1 (- (expt 2 32))) 1) (num-test (expt -1 (expt 2 32)) 1) (num-test (expt -1 -0.0) 1.0) (num-test (expt -1 -100) 1) (num-test (expt -1 -1000) 1) (num-test (expt -1 -1001) -1) (num-test (expt -1 -101) -1) (num-test (expt -1 -255) -1) (num-test (expt -1 -256) 1) (num-test (expt -1 0) 1) (num-test (expt -1 0+i) 4.321391826377224977441773717172801127572810981063308298071968740105076575701806E-2) (num-test (expt -1 0-i) 2.314069263277926900572908636794854738026610624260021199344504640952434235069032E1) (num-test (expt -1 0.0) 1.0) (num-test (expt -1 0.00000001) 1.0+0.00000003141593i) (num-test (expt -1 1) -1) (num-test (expt -1 1.0) -1.0+0.0i) (num-test (expt -1 1/2) 0+i) (num-test (expt -1 10) 1) (num-test (expt -1 100) 1) (num-test (expt -1 1000) 1) (num-test (expt -1 1001) -1) (num-test (expt -1 101) -1) (num-test (expt -1 1234) 1) (num-test (expt -1 1234.0) 1.0) (num-test (expt -1 1234000000.0) 1.0) (num-test (expt -1 2) 1) (num-test (expt -1 255) -1) (num-test (expt -1 256) 1) (num-test (expt -1 3) -1) (num-test (expt -1 500029) -1) (num-test (expt -1 pi) -0.90268536193307-0.43030121700009i) (num-test (expt -1.0 -0.0) 1.0) (num-test (expt -1.0 -0.00000001) 1.0-0.00000003141593i) (num-test (expt -1.0 -1) -1.0-0.0i) (num-test (expt -1.0 -1.0) -1.0-0.0i) (num-test (expt -1.0 -10) 1.0+0.0i) (num-test (expt -1.0 -1234) 1.0) (num-test (expt -1.0 -1234.0) 1.0) (num-test (expt -1.0 -1234000000) 1.0) (num-test (expt -1.0 -1234000000.0) 1.0) (num-test (expt -1.0 -2) 1.0+0.0i) (num-test (expt -1.0 -3) -1.0-0.0i) (num-test (expt -1.0 -3.14159265358979) -0.90268536193307+0.43030121700009i) (num-test (expt -1.0 -500029) -1.0) (num-test (expt -1.0 0) 1.0) (num-test (expt -1.0 0.0) 1.0) (num-test (expt -1.0 0.00000001) 1.0+0.00000003141593i) (num-test (expt -1.0 1) -1.0+0.0i) (num-test (expt -1.0 1.0) -1.0+0.0i) (num-test (expt -1.0 1/2) 0+i) (num-test (expt -1.0 10) 1.0-0.0i) (num-test (expt -1.0 1234) 1.0) (num-test (expt -1.0 1234.0) 1.0) (num-test (expt -1.0 1234000000) 1.0) (num-test (expt -1.0 1234000000.0) 1.0) (num-test (expt -1.0 2) 1.0-0.0i) (num-test (expt -1.0 3) -1.0+0.0i) (num-test (expt -1.0 500029) -1.0) (num-test (expt -1.0 pi) -0.90268536193307-0.43030121700009i) (num-test (expt -1.0+0.00000001i 3.14159265358979-0.00000001i) -0.90268540381008-0.43030120215971i) (num-test (expt -1.0-0.00000001i -3.14159265358979-0.00000001i) -0.90268534709269-0.43030117512308i) (num-test (expt -1.0e+00+0.0e+00i -1.0e+00+0.0e+00i) -1e0+0.0i) (num-test (expt -1.0e+00+0.0e+00i 0.0e+00+0.0e+00i) 1e0+0.0i) (num-test (expt -1.0e+00+0.0e+00i 0.0e+00+1.0e+00i) 4.3213918263772249774e-2+0.0i) (num-test (expt -1.0e+00+0.0e+00i 0.0e+00-1.0e+00i) 2.3140692632779269006e1+0.0i) (num-test (expt -1.0e+00+0.0e+00i 1.0e+00+0.0e+00i) -1e0+0.0i) (num-test (expt -1.0e+00+0.0e+00i 5.0e-01+1.00000000000000005551e-01i) 0+7.3040269104864559813e-1i) (num-test (expt -1.0e+00+0.0e+00i 5.0e-01-1.00000000000000005551e-01i) 0+1.3691077706248469087e0i) (if (not (provided? 'freebsd)) (num-test (expt -1/2 (- (real-part (log 0)))) (expt -0.5 (- (real-part (log 0)))))) (num-test (expt -1/3 10/500029) 0.99997802729625+0.00006282682861i) (num-test (expt -1/8 -3) -512) (num-test (expt -10 3) -1000) (num-test (expt -10 pi) -1250.63060831127905-596.16328730697728i) (num-test (expt -10/1234000000 1/500029) 0.99996274095212+0.00000628258681i) (num-test (expt -10/500029 2/1234000000) 0.99999998246380+0.00000000509172i) (num-test (expt -1234 0) 1) (num-test (expt -1234 0.0) 1.0) (num-test (expt -1234 0.00000001) 1.00000007118016+0.00000003141593i) (num-test (expt -1234 1) -1234) (num-test (expt -1234 1.0) -1234.00000000000045+0.00000000000015i) (num-test (expt -1234 2) 1522756) (num-test (expt -1234.0 -0.0) 1.0) (num-test (expt -1234.0 -0.00000001) 0.99999992881984-0.00000003141592i) (num-test (expt -1234.0 -1) -0.00081037277147-0.0i) (num-test (expt -1234.0 -1.0) -0.00081037277147-0.0i) (num-test (expt -1234.0 -2) 0.00000065670403+0.0i) (num-test (expt -1234.0 -3) -0.00000000053218-0.0i) (num-test (expt -1234.0 -3.14159265358979) -0.00000000017534+0.00000000008358i) (num-test (expt -1234.0 0) 1.0) (num-test (expt -1234.0 0.0) 1.0) (num-test (expt -1234.0 0.00000001) 1.00000007118016+0.00000003141593i) (num-test (expt -1234.0 1) -1234.00000000000045+0.00000000000015i) (num-test (expt -1234.0 1.0) -1234.00000000000045+0.00000000000015i) (num-test (expt -1234.0 2) 1522756.00000000093132-0.00000000037296i) (num-test (expt -1234.0+1234.0i 3.14159265358979-0.0i) 6676669154.05054950714111+13759228759.84499740600586i) (num-test (expt -1234.0-1234.0i -3.14159265358979-0.0i) 2.854567008891443E-11+5.882669873167984E-11i) (num-test (expt -1234/10 0/1) 1) (num-test (expt -1234/500029 3/500029) 0.99996397612963+0.00001884778372i) (num-test (expt -1234000000 0) 1) (num-test (expt -1234000000 0.0) 1.0) (num-test (expt -1234000000 0.00000001) 1.00000020933529+0.00000003141593i) (num-test (expt -1234000000.0 -0.0) 1.0) (num-test (expt -1234000000.0 -0.00000001) 0.99999979066475-0.00000003141592i) (num-test (expt -1234000000.0 -1) -0.00000000081037-0.0i) (num-test (expt -1234000000.0 -1.0) -0.00000000081037-0.0i) (num-test (expt -1234000000.0 0) 1.0) (num-test (expt -1234000000.0 0.0) 1.0) (num-test (expt -1234000000.0 0.00000001) 1.00000020933529+0.00000003141593i) (num-test (expt -1234000000/10 1/2) 0.00000000000068+11108.55526159905094i) (num-test (expt -1234000000/3 0/3) 1) (num-test (expt -2 0) 1) (num-test (expt -2 0.0) 1.0) (num-test (expt -2 0.00000001) 1.00000000693147+0.00000003141593i) (num-test (expt -2 1) -2) (num-test (expt -2 1.0) -2.0+0.0i) (num-test (expt -2 10) 1024) (num-test (expt -2 2) 4) (num-test (expt -2 3) -8) (num-test (expt -2 pi) -7.96617830388569-3.79739869898975i) (num-test (expt -2/1 3/1) -8) (num-test (expt -2/1234 500029/1234000000) 0.99739915734849+0.00126969420446i) (num-test (expt -2/500029 0/10) 1) (num-test (expt -256 0) 1) (num-test (expt -256 1) -256) (num-test (expt -2742638075.5 1/2) (sqrt -2742638075.5)) (num-test (expt -2742638075.5 2) (* -2742638075.5 -2742638075.5)) ; from bug-guile (num-test (expt -3 0) 1) (num-test (expt -3 0.0) 1.0) (num-test (expt -3 0.00000001) 1.00000001098612+0.00000003141593i) (num-test (expt -3 1) -3) (num-test (expt -3 1.0) -3.0+0.0i) (num-test (expt -3 10) 59049) (num-test (expt -3 2) 9) (num-test (expt -3 3) -27) (num-test (expt -3 pi) -28.47456044077623-13.57354237468751i) (num-test (expt -3.14159265358979 -0.0) 1.0) (num-test (expt -3.14159265358979 -0.00000001) 0.99999998855270-0.00000003141593i) (num-test (expt -3.14159265358979 -1) -0.31830988618379-0.0i) (num-test (expt -3.14159265358979 -1.0) -0.31830988618379-0.0i) (num-test (expt -3.14159265358979 -10) 0.00001067827923+0.0i) (num-test (expt -3.14159265358979 -2) 0.10132118364234+0.0i) (num-test (expt -3.14159265358979 -3) -0.03225153443320-0.0i) (num-test (expt -3.14159265358979 -3.14159265358979) -0.02475677172327+0.01180130912803i) (num-test (expt -3.14159265358979 0) 1.0) (num-test (expt -3.14159265358979 0.0) 1.0) (num-test (expt -3.14159265358979 0.00000001) 1.00000001144730+0.00000003141593i) (num-test (expt -3.14159265358979 1) -3.14159265358979+0.0i) (num-test (expt -3.14159265358979 1.0) -3.14159265358979+0.0i) (num-test (expt -3.14159265358979 10) 93648.04747608296748) (num-test (expt -3.14159265358979 2) 9.86960440108936-0.0i) (num-test (expt -3.14159265358979 3) -31.00627668029983) (num-test (expt -3.14159265358979 pi) -32.91385774189388-15.68971165343314i) (num-test (expt -3.14159265358979-3.14159265358979i -1234000000.0-0.0i) 0.0) (num-test (expt -3/1 10/2) -243) (num-test (expt -3/1234000000 0/1234000000) 1) (num-test (expt -3/500029 1/1234) 0.99030033992383+0.00252117260474i) (num-test (expt -500029 0) 1) (num-test (expt -500029 0.0) 1.0) (num-test (expt -500029 0.00000001) 1.00000013122422+0.00000003141593i) (num-test (expt -500029 1) -500029) (num-test (expt -500029 1.0) -500029.00000000040745+0.00000000006123i) (num-test (expt -500029/10 2/3) -678.63064326537926+1175.42275370878747i) (num-test (expt -500029/1234 3/2) -0.00000000000150-8156.80442672750178i) (num-test (expt -500029/1234000000 10/1) 0.0) (num-test (expt -500029/2 0/1234) 1) (num-test (expt -500029/3 1/10) 3.16514579334680+1.02841820970710i) (num-test (expt .1 -1) 10.0) (num-test (expt .1 -2) 100.0) (num-test (expt 0 (expt 2 31)) 0) (num-test (expt 0 (expt 2 32)) 0) (num-test (expt 0 (expt 2 33)) 0) (num-test (expt 0 (expt 2 63)) 0) (num-test (expt 0 (expt 2 64)) 0) (num-test (expt 0 (expt 2 65)) 0) (num-test (expt 0 -0.0) 0.0) (num-test (expt 0 -0/4) 1) (num-test (expt 0 0) 1) (num-test (expt 0 -0) 1) (num-test (expt 0 0.0) 0.0) (num-test (expt 0 0.00000001) 0.0) (num-test (expt 0 1) 0) (num-test (expt 0 1.0) 0.0) (num-test (expt 0 1.0+i) 0.0) ; ?? (num-test (expt 0 1/10) 0) (num-test (expt 0 1/4) 0) (num-test (expt 0 10) 0) (num-test (expt 0 100) 0) (num-test (expt 0 1000) 0) (num-test (expt 0 1001) 0) (num-test (expt 0 101) 0) (num-test (expt 0 1234) 0) (num-test (expt 0 1234.0) 0.0) (num-test (expt 0 1234000000) 0) (num-test (expt 0 1234000000.0) 0.0) (num-test (expt 0 2) 0) (num-test (expt 0 256) 0) (num-test (expt 0 3) 0) (num-test (expt 0 500029) 0) (num-test (expt 0 pi) 0.0) (num-test (expt 0+1e-15i 0-1e-15i) 1.0000000000000015707963267943015114538E0+3.453877639491074211979699606989171173842E-14i) (num-test (expt 0+1i 2) -1) (num-test (expt 0+i 0+i) 2.078795763507619085469556198349787700342E-1) (num-test (expt 0+i 0+i) (exp (/ pi -2))) (num-test (expt 0+i 0-i) 4.810477380965351655473035666703833126401E0) (num-test (expt 0+i 1/2) (complex (/ (sqrt 2)) (/ (sqrt 2)))) (num-test (expt 0+i 2) -1.0) (num-test (expt 0-i 1+i) 0.0-4.810477380965351655473035666703833126401E0i) (num-test (expt 0-i 1-i) 0.0-2.078795763507619085469556198349787700342E-1i) (num-test (expt 0-i 2) -1) (num-test (expt 0.0 (expt 2 31)) 0.0) (num-test (expt 0.0 (expt 2 32)) 0.0) (num-test (expt 0.0 (expt 2 33)) 0.0) (num-test (expt 0.0 (expt 2 63)) 0.0) (num-test (expt 0.0 (expt 2 64)) 0.0) (num-test (expt 0.0 (expt 2 65)) 0.0) (num-test (expt 0.0 0) 0.0) (num-test (expt 0.0 0+i) 0.0) ; why would they be radically different? (num-test (expt 0.0 0-i) 0.0) (num-test (expt 0.0 0.0) 0.0) (num-test (expt 0.0 0.00000001) 0.0) (num-test (expt 0.0 1) 0.0) (num-test (expt 0.0 1.0) 0.0) (num-test (expt 0.0 1234.0) 0.0) (num-test (expt 0.0 1234000000.0) 0.0) (num-test (expt 0.0 1e-15+i) 0.0) (num-test (expt 0.0 1e-15-i) 0.0) (num-test (expt 0.0 pi) 0.0) (num-test (expt 0.0-1234000000.0i -1234000000.0+0.00000001i) 0.0) (num-test (expt 0.00000001 -0.0) 1.0) (num-test (expt 0.00000001 -0.00000001) 1.00000018420682) (num-test (expt 0.00000001 -1) 100000000.00000017881393) (num-test (expt 0.00000001 -1.0) 100000000.00000017881393) (num-test (expt 0.00000001 0) 1.0) (num-test (expt 0.00000001 0.0) 1.0) (num-test (expt 0.00000001 0.00000001) 0.99999981579321) (num-test (expt 0.00000001 1) 0.00000001) (num-test (expt 0.00000001 1.0) 0.00000001) (num-test (expt 0.00000001 10) 0.0) (num-test (expt 0.00000001 1234) 0.0) (num-test (expt 0.00000001 1234.0) 0.0) (num-test (expt 0.00000001 1234000000) 0.0) (num-test (expt 0.00000001 1234000000.0) 0.0) (num-test (expt 0.00000001 2) 0.0) (num-test (expt 0.00000001 3) 0.0) (num-test (expt 0.00000001 500029) 0.0) (num-test (expt 0.00000001 pi) 0.0) (num-test (expt 0.00000001+0.00000001i 1.0+0.0i) 0.00000001+0.00000001i) (num-test (expt 0.00000001+0.0i 0.00000001+0.00000001i) 0.99999981579319-0.00000018420677i) (num-test (expt 0.00000001-0.00000001i -1.0+0.0i) 50000000.00000004470348+50000000.00000003725290i) (num-test (expt 0.00000001-0.0i -0.00000001+0.00000001i) 1.00000018420681-0.00000018420684i) (num-test (expt 0.0e+00+1.0e+00i -1.0e+00+0.0e+00i) 0-1i) (num-test (expt 0.0e+00+1.0e+00i 0.0e+00+0.0e+00i) 1e0+0.0i) (num-test (expt 0.0e+00+1.0e+00i 0.0e+00+1.0e+00i) 2.0787957635076190855e-1+0.0i) (num-test (expt 0.0e+00+1.0e+00i 0.0e+00-1.0e+00i) 4.8104773809653516555e0+0.0i) (num-test (expt 0.0e+00+1.0e+00i 1.0e+00+0.0e+00i) 0+1i) (num-test (expt 0.0e+00+1.0e+00i 5.0e-01+1.00000000000000005551e-01i) 6.0431891044739184057e-1+6.0431891044739184057e-1i) (num-test (expt 0.0e+00+1.0e+00i 5.0e-01-1.00000000000000005551e-01i) 8.2737771622906514822e-1+8.2737771622906514822e-1i) (num-test (expt 0.0e+00-1.0e+00i -1.0e+00+0.0e+00i) 0+1i) (num-test (expt 0.0e+00-1.0e+00i 0.0e+00+0.0e+00i) 1e0+0.0i) (num-test (expt 0.0e+00-1.0e+00i 0.0e+00+1.0e+00i) 4.8104773809653516555e0+0.0i) (num-test (expt 0.0e+00-1.0e+00i 0.0e+00-1.0e+00i) 2.0787957635076190855e-1+0.0i) (num-test (expt 0.0e+00-1.0e+00i 1.0e+00+0.0e+00i) 0-1i) (num-test (expt 0.0e+00-1.0e+00i 5.0e-01+1.00000000000000005551e-01i) 8.2737771622906514822e-1-8.2737771622906514822e-1i) (num-test (expt 0.0e+00-1.0e+00i 5.0e-01-1.00000000000000005551e-01i) 6.0431891044739184057e-1-6.0431891044739184057e-1i) (num-test (expt 0/10 10/1234) 0.0) (num-test (expt 0/11 000) 1) (num-test (expt 0/1234 1234/10) 0.0) (num-test (expt 0/2 2/500029) 0.0) (num-test (expt 0/3 3/1234000000) 0.0) (num-test (expt 0/500029 500029/2) 0.0) (num-test (expt -0.0 most-positive-fixnum) 0.0) (num-test (expt 0 most-positive-fixnum) 0) (test (expt 0 (- (expt 2 32))) 'error) (test (expt 0 (- (expt 2.0 60))) 'error) (test (expt 0 (complex (- (expt 2 60)) 1.0)) 'error) (test (expt 0 -255) 'error) (test (expt 0 -1) 'error) (test (expt 0 -1.0) 'error) (test (expt 0 -1/2) 'error) (num-test (expt 0 1/2) 0) ; or 0.0 (num-test (expt 0 -0+i) 0.0) (num-test (expt 0 -0-i) 0.0) (test (expt 0 -1+i) 'error) (test (expt 0 most-negative-fixnum) 'error) (test (expt 0.0 most-negative-fixnum) 'error) (test (expt 0.0 -255) 'error) (test (expt 0.0 -1) 'error) (test (expt 0.0 -1.0) 'error) (test (expt 0.0 -1/2) 'error) (num-test (expt 0.0 1/2) 0.0) (num-test (expt 0.0 -0+i) 0.0) (num-test (expt 0.0 -0-i) 0.0) (test (expt 0.0 -1+i) 'error) (num-test (expt 1 1/2) 1) (num-test (expt 1 (- (expt 2 32))) 1) (num-test (expt 1 (expt 2 32)) 1) (num-test (expt 1 (real-part (log 0))) (expt 1.0 (real-part (log 0)))) (num-test (expt 1 -0) 1) (num-test (expt 1 -0.0) 1.0) (num-test (expt 1 -0.00000001) 1.0) (num-test (expt 1 -1) 1) (num-test (expt 1 -1.0) 1.0) (num-test (expt 1 -10) 1) (num-test (expt 1 -100) 1) (num-test (expt 1 -1000) 1) (num-test (expt 1 -1001) 1) (num-test (expt 1 -101) 1) (num-test (expt 1 -1234) 1) (num-test (expt 1 -1234.0) 1.0) (num-test (expt 1 -1234000000) 1) (num-test (expt 1 -1234000000.0) 1.0) (num-test (expt 1 -1e-15) 1) (num-test (expt 1 -2) 1) (num-test (expt 1 -3) 1) (num-test (expt 1 -3.14159265358979) 1.0) (num-test (expt 1 -500029) 1) (num-test (expt 1 0) 1) (num-test (expt 1 0+i) 1) (num-test (expt 1 0-i) 1) (num-test (expt 1 0.0) 1.0) (num-test (expt 1 0.00000001) 1.0) (num-test (expt 1 1) 1) (num-test (expt 1 1+i) 1) (num-test (expt 1 1.0) 1.0) (num-test (expt 1 1/10) 1) (num-test (expt 1 10) 1) (num-test (expt 1 100) 1) (num-test (expt 1 1000) 1) (num-test (expt 1 1001) 1) (num-test (expt 1 101) 1) (num-test (expt 1 1234) 1) (num-test (expt 1 1234.0) 1.0) (num-test (expt 1 1234000000) 1) (num-test (expt 1 1234000000.0) 1.0) (num-test (expt 1 2) 1) (num-test (expt 1 3) 1) (num-test (expt 1 500029) 1) (num-test (expt 1 most-negative-fixnum) 1) (num-test (expt 1 pi) 1.0) (num-test (expt 1+i 1) 1+i) (num-test (expt 1+i 1.0) 1.0+i) (num-test (expt 1.0 -0.0) 1.0) (num-test (expt 1.0 -0.00000001) 1.0) (num-test (expt 1.0 -1) 1.0) (num-test (expt 1.0 -1.0) 1.0) (num-test (expt 1.0 -1/2) 1.0) (num-test (expt 1.0 -10) 1.0) (num-test (expt 1.0 -1234) 1.0) (num-test (expt 1.0 -1234.0) 1.0) (num-test (expt 1.0 -1234000000) 1.0) (num-test (expt 1.0 -1234000000.0) 1.0) (num-test (expt 1.0 -2) 1.0) (num-test (expt 1.0 -3) 1.0) (num-test (expt 1.0 -3.14159265358979) 1.0) (num-test (expt 1.0 -500029) 1.0) (num-test (expt 1.0 0) 1.0) (num-test (expt 1.0 0.0) 1.0) (num-test (expt 1.0 0.00000001) 1.0) (num-test (expt 1.0 1) 1.0) (num-test (expt 1.0 1.0) 1.0) (num-test (expt 1.0 1/2) 1.0) (num-test (expt 1.0 10) 1.0) (num-test (expt 1.0 1234) 1.0) (num-test (expt 1.0 1234.0) 1.0) (num-test (expt 1.0 1234000000) 1.0) (num-test (expt 1.0 1234000000.0) 1.0) (num-test (expt 1.0 2) 1.0) (num-test (expt 1.0 3) 1.0) (num-test (expt 1.0 500029) 1.0) (num-test (expt 1.0 pi) 1.0) (num-test (expt 1.0+0.00000001i 3.14159265358979+0.00000001i) 1.0+0.00000003141593i) (num-test (expt 1.0-0.00000001i -3.14159265358979+0.00000001i) 1.0+0.00000003141593i) (num-test (expt 1.0e+00+0.0e+00i -1.0e+00+0.0e+00i) 1e0+0.0i) (num-test (expt 1.0e+00+0.0e+00i 0.0e+00+1.0e+00i) 1e0+0.0i) (num-test (expt 1.0e+00+0.0e+00i 0.0e+00-1.0e+00i) 1e0+0.0i) (num-test (expt 1.0e+00+0.0e+00i 1.0e+00+0.0e+00i) 1e0+0.0i) (num-test (expt 1.0e+00+0.0e+00i 5.0e-01+1.00000000000000005551e-01i) 1e0+0.0i) (num-test (expt 1.0e+00+0.0e+00i 5.0e-01-1.00000000000000005551e-01i) 1e0+0.0i) (num-test (expt 1/1234000000 500029/10) 0.0) (num-test (expt 1/2 (- (real-part (log 0)))) (expt 0.5 (- (real-part (log 0))))) (num-test (expt 1/2 -10) 1024) (num-test (expt 1/2 -3) 8) (num-test (expt 1/2 1/3) 7.937005259840997373758528196361541301963E-1) (num-test (expt 1/2 10) 1/1024) (num-test (expt 1/2 3) 1/8) (num-test (expt 1/3 10/500029) 0.99997802926990) (num-test (expt 1/4 -2) 16) (num-test (expt 1/4 1/2) 1/2) (num-test (expt 1/4 1/3) 6.299605249474365823836053036391141752849E-1) (num-test (expt 1/64 -1/2) 8) (num-test (expt 1/64 -1/3) 4) (num-test (expt 1/64 -2/3) 16) (num-test (expt 1/64 -3/2) 512) (num-test (expt 1/64 1/2) 1/8) (num-test (expt 1/64 1/3) 1/4) (num-test (expt 1/64 2/3) 1/16) (num-test (expt 1/64 3/2) 1/512) (num-test (expt 1/9223372036854775807 -1) 9223372036854775807) (num-test (expt 1/9223372036854775807 1) 1/9223372036854775807) (num-test (expt 9223372036854775807 -1) 1/9223372036854775807) (num-test (expt 10 -0.0) 1.0) (num-test (expt 10 -0.00000001) 0.99999997697415) (num-test (expt 10 -1) 1/10) (num-test (expt 10 -1.0) 0.1) (num-test (expt 10 -10) 1/10000000000) (num-test (expt 10 -2) 1/100) (num-test (expt 10 -3) 1/1000) (num-test (expt 10 -3.14159265358979) 0.00072178415907) (num-test (expt 10 0) 1) (num-test (expt 10 0.0) 1.0) (num-test (expt 10 0.00000001) 1.00000002302585) (num-test (expt 10 1) 10) (num-test (expt 10 1.0) 10.0) (num-test (expt 10 10) 10000000000) (num-test (expt 10 2) 100) (num-test (expt 10 3) 1000) (num-test (expt 10 pi) 1385.45573136701182) (num-test (expt 10/1234000000 1/500029) 0.99996274097186) (num-test (expt 10/500029 2/1234000000) 0.99999998246380) (num-test (expt 10000000000 1/10) 10) (num-test (expt 1024 1/10) 2) (num-test (expt 1048576 1/10) 4) (num-test (expt 1073741824 1/10) 8) (num-test (expt 11 10) 25937424601) (num-test (expt 1234 -0.0) 1.0) (num-test (expt 1234 -0.00000001) 0.99999992881984) (num-test (expt 1234 -1) 1/1234) (num-test (expt 1234 -1.0) 0.00081037277147) (num-test (expt 1234 -2) 1/1522756) (num-test (expt 1234 -3) 1/1879080904) (num-test (expt 1234 -3.14159265358979) 0.00000000019424) (num-test (expt 1234 0) 1) (num-test (expt 1234 0.0) 1.0) (num-test (expt 1234 0.00000001) 1.00000007118016) (num-test (expt 1234 1) 1234) (num-test (expt 1234 1.0) 1234.00000000000045) (num-test (expt 1234 2) 1522756) (num-test (expt 1234.0 -0.0) 1.0) (num-test (expt 1234.0 -0.00000001) 0.99999992881984) (num-test (expt 1234.0 -1) 0.00081037277147) (num-test (expt 1234.0 -1.0) 0.00081037277147) (num-test (expt 1234.0 -2) 0.00000065670403) (num-test (expt 1234.0 -3) 0.00000000053218) (num-test (expt 1234.0 -3.14159265358979) 0.00000000019424) (num-test (expt 1234.0 0) 1.0) (num-test (expt 1234.0 0.0) 1.0) (num-test (expt 1234.0 0.00000001) 1.00000007118016) (num-test (expt 1234.0 1) 1234.00000000000045) (num-test (expt 1234.0 1.0) 1234.00000000000045) (num-test (expt 1234.0 2) 1522756.00000000093132) (num-test (expt 1234.0+1234.0i 3.14159265358979+0.0i) -11947544392.17545890808105+9547275530.50568199157715i) (num-test (expt 1234.0-1234.0i -3.14159265358979+0.0i) -5.108095859217296E-11+4.081876325659167E-11i) (num-test (expt 1234/10 0/1) 1) (num-test (expt 1234/500029 3/500029) 0.99996397630725) (num-test (expt 1234000000 -0.0) 1.0) (num-test (expt 1234000000 -0.00000001) 0.99999979066475) (num-test (expt 1234000000 -1) 1/1234000000) (num-test (expt 1234000000 -1.0) 0.00000000081037) (num-test (expt 1234000000 0) 1) (num-test (expt 1234000000 0.0) 1.0) (num-test (expt 1234000000 0.00000001) 1.00000020933529) (num-test (expt 1234000000.0 -0.0) 1.0) (num-test (expt 1234000000.0 -0.00000001) 0.99999979066475) (num-test (expt 1234000000.0 -1) 0.00000000081037) (num-test (expt 1234000000.0 -1.0) 0.00000000081037) (num-test (expt 1234000000.0 0) 1.0) (num-test (expt 1234000000.0 0.0) 1.0) (num-test (expt 1234000000.0 0.00000001) 1.00000020933529) (num-test (expt 1234000000/10 1/2) 11108.55526159905094) (num-test (expt 1234000000/3 0/3) 1) (num-test (expt 14879/18662 14879/18662) 8.347553395975456341642526041524525735791E-1) (num-test (expt 16 1/4) 2) (num-test (expt 1e-1 1e1) 1e-10) (num-test (expt 1e-1 1e2) 1e-100) (num-test (expt 1e-15 -1e-15) 1.000000000000034538776394911284329951335E0) (num-test (expt 1e-15 0+i) -0.999824358967590-0.018741697229594i) (num-test (expt 1e-15 0-i) -0.999824358967590+0.018741697229594i) (num-test (expt 1e-15 1e-15) 9.99999999999965461223605089908597123527E-1) (num-test (expt 1e-15 1e100) 0.0) (num-test (expt 1e15 -1e1) 1e-150) (num-test (expt 1e15 1e1) 1e150) (num-test (expt 1e18 -3) 1e-54) (if (not with-bignums) (num-test (expt 1e18 -63) 0.0)) ; 1e-1134 (num-test (expt 1+1i -63) 2.3283064365386962890625E-10+2.3283064365386962890625E-10i) (num-test (expt 1+1i -3) -0.25-0.25i) (num-test (expt 2 (real-part (log 0))) (expt 2.0 (real-part (log 0)))) (num-test (expt 2 -0.0) 1.0) (num-test (expt 2 -0.00000001) 0.99999999306853) (num-test (expt 2 -1) 1/2) (num-test (expt 2 -1.0) 0.50000000000000) (num-test (expt 2 -10) 1/1024) (num-test (expt 2 -2) 1/4) (num-test (expt 2 -3) 1/8) (num-test (expt 2 -3.14159265358979) 0.11331473229676) (num-test (expt 2 -9) 1/512) (num-test (expt 2 0) 1) (num-test (expt 2 0.0) 1.0) (num-test (expt 2 0.00000001) 1.00000000693147) (num-test (expt 2 1) 2) (num-test (expt 2 1+i) 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i) (num-test (expt 2 1.0) 2.0) (num-test (expt 2 1/3) 1.25992104989487316476721060727822835057E0) (num-test (expt 2 10) 1024) (num-test (expt 2 2) 4) (num-test (expt 2 3) 8) (num-test (expt 2 9) 512) (if (not with-bignums) (test (infinite? (expt 2 1000000000000)) #t)) (num-test (expt 2 pi) 8.82497782707629) (num-test (expt 2.0 -1.0220000e+03) 2.225073858507201383090232717332404063624E-308) (num-test (expt 2.0 1.0230000e+03) 8.98846567431157953864652595394512365232E307) (num-test (expt 2/1 3/1) 8) (num-test (expt 2/10 1234000000/500029) 0.0) (num-test (expt 2/1234 500029/1234000000) 0.99739996551176) (num-test (expt 2/3 -5) (/ 1 (* 2/3 2/3 2/3 2/3 2/3))) (num-test (expt 2/3 5) (* 2/3 2/3 2/3 2/3 2/3)) (num-test (expt 2/500029 0/10) 1) (num-test (expt 25 6) (+ (expt 1 6) (expt 2 6) (expt 3 6) (expt 5 6) (expt 6 6) (expt 7 6) (expt 8 6) (expt 9 6) (expt 10 6) (expt 12 6) (expt 13 6) (expt 15 6) (expt 16 6) (expt 17 6) (expt 18 6) (expt 23 6))) (num-test (expt 256 0) 1) (num-test (expt 256 1) 256) (num-test (expt 25937424601 1/10) 11) (num-test (expt 2718/1000 617/5) 3.858179469787681136058424024656091858698003418770850904916305853631035158956514884526199288e53) ; not an int! (num-test (expt 282475249 1/10) 7) (num-test (expt 29490/26049 29490/26049) 1.15080464191338725897675441635942490625E0) (num-test (expt 3 -0.0) 1.0) (num-test (expt 3 -0.00000001) 0.99999998901388) (num-test (expt 3 -1) 1/3) (num-test (expt 3 -1.0) 0.33333333333333) (num-test (expt 3 -10) 1/59049) (num-test (expt 3 -2) 1/9) (num-test (expt 3 -3) 1/27) (num-test (expt 3 -3.14159265358979) 0.03170146783514) (num-test (expt 3 0) 1) (num-test (expt 3 0.0) 1.0) (num-test (expt 3 0.00000001) 1.00000001098612) (num-test (expt 3 1) 3) (num-test (expt 3 1.0) 3.0) (num-test (expt 3 10) 59049) (num-test (expt 3 2) 9) (num-test (expt 3 3) 27) (num-test (expt 3 9) (* 3 3 3 3 3 3 3 3 3)) (num-test (expt 3 pi) 31.54428070019755) (num-test (expt 3.0 0) 1.0) (num-test (expt 3.0 0.0) 1.0) (num-test (expt 3.0 1) 3.0) (num-test (expt 3.0 1.0) 3.0) (num-test (expt 3.14159265358979 -0.0) 1.0) (num-test (expt 3.14159265358979 -0.00000001) 0.99999998855270) (num-test (expt 3.14159265358979 -1) 0.31830988618379) (num-test (expt 3.14159265358979 -1.0) 0.31830988618379) (num-test (expt 3.14159265358979 -10) 0.00001067827923) (num-test (expt 3.14159265358979 -2) 0.10132118364234) (num-test (expt 3.14159265358979 -3) 0.03225153443320) (num-test (expt 3.14159265358979 -3.14159265358979) 0.02742569312330) (num-test (expt 3.14159265358979 0) 1.0) (num-test (expt 3.14159265358979 0.0) 1.0) (num-test (expt 3.14159265358979 0.00000001) 1.00000001144730) (num-test (expt 3.14159265358979 1) pi) (num-test (expt 3.14159265358979 1.0) pi) (num-test (expt 3.14159265358979 10) 93648.04747608296748) (num-test (expt 3.14159265358979 2) 9.86960440108936) (num-test (expt 3.14159265358979 3) 31.00627668029983) (num-test (expt 3.14159265358979 pi) 36.46215960720790) (num-test (expt 3.14159265358979-3.14159265358979i -1234000000.0+0.0i) 0.0) (num-test (expt 3/1 10/2) 243) (num-test (expt 3/1234000000 0/1234000000) 1) (num-test (expt 3/4 0) 1) (num-test (expt 3/4 0.0) 1.0) (num-test (expt 3/4 1) 3/4) (num-test (expt 3/4 1.0) 0.75) (num-test (expt 3/500029 1/1234) 0.99030354920325) (num-test (expt 3486784401 1/10) 9) (num-test (expt 36836/40706 36836/40706) 9.135636805317119582757524254250295946631E-1) (num-test (expt 38246/41321 38246/41321) 9.309245639585393834533875308768247886091E-1) (num-test (expt 4 1/3) 1.587401051968199474751705639272308260393E0) (num-test (expt 4 10) 1048576) (num-test (expt 45692/25507 45692/25507) 2.841422098671431061341360858366953184273E0) (num-test (expt 46394/6866 46394/6866) 4.043224602803809364259118808807234861721E5) (num-test (expt 5 10) 9765625) (num-test (expt 5.0e-01+1.00000000000000005551e-01i -1.0e+00+0.0e+00i) 1.9230769230769230687e0-3.8461538461538463509e-1i) (num-test (expt 5.0e-01+1.00000000000000005551e-01i 0.0e+00+0.0e+00i) 1e0+0.0i) (num-test (expt 5.0e-01+1.00000000000000005551e-01i 0.0e+00+1.0e+00i) 6.4160554864378080418e-1-5.1201864456768275590e-1i) (num-test (expt 5.0e-01+1.00000000000000005551e-01i 0.0e+00-1.0e+00i) 9.5219021866126714108e-1+7.5987364224031834571e-1i) (num-test (expt 5.0e-01+1.00000000000000005551e-01i 1.0e+00+0.0e+00i) 5e-1+1.0000000000000000555e-1i) (num-test (expt 5.0e-01+1.00000000000000005551e-01i 5.0e-01+1.00000000000000005551e-01i) 6.9977300530987816719e-1+2.1940939105372143160e-2i) (num-test (expt 5.0e-01+1.00000000000000005551e-01i 5.0e-01-1.00000000000000005551e-01i) 7.1829191470060938876e-1+1.2038189555821612762e-1i) (num-test (expt 5.0e-01-1.00000000000000005551e-01i -1.0e+00+0.0e+00i) 1.9230769230769230687e0+3.8461538461538463509e-1i) (num-test (expt 5.0e-01-1.00000000000000005551e-01i 0.0e+00+0.0e+00i) 1e0+0.0i) (num-test (expt 5.0e-01-1.00000000000000005551e-01i 0.0e+00+1.0e+00i) 9.5219021866126714108e-1-7.5987364224031834571e-1i) (num-test (expt 5.0e-01-1.00000000000000005551e-01i 0.0e+00-1.0e+00i) 6.4160554864378080418e-1+5.1201864456768275590e-1i) (num-test (expt 5.0e-01-1.00000000000000005551e-01i 1.0e+00+0.0e+00i) 5e-1-1.0000000000000000555e-1i) (num-test (expt 5.0e-01-1.00000000000000005551e-01i 5.0e-01+1.00000000000000005551e-01i) 7.1829191470060938876e-1-1.2038189555821612762e-1i) (num-test (expt 5.0e-01-1.00000000000000005551e-01i 5.0e-01-1.00000000000000005551e-01i) 6.9977300530987816719e-1-2.1940939105372143160e-2i) (num-test (expt 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 9.999999999999958444410197170329529649165E-1) (num-test (expt 500029 -0.0) 1.0) (num-test (expt 500029 -0.00000001) 0.99999986877579) (num-test (expt 500029 -1) 1/500029) (num-test (expt 500029 -1.0) 0.00000199988401) (num-test (expt 500029 -2) 1/250029000841) (num-test (expt 500029 0) 1) (num-test (expt 500029 0.0) 1.0) (num-test (expt 500029 0.00000001) 1.00000013122422) (num-test (expt 500029 1) 500029) (num-test (expt 500029 1.0) 500029.00000000040745) (num-test (expt 500029/10 2/3) 1357.26128653075921) (num-test (expt 500029/1234 3/2) 8156.80442672750178) (if (not with-bignums) (num-test (expt 500029/1234000000 10/1) 0.0) (num-test (expt 500029/1234000000 10/1) 977129054104898258427314355689841897479681961836578300201/8187505353567209228244052427776000000000000000000000000000000000000000000000000000000000000)) (num-test (expt 500029/2 0/1234) 1) (num-test (expt 500029/3 1/10) 3.32803123591083) (num-test (expt 50664/22466 50664/22466) 6.258302816095884603297081160883745414829E0) (num-test (expt 512 1/9) 2) (num-test (expt 56052/41477 56052/41477) 1.502246288382607077882411462458143945519E0) (num-test (expt 58288/55799 58288/55799) 1.046641989822034585352255152505850793912E0) (num-test (expt 59049 1/10) 3) (num-test (expt 6 10) 60466176) (num-test (expt 60466176 1/10) 6) (num-test (expt 64 -1/2) 1/8) (num-test (expt 64 -1/3) 1/4) (num-test (expt 64 -1/6) 1/2) (num-test (expt 64 -2/3) 1/16) (num-test (expt 64 -3/2) 1/512) (num-test (expt 64 1/2) 8) (num-test (expt 64 1/3) 4) (num-test (expt 64 1/6) 2) (num-test (expt 64 2/3) 16) (num-test (expt 64 3/2) 512) (num-test (expt 64/81 1/2) 8/9) (num-test (expt 7 10) 282475249) (num-test (expt 747/28616 747/28616) 9.092208838715899745892490249764275628871E-1) (num-test (expt 8 1/3) 2) (num-test (expt 8 10) 1073741824) (num-test (expt 9 10) 3486784401) (num-test (expt 9765625 1/10) 5) (num-test (sqrt (- (expt 4 1/5) (expt 3 1/5))) (/ (+ (* (- (expt 2 3/5)) (expt 3 4/5)) (expt 3 3/5) (* 2 (expt 2 2/5) (expt 3 2/5)) (* (- (expt 2 4/5)) (expt 3 1/5)) (expt 2 1/5)) 5)) (num-test (sqrt (- (expt 4 2/3) (* (sqrt 3) (expt 5 1/6)))) (+ (/ (expt 5 1/3) (sqrt 6)) (- (/ (expt 5 5/6) (* 3 (sqrt 2)))) (/ (* (expt 2 1/6) (sqrt 5)) 3) (- (/ (* (expt 2 5/6) (expt 5 1/6)) 3)) (/ (expt 2 1/6) (sqrt 3)))) (num-test (sqrt (- (expt 5 1/3) (expt 4 1/3))) (/ (+ (expt 2 1/3) (expt 20 1/3) (- (expt 25 1/3))) 3)) (num-test (sqrt (- 127 (* 4 (sqrt 6) (expt 7 1/4)))) (+ (/ (* (sqrt 3) (expt 7 3/4)) (sqrt 2)) (* 2 (sqrt 7)) (/ (* 3 (sqrt 3) (expt 7 1/4)) (sqrt 2)) -6)) (num-test (sqrt (- 161 (* 12 (expt 5 1/4)))) (+ (* 2 (expt 5 3/4)) (- (* 3 (sqrt 5))) (* 4 (sqrt (sqrt 5))) 6)) (num-test (sqrt (- 2 (expt 2 1/7))) (/ (* (expt 2 1/14) (+ (- (expt 2 6/7)) (expt 2 5/7) (expt 2 3/7) (* 2 (expt 2 1/7)) -1)) (sqrt 7))) (test (= (+ (expt 2421 3) (expt 19083 3)) (+ (expt 5436 3) (expt 18948 3)) (+ (expt 10200 3) (expt 18072 3)) (+ (expt 13322 3) (expt 16630 3))) #t) ;;; amol sasane MAA Monthly (num-test (expt (sqrt 2) (log 3 2)) (sqrt 3)) (num-test (expt (expt 2 (sqrt 2)) 1/2) (expt (sqrt 2) (sqrt 2))) (num-test (expt (sqrt 2) (* 2 (log 3 2))) 3) (num-test (expt (sqrt 2) (+ (sqrt 2) 1)) (* (sqrt 2) (expt (sqrt 2) (sqrt 2)))) (num-test (expt (expt (sqrt 2) (sqrt 2)) (sqrt 2)) 2) (when with-bignums (num-test (expt 217288600195263/172462076265329 3) 10259136929659080970340082456456437407056447/5129568464829540485170041227870088110206289) ; 2.0+ (num-test (expt (bignum -inf.0) 1+i) +nan.0+nan.0i) (num-test (expt (bignum -inf.0) (bignum 1+i)) +nan.0+nan.0i)) (unless with-bignums (num-test (expt (+ 1 (/ 1000000)) 100) 1.0001000049501534764) (num-test (expt (+ 1 (/ 1000000000)) 100000000) 1.1051709271646142850) (num-test (expt (+ 1 (/ 1000000000)) 10000000000) 2.20264839094613347809362152246750859877E4) (test (infinite? (expt 3/4 most-negative-fixnum)) #t) (num-test (expt 4/3 most-negative-fixnum) 0) (num-test (expt 1.0 most-negative-fixnum) 1.0) (num-test (expt -1.0 most-negative-fixnum) 1.0) (num-test (expt 1.0 most-positive-fixnum) 1.0) (num-test (expt -1.0 most-positive-fixnum) -1.0) (num-test (expt -1.0 (+ (expt 2 53) 1)) -1.0) (num-test (expt -1.0 (- 1 (expt 2 54))) -1.0) (num-test (expt -1.0 (expt 2 54)) 1.0) (num-test (expt 2.0 (- (expt 2 53))) 0.0) (num-test (expt 2 most-negative-fixnum) 0) (test (nan? (expt 1/0 0)) #t) (test (infinite? (expt 2 (expt 3 (expt 4 2)))) #t) ; bug-guile, gmp does this in about a second but the printout is enormous (test (nan? (expt (complex 0 1/0) 0)) #t) (test (nan? (expt (complex 1/0 1/0) 0)) #t) (test (nan? (expt (complex 1/0 0) 0)) #t) (num-test (expt most-negative-fixnum 8) 5.237424972633826992021103514924158643547E151) (num-test (expt most-negative-fixnum 2) 8.5070591730234615865843651857942052864E37) (num-test (expt most-negative-fixnum -1) -1.084202172485504434007452800869941711426E-19) (num-test (expt most-negative-fixnum -2) 1.175494350822287507968736537222245677819E-38)) (num-test (expt -1 most-negative-fixnum) 1) (num-test (expt 1 most-positive-fixnum) 1) (num-test (expt -1 most-positive-fixnum) -1) (num-test (expt most-positive-fixnum 1) most-positive-fixnum) (num-test (expt most-positive-fixnum -1) (/ most-positive-fixnum)) (num-test (expt most-negative-fixnum 1) most-negative-fixnum) (num-test (expt most-negative-fixnum 0) 1) (num-test (expt 1/9223372036854775807 9223372036854775807) 0.0) (test (infinite? (expt 1/9223372036854775807 -9223372036854775807)) #t) (test (infinite? (expt 9223372036854775807 9223372036854775807)) #t) (num-test (expt 0+i (+ 0 (expt 2 16))) 1.0) (num-test (expt 0+i (+ 1 (expt 2 16))) 0+i) (num-test (expt 0+i (+ 2 (expt 2 16))) -1.0) (num-test (expt 0+i (+ 3 (expt 2 16))) 0-i) (num-test (expt 0-i (+ 0 (expt 2 16))) 1.0) (num-test (expt 0-i (+ 1 (expt 2 16))) 0-i) (num-test (expt 0-i (+ 2 (expt 2 16))) -1.0) (num-test (expt 0-i (+ 3 (expt 2 16))) 0+i) (num-test (expt 0+i (+ 0 (expt 2 54))) 1.0) (num-test (expt 0+i (+ 1 (expt 2 54))) 0+i) (num-test (expt 0+i (+ 2 (expt 2 54))) -1.0) (num-test (expt 0+i (+ 3 (expt 2 54))) 0-i) (num-test (expt 0-i (+ 0 (expt 2 54))) 1.0) (num-test (expt 0-i (+ 1 (expt 2 54))) 0-i) (num-test (expt 0-i (+ 2 (expt 2 54))) -1.0) (num-test (expt 0-i (+ 3 (expt 2 54))) 0+i) (test (nan? (expt 0/0+0/0i 0+0/0i)) #t) (test (nan? (expt (bignum 0/0+0/0i) 0+0/0i)) #t) (let ((val1 (catch #t (lambda () (expt 0.0 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (expt 0.0 -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (let ((val1 (catch #t (lambda () (expt 2.0 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (expt 2.0 -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) ;; (test (expt 0 0-i) 0.0) ; sbcl and clisp say division by 0 here, guile says NaN ;; but (expt 0.0 1e-15-i) is 0.0?? ;; clisp says (expt 0 1+i) is 0, but (expt 0 0+i) is division by zero??) -- sbcl agrees #| (do ((i 30 (+ i 1))) ((= i 63)) (format #t "~D: (- ~A ~A) -> ~A~%" i (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100) (- (+ (expt 2.0 i) 500) (+ (expt 2.0 i) 100)))) 55: (- 3.6028797018964e+16 3.6028797018964e+16) -> 400.0 56: (- 7.2057594037928e+16 7.2057594037928e+16) -> 400.0 57: (- 1.4411518807586e+17 1.4411518807586e+17) -> 416.0 58: (- 2.8823037615171e+17 2.8823037615171e+17) -> 384.0 59: (- 5.7646075230342e+17 5.7646075230342e+17) -> 384.0 60: (- 1.1529215046068e+18 1.1529215046068e+18) -> 512.0 61: (- 2.3058430092137e+18 2.3058430092137e+18) -> 512.0 62: (- 4.6116860184274e+18 4.6116860184274e+18) -> 0.0 |# (test (< (abs (- (+ (complex 1.0 0.0) (make-polar 1.0 0.0) 1.0+0i (* -1.0 -1.0) (/ 1.0) (exp 0.0) (abs -1.0) (cos 0.0) (log (exp 1)) (magnitude 1.0+0i) (max 0.0 1.0) (min 1.0 2.0)) 12.0)) 1e-12) #t) (let ((xs (list 2 3 4 1/2 1/3 1/4 2.5 1+i 2.5+1.5i 2.5-.5i)) (ys (list 2 3 4 -2 -3 1/2 1/3 1/4 -1/2 -1/3 -1/4 2.5 -3.5 1+i -1+2i 2.5+1.5i 2.5-.5i))) (for-each (lambda (x) (for-each (lambda (y) (num-test (expt (expt x y) (/ y)) x) ;; (if (> (magnitude (- (expt (expt x y) (/ y)) x)) 1e-6) ;; (format #t ";(expt (expt ~A ~A) (/ ~A)) -> ~A (~A)~%" x y y (expt (expt x y) (/ y)) (magnitude (- (expt (expt x y) (/ y)) x)))) ) ys)) xs)) (when with-bignums ;; from Knuth IIp245(3rd) (let* ((f (lambda (x) (/ (- 1 (expt x 107)) (- 1 x)))) (g (lambda (y) (f (* (- 1/3 (* y y)) (+ 3 (* 3.45 y y)))))) (gx (lambda (y) (+ 107 (* -10491.35 y y) (* 659749.9625 y y y y) (* 30141386.26625 (expt y 6)))))) (do ((i 3 (+ i 1))) ((> i 10)) (let ((g1 (g (expt 10 (- i)))) (g2 (gx (expt 10 (- i))))) (let ((diff (abs (- g1 g2)))) (if (or (nan? diff) (> diff (expt 10 (- -7 i)))) (format #t ";g(1e-~D) -> ~A ~A, diff: ~A~%" i g1 g2 (abs (- g1 g2)))))))) (let ((p (lambda (x y) (+ (* 2 y y) (* 9 x x x x) (* -1 y y y y))))) (num-test (p 408855776 708158977) 1)) (let ((p (lambda (x y) (+ (* 2 y y) (* (- (* 3 x x) (* y y)) (+ (* 3 x x) (* y y))))))) (num-test (p 408855776 708158977) 1))) (let ((top-exp 60)) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (+ 2 (expt 2 i))) (val2 (- val1 1))) (if (not (> val1 val2)) (begin (set! happy #f) (display "(> ") (display val1) (display " ") (display val2) (display ") -> ") (display (> val1 val2)) (display "?") (newline))) (if (< val1 val2) (begin (set! happy #f) (display "(< ") (display val1) (display " ") (display val2) (display ") -> ") (display (< val1 val2)) (display "?") (newline)))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (> i top-exp))) (let* ((val1 (/ (expt 2 i) 3)) (val2 (/ (+ 1 (expt 2 i)) 3))) (if (> val1 val2) (begin (set! happy #f) (display "(> ") (display val1) (display " ") (display val2) (display ") -> ") (display (> val1 val2)) (display "?") (newline))) (if (not (> val2 val1)) (begin (set! happy #f) (display "(> ") (display val1) (display " ") (display val2) (display ") -> ") (display (> val2 val1)) (display "?") (newline))) (if (not (< val1 val2)) (begin (set! happy #f) (display "(< ") (display val1) (display " ") (display val2) (display ") -> ") (display (< val1 val2)) (display "?") (newline))) (if (< val2 val1) (begin (set! happy #f) (display "(< ") (display val1) (display " ") (display val2) (display ") -> ") (display (< val2 val1)) (display "?") (newline))) )))) (let* ((x (* #x1.6000022202b1076a (expt 2 -58))) (a (expt (- 1.01 x) (- 1.01 x))) (b (expt x (- 1.01 (expt x (- 1.01 x)))))) (num-test a 1.010100503341741589854787064753636627742E0) (num-test b 3.201463978607038931337314838029261023486E-18) (num-test x 4.770489999999999999978271189676737354422E-18) (num-test (+ a b -1.01) 1.005033417415841744668463594232356924E-4) (test (positive? (+ a b -1.01)) #t)) (do ((k 1 (+ k 1))) ((= k 12)) (num-test (+ (expt 11 k) (expt 24 k) (expt 65 k) (expt 90 k) (expt 129 k) (expt 173 k) (expt 212 k) (expt 237 k) (expt 278 k) (expt 291 k) (expt 302 k)) (+ (expt 3 k) (expt 5 k) (expt 30 k) (expt 57 k) (expt 104 k) (expt 116 k) (expt 186 k) (expt 198 k) (expt 245 k) (expt 272 k) (expt 297 k) (expt 299 k)))) (let ((top 0)) (let ((x-10 (lambda (n) (- (expt n 10) (* n n n n n n n n n n))))) (let ((happy #t) (lim (if with-bignums 100 74))) (do ((i 1 (+ i 1))) ((or (not happy) (= i lim))) ; stop around 63 bits (let ((val (x-10 i))) (if (not (= val 0)) (begin (set! top (- i 1)) (set! happy #f) (format #t "(expt ~D 10) = ~D, (* ~D ... 10x) = ~D, (x-10 ~D) = ~D~%" i (expt i 10) i (* i i i i i i i i i i) i (x-10 i)))))))) (if (> top 63) (num-test (+ (expt 1 10) (expt 2 10) (expt 4 10) (expt 5 10) (expt 6 10) (expt 8 10) (expt 12 10) (expt 15 10) (expt 16 10) (expt 17 10) (expt 20 10) (expt 21 10) (expt 25 10) (expt 26 10) (expt 27 10) (expt 28 10) (expt 30 10) (expt 36 10) (expt 37 10) (expt 38 10) (expt 40 10) (expt 51 10) (expt 62 10)) (expt 63 10)))) (do ((i 1 (+ i 1))) ((= i 10)) (let ((v (vector i (- i) (/ i) (/ i (+ i 1)) (- (/ i)) (/ (- i) (+ i 1)) (random (* i 10.0)) (sqrt i) (+ i (random (sqrt i))) (- (random (* i 2.0)) i) (complex i i) (complex (- i) (- i)) ))) (let ((len (length v))) (do ((k 0 (+ k 1))) ((= k len)) (do ((j 0 (+ j 1))) ((= j len)) (let ((val1 (catch #t (lambda () (expt (v k) (v j))) (lambda args 'error)))) ; (expt 0 -1) for example (if (number? val1) (let ((val2 (if (zero? (v k)) 0 (exp (* (v j) (log (v k)))))) (val3 (if (zero? (v k)) 0 (exp (* (v j) (+ (* 0+2i pi) (log (v k)))))))) (let ((diff (min (magnitude (- val1 val2)) (magnitude (- val1 val3))))) (if (> (/ diff (max (magnitude val1) 1)) 1e-12) (format #t ";(expt ~A ~A), ~A ~A ~A: ~A~%" (v k) (v j) val1 val2 val3 diff))))))))))) (if with-bignums (num-test (let ((dickey (lambda (x y) ; from Kawa (+ (* 1335/4 (expt y 6)) (* (expt x 2) (- (* 11 (expt x 2) (expt y 2)) (expt y 6) (* 121 (expt y 4)) 2)) (* 11/2 (expt y 8)) (/ x (* 2 y)))))) (dickey 77617 33096)) -54767/66192)) (let ((x-10 (lambda (n) (- (expt n 10) (* n n n n n n n n n n))))) (let ((happy #t) (lim (if with-bignums 100 74))) (do ((i 1 (+ i 2))) ((or (not happy) (> i lim))) ; stop around 63 bits (let ((val (x-10 (/ i 2)))) (unless (= val 0) (set! happy #f) (display "(expt ") (display i) (display "/2 10) = ") (display (expt (/ i 2) 10)) (display " but (* ") (display i) (display "/2 ... 10x) = ") (display (/ (* i i i i i i i i i i) 1024)) (newline)))))) (let ((x-10 (lambda (n) (- (expt n -10) (/ 1 (* n n n n n n n n n n)))))) (let ((happy #t) (lim (if with-bignums 100 74))) (do ((i 1 (+ i 2))) ((or (not happy) (> i lim))) ; stop around 63 bits (let ((val (x-10 (/ i 2)))) (unless (= val 0) (set! happy #f) (display "(expt ") (display i) (display "/2 -10) = ") (display (expt (/ i 2) -10)) (display " but (* 1/(") (display i) (display "/2) ... 10x) = ") (display (/ 1024 (* i i i i i i i i i i))) (display " [diff=") (display val) (display "]") (newline)))))) (let ((happy #t) (lim (if with-bignums 50 19))) (do ((i 1 (+ i 1))) ((or (not happy) (> i lim))) (let* ((val1 (expt 3 i)) (val2 (sqrt (* val1 val1)))) (unless (= val1 val2) (set! happy #f) (display "[3^i] (sqrt ") (display (* val1 val1)) (display " = ") (display val2) (display " but should be ") (display val1) (newline))))) (if (not with-bignums) (begin (num-test (* (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 4194300.0019569) (num-test (expt -2/10 1234000000/500029) 0.0) (num-test (expt -1/1234000000 500029/10) 0.0) (num-test (expt 3.14159265358979-1.0i -1234.0+0.00000001i) 0.0) (num-test (expt -3.14159265358979-1.0i -1234.0-0.00000001i) 0.0) (num-test (expt 1234000000.0-1234000000.0i -1234.0+0.0i) 0.0) (num-test (expt -1234000000.0-1234000000.0i -1234.0-0.0i) 0.0) ) (begin (num-test (* (/ (expt 2 31) (+ (expt 2 20) 1)) (/ (+ (expt 2 31) 1) (expt 2 20))) 4398046513152/1048577) (test (expt 1/2 9223372036854775807) 0.0) (num-test (expt (expt -4722366482869645213696/6561 1/2) 2) -4722366482869645213696/6561) (num-test (expt 324518553658426726783156020576256.0 1/3) 68719476736.0) (num-test (expt 4722366482869645213696 1/2) 68719476736) (num-test (expt 4722366482869645213696.0 1/2) 68719476736.0) (num-test (expt 4722366482869645213696/6561 -1/2) (/ 68719476736/81)) (num-test (* (/ (expt 2 61) (+ (expt 2 40) 1)) (/ (+ (expt 2 61) 1) (expt 2 40))) 4835703278458516700921856/1099511627777) (num-test (+ (- 512 (expt 2.0 62)) (- (expt 2.0 62) 513)) -1.0) (num-test (+ (/ (expt 2 61) (+ (expt 2 40) 1)) (/ (+ (expt 2 61) 1) (expt 2 40))) 5070602400915223450095538143233/1208925819615728686333952) (num-test (+ (expt 2 61) (expt 2 62) (expt 2 61)) (/ (expt 2 64) 2)) (num-test (* 2 (expt 2 62)) (expt 2 63)) (num-test (* 8 (expt 2 30) (expt 2 30)) 9223372036854775808) (num-test (- (+ (expt 2.0 62) 500) (+ (expt 2.0 62) 100)) 4.000E2) (num-test (- (+ (expt 2.0 62) 512) (+ (expt 2.0 62) 513)) -1.0) (num-test (- (/ (expt 2 61) (+ (expt 2 40) 1)) (/ (+ (expt 2 61) 1) (expt 2 40))) -2305844108725321729/1208925819615728686333952) (num-test (/ (/ (expt 2 61) (+ (expt 2 40) 1)) (/ (+ (expt 2 61) 1) (expt 2 40))) 2535301200456458802993406410752/2535301200458764647102131732481) (num-test (/ (expt (* 1.2345e-170 1.2345e-170) 1/100)) 2.501325312985302606641508258507698932691E3) (num-test (/ (log (expt 2 32)) (log 2)) 32.0) (num-test 1180591620717411303424/1180591620717411303425 (/ (expt 2 70) (+ (expt 2 70) 1))) (test (< (abs (- (expt (- (exp (* pi (sqrt (bignum "163")))) 744) 1/3) 6.4031999999999999999999999999939031735E5)) 1e-32) #t) (test (> (+ (expt 2.0 62) 500) (+ (expt 2.0 62) 100)) #t) (num-test (expt -2/10 1234000000/500029) 9.92209574402351949043519108941671096176E-1726-4.788930572030484370393069119625570107346E-1726i) (num-test (expt -1/1234000000 500029/10) -7.168156874677746632219778149112758764437E-454593+2.32907535423388290492582809530285175961E-454593i) (num-test (expt 3.14159265358979-1.0i -1234.0+0.00000001i) -4.480790643664505864348068449454625911766E-640-6.676876181099023202939008945839411012697E-641i) (num-test (expt -3.14159265358979-1.0i -1234.0-0.00000001i) -4.480790502896318391426668753233092987401E-640+6.676875971338774903151645323179283073828E-641i) (num-test (expt 1234000000.0-1234000000.0i -1234.0+0.0i) 0.0+3.815800046393940013006703716489144169017E-11405i) (num-test (expt -1234000000.0-1234000000.0i -1234.0-0.0i) 0.0-3.815800046393940013006703716489144169017E-11405i) (test (zero? (- (expt 2 1/3) 1.2599210498949)) #f) ; make sure it's not just libm's cbrt )) (when (and (not (provided? 'freebsd)) (not (provided? 'openbsd))) (for-each (lambda (data) (let ((num1 (car data)) (num2 (cadr data)) (val (caddr data))) (num-test-2 'expt num1 num2 (expt num1 num2) val))) (vector (list 0 0 1) (list 0 1 0) (list 0 2 0) (list 0 3 0) (list 0 1/2 0) (list 0 1/3 0) (list 0 0.0 0.0) (list 0 1.0 0.0) (list 0 2.0 0.0) (list 0 1.000000000000000000000000000000000000002E-309 0.0) (list 0 1e+16 0.0) (list 0 +inf.0 0.0) (list 0 0+1i 0.0) (list 0 0+2i 0.0) (list 0 0-1i 0.0) (list 0 1+1i 0.0) (list 0 1-1i 0.0) (list 0 0.1+0.1i 0.0) (list 0 1e+16+1e+16i 0.0) (list 0 1e-16+1e-16i 0.0) (list 1 0 1) (list 1 1 1) (list 1 2 1) (list 1 3 1) (list 1 -1 1) (list 1 -2 1) (list 1 -3 1) (list 1 1/2 1) (list 1 1/3 1.0) (list 1 -1/2 1.000E0) (list 1 -1/3 1.000E0) (list 1 0.0 1.000E0) (list 1 1.0 1.000E0) (list 1 2.0 1.000E0) (list 1 -2.0 1.000E0) (list 1 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1 1e+16 1.000E0) (list 1 +inf.0 1.000E0) (list 1 -inf.0 1.000E0) (list 1 0+1i 1.0) (list 1 0+2i 1.0) (list 1 0-1i 1.0) (list 1 1+1i 1.0) (list 1 1-1i 1.0) (list 1 -1+1i 1.0) (list 1 -1-1i 1.0) (list 1 0.1+0.1i 1.0) (list 1 1e+16+1e+16i 1.0) (list 1 1e-16+1e-16i 1.0) (list 2 0 1) (list 2 1 2) (list 2 2 4) (list 2 3 8) (list 2 -1 1/2) (list 2 -2 1/4) (list 2 -3 1/8) (list 2 1/2 1.4142135623731) (list 2 1/3 1.2599210498949) (list 2 -1/2 7.071067811865475244008443621048490392845E-1) (list 2 -1/3 7.937005259840997475556964875637659160371E-1) (list 2 0.0 1.000E0) (list 2 1.0 2.000E0) (list 2 2.0 4.000E0) (list 2 -2.0 2.500E-1) (list 2 1.000000000000000000000000000000000000002E-309 1.000E0) (list 2 -inf.0 0.0) (list 2 0+1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i) (list 2 0+2i 1.83456974743301676839941236809235104518E-1+9.830277404112437205861648503427281526099E-1i) (list 2 0-1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i) (list 2 1+1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i) (list 2 1-1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i) (list 2 -1+1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i) (list 2 -1-1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i) (list 2 0.1+0.1i 1.069199809265204517687304849996528484166E0+7.423020183379063973209835788737470580225E-2i) (list 2 1e-16+1e-16i 1.00000000000000006931471805599452949289E0+6.931471805599453429742233135802455373554E-17i) (list 3 0 1) (list 3 1 3) (list 3 2 9) (list 3 3 27) (list 3 -1 1/3) (list 3 -2 1/9) (list 3 -3 1/27) (list 3 1/2 1.7320508075689) (list 3 1/3 1.4422495703074) (list 3 -1/2 5.773502691896257645091487805019574556475E-1) (list 3 -1/3 6.933612743506347189382852083362015558497E-1) (list 3 0.0 1.000E0) (list 3 1.0 3.000E0) (list 3 2.0 9.000E0) (list 3 -2.0 1.111111111111111111111111111111111111113E-1) (list 3 1.000000000000000000000000000000000000002E-309 1.000E0) (list 3 -inf.0 0.0) (list 3 0+1i 4.548324228266097550275651435950424840878E-1+8.905770416677470590749273065651780951036E-1i) (list 3 0+2i -5.862549342913521629213761016900936427016E-1+8.101266271509919688171526765177844453941E-1i) (list 3 0-1i 4.548324228266097550275651435950424840878E-1-8.905770416677470590749273065651780951036E-1i) (list 3 1+1i 1.364497268479829265082695430785127452266E0+2.671731125003241177224781919695534285314E0i) (list 3 1-1i 1.364497268479829265082695430785127452266E0-2.671731125003241177224781919695534285314E0i) (list 3 -1+1i 1.516108076088699183425217145316808280297E-1+2.968590138892490196916424355217260317017E-1i) (list 3 -1-1i 1.516108076088699183425217145316808280297E-1-2.968590138892490196916424355217260317017E-1i) (list 3 0.1+0.1i 1.109394427306365911813022078881836880638E0+1.223721548273860448930668229757603279477E-1i) (list 3 1e-16+1e-16i 1.00000000000000010986122886681096684318E0+1.098612288668109789126712952843432012306E-16i) (list -1 0 1) (list -1 1 -1) (list -1 2 1) (list -1 3 -1) (list -1 -1 -1) (list -1 -2 1) (list -1 -3 -1) (list -1 1/2 0+1i) (list -1 1/3 -1.0) (list -1 -1/2 0.0-1.00E0i) (list -1 -1/3 5.000000000000000503430454055824822034062E-1-8.660254037844386176981523540143355578944E-1i) (list -1 0.0 1.000E0) (list -1 1.0 -1.00E0) (list -1 2.0 1.000E0) (list -1 -2.0 1.000E0) ;(list -1 1e+16 1.000E0) (list -1 0+1i 4.321391826377224977441773717172801127579E-2) (list -1 0+2i 1.86744273170798881443021293482703039342E-3) (list -1 0-1i 2.314069263277926900572908636794854738031E1) (list -1 1+1i -4.321391826377224977441773717172801127579E-2) (list -1 1-1i -2.314069263277926900572908636794854738031E1) (list -1 -1+1i -4.321391826377224977441773717172801127579E-2) (list -1 -1-1i -2.314069263277926900572908636794854738031E1) (list -1 0.1+0.1i 6.946542388413302284911578278489504217747E-1+2.257068442712257901873502529761755278285E-1i) (list -1 1e+16+1e+16i 0.0) (list -1 1e-16+1e-16i 9.999999999999996858407346410206827203587E-1+3.141592653589792185835963602803850622895E-16i) (list -2 0 1) (list -2 1 -2) (list -2 2 4) (list -2 3 -8) (list -2 -1 -1/2) (list -2 -2 1/4) (list -2 -3 -1/8) (list -2 1/2 0+1.4142135623731i) (list -2 1/3 -1.2599210498949) (list -2 -1/2 0.0-7.071067811865475244008443621048490392845E-1i) (list -2 -1/3 3.968502629920499137351498618341152884837E-1-6.873648184993012989383839761489500939792E-1i) (list -2 0.0 1.000E0) (list -2 1.0 -2.00E0) (list -2 2.0 4.000E0) (list -2 -2.0 2.500E-1) (list -2 -inf.0 0.0) (list -2 0+1i 3.324182700885665525901791766265082328307E-2+2.761202036833300995082465454051316449496E-2i) (list -2 0+2i 3.425953940655147934023229852954811989202E-4+1.835748008898304681163796172161682131024E-3i) (list -2 0-1i 1.780072097764048857359856955378859222048E1-1.478600649942216768260366593652156810413E1i) (list -2 1+1i -6.648365401771331051803583532530164656613E-2-5.522404073666601990164930908102632898992E-2i) (list -2 1-1i -3.560144195528097714719713910757718444095E1+2.957201299884433536520733187304313620826E1i) (list -2 -1+1i -1.662091350442832762950895883132541164153E-2-1.380601018416650497541232727025658224748E-2i) (list -2 -1-1i -8.900360488820244286799284776894296110238E0+7.393003249711083841301832968260784052065E0i) (list -2 0.1+0.1i 7.259699150688950609812198701314241029302E-1+2.928900391985359860022641767906842987898E-1i) (list -2 1e+16+1e+16i 0.0) (list -2 1e-16+1e-16i 9.999999999999997551554526970151686615297E-1+3.834739834149737528810186916384012655492E-16i) (list -3 0 1) (list -3 1 -3) (list -3 2 9) (list -3 3 -27) (list -3 -1 -1/3) (list -3 -2 1/9) (list -3 -3 -1/27) (list -3 1/2 0+1.7320508075689i) (list -3 1/3 -1.4422495703074) (list -3 -1/2 0.0-5.773502691896257645091487805019574556475E-1i) (list -3 -1/3 3.466806371753173943750607212746369268463E-1-6.004684775880013553913614575447052401843E-1i) (list -3 0.0 1.000E0) (list -3 1.0 -3.00E0) (list -3 2.0 9.000E0) (list -3 -2.0 1.111111111111111111111111111111111111113E-1) (list -3 -inf.0 0.0) (list -3 0+1i 1.965509114374261361108537566165204334024E-2+3.848532348622211453375207440262631065206E-2i) (list -3 0+2i -1.094797515970330168691448329739632503045E-3+1.512865081636227781901948390654863520171E-3i) (list -3 0-1i 1.052513729605287378161514526579733692066E1-2.060856958704319044776041543097331663996E1i) (list -3 1+1i -5.896527343122784083325612698495613002091E-2-1.15455970458666343601256223207878931956E-1i) (list -3 1-1i -3.157541188815862134484543579739201076193E1+6.182570876112957134328124629291994991979E1i) (list -3 -1+1i -6.551697047914204537028458553884014446755E-3-1.282844116207403817791735813420877021735E-2i) (list -3 -1-1i -3.508379098684291260538381755265778973549E0+6.869523195681063482586805143657772213312E0i) (list -3 0.1+0.1i 7.430253085825579186796890883432274992943E-1+3.354042513063949187690186935389269335405E-1i) (list -3 1e+16+1e+16i 0.0) (list -3 1e-16+1e-16i 9.999999999999997957019635078315805356955E-1+4.240204942257901974962676555647136289098E-16i) (list 1/2 0 1) (list 1/2 1 1/2) (list 1/2 2 1/4) (list 1/2 3 1/8) (list 1/2 -1 2) (list 1/2 -2 4) (list 1/2 -3 8) (list 1/2 1/2 0.70710678118655) (list 1/2 1/3 0.7937005259841) (list 1/2 -1/2 1.414213562373095048801688724209698078569E0) (list 1/2 -1/3 1.259921049894873148607716059938123324722E0) (list 1/2 0.0 1.000E0) (list 1/2 1.0 5.000E-1) (list 1/2 2.0 2.500E-1) (list 1/2 -2.0 4.000E0) (list 1/2 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1/2 1e+16 0.0) (list 1/2 +inf.0 0.0) (list 1/2 0+1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i) (list 1/2 0+2i 1.83456974743301676839941236809235104518E-1-9.830277404112437205861648503427281526099E-1i) (list 1/2 0-1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i) (list 1/2 1+1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i) (list 1/2 1-1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i) (list 1/2 -1+1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i) (list 1/2 -1-1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i) (list 1/2 0.1+0.1i 9.307924962319322751032548220951692988141E-1-6.462114401999142796156052473887795907618E-2i) (list 1/2 1e+16+1e+16i 0.0) (list 1/2 1e-16+1e-16i 9.999999999999999306852819440054705071071E-1-6.931471805599452468836205299399646209468E-17i) (list 1/3 0 1) (list 1/3 1 1/3) (list 1/3 2 1/9) (list 1/3 3 1/27) (list 1/3 -1 3) (list 1/3 -2 9) (list 1/3 -3 27) (list 1/3 1/2 0.57735026918963) (list 1/3 1/3 0.69336127435063) (list 1/3 -1/2 1.732050807568877341601513501094972563495E0) (list 1/3 -1/3 1.442249570307408379689974332217791378498E0) (list 1/3 0.0 1.000E0) (list 1/3 1.0 3.333333333333333148296162562473909929395E-1) (list 1/3 2.0 1.111111111111110987752997263871498932361E-1) (list 1/3 -2.0 9.000000000000000999200722162640969581442E0) (list 1/3 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1/3 1e+16 0.0) (list 1/3 +inf.0 0.0) (list 1/3 0+1i 4.548324228266097055906083004905301340071E-1-8.905770416677470843231987149725161148001E-1i) (list 1/3 0+2i -5.862549342913522528634995341851693014879E-1-8.101266271509919037297800414810374565267E-1i) (list 1/3 0-1i 4.548324228266097055906083004905301340071E-1+8.905770416677470843231987149725161148001E-1i) (list 1/3 1+1i 1.516108076088698934474456306943980624137E-1-2.968590138892490116287472906226681453643E-1i) (list 1/3 1-1i 1.516108076088698934474456306943980624137E-1+2.968590138892490116287472906226681453643E-1i) (list 1/3 -1+1i 1.364497268479829192516639126693602447003E0-2.671731125003241401280466674231091613441E0i) (list 1/3 -1-1i 1.364497268479829192516639126693602447003E0+2.671731125003241401280466674231091613441E0i) (list 1/3 0.1+0.1i 8.905570151840088631186184238937353595899E-1-9.823321468210062916108146236871209771647E-2i) (list 1/3 1e+16+1e+16i 0.0) (list 1/3 1e-16+1e-16i 9.999999999999998901387711331890276057033E-1-1.098612288668109603248072021584861739285E-16i) (list -1/2 0 1) (list -1/2 1 -1/2) (list -1/2 2 1/4) (list -1/2 3 -1/8) (list -1/2 -1 -2) (list -1/2 -2 4) (list -1/2 -3 -8) (list -1/2 1/2 0+0.70710678118655i) (list -1/2 1/3 -0.7937005259841) (list -1/2 -1/2 0.0-1.414213562373095048801688724209698078569E0i) (list -1/2 -1/3 6.299605249474366377321206522758126486977E-1-1.09112363597172135294521532465807648133E0i) (list -1/2 0.0 1.000E0) (list -1/2 1.0 -5.00E-1) (list -1/2 2.0 2.500E-1) (list -1/2 -2.0 4.000E0) (list -1/2 1e+16 0.0) (list -1/2 +inf.0 0.0) (list -1/2 0+1i 3.324182700885665525901791766265082328307E-2-2.761202036833300995082465454051316449496E-2i) (list -1/2 0+2i 3.425953940655147934023229852954811989202E-4-1.835748008898304681163796172161682131024E-3i) (list -1/2 0-1i 1.780072097764048857359856955378859222048E1+1.478600649942216768260366593652156810413E1i) (list -1/2 1+1i -1.662091350442832762950895883132541164153E-2+1.380601018416650497541232727025658224748E-2i) (list -1/2 1-1i -8.900360488820244286799284776894296110238E0-7.393003249711083841301832968260784052065E0i) (list -1/2 -1+1i -6.648365401771331051803583532530164656613E-2+5.522404073666601990164930908102632898992E-2i) (list -1/2 -1-1i -3.560144195528097714719713910757718444095E1-2.957201299884433536520733187304313620826E1i) (list -1/2 0.1+0.1i 6.611643874791633083240145101585573999158E-1+1.651968853835831321053883592233542783317E-1i) (list -1/2 1e+16+1e+16i 0.0) (list -1/2 1e-16+1e-16i 9.999999999999996165260165850261967791906E-1+2.448445473029846938952343072863939318955E-16i) (list -1/3 0 1) (list -1/3 1 -1/3) (list -1/3 2 1/9) (list -1/3 3 -1/27) (list -1/3 -1 -3) (list -1/3 -2 9) (list -1/3 -3 -27) (list -1/3 1/2 0+0.57735026918963i) (list -1/3 1/3 -0.69336127435063) (list -1/3 -1/2 0.0-1.732050807568877341601513501094972563495E0i) (list -1/3 -1/3 7.211247851537042624522227702765802634347E-1-1.249024766483406435214284662923064132397E0i) (list -1/3 0.0 1.000E0) (list -1/3 1.0 -3.333333333333333148296162562473909929395E-1) (list -1/3 2.0 1.111111111111110987752997263871498932361E-1) (list -1/3 -2.0 9.000000000000000999200722162640969581442E0) (list -1/3 1e+16 0.0) (list -1/3 +inf.0 0.0) (list -1/3 0+1i 1.965509114374261147472076343409745270744E-2-3.848532348622211562482881134707887874423E-2i) (list -1/3 0+2i -1.094797515970330336653213008135348071651E-3-1.512865081636227660355007437386042651667E-3i) (list -1/3 0-1i 1.052513729605287263760972225954207976974E1+2.060856958704319103202290360191646176391E1i) (list -1/3 1+1i -6.551697047914203461214675496548324731564E-3+1.282844116207403782948806637317477237465E-2i) (list -1/3 1-1i -3.508379098684290684449078029532994204954E0-6.869523195681063296005826865220406716345E0i) (list -1/3 -1+1i -5.896527343122783769739250113564997536121E-2+1.154559704586663532835802707239006768699E-1i) (list -1/3 -1-1i -3.15754118881586196656166312914556280733E1-6.182570876112957652808497982451530065146E1i) (list -1/3 0.1+0.1i 6.408011144159694212372342969009069525835E-1+1.327666945668531521695779387535105337549E-1i) (list -1/3 1e+16+1e+16i 0.0) (list -1/3 1e-16+1e-16i 9.999999999999995759795057742097793539085E-1+2.042980364921682582587891581219059394882E-16i) (list 0.0 0 0.0) (list 0.0 1 0.0) (list 0.0 2 0.0) (list 0.0 3 0.0) (list 0.0 1/2 0.0) (list 0.0 1/3 0.0) (list 0.0 0.0 0.0) (list 0.0 1.0 0.0) (list 0.0 2.0 0.0) (list 0.0 1.000000000000000000000000000000000000002E-309 0.0) (list 0.0 1e+16 0.0) (list 0.0 +inf.0 0.0) (list 0.0 0+1i 0.0) (list 0.0 0+2i 0.0) (list 0.0 0-1i 0.0) (list 0.0 1+1i 0.0) (list 0.0 1-1i 0.0) (list 0.0 0.1+0.1i 0.0) (list 0.0 1e+16+1e+16i 0.0) (list 0.0 1e-16+1e-16i 0.0) (list 1.0 0 1.0) (list 1.0 1 1.0) (list 1.0 2 1.0) (list 1.0 3 1.0) (list 1.0 -1 1.0) (list 1.0 -2 1.0) (list 1.0 -3 1.0) (list 1.0 1/2 1.0) (list 1.0 1/3 1.0) (list 1.0 -1/2 1.000E0) (list 1.0 -1/3 1.000E0) (list 1.0 0.0 1.000E0) (list 1.0 1.0 1.000E0) (list 1.0 2.0 1.000E0) (list 1.0 -2.0 1.000E0) (list 1.0 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1.0 1e+16 1.000E0) (list 1.0 +inf.0 1.000E0) (list 1.0 -inf.0 1.000E0) (list 1.0 0+1i 1) (list 1.0 0+2i 1) (list 1.0 0-1i 1) (list 1.0 1+1i 1) (list 1.0 1-1i 1) (list 1.0 -1+1i 1) (list 1.0 -1-1i 1) (list 1.0 0.1+0.1i 1) (list 1.0 1e+16+1e+16i 1) (list 1.0 1e-16+1e-16i 1) (list 2.0 0 1.0) (list 2.0 1 2.0) (list 2.0 2 4.000E0) (list 2.0 3 8.000E0) (list 2.0 -1 5.000E-1) (list 2.0 -2 2.500E-1) (list 2.0 -3 1.250E-1) (list 2.0 1/2 1.4142135623731) (list 2.0 1/3 1.2599210498949) (list 2.0 -1/2 7.071067811865475244008443621048490392845E-1) (list 2.0 -1/3 7.937005259840997475556964875637659160371E-1) (list 2.0 0.0 1.000E0) (list 2.0 1.0 2.000E0) (list 2.0 2.0 4.000E0) (list 2.0 -2.0 2.500E-1) (list 2.0 1.000000000000000000000000000000000000002E-309 1.000E0) (list 2.0 -inf.0 0.0) (list 2.0 0+1i 7.692389013639721265783299936612707014395E-1+6.389612763136348011500329114647017842567E-1i) (list 2.0 0+2i 1.83456974743301676839941236809235104518E-1+9.830277404112437205861648503427281526099E-1i) (list 2.0 0-1i 7.692389013639721265783299936612707014395E-1-6.389612763136348011500329114647017842567E-1i) (list 2.0 1+1i 1.538477802727944253156659987322541402879E0+1.277922552627269602300065822929403568513E0i) (list 2.0 1-1i 1.538477802727944253156659987322541402879E0-1.277922552627269602300065822929403568513E0i) (list 2.0 -1+1i 3.846194506819860632891649968306353507197E-1+3.194806381568174005750164557323508921283E-1i) (list 2.0 -1-1i 3.846194506819860632891649968306353507197E-1-3.194806381568174005750164557323508921283E-1i) (list 2.0 0.1+0.1i 1.069199809265204517687304849996528484166E0+7.423020183379063973209835788737470580225E-2i) (list 2.0 1e-16+1e-16i 1.00000000000000006931471805599452949289E0+6.931471805599453429742233135802455373554E-17i) (list -2.0 0 1.0) (list -2.0 1 -2.0) (list -2.0 2 4.000E0) (list -2.0 3 -8.00E0) (list -2.0 -1 -5.00E-1) (list -2.0 -2 2.500E-1) (list -2.0 -3 -1.25E-1) (list -2.0 1/2 0+1.4142135623731i) (list -2.0 1/3 -1.2599210498949) (list -2.0 -1/2 0.0-7.071067811865475244008443621048490392845E-1i) (list -2.0 -1/3 3.968502629920499137351498618341152884837E-1-6.873648184993012989383839761489500939792E-1i) (list -2.0 0.0 1.000E0) (list -2.0 1.0 -2.00E0) (list -2.0 2.0 4.000E0) (list -2.0 -2.0 2.500E-1) (list -2.0 -inf.0 0.0) (list -2.0 0+1i 3.324182700885665525901791766265082328307E-2+2.761202036833300995082465454051316449496E-2i) (list -2.0 0+2i 3.425953940655147934023229852954811989202E-4+1.835748008898304681163796172161682131024E-3i) (list -2.0 0-1i 1.780072097764048857359856955378859222048E1-1.478600649942216768260366593652156810413E1i) (list -2.0 1+1i -6.648365401771331051803583532530164656613E-2-5.522404073666601990164930908102632898992E-2i) (list -2.0 1-1i -3.560144195528097714719713910757718444095E1+2.957201299884433536520733187304313620826E1i) (list -2.0 -1+1i -1.662091350442832762950895883132541164153E-2-1.380601018416650497541232727025658224748E-2i) (list -2.0 -1-1i -8.900360488820244286799284776894296110238E0+7.393003249711083841301832968260784052065E0i) (list -2.0 0.1+0.1i 7.259699150688950609812198701314241029302E-1+2.928900391985359860022641767906842987898E-1i) (list -2.0 1e+16+1e+16i 0.0) (list -2.0 1e-16+1e-16i 9.999999999999997551554526970151686615297E-1+3.834739834149737528810186916384012655492E-16i) (list 1.000000000000000000000000000000000000002E-309 0 1.0) (list 1.000000000000000000000000000000000000002E-309 1 1.000000000000000000000000000000000000002E-309) (list 1.000000000000000000000000000000000000002E-309 2 1.000000000000000000000000000000000000006E-618) (list 1.000000000000000000000000000000000000002E-309 3 1.000000000000000000000000000000000000006E-927) (list 1.000000000000000000000000000000000000002E-309 1/2 3.162277660168379331998893544432718533725E-155) (list 1.000000000000000000000000000000000000002E-309 1/3 1.000000000000000000000000000000000000001E-103) (list 1.000000000000000000000000000000000000002E-309 -1/2 3.162277660168379331998893544432718533715E154) (list 1.000000000000000000000000000000000000002E-309 -1/3 9.999999999999868346276200367559315452517E102) (list 1.000000000000000000000000000000000000002E-309 0.0 1.000E0) (list 1.000000000000000000000000000000000000002E-309 1.0 1.000000000000000000000000000000000000002E-309) (list 1.000000000000000000000000000000000000002E-309 2.0 1.000000000000000000000000000000000000006E-618) (list 1.000000000000000000000000000000000000002E-309 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1.000000000000000000000000000000000000002E-309 1e+16 0.0) (list 1.000000000000000000000000000000000000002E-309 +inf.0 0.0) (list 1.000000000000000000000000000000000000002E-309 0+1i 7.188026041688456386956035152151008205727E-2-9.974132684912512522858369772702724490842E-1i) (list 1.000000000000000000000000000000000000002E-309 0+2i -9.896664563248017162886921042023427507381E-1-1.433886509648142863446390724753118562651E-1i) (list 1.000000000000000000000000000000000000002E-309 0-1i 7.188026041688456386956035152151008205727E-2+9.974132684912512522858369772702724490842E-1i) (list 1.000000000000000000000000000000000000002E-309 1+1i 7.188026041688456386956035152151008205733E-311-9.974132684912512522858369772702724490883E-310i) (list 1.000000000000000000000000000000000000002E-309 1-1i 7.188026041688456386956035152151008205733E-311+9.974132684912512522858369772702724490883E-310i) (list 1.000000000000000000000000000000000000002E-309 0.1+0.1i -5.63455610426506242496256141630861088283E-32-1.125793483521731083006048050604051624164E-31i) (list 1.000000000000000000000000000000000000002E-309 1e+16+1e+16i 0.0) (list 1.000000000000000000000000000000000000002E-309 1e-16+1e-16i 9.999999999999288501206264839898510340166E-1-7.114987937351094784363111696637191907549E-14i) (list 1e+16 0 1.0) (list 1e+16 1 1e+16) (list 1e+16 2 1.000E32) (list 1e+16 3 1.000E48) (list 1e+16 -1 1.000000000000000000000000000000000000001E-16) (list 1e+16 -2 9.999999999999999999999999999999999999998E-33) (list 1e+16 -3 9.999999999999999999999999999999999999991E-49) (list 1e+16 1/2 100000000.0) (list 1e+16 1/3 215443.46900319) (list 1e+16 -1/2 9.99999999999999999999999999999999999999E-9) (list 1e+16 -1/3 4.641588833612782056591069448235278756067E-6) (list 1e+16 0.0 1.000E0) (list 1e+16 1.0 1.000E16) (list 1e+16 2.0 1.000E32) (list 1e+16 -2.0 9.999999999999999999999999999999999999998E-33) (list 1e+16 1.000000000000000000000000000000000000002E-309 1.000E0) (list 1e+16 -inf.0 0.0) (list 1e+16 0+1i 6.541406923671771082966425998087477095845E-1-7.563728938753623529733450264648351927405E-1i) (list 1e+16 0+2i -1.441999091787803208994630162235380065937E-1-9.895485769747898065837021120946943010267E-1i) (list 1e+16 0-1i 6.541406923671771082966425998087477095845E-1+7.563728938753623529733450264648351927405E-1i) (list 1e+16 1+1i 6.541406923671771082966425998087477095832E15-7.563728938753623529733450264648351927387E15i) (list 1e+16 1-1i 6.541406923671771082966425998087477095832E15+7.563728938753623529733450264648351927387E15i) (list 1e+16 -1+1i 6.541406923671771082966425998087477095825E-17-7.563728938753623529733450264648351927399E-17i) (list 1e+16 -1-1i 6.541406923671771082966425998087477095825E-17+7.563728938753623529733450264648351927399E-17i) (list 1e+16 0.1+0.1i -3.409382666305111714726686098434812471081E1-2.055490637125206804018448749591854294103E1i) (list 1e+16 1e-16+1e-16i 1.000000000000003684136148790473017422188E0+3.684136148790486590281349632497736627823E-15i) (list +inf.0 0 1.0) (list +inf.0 -1 0.0) (list +inf.0 -2 0.0) (list +inf.0 -3 0.0) (list +inf.0 -1/2 0.0) (list +inf.0 -1/3 0.0) (list +inf.0 0.0 1.000E0) (list +inf.0 -2.0 0.0) (list +inf.0 -inf.0 0.0) (list +inf.0 -1+1i (if with-bignums +nan.0+nan.0i 0.0)) (list +inf.0 -1-1i (if with-bignums +nan.0+nan.0i 0.0)) (list -inf.0 0 1.0) (list -inf.0 -1 0.0) (list -inf.0 -2 0.0) (list -inf.0 -3 0.0) (list -inf.0 -1/2 0.0) (list -inf.0 -1/3 0.0) (list -inf.0 0.0 1.000E0) (list -inf.0 -2.0 0.0) (list -inf.0 -inf.0 0.0) (list -inf.0 -1+1i (if with-bignums +nan.0+nan.0i 0.0)) (list -inf.0 -1-1i (if with-bignums +nan.0+nan.0i 0.0)) (list 0+1i 0 1.0) (list 0+1i 1 0+1i) (list 0+1i 2 -1.00E0) (list 0+1i 3 0.0-1.00E0i) (list 0+1i -1 0.0-1.00E0i) (list 0+1i -2 -1.00E0) (list 0+1i -3 0.0+1.000E0i) (list 0+1i 1/2 0.70710678118655+0.70710678118655i) (list 0+1i 1/3 8.660254037844386612965085791222353988232E-1+4.999999999999999748284772972087582646907E-1i) (list 0+1i -1/2 7.071067811865475244008443621048490392845E-1-7.071067811865475244008443621048490392845E-1i) (list 0+1i -1/3 8.660254037844386612965085791222353988232E-1-4.999999999999999748284772972087582646907E-1i) (list 0+1i 0.0 1.000E0) (list 0+1i 1.0 0.0+1.000E0i) (list 0+1i 2.0 -1.00E0) (list 0+1i -2.0 -1.00E0) (list 0+1i 1.000000000000000000000000000000000000002E-309 1.000E0+1.570796326794896619231321691639751442098E-309i) ;(list 0+1i 1e+16 1.000E0) (list 0+1i 0+1i 2.078795763507619085469556198349787700342E-1) (list 0+1i 0+2i 4.321391826377224977441773717172801127579E-2) (list 0+1i 0-1i 4.810477380965351655473035666703833126401E0) (list 0+1i 1+1i 0.0+2.078795763507619085469556198349787700342E-1i) (list 0+1i 1-1i 0.0+4.810477380965351655473035666703833126401E0i) (list 0+1i -1+1i 0.0-2.078795763507619085469556198349787700342E-1i) (list 0+1i -1-1i 0.0-4.810477380965351655473035666703833126401E0i) (list 0+1i 0.1+0.1i 8.441140118165246481415723784169170682829E-1+1.336945253316592796595429310740609657101E-1i) (list 0+1i 1e+16+1e+16i 0.0) (list 0+1i 1e-16+1e-16i 9.999999999999998429203673205103413601794E-1+1.570796326794896339658091828635841709635E-16i) (list 0+2i 0 1.0) (list 0+2i 1 0+2i) (list 0+2i 2 -4.00E0) (list 0+2i 3 0.0-8.00E0i) (list 0+2i -1 0.0-5.00E-1i) (list 0+2i -2 -2.50E-1) (list 0+2i -3 0.0+1.250E-1i) (list 0+2i 1/2 1+1i) (list 0+2i 1/3 1.09112363597172140787570207348670009638E0+6.299605249474365425897267188156853709001E-1i) (list 0+2i -1/2 5.000E-1-5.00E-1i) (list 0+2i -1/3 6.873648184993013335424222440592397343418E-1-3.968502629920498537991974347557662898919E-1i) (list 0+2i 0.0 1.000E0) (list 0+2i 1.0 0.0+2.000E0i) (list 0+2i 2.0 -4.00E0) (list 0+2i -2.0 -2.50E-1) (list 0+2i 1.000000000000000000000000000000000000002E-309 1.000E0+1.570796326794896619231321691639751442098E-309i) (list 0+2i -inf.0 0.0) (list 0+2i 0+1i 1.599090569280680525199117755445296515815E-1+1.328269994246205222492823642245871455648E-1i) (list 0+2i 0+2i 7.927894711475968677072935966913922424434E-3+4.248048042515221109836149914964543748435E-2i) (list 0+2i 0-1i 3.700406335570025108741522919010577122043E0-3.073708767019492322385562434551223151799E0i) (list 0+2i 1+1i -2.656539988492410444985647284491742911296E-1+3.19818113856136105039823551089059303163E-1i) (list 0+2i 1-1i 6.147417534038984644771124869102446303599E0+7.400812671140050217483045838021154244087E0i) (list 0+2i -1+1i 6.641349971231026112464118211229357278239E-2-7.995452846403402625995588777226482579074E-2i) (list 0+2i -1-1i -1.5368543835097461611927812172756115759E0-1.850203167785012554370761459505288561022E0i) (list 0+2i 0.1+0.1i 8.926023688328728424160522546503419745435E-1+2.056049144522835172454080598405456305612E-1i) (list 0+2i 1e+16+1e+16i 0.0) (list 0+2i 1e-16+1e-16i 9.999999999999999122350853765048490772098E-1+2.263943507354841682632315142216062597333E-16i) (list 0-1i 0 1.0) (list 0-1i 1 0-1i) (list 0-1i 2 -1.00E0) (list 0-1i 3 0.0+1.000E0i) (list 0-1i -1 0.0+1.000E0i) (list 0-1i -2 -1.00E0) (list 0-1i -3 0.0-1.00E0i) (list 0-1i 1/2 0.70710678118655-0.70710678118655i) (list 0-1i 1/3 8.660254037844386612965085791222353988232E-1-4.999999999999999748284772972087582646907E-1i) (list 0-1i -1/2 7.071067811865475244008443621048490392845E-1+7.071067811865475244008443621048490392845E-1i) (list 0-1i -1/3 8.660254037844386612965085791222353988232E-1+4.999999999999999748284772972087582646907E-1i) (list 0-1i 0.0 1.000E0) (list 0-1i 1.0 0.0-1.00E0i) (list 0-1i 2.0 -1.00E0) (list 0-1i -2.0 -1.00E0) (list 0-1i 1.000000000000000000000000000000000000002E-309 1.000E0-1.570796326794896619231321691639751442098E-309i) ;(list 0-1i 1e+16 1.000E0) (list 0-1i 0+1i 4.810477380965351655473035666703833126401E0) (list 0-1i 0+2i 2.314069263277926900572908636794854738031E1) (list 0-1i 0-1i 2.078795763507619085469556198349787700342E-1) (list 0-1i 1+1i 0.0-4.810477380965351655473035666703833126401E0i) (list 0-1i 1-1i 0.0-2.078795763507619085469556198349787700342E-1i) (list 0-1i -1+1i 0.0+4.810477380965351655473035666703833126401E0i) (list 0-1i -1-1i 0.0+2.078795763507619085469556198349787700342E-1i) (list 0-1i 0.1+0.1i 1.15568305287131774105188044357174956096E0-1.830422135215751576397991439148491080012E-1i) (list 0-1i 1e-16+1e-16i 1.000000000000000157079632679489658639818E0-1.570796326794896833138311883103752021701E-16i) (list 1+1i 0 1.0) (list 1+1i 1 1+1i) (list 1+1i 2 0.0+2.000E0i) (list 1+1i 3 -2.00E0+2.000E0i) (list 1+1i -1 5.000E-1-5.00E-1i) (list 1+1i -2 0.0-5.00E-1i) (list 1+1i -3 -2.50E-1-2.50E-1i) (list 1+1i 1/2 1.0986841134678+0.45508986056223i) (list 1+1i 1/3 1.084215081491351179148689172984121435876E0+2.905145555072514268841073782856571173254E-1i) (list 1+1i -1/2 7.768869870150186536720794765315734740815E-1-3.217971264527913123677217187091049044625E-1i) (list 1+1i -1/3 8.605420804595790018414012402960957705697E-1-2.305815555121423995608566442452670487351E-1i) (list 1+1i 0.0 1.000E0) (list 1+1i 1.0 1.000E0+1.000E0i) (list 1+1i 2.0 0.0+2.000E0i) (list 1+1i -2.0 0.0-5.00E-1i) (list 1+1i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i) (list 1+1i -inf.0 0.0) (list 1+1i 0+1i 4.288290062943678493226520070973354996125E-1+1.548717524642467781923098896798325813036E-1i) (list 1+1i 0+2i 1.599090569280680525199117755445296515815E-1+1.328269994246205222492823642245871455648E-1i) (list 1+1i 0-1i 2.062872235080904951706990637170143171029E0-7.450070621797240878593548325920103204625E-1i) (list 1+1i 1+1i 2.739572538301210711303421174175029183081E-1+5.837007587586146275149618967771680809154E-1i) (list 1+1i 1-1i 2.807879297260629039566345469762153491497E0+1.317865172901180863847635804578132850572E0i) (list 1+1i -1+1i 2.918503793793073137574809483885840404577E-1-1.369786269150605355651710587087514591541E-1i) (list 1+1i -1-1i 6.589325864505904319238179022890664252861E-1-1.403939648630314519783172734881076745749E0i) (list 1+1i 0.1+0.1i 9.509412581367732262071184402582209392577E-1+1.08106001655210286400223506650660553711E-1i) (list 1+1i 1e+16+1e+16i 0.0) (list 1+1i 1e-16+1e-16i 9.99999999999999956117542688252429982572E-1+1.131971753677420890989859729961488955736E-16i) (list 1-1i 0 1.0) (list 1-1i 1 1-1i) (list 1-1i 2 0.0-2.00E0i) (list 1-1i 3 -2.00E0-2.00E0i) (list 1-1i -1 5.000E-1+5.000E-1i) (list 1-1i -2 0.0+5.000E-1i) (list 1-1i -3 -2.50E-1+2.500E-1i) (list 1-1i 1/2 1.0986841134678-0.45508986056223i) (list 1-1i 1/3 1.084215081491351179148689172984121435876E0-2.905145555072514268841073782856571173254E-1i) (list 1-1i -1/2 7.768869870150186536720794765315734740815E-1+3.217971264527913123677217187091049044625E-1i) (list 1-1i -1/3 8.605420804595790018414012402960957705697E-1+2.305815555121423995608566442452670487351E-1i) (list 1-1i 0.0 1.000E0) (list 1-1i 1.0 1.000E0-1.00E0i) (list 1-1i 2.0 0.0-2.00E0i) (list 1-1i -2.0 0.0+5.000E-1i) (list 1-1i 1.000000000000000000000000000000000000002E-309 1.000E0-7.853981633974483096156608458198757210488E-310i) (list 1-1i -inf.0 0.0) (list 1-1i 0+1i 2.062872235080904951706990637170143171029E0+7.450070621797240878593548325920103204625E-1i) (list 1-1i 0+2i 3.700406335570025108741522919010577122043E0+3.073708767019492322385562434551223151799E0i) (list 1-1i 0-1i 4.288290062943678493226520070973354996125E-1-1.548717524642467781923098896798325813036E-1i) (list 1-1i 1+1i 2.807879297260629039566345469762153491497E0-1.317865172901180863847635804578132850572E0i) (list 1-1i 1-1i 2.739572538301210711303421174175029183081E-1-5.837007587586146275149618967771680809154E-1i) (list 1-1i -1+1i 6.589325864505904319238179022890664252861E-1+1.403939648630314519783172734881076745749E0i) (list 1-1i -1-1i 2.918503793793073137574809483885840404577E-1+1.369786269150605355651710587087514591541E-1i) (list 1-1i 0.1+0.1i 1.118774658142734663065880800594211744947E0-4.912611879174141197780391086654035970153E-2i) (list 1-1i 1e-16+1e-16i 1.000000000000000113197175367742099510321E0-4.388245731174756954083421259082963337401E-17i) (list -1+1i 0 1.0) (list -1+1i 1 -1+1i) (list -1+1i 2 0.0-2.00E0i) (list -1+1i 3 2.000E0+2.000E0i) (list -1+1i -1 -5.00E-1-5.00E-1i) (list -1+1i -2 0.0+5.000E-1i) (list -1+1i -3 2.500E-1-2.50E-1i) (list -1+1i 1/2 0.45508986056223+1.0986841134678i) (list -1+1i 1/3 7.937005259840997668899692535826356354889E-1+7.937005259840996976818927177620594283082E-1i) (list -1+1i -1/2 3.217971264527913123677217187091049044625E-1-7.768869870150186536720794765315734740815E-1i) (list -1+1i -1/3 6.299605249474366138887223148884515164688E-1-6.299605249474365589582355660598282273075E-1i) (list -1+1i 0.0 1.000E0) (list -1+1i 1.0 -1.00E0+1.000E0i) (list -1+1i 2.0 0.0-2.00E0i) (list -1+1i -2.0 0.0+5.000E-1i) (list -1+1i 1.000000000000000000000000000000000000002E-309 1.000E0+2.35619449019234492884698253745962716315E-309i) (list -1+1i -inf.0 0.0) (list -1+1i 0+1i 8.914479215539140039333169785416699948907E-2+3.219467429096768688435430339284927790439E-2i) (list -1+1i 0+2i 6.910296915726436425237112293342453374671E-3+5.7399750963576748986151091014202337188E-3i) (list -1+1i 0-1i 9.923400226678132867281183645053121674554E0-3.583839621275010020102858511593195855531E0i) (list -1+1i 1+1i -1.213394664463590872776860012470162773935E-1+5.695011786442371350897739446131772158468E-2i) (list -1+1i 1-1i -6.339560605403122847178325133459925819034E0+1.350723984795314288738404215664631753007E1i) (list -1+1i -1+1i -2.847505893221185675448869723065886079234E-2-6.066973322317954363884300062350813869673E-2i) (list -1+1i -1-1i -6.753619923976571443692021078323158765037E0-3.169780302701561423589162566729962909517E0i) (list -1+1i 0.1+0.1i 7.882496598308880991233017323974702727041E-1+2.1838943088351018304792416348997040808E-1i) (list -1+1i 1e+16+1e+16i 0.0) (list -1+1i 1e-16+1e-16i 9.999999999999997990379100087627604548201E-1+2.702768080472316983907841531363385588262E-16i) (list -1-1i 0 1.0) (list -1-1i 1 -1-1i) (list -1-1i 2 0.0+2.000E0i) (list -1-1i 3 2.000E0-2.00E0i) (list -1-1i -1 -5.00E-1+5.000E-1i) (list -1-1i -2 0.0-5.00E-1i) (list -1-1i -3 2.500E-1+2.500E-1i) (list -1-1i 1/2 0.45508986056223-1.0986841134678i) (list -1-1i 1/3 7.937005259840997668899692535826356354889E-1-7.937005259840996976818927177620594283082E-1i) (list -1-1i -1/2 3.217971264527913123677217187091049044625E-1+7.768869870150186536720794765315734740815E-1i) (list -1-1i -1/3 6.299605249474366138887223148884515164688E-1+6.299605249474365589582355660598282273075E-1i) (list -1-1i 0.0 1.000E0) (list -1-1i 1.0 -1.00E0-1.00E0i) (list -1-1i 2.0 0.0+2.000E0i) (list -1-1i -2.0 0.0-5.00E-1i) (list -1-1i 1.000000000000000000000000000000000000002E-309 1.000E0-2.35619449019234492884698253745962716315E-309i) (list -1-1i -inf.0 0.0) (list -1-1i 0+1i 9.923400226678132867281183645053121674554E0+3.583839621275010020102858511593195855531E0i) (list -1-1i 0+2i 8.562996562781501151982322359385576132148E1+7.112774982027701655978420905114385775416E1i) (list -1-1i 0-1i 8.914479215539140039333169785416699948907E-2-3.219467429096768688435430339284927790439E-2i) (list -1-1i 1+1i -6.339560605403122847178325133459925819034E0-1.350723984795314288738404215664631753007E1i) (list -1-1i 1-1i -1.213394664463590872776860012470162773935E-1-5.695011786442371350897739446131772158468E-2i) (list -1-1i -1+1i -6.753619923976571443692021078323158765037E0+3.169780302701561423589162566729962909517E0i) (list -1-1i -1-1i -2.847505893221185675448869723065886079234E-2+6.066973322317954363884300062350813869673E-2i) (list -1-1i 0.1+0.1i 1.283956758872096257591990187677552600208E0-2.615572127992484175251616566885584992446E-1i) (list -1-1i 1e-16+1e-16i 1.000000000000000270276808047231769038073E0-2.009620899912372775286764036246047795846E-16i) (list 0.1+0.1i 0 1.0) (list 0.1+0.1i 1 0.1+0.1i) (list 0.1+0.1i 2 0.0+2.000000000000000222044604925031314247702E-2i) (list 0.1+0.1i 3 -2.000000000000000333066907387546980616012E-3+2.000000000000000333066907387546980616012E-3i) (list 0.1+0.1i -1 4.999999999999999722444243843710880301532E0-4.999999999999999722444243843710880301532E0i) (list 0.1+0.1i -2 0.0-4.999999999999999444888487687421776010503E1i) (list 0.1+0.1i -3 -2.499999999999999583666365765566343563457E2-2.499999999999999583666365765566343563457E2i) (list 0.1+0.1i 1/2 0.34743442276012+0.14391204994251i) (list 0.1+0.1i 1/3 5.032480615484825043523903544407412355396E-1+1.348449116844438143505188591437346924604E-1i) (list 0.1+0.1i -1/2 2.45673236351311521671469493547019420871E0-1.017611864088040968689409531603674348818E0i) (list 0.1+0.1i -1/3 1.853981710374325315321217484547221353494E0-4.967729020768720696346827580207236635648E-1i) (list 0.1+0.1i 0.0 1.000E0) (list 0.1+0.1i 1.0 1.000000000000000055511151231257827021182E-1+1.000000000000000055511151231257827021182E-1i) (list 0.1+0.1i 2.0 0.0+2.000000000000000222044604925031314247702E-2i) (list 0.1+0.1i -2.0 0.0-4.999999999999999444888487687421776010503E1i) (list 0.1+0.1i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i) (list 0.1+0.1i 1e+16 0.0) (list 0.1+0.1i +inf.0 (if with-bignums +nan.0+nan.0i 0.0)) (list 0.1+0.1i 0+1i -1.713226510357599956083331913106303247236E-1-4.22525887482460786856087271691853977193E-1i) (list 0.1+0.1i 0+2i -1.491766748349203175549260651566533449245E-1+1.447765103494648437770214174856742113327E-1i) (list 0.1+0.1i 0-1i -8.241437376545436347801862567004657850891E-1+2.032551224606688826869616254728598600103E0i) (list 0.1+0.1i 1+1i 2.512032364467008051923349285554493285946E-2-5.938485385182208154296364931488770060654E-2i) (list 0.1+0.1i 1-1i -2.856694962261232620228228583084710444815E-1+1.208407486952145259169520755212883935691E-1i) (list 0.1+0.1i -1+1i -2.969242692591103747496022164280467138525E0-1.256016182233503886515866161034993752114E0i) (list 0.1+0.1i -1-1i 6.042037434760725625046696204216927090118E0+1.428347481130616151535688219886713564214E1i) (list 0.1+0.1i 0.1+0.1i 7.550220306566742029451631510549876832316E-1-8.878982993466537268563019824356751882119E-2i) (list 0.1+0.1i 1e+16+1e+16i 0.0) (list 0.1+0.1i 1e-16+1e-16i 9.999999999999997258590333888479081137213E-1-1.170613339316624318801081266623392933101E-16i) (list 1e+16+1e+16i 0 1.0) (list 1e+16+1e+16i 1 1e+16+1e+16i) (list 1e+16+1e+16i 2 0.0+2.000E32i) (list 1e+16+1e+16i 3 -2.00E48+2.000E48i) (list 1e+16+1e+16i -1 5.000000000000000000000000000000000000004E-17-5.000000000000000000000000000000000000004E-17i) (list 1e+16+1e+16i -2 0.0-4.999999999999999999999999999999999999999E-33i) (list 1e+16+1e+16i -3 -2.499999999999999999999999999999999999998E-49-2.499999999999999999999999999999999999998E-49i) (list 1e+16+1e+16i 1/2 109868411.34678+45508986.056223i) (list 1e+16+1e+16i 1/3 2.335870583020711134947889498537726801442E5+6.258946363440152792122310286091229534238E4i) (list 1e+16+1e+16i -1/2 7.76886987015018653672079476531573474081E-9-3.217971264527913123677217187091049044617E-9i) (list 1e+16+1e+16i -1/3 3.994282511515094148675512812353991597295E-6-1.070264773302225997506194769200154785053E-6i) (list 1e+16+1e+16i 0.0 1.000E0) (list 1e+16+1e+16i 1.0 1.000E16+1.000E16i) (list 1e+16+1e+16i 2.0 0.0+2.000E32i) (list 1e+16+1e+16i -2.0 0.0-4.999999999999999999999999999999999999999E-33i) (list 1e+16+1e+16i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i) (list 1e+16+1e+16i -inf.0 0.0) (list 1e+16+1e+16i 0+1i 3.97655298675457451476815297378330384373E-1-2.23046721083486532799277949440696753733E-1i) (list 1e+16+1e+16i 0+2i 1.083798967785726369788640263558841648425E-1-1.773914209820705797251910148995630479122E-1i) (list 1e+16+1e+16i 0-1i 1.912911819699309232365644880468914363155E0+1.072961206670599579011330828139081101248E0i) (list 1e+16+1e+16i 1+1i 6.207020197589439842760932468190271381067E15+1.746085775919709186775373479376336306396E15i) (list 1e+16+1e+16i 1-1i 8.39950613028709653354314052329833261908E15+2.985873026369908811376975708607995464407E16i) (list 1e+16+1e+16i -1+1i 8.730428879598545933876867396881681532013E-18-3.103510098794719921380466234095135690525E-17i) (list 1e+16+1e+16i -1-1i 1.492936513184954405688487854303997732202E-16-4.19975306514354826677157026164916630953E-17i) (list 1e+16+1e+16i 0.1+0.1i -3.019911767946562559553699791129052056384E1-2.323225580723027414176687762549620584343E1i) (list 1e+16+1e+16i 1e-16+1e-16i 1.000000000000003640253691478724868702006E0+3.797333324158228934745194038802400084708E-15i) (list 1e-16+1e-16i 0 1.0) (list 1e-16+1e-16i 1 1e-16+1e-16i) (list 1e-16+1e-16i 2 0.0+1.999999999999999916391146896138415121169E-32i) (list 1e-16+1e-16i 3 -1.999999999999999874586720344207623992465E-48+1.999999999999999874586720344207623992465E-48i) (list 1e-16+1e-16i -1 5.000000000000000104511066379826984375319E15-5.000000000000000104511066379826984375319E15i) (list 1e-16+1e-16i -2 0.0-5.00000000000000020902213275965397093513E31i) (list 1e-16+1e-16i -3 -2.500000000000000156766599569740479839725E47-2.500000000000000156766599569740479839725E47i) (list 1e-16+1e-16i 1/2 1.0986841134678e-08+4.5508986056223e-09i) (list 1e-16+1e-16i 1/3 5.032480615484828131577934532998162284517E-6+1.348449116844438970946772378503363059943E-6i) (list 1e-16+1e-16i -1/2 7.768869870150186617914082234866133300043E7-3.217971264527913157308578030636299721171E7i) (list 1e-16+1e-16i -1/3 1.853981710374324177672385518009559821262E5-4.967729020768717648025969623769604859166E4i) (list 1e-16+1e-16i 0.0 1.000E0) (list 1e-16+1e-16i 1.0 9.999999999999999790977867240346035618411E-17+9.999999999999999790977867240346035618411E-17i) (list 1e-16+1e-16i 2.0 0.0+1.999999999999999916391146896138415121169E-32i) (list 1e-16+1e-16i -2.0 0.0-5.00000000000000020902213275965397093513E31i) (list 1e-16+1e-16i 1.000000000000000000000000000000000000002E-309 1.000E0+7.853981633974483096156608458198757210488E-310i) (list 1e-16+1e-16i 1e+16 0.0) (list 1e-16+1e-16i +inf.0 (if with-bignums +nan.0+nan.0i 0.0)) (list 1e-16+1e-16i 0+1i 1.633737074935952277071942452600366041402E-1+4.256625518536474393286932017574035701805E-1i) (list 1e-16+1e-16i 0+2i -1.544976397503562816275493845355474590488E-1+1.390841384750302156856253710476447606724E-1i) (list 1e-16+1e-16i 0-1i 7.859055245423894167511168257029299588438E-1-2.047640077615962126490396474363177248838E0i) (list 1e-16+1e-16i 1+1i -2.622888443600522061390815917770620324788E-17+5.890362593472426547237259268645081580369E-17i) (list 1e-16+1e-16i 1-1i 2.833545602158351484014138796578448096738E-16-1.26173455307357268336623492266154970137E-16i) (list 1e-16+1e-16i -1+1i 2.945181296736213396740244835851862239781E15+1.311444221800261085519581606088360070987E15i) (list 1e-16+1e-16i -1-1i -6.308672765367863680561621873294727149409E15-1.416772801079175801234443901776883778303E16i) (list 1e-16+1e-16i 0.1+0.1i -2.185846675892145203322615268234771243738E-2+1.000746379588156995072970612624735653063E-2i) (list 1e-16+1e-16i 1e+16+1e+16i 0.0) (list 1e-16+1e-16i 1e-16+1e-16i 9.999999999999962719813938977799891729155E-1-3.570938973422717612919117771011138615376E-15i) ))) ;; there's a difference here between gmp/non-gmp: ; (test (expt 0 (real-part (log 0))) (expt 0.0 (real-part (log 0)))) ; (num-test (expt 1.0 (/ (real-part (log 0)) (real-part (log 0)))) (expt 1 (/ (real-part (log 0)) (real-part (log 0))))) ; (num-test (expt 0.0 (/ (real-part (log 0)) (real-part (log 0)))) (expt 0 (/ (real-part (log 0)) (real-part (log 0))))) #| (let ((eps 1e-7)) (do ((i 0 (+ i 1))) ((= i 1000)) (let ((val (- (random 1000.0) 500.0))) (let ((rval (rationalize val)) (ival (floor val))) (let ((frval (exact->inexact rval)) (fival (exact->inexact ival))) (for-each (lambda (e) (if (> (magnitude (- (expt rval e) (expt frval e))) eps) (format #t "~A: ;(expt ~A e) != (expt ~A e) -> ~A~%" e rval frval (magnitude (- (expt rval e) (expt frval e))))) (if (> (magnitude (- (expt ival e) (expt fival e))) eps) (format #t "~A ;(expt ~A e) != (expt ~A e) -> ~A~%" e ival fival (magnitude (- (expt ival e) (expt fival e)))))) (list 0 0.0 (log 0) (real-part (log 0)) (- (real-part (log 0)))))))))) |# ;; table[(1/10^k)/(((1/10^k)^(1/10^k)) - 1), {k, 1, 30}] ;; the test came from calc_errors.txt from the web by "dave" (let ((expts (list -0.48621160938616180680870317336747983548142173621715706851490974881717 -0.22218561601345857583044966876729715619642038672598556073380084629504 -0.14526540294689938889864991134840220307566223888497162784858064408875 -0.10862362815109649171007844591526444220973735508130191198062253212652 -0.08686389647659141105044978528770239308857034812798554177686261943193 -0.07238291365169326382168151357331039782973682143307349669152489742891 -0.06204211884333512141082278643490234288550259196615819050849846987015 -0.05428681523790663196206398113420109019962541643547760927657854324749 -0.04825494293369464924373092184737925979664303236414611590980578553450 -0.04342944824032518278430110099994422226122739720915846151097610557365 -0.03948131654165925705940460838351885560840418164027583205682137097699 -0.03619120682577098563759637916147675090355043511246085981138602579761 -0.03340726783876167905008686486133377017608955166698061593202699553920 -0.03102103442166584483222349447696386196557178259759899539894506586562 -0.02895296546021728851007526126398523685253569082526692705926181546848 -0.02714340511895328922819555743231851877797306680518273360154914602559 -0.02554673422960305368536052464215356633451937057629542604571806752914 -0.02412747121684732425839605105092250802578858425793889081112350331353 -0.02285760431069746466321731152192658331511007129540571803806313398860 -0.02171472409516259138755644594583025411510361447234900258639235440074 -0.02068068961444056322198232947221928963307055360980162368063530687389 -0.01974065826832962852964676904166386737701808793240851850210059107980 -0.01888236877840225337614103995289587314323465286757518193028428290776 -0.01809560341263549281879753828819187842893320857975794377409033233328 -0.01737177927613007310604520675666420329177588023219463316734886061171 -0.01670363391935583952504342495833096470363065406937228989783888395986 -0.01608498081123154917226403453394833638127396317791358170357400676126 -0.01551051721083042241611174715416446722479989306441666312924319204483 -0.01497567178976730440176306617453810628601368985529884710795141610434 -0.01447648273010839425503763063105350274314656686012221887048754923492))) (let ((happy #t)) (do ((i 1 (+ i 1))) ((or (= i (length expts)) (not happy))) (catch #t (lambda () (let ((val (/ (expt .1 i) (- (expt (expt .1 i) (expt .1 i)) 1)))) (if (> (abs (- val (list-ref expts (- i 1)))) 1e-6) (begin (set! happy #f) (if (or with-bignums (< (abs (log (expt .1 i) 2)) 46)) (begin (display "expt error > 1e-6 around 2^") (display (log (expt .1 i) 2)) (newline))))))) (lambda args (display "expt not accurate below around 2^") (display (/ (log (expt .1 i)) (log 2))) (newline)))))) (test (expt) 'error) (test (expt 1) 'error) (test (expt 1.0+23.0i) 'error) (test (expt "hi" "hi") 'error) (test (expt 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error) (test (expt #t 0) 'error) (test (expt 0 -1/4) 'error) (test (expt 0.0 -0.1) 'error) (test (expt 0 -1.0) 'error) (test (expt 0 -1.0+i) 'error) (unless with-bignums (test (nan? (expt 0 0+0/0i)) #t) (test (nan? (expt 0 0-0/0i)) #t) (test (nan? (expt 0 0/0+i)) #t) (test (nan? (expt 0 +nan.0)) #t)) (for-each (lambda (arg) (test (expt arg +nan.0) 'error) (test (expt +nan.0 arg) 'error) (test (expt arg +inf.0) 'error) (test (expt +inf.0 arg) 'error) (test (expt arg 2) 'error) (test (expt 2 arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (when full-s7test (for-each (lambda (n) (let ((x 0.0)) (define (f1) (expt n 0+0/0i)) (define (f2) (expt n (bignum 0+0/0i))) (define (f3) (expt (bignum n) 0+0/0i)) (define (f4) (expt (bignum n) (bignum 0+0/0i))) (define (f5) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (expt n 0+0/0i)))) (define (f6) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (expt n (bignum 0+0/0i))))) (define (f7) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (expt (bignum n) 0+0/0i)))) (define (f8) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (expt (bignum n) (bignum 0+0/0i))))) (define (g1) (f1)) (define (g2) (f2)) (define (g3) (f3)) (define (g4) (f4)) (define (g5) (f5)) (define (g6) (f6)) (define (g7) (f7)) (define (g8) (f8)) (let ((val (expt n 0+0/0i))) (unless (nan? val) (format *stderr* "expt 1 ~S: ~S~%" n val))) (let ((val (expt n (bignum 0+0/0i)))) (unless (nan? val) (format *stderr* "expt 2 ~S: ~S~%" n val))) (let ((val (expt n 0+0/0i))) (unless (nan? val) (format *stderr* "expt 3 ~S: ~S~%" n val))) (let ((val (expt n (bignum 0+0/0i)))) (unless (nan? val) (format *stderr* "expt 4 ~S: ~S~%" n val))) (let ((val (f1))) (unless (nan? val) (format *stderr* "expt f1 ~S: ~S~%" n val))) (let ((val (f2))) (unless (nan? val) (format *stderr* "expt f2 ~S: ~S~%" n val))) (let ((val (f3))) (unless (nan? val) (format *stderr* "expt f3 ~S: ~S~%" n val))) (let ((val (f4))) (unless (nan? val) (format *stderr* "expt f4 ~S: ~S~%" n val))) (let ((val (f5))) (unless (nan? val) (format *stderr* "expt f5 ~S: ~S~%" n val))) (let ((val (f6))) (unless (nan? val) (format *stderr* "expt f6 ~S: ~S~%" n val))) (let ((val (f7))) (unless (nan? val) (format *stderr* "expt f7 ~S: ~S~%" n val))) (let ((val (f8))) (unless (nan? val) (format *stderr* "expt f8 ~S: ~S~%" n val))) (let ((val (g1))) (unless (nan? val) (format *stderr* "expt g1 ~S: ~S~%" n val))) (let ((val (g2))) (unless (nan? val) (format *stderr* "expt g2 ~S: ~S~%" n val))) (let ((val (g3))) (unless (nan? val) (format *stderr* "expt g3 ~S: ~S~%" n val))) (let ((val (g4))) (unless (nan? val) (format *stderr* "expt g4 ~S: ~S~%" n val))) (let ((val (g5))) (unless (nan? val) (format *stderr* "expt g5 ~S: ~S~%" n val))) (let ((val (g6))) (unless (nan? val) (format *stderr* "expt g6 ~S: ~S~%" n val))) (let ((val (g7))) (unless (nan? val) (format *stderr* "expt g7 ~S: ~S~%" n val))) (let ((val (g8))) (unless (nan? val) (format *stderr* "expt g8 ~S: ~S~%" n val))))) (list -1 2 2/3 2.0 1+i +nan.0 +inf.0 +nan.0+i +inf.0+i 0+nan.0i 0+inf.0i +inf.0+nan.0i +inf.0+inf.0i +nan.0+nan.0i +nan.0+inf.0i)) (for-each (lambda (n) (let ((x 0.0)) (define (f1) (log n 0+0/0i)) (define (f2) (log n (bignum 0+0/0i))) (define (f3) (log (bignum n) 0+0/0i)) (define (f4) (log (bignum n) (bignum 0+0/0i))) (define (f5) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (log n 0+0/0i)))) (define (f6) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (log n (bignum 0+0/0i))))) (define (f7) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (log (bignum n) 0+0/0i)))) (define (f8) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (log (bignum n) (bignum 0+0/0i))))) (define (g1) (f1)) (define (g2) (f2)) (define (g3) (f3)) (define (g4) (f4)) (define (g5) (f5)) (define (g6) (f6)) (define (g7) (f7)) (define (g8) (f8)) (let ((val (log n 0+0/0i))) (unless (nan? val) (format *stderr* "log 1 ~S: ~S~%" n val))) (let ((val (log n (bignum 0+0/0i)))) (unless (nan? val) (format *stderr* "log 2 ~S: ~S~%" n val))) (let ((val (log n 0+0/0i))) (unless (nan? val) (format *stderr* "log 3 ~S: ~S~%" n val))) (let ((val (log n (bignum 0+0/0i)))) (unless (nan? val) (format *stderr* "log 4 ~S: ~S~%" n val))) (let ((val (f1))) (unless (nan? val) (format *stderr* "log f1 ~S: ~S~%" n val))) (let ((val (f2))) (unless (nan? val) (format *stderr* "log f2 ~S: ~S~%" n val))) (let ((val (f3))) (unless (nan? val) (format *stderr* "log f3 ~S: ~S~%" n val))) (let ((val (f4))) (unless (nan? val) (format *stderr* "log f4 ~S: ~S~%" n val))) (let ((val (f5))) (unless (nan? val) (format *stderr* "log f5 ~S: ~S~%" n val))) (let ((val (f6))) (unless (nan? val) (format *stderr* "log f6 ~S: ~S~%" n val))) (let ((val (f7))) (unless (nan? val) (format *stderr* "log f7 ~S: ~S~%" n val))) (let ((val (f8))) (unless (nan? val) (format *stderr* "log f8 ~S: ~S~%" n val))) (let ((val (g1))) (unless (nan? val) (format *stderr* "log g1 ~S: ~S~%" n val))) (let ((val (g2))) (unless (nan? val) (format *stderr* "log g2 ~S: ~S~%" n val))) (let ((val (g3))) (unless (nan? val) (format *stderr* "log g3 ~S: ~S~%" n val))) (let ((val (g4))) (unless (nan? val) (format *stderr* "log g4 ~S: ~S~%" n val))) (let ((val (g5))) (unless (nan? val) (format *stderr* "log g5 ~S: ~S~%" n val))) (let ((val (g6))) (unless (nan? val) (format *stderr* "log g6 ~S: ~S~%" n val))) (let ((val (g7))) (unless (nan? val) (format *stderr* "log g7 ~S: ~S~%" n val))) (let ((val (g8))) (unless (nan? val) (format *stderr* "log g8 ~S: ~S~%" n val))))) (list -1 2 2/3 2.0 1+i +nan.0 +inf.0 +nan.0+i +inf.0+i 0+nan.0i 0+inf.0i +inf.0+nan.0i +inf.0+inf.0i +nan.0+nan.0i +nan.0+inf.0i))) (when with-bignums (test (+ (expt -80538738812075974 3) (expt 80435758145817515 3) (expt 12602123297335631 3)) 42)) ;;; -------------------------------------------------------------------------------- (let ((f= (lambda (a b) (< (abs (- a b)) 1.0e-15)))) (let ((log2 0.69314718055994530941723212145817656807550013436025525412068000949339362196969471560586332699641868754200148102057068573368552023575813055703267075163507596193072757082837143519030703862389167347112335011536449795523912047517268157493206515552473413952588295045300709532636664265410423915781495204374043038550080194417064167151864471283996817178454695702627163106454615025720740248163777338963855069526066834113727387372292895649354702576265209885969320196505855476470330679365443254763274495125040606943814710468994650622016772042452452961268794654619316517468139267250410380254625965686914419287160829380317271436778265487756648508567407764845146443994046142260319309673540257444607030809608504748663852313818167675143866747664789088143714198549423151997354880375165861275352916610007105355824987941472950929311389715599820565439287170007218085761025236889213244971389320378439353088774825970171559107088236836275898425891853530243634214367061189236789192372314672321720534016492568727477823445353476481149418642386776774406069562657379600867076257199184734022651462837904883062033061144630073719489002743643965002580936519443041191150608094879306786515887090060520346842973619384128965255653968602219412292420757432175748909770675268711581705113700915894266547859596489065305846025866838294002283300538207400567705304678700184162404418833232798386349001563121889560650553151272199398332030751408426091479001265168243443893572472788205486271552741877243002489794540196187233980860831664811490930667519339312890431641370681397776498176974868903887789991296503619270710889264105230924783917373501229842420499568935992206602204654941510613918788574424557751020683703086661948089641218680779020818158858000168811597305618667619918739520076671921459223672060253959543654165531129517598994005600036651356756905124592682574394648316833262490180382424082423145230614096380570070255138770268178516306902551370323405380214501901537402950994226299577964742713815736380172987394070424217997226696297993931270694) (log3 1.09861228866810969139524523692252570464749055782274945173469433363749429321860896687361575481373208878797002906595786574236800422593051982105280187076727741060316276918338136717937369884436095990374257031679591152114559191775067134705494016677558022220317025294689756069010652150564286813803631737329857778236699165479213181814902003010382363012224865274819822599109745249089645805346700884596508574844411901885708764749486707961308582941160216612118400140982551439194876889367984943022557315353296853452952514592138764946859325627944165569415782723103551688661021184698904399430631382552857364668828249881368228006341439107868932514564375102044516275619349739821169415857405353617589009751222337977369696877543547951357129821770175812421223514058101632724655889372495649191852429607966842346470693772372526550820320783339280558928531468730951326064583091843974968222303257654675333118230196492752575991322178513533902374829643395025460742458249346668661218814365265654295427676105054777954229339733234011737431939745798470185595484940594783539438410106029307622922281312074893063445340252777326856271480016818715472439782071878034446780216178158419042820076721243255738014364178876826161041016818724240687908909929874208152183237528942752732534071002835750695062403965462752244308462588450859786253083224774538885068003488324340490083990058080943565282122370388702036804548600776214244088697259413584365999226211739670804950952792714363154640444623089158185367119608370304853520909672629582415040355995121355450332241748474100331981487832452569334704949937301656336660991903957122822844881674312150628569993874038819012744839564791034772885972119850649422796985791669956418551265041502191554719665856929726606523573293736830027830921776605387030462007661584946700226011756797518003934791763277844935142634968360037557857160700498181519184373438290934746660457750659273670121115370582496479847930404205823964753857850960626093389914706120130243108260518262958640076003059494321166880446106134684533980)) (if (not (f= log3 (log 3.0))) (begin (display "(- (log 3.0) true-log-3) = ") (display (- log3 (log 3.0))) (newline))) (if (not (f= log2 (log 2.0))) (begin (display "(- (log 2.0) true-log-2) = ") (display (- log2 (log 2.0))) (newline))) (if (not (f= 3.0 (exp log3))) (begin (display "(- 3.0 (exp log3)) = ") (display (- 3.0 (exp log3))) (newline))) (if (not (f= 2.0 (exp log2))) (begin (display "(- 2.0 (exp log2)) = ") (display (- 2.0 (exp log2))) (newline)))) (let ((sin1 8.414709848078965066525023216302989996225630607983710656727517099919104043912396689486397435430526959e-1) (cos1 5.403023058681397174009366074429766037323104206179222276700972553811003947744717645179518560871830894e-1) (tan1 1.557407724654902230506974807458360173087250772381520038383946605698861397151727289555099965202242984e0)) (if (not (f= sin1 (sin 1))) (begin (display "(- (sin 1) true-sin-1) = ") (display (- sin1 (sin 1))) (newline))) (if (not (f= (asin sin1) 1.0)) (begin (display "(- (asin (sin 1)) 1) = ") (display (- (asin sin1) 1)) (newline))) (if (not (f= cos1 (cos 1))) (begin (display "(- (cos 1) true-cos-1) = ") (display (- cos1 (cos 1))) (newline))) (if (not (f= (acos cos1) 1.0)) (begin (display "(- (acos (cos 1)) 1) = ") (display (- (acos cos1) 1)) (newline))) (if (not (f= tan1 (tan 1))) (begin (display "(- (tan 1) true-tan-1) = ") (display (- tan1 (tan 1))) (newline))) (if (not (f= (atan tan1) 1.0)) (begin (display "(- (atan (tan 1)) 1) = ") (display (- (atan tan1) 1)) (newline))) (set! sin1 -.3056143888882523) (set! cos1 -.9521553682590148) (set! tan1 .3209711346238149) (if (not (f= sin1 (sin 10000))) (begin (display "(- (sin 10000) true-sin-10000) = ") (display (- sin1 (sin 10000))) (newline))) (if (not (f= cos1 (cos 10000))) (begin (display "(- (cos 10000) true-cos-10000) = ") (display (- cos1 (cos 10000))) (newline))) (if (not (f= tan1 (tan 10000))) (begin (display "(- (tan 10000) true-tan-10000) = ") (display (- tan1 (tan 10000))) (newline))) ) (let ((sinh1 1.175201193643801456882381850595600815155717981334095870229565413013307567304323895607117452089623392e0) (cosh1 1.543080634815243778477905620757061682601529112365863704737402214710769063049223698964264726435543036e0) (tanh1 7.615941559557648881194582826047935904127685972579365515968105001219532445766384834589475216736767144e-1)) (if (not (f= sinh1 (sinh 1))) (begin (display "(- (sinh 1) true-sinh-1) = ") (display (- sinh1 (sinh 1))) (newline))) (if (not (f= (asinh sinh1) 1.0)) (begin (display "(- (asinh (sinh 1)) 1) = ") (display (- (asinh sinh1) 1)) (newline))) (if (not (f= cosh1 (cosh 1))) (begin (display "(- (cosh 1) true-cosh-1) = ") (display (- cosh1 (cosh 1))) (newline))) (if (not (f= (acosh cosh1) 1.0)) (begin (display "(- (acosh (cosh 1)) 1) = ") (display (- (acosh cosh1) 1)) (newline))) (if (not (f= tanh1 (tanh 1))) (begin (display "(- (tanh 1) true-tanh-1) = ") (display (- tanh1 (tanh 1))) (newline))) (if (not (f= (atanh tanh1) 1.0)) (begin (display "(- (atanh (tanh 1)) 1) = ") (display (- (atanh tanh1) 1)) (newline))) )) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 512)) ; these checked against arprec (digits = 512) (num-test (sin (bignum "696898287454081973170944403677937368733396.0")) -0.01999904696709900707248379699203543861700131080741493395453090012397) (num-test (cos (bignum "696898287454081973170944403677937368733396.0")) -0.99979999906001588673892554498680272502063995303949755633430660411025) (num-test (tan (bignum "696898287454081973170944403677937368733396.0")) 0.02000304759542063815661565629241173304757896817099118262507840447691) (num-test (log (bignum "696898287454081973170944403677937368733396.0")) 96.34745809783239800899232787971326647885871562509641009125683617504293) (num-test (sqrt (bignum "696898287454081973170944403677937368733396.0")) 8.34804340821298061589146684184612401904558331041225568173326261228620e20)) ;; these can be checked against arprec -- get tables of the others as well ;; (num-test (sin 31415926535897932384626433832795028841.971693993751058209749445) 6.8290634690588564658126265428876656461078982456442870201741792E-24) ;; this test requires 500 bits of precision (num-test (sin 31415926535897932384626433832795028841) -8.2584214320186030736155068085595298665361290626210864656288000E-1) (num-test (sin 1.0) 0.84147098480789650665250232163029899962256306079837106567275170999191) ; if bignum here ;; (num-test (cos 31415926535897932384626433832795028841.971693993751058209749445) 9.9999999999999999999999999999999999999999999997668194606778265E-1) ;; 500 bits (num-test (cos 1.0) 5.4030230586813971740093660744297660373231042061792222767009714E-1)) ;;; -------------------------------------------------------------------------------- ;;; * ;;; -------------------------------------------------------------------------------- (num-test (* -0.0) 0.0) (num-test (* -0.0+0.00000001i) -0.0+0.00000001i) (num-test (* -1.0) -1.0) (num-test (* -1.0+1.0i -1.0+1.0i) 0.0-2.0i) (num-test (* -1.0+1.0i 0) 0.0) (num-test (* -1.0+1.0i 0.0) 0.0) (num-test (* -1.0+1.0i 0.0+1.0i) -1.0-1.0i) (num-test (* -1.0+1.0i 1) -1.0+1.0i) (num-test (* -1.0+1.0i 1.0) -1.0+1.0i) (num-test (* -1.0+1.0i 1.0+1.0i) -2.0) (num-test (* -1.0+1.0i 1/1) -1.0+1.0i) (num-test (* -1.0+1.0i 123.4) -123.4+123.4i) (num-test (* -1.0+1.0i 1234) -1234.0+1234.0i) (num-test (* -1.0+1.0i 1234/11) -112.18181818181819+112.18181818181819i) (num-test (* -1.0+1.0i) -1.0+1.0i) (num-test (* -10) -10) (num-test (* -10/3) -10/3) (num-test (* -2/2) -2/2) (num-test (* 0 0) 0) (num-test (* 0 0.0+1.0i) 0.0) (num-test (* 0 1 0) 0) (num-test (* 0 1 0.0+1.0i) 0.0) (num-test (* 0 1 1.0) 0.0) (num-test (* 0 1 1/1) 0) (num-test (* 0 1 1234) 0) (num-test (* 0 1) 0) (num-test (* 0 1.0 0) 0.0) (num-test (* 0 1.0 0.0+1.0i) 0.0) (num-test (* 0 1.0 1.0) 0.0) (num-test (* 0 1.0 1/1) 0.0) (num-test (* 0 1.0 1234) 0.0) (num-test (* 0 1.0) 0.0) (num-test (* 0 1.0+1.0i 0) 0.0) (num-test (* 0 1.0+1.0i 0.0+1.0i) 0.0) (num-test (* 0 1.0+1.0i 1.0) 0.0) (num-test (* 0 1.0+1.0i 1/1) 0.0) (num-test (* 0 1.0+1.0i 1234) 0.0) (num-test (* 0 1.0+1.0i) 0.0) (num-test (* 0 123.4) 0.0) (num-test (* 0 1234/11) 0) (num-test (* 0.0 -1.0+1.0i -1.0+1.0i) 0.0) (num-test (* 0.0 -1.0+1.0i 0.0) 0.0) (num-test (* 0.0 -1.0+1.0i 1) 0.0) (num-test (* 0.0 -1.0+1.0i 1.0+1.0i) 0.0) (num-test (* 0.0 -1.0+1.0i 123.4) 0.0) (num-test (* 0.0 -1.0+1.0i 1234/11) 0.0) (num-test (* 0.0 0 -1.0+1.0i) 0.0) (num-test (* 0.0 0 0.0) 0.0) (num-test (* 0.0 0 1) 0.0) (num-test (* 0.0 0 1.0+1.0i) 0.0) (num-test (* 0.0 0 123.4) 0.0) (num-test (* 0.0 0 1234/11) 0.0) (num-test (* 0.0 0.0 -1.0+1.0i) 0.0) (num-test (* 0.0 0.0 0.0) 0.0) (num-test (* 0.0 0.0 1) 0.0) (num-test (* 0.0 0.0 1.0+1.0i) 0.0) (num-test (* 0.0 0.0 123.4) 0.0) (num-test (* 0.0 0.0 1234/11) 0.0) (num-test (* 0.0 0.0+1.0i -1.0+1.0i) 0.0) (num-test (* 0.0 0.0+1.0i 0.0) 0.0) (num-test (* 0.0 0.0+1.0i 1) 0.0) (num-test (* 0.0 0.0+1.0i 1.0+1.0i) 0.0) (num-test (* 0.0 0.0+1.0i 123.4) 0.0) (num-test (* 0.0 0.0+1.0i 1234/11) 0.0) (num-test (* 0.0 1 -1.0+1.0i) 0.0) (num-test (* 0.0 1 0.0) 0.0) (num-test (* 0.0 1 1.0) 0.0) (num-test (* 0.0 1 1/1) 0.0) (num-test (* 0.0 1 1234) 0.0) (num-test (* 0.0 1) 0.0) (num-test (* 0.0 1.0 0) 0.0) (num-test (* 0.0 1.0 0.0+1.0i) 0.0) (num-test (* 0.0 1.0 1.0) 0.0) (num-test (* 0.0 1.0 1/1) 0.0) (num-test (* 0.0 1.0 1234) 0.0) (num-test (* 0.0 1.0) 0.0) (num-test (* 0.0 1.0+1.0i 0) 0.0) (num-test (* 0.0 1.0+1.0i 0.0+1.0i) 0.0) (num-test (* 0.0 1.0+1.0i 1.0) 0.0) (num-test (* 0.0 1.0+1.0i 1/1) 0.0) (num-test (* 0.0 1.0+1.0i 1234) 0.0) (num-test (* 0.0 1.0+1.0i) 0.0) (num-test (* 0.0 123.4 0) 0.0) (num-test (* 0.0 123.4 0.0+1.0i) 0.0) (num-test (* 0.0 123.4 1.0) 0.0) (num-test (* 0.0 123.4 1/1) 0.0) (num-test (* 0.0 123.4 1234) 0.0) (num-test (* 0.0 123.4) 0.0) (num-test (* 0.0 1234 0) 0.0) (num-test (* 0.0 1234 0.0+1.0i) 0.0) (num-test (* 0.0 1234 1.0) 0.0) (num-test (* 0.0 1234 1/1) 0.0) (num-test (* 0.0 1234 1234) 0.0) (num-test (* 0.0 1234) 0.0) (num-test (* 0.0 1234/11 0) 0.0) (num-test (* 0.0 1234/11 0.0+1.0i) 0.0) (num-test (* 0.0 1234/11 1.0) 0.0) (num-test (* 0.0 1234/11 1/1) 0.0) (num-test (* 0.0 1234/11 1234) 0.0) (num-test (* 0.0 1234/11) 0.0) (num-test (* 0.0+0.00000001i) 0.0+0.00000001i) (num-test (* 0.0+1.0i 0) 0.0) (num-test (* 0.0+1.0i 0.0+1.0i) -1.0) (num-test (* 0.0+1.0i 1.0) 0.0+1.0i) (num-test (* 0.0+1.0i 1/1) 0.0+1.0i) (num-test (* 0.0+1.0i 1234) 0.0+1234.0i) (num-test (* 0/1) 0/1) (num-test (* 1 0) 0) (num-test (* 1 0.0+1.0i) 0.0+1.0i) (num-test (* 1 1 0) 0) (num-test (* 1 1 0.0+1.0i) 0.0+1.0i) (num-test (* 1 1 1.0) 1.0) (num-test (* 1 1 1/1) 1) (num-test (* 1 1 1234) 1234) (num-test (* 1 1) 1) (num-test (* 1 1.0 0) 0.0) (num-test (* 1 1.0 0.0+1.0i) 0.0+1.0i) (num-test (* 1 1.0 1.0) 1.0) (num-test (* 1 1.0 1/1) 1.0) (num-test (* 1 1.0 1234) 1234.0) (num-test (* 1 1.0) 1.0) (num-test (* 1 1.0+1.0i 0) 0.0) (num-test (* 1 1.0+1.0i 0.0+1.0i) -1.0+1.0i) (num-test (* 1 1.0+1.0i 1.0) 1.0+1.0i) (num-test (* 1 1.0+1.0i 1/1) 1.0+1.0i) (num-test (* 1 1.0+1.0i 1234) 1234.0+1234.0i) (num-test (* 1 1.0+1.0i) 1.0+1.0i) (num-test (* 1 1234) 1234) (num-test (* 1.0 -1.0+1.0i -1.0+1.0i) 0.0-2.0i) (num-test (* 1.0 -1.0+1.0i 0.0) 0.0) (num-test (* 1.0 -1.0+1.0i 1) -1.0+1.0i) (num-test (* 1.0 -1.0+1.0i 1.0+1.0i) -2.0) (num-test (* 1.0 -1.0+1.0i 123.4) -123.4+123.4i) (num-test (* 1.0 -1.0+1.0i 1234/11) -112.18181818181819+112.18181818181819i) (num-test (* 1.0 0 -1.0+1.0i) 0.0) (num-test (* 1.0 0 0.0) 0.0) (num-test (* 1.0 0 1) 0.0) (num-test (* 1.0 0 1.0+1.0i) 0.0) (num-test (* 1.0 0 123.4) 0.0) (num-test (* 1.0 0 1234/11) 0.0) (num-test (* 1.0 0.0 -1.0+1.0i) 0.0) (num-test (* 1.0 0.0 0.0) 0.0) (num-test (* 1.0 0.0 1) 0.0) (num-test (* 1.0 0.0 1.0+1.0i) 0.0) (num-test (* 1.0 0.0 123.4) 0.0) (num-test (* 1.0 0.0 1234/11) 0.0) (num-test (* 1.0 0.0+1.0i -1.0+1.0i) -1.0-1.0i) (num-test (* 1.0 0.0+1.0i 0.0) 0.0) (num-test (* 1.0 0.0+1.0i 1) 0.0+1.0i) (num-test (* 1.0 0.0+1.0i 1.0+1.0i) -1.0+1.0i) (num-test (* 1.0 0.0+1.0i 123.4) 0.0+123.4i) (num-test (* 1.0 0.0+1.0i 1234/11) 0.0+112.18181818181819i) (num-test (* 1.0 1 -1.0+1.0i) -1.0+1.0i) (num-test (* 1.0 1 0.0) 0.0) (num-test (* 1.0 1 1) 1.0) (num-test (* 1.0 1 1.0+1.0i) 1.0+1.0i) (num-test (* 1.0 1 123.4) 123.4) (num-test (* 1.0 1 1234/11) 112.18181818181819) (num-test (* 1.0 1.0 -1.0+1.0i) -1.0+1.0i) (num-test (* 1.0 1.0 0.0) 0.0) (num-test (* 1.0 1.0 1) 1.0) (num-test (* 1.0 1.0 1.0+1.0i) 1.0+1.0i) (num-test (* 1.0 1.0 123.4) 123.4) (num-test (* 1.0 1.0 1234/11) 112.18181818181819) (num-test (* 1.0 1.0+1.0i -1.0+1.0i) -2.0) (num-test (* 1.0 1.0+1.0i 0.0) 0.0) (num-test (* 1.0 1.0+1.0i 1) 1.0+1.0i) (num-test (* 1.0 1.0+1.0i 1.0+1.0i) 0.0+2.0i) (num-test (* 1.0 1.0+1.0i 123.4) 123.4+123.4i) (num-test (* 1.0 1.0+1.0i 1234/11) 112.18181818181819+112.18181818181819i) (num-test (* 1.0 1/1 -1.0+1.0i) -1.0+1.0i) (num-test (* 1.0 123.4 0) 0.0) (num-test (* 1.0 123.4 0.0+1.0i) 0.0+123.4i) (num-test (* 1.0 123.4 1.0) 123.4) (num-test (* 1.0 123.4 1/1) 123.4) (num-test (* 1.0 123.4 1234) 152275.60000000000582) (num-test (* 1.0 123.4) 123.4) (num-test (* 1.0 1234 0) 0.0) (num-test (* 1.0 1234 0.0+1.0i) 0.0+1234.0i) (num-test (* 1.0 1234 1.0) 1234.0) (num-test (* 1.0 1234 1/1) 1234.0) (num-test (* 1.0 1234 1234) 1522756.0) (num-test (* 1.0 1234) 1234.0) (num-test (* 1.0 1234/11 0) 0.0) (num-test (* 1.0 1234/11 0.0+1.0i) 0.0+112.18181818181819i) (num-test (* 1.0 1234/11 1.0) 112.18181818181819) (num-test (* 1.0 1234/11 1/1) 112.18181818181819) (num-test (* 1.0 1234/11 1234) 138432.36363636364695) (num-test (* 1.0 1234/11) 112.18181818181819) (num-test (* 1.0+1.0i -1.0+1.0i -1.0+1.0i) 2.0-2.0i) (num-test (* 1.0+1.0i -1.0+1.0i 0.0) 0.0) (num-test (* 1.0+1.0i -1.0+1.0i 1) -2.0) (num-test (* 1.0+1.0i -1.0+1.0i 1.0+1.0i) -2.0-2.0i) (num-test (* 1.0+1.0i -1.0+1.0i 123.4) -246.8) (num-test (* 1.0+1.0i -1.0+1.0i 1234/11) -224.36363636363637) (num-test (* 1.0+1.0i 0 -1.0+1.0i) 0.0) (num-test (* 1.0+1.0i 0 0.0) 0.0) (num-test (* 1.0+1.0i 0 1) 0.0) (num-test (* 1.0+1.0i 0 1.0+1.0i) 0.0) (num-test (* 1.0+1.0i 0 123.4) 0.0) (num-test (* 1.0+1.0i 0 1234/11) 0.0) (num-test (* 1.0+1.0i 0.0 -1.0+1.0i) 0.0) (num-test (* 1.0+1.0i 0.0 0.0) 0.0) (num-test (* 1.0+1.0i 0.0 1) 0.0) (num-test (* 1.0+1.0i 0.0 1.0+1.0i) 0.0) (num-test (* 1.0+1.0i 0.0 123.4) 0.0) (num-test (* 1.0+1.0i 0.0 1234/11) 0.0) (num-test (* 1.0+1.0i 0.0+1.0i -1.0+1.0i) 0.0-2.0i) (num-test (* 1.0+1.0i 0.0+1.0i 0.0) 0.0) (num-test (* 1.0+1.0i 0.0+1.0i 1) -1.0+1.0i) (num-test (* 1.0+1.0i 0.0+1.0i 1.0+1.0i) -2.0) (num-test (* 1.0+1.0i 0.0+1.0i 123.4) -123.4+123.4i) (num-test (* 1.0+1.0i 0.0+1.0i 1234/11) -112.18181818181819+112.18181818181819i) (num-test (* 1.0+1.0i 1 -1.0+1.0i) -2.0) (num-test (* 1.0+1.0i 1 0.0) 0.0) (num-test (* 1.0+1.0i 1 1) 1.0+1.0i) (num-test (* 1.0+1.0i 1 1.0+1.0i) 0.0+2.0i) (num-test (* 1.0+1.0i 1 123.4) 123.4+123.4i) (num-test (* 1.0+1.0i 1 1234/11) 112.18181818181819+112.18181818181819i) (num-test (* 1.0+1.0i 1.0 -1.0+1.0i) -2.0) (num-test (* 1.0+1.0i 1.0 0.0) 0.0) (num-test (* 1.0+1.0i 1.0 1) 1.0+1.0i) (num-test (* 1.0+1.0i 1.0 1.0+1.0i) 0.0+2.0i) (num-test (* 1.0+1.0i 1.0 123.4) 123.4+123.4i) (num-test (* 1.0+1.0i 1.0 1234/11) 112.18181818181819+112.18181818181819i) (num-test (* 1.0+1.0i 1.0+1.0i -1.0+1.0i) -2.0-2.0i) (num-test (* 1.0+1.0i 1.0+1.0i 0.0) 0.0) (num-test (* 1.0+1.0i 1.0+1.0i 1) 0.0+2.0i) (num-test (* 1.0+1.0i 1.0+1.0i 1.0+1.0i) -2.0+2.0i) (num-test (* 1.0+1.0i 1.0+1.0i 123.4) 0.0+246.8i) (num-test (* 1.0+1.0i 1.0+1.0i 1234/11) 0.0+224.36363636363637i) (num-test (* 1.0+1.0i 123.4 -1.0+1.0i) -246.8) (num-test (* 1.0+1.0i 123.4 0.0) 0.0) (num-test (* 1.0+1.0i 123.4 1) 123.4+123.4i) (num-test (* 1.0+1.0i 123.4 1.0+1.0i) 0.0+246.8i) (num-test (* 1.0+1.0i 123.4 123.4) 15227.56000000000131+15227.56000000000131i) (num-test (* 1.0+1.0i 123.4 1234/11) 13843.23636363636433+13843.23636363636433i) (num-test (* 1.0+1.0i 1234 -1.0+1.0i) -2468.0) (num-test (* 1.0+1.0i 1234 0.0) 0.0) (num-test (* 1.0+1.0i 1234 1) 1234.0+1234.0i) (num-test (* 1.0+1.0i 1234 1.0+1.0i) 0.0+2468.0i) (num-test (* 1.0+1.0i 1234 123.4) 152275.60000000000582+152275.60000000000582i) (num-test (* 1.0+1.0i 1234 1234/11) 138432.36363636364695+138432.36363636364695i) (num-test (* 1.0+1.0i 1234/11 -1.0+1.0i) -224.36363636363637) (num-test (* 1.0+1.0i 1234/11 0.0) 0.0) (num-test (* 1.0+1.0i 1234/11 1) 112.18181818181819+112.18181818181819i) (num-test (* 1.0+1.0i 1234/11 1.0+1.0i) 0.0+224.36363636363637i) (num-test (* 1.0+1.0i 1234/11 123.4) 13843.23636363636433+13843.23636363636433i) (num-test (* 1.0+1.0i 1234/11 1234/11) 12584.76033057851419+12584.76033057851419i) (num-test (* 1.0+1.0i) 1.0+1.0i) (num-test (* 10/3) 10/3) (num-test (* 123.4 -1.0+1.0i 0) 0.0) (num-test (* 123.4 -1.0+1.0i 0.0+1.0i) -123.4-123.4i) (num-test (* 123.4 -1.0+1.0i 1.0) -123.4+123.4i) (num-test (* 123.4 -1.0+1.0i 1/1) -123.4+123.4i) (num-test (* 123.4 -1.0+1.0i 1234) -152275.60000000000582+152275.60000000000582i) (num-test (* 123.4 -1.0+1.0i) -123.4+123.4i) (num-test (* 123.4 0 0) 0.0) (num-test (* 123.4 0 0.0+1.0i) 0.0) (num-test (* 123.4 0 1.0) 0.0) (num-test (* 123.4 0 1/1) 0.0) (num-test (* 123.4 0 1234) 0.0) (num-test (* 123.4 0) 0.0) (num-test (* 123.4 0.0 0) 0.0) (num-test (* 123.4 0.0 0.0+1.0i) 0.0) (num-test (* 123.4 0.0 1.0) 0.0) (num-test (* 123.4 0.0 1/1) 0.0) (num-test (* 123.4 0.0 1234) 0.0) (num-test (* 123.4 0.0) 0.0) (num-test (* 123.4 0.0+1.0i 0) 0.0) (num-test (* 123.4 0.0+1.0i 0.0+1.0i) -123.4) (num-test (* 123.4 0.0+1.0i 1.0) 0.0+123.4i) (num-test (* 123.4 0.0+1.0i 1/1) 0.0+123.4i) (num-test (* 123.4 0.0+1.0i 1234) 0.0+152275.60000000000582i) (num-test (* 123.4 0.0+1.0i) 0.0+123.4i) (num-test (* 123.4 1 0) 0.0) (num-test (* 123.4 1 0.0+1.0i) 0.0+123.4i) (num-test (* 123.4 1 1.0) 123.4) (num-test (* 123.4 1 1/1) 123.4) (num-test (* 123.4 1 1234) 152275.60000000000582) (num-test (* 123.4 1) 123.4) (num-test (* 123.4 1.0 0) 0.0) (num-test (* 123.4 1.0 0.0+1.0i) 0.0+123.4i) (num-test (* 123.4 1.0 1.0) 123.4) (num-test (* 123.4 1.0 1/1) 123.4) (num-test (* 123.4 1.0 1234) 152275.60000000000582) (num-test (* 123.4 1.0) 123.4) (num-test (* 123.4 1.0+1.0i 0) 0.0) (num-test (* 123.4 1.0+1.0i 0.0+1.0i) -123.4+123.4i) (num-test (* 123.4 1.0+1.0i 1.0) 123.4+123.4i) (num-test (* 123.4 1.0+1.0i 1/1) 123.4+123.4i) (num-test (* 123.4 1.0+1.0i 1234) 152275.60000000000582+152275.60000000000582i) (num-test (* 123.4 1.0+1.0i) 123.4+123.4i) (num-test (* 123.4 123.4 -1.0+1.0i) -15227.56000000000131+15227.56000000000131i) (num-test (* 123.4 123.4 0.0) 0.0) (num-test (* 123.4 123.4 1) 15227.56000000000131) (num-test (* 123.4 123.4 1.0+1.0i) 15227.56000000000131+15227.56000000000131i) (num-test (* 123.4 123.4 123.4) 1879080.90400000032969) (num-test (* 123.4 123.4 1234/11) 1708255.36727272742428) (num-test (* 123.4 1234 -1.0+1.0i) -152275.60000000000582+152275.60000000000582i) (num-test (* 123.4 1234 0.0) 0.0) (num-test (* 123.4 1234 1) 152275.60000000000582) (num-test (* 123.4 1234 1.0+1.0i) 152275.60000000000582+152275.60000000000582i) (num-test (* 123.4 1234 123.4) 18790809.04000000283122) (num-test (* 123.4 1234 1234/11) 17082553.67272727191448) (num-test (* 123.4 1234/11 -1.0+1.0i) -13843.23636363636433+13843.23636363636433i) (num-test (* 123.4 1234/11 0.0) 0.0) (num-test (* 123.4 1234/11 1) 13843.23636363636433) (num-test (* 123.4 1234/11 1.0+1.0i) 13843.23636363636433+13843.23636363636433i) (num-test (* 123.4 1234/11 123.4) 1708255.36727272742428) (num-test (* 123.4 1234/11 1234/11) 1552959.42479338846169) (num-test (* 1234 -1.0+1.0i) -1234.0+1234.0i) (num-test (* 1234 0.0) 0.0) (num-test (* 1234 1) 1234) (num-test (* 1234 1.0+1.0i) 1234.0+1234.0i) (num-test (* 1234 123.4) 152275.60000000000582) (num-test (* 1234 1234/11) 1522756/11) (num-test (* 1234/11 0) 0) (num-test (* 1234/11 0.0+1.0i) 0.0+112.18181818181819i) (num-test (* 1234/11 1.0) 112.18181818181819) (num-test (* 1234/11 1/1) 1234/11) (num-test (* 1234/11 1234) 1522756/11) (num-test (* 1234000000) 1234000000) (num-test (* 1234000000/10) 1234000000/10) (num-test (* 2) 2) (num-test (* 2/2) 2/2) (num-test (let ((x 1) (y 2)) (set! x (* 0 (let () (set! y 32) 1))) y) 32) (num-test (* 4) 4 ) (num-test (* 7 6 5 4 3 2 1) 5040) (num-test (*) 1 ) (num-test (* (+ 1 3 5) (* 1 3 5)) 135) (when with-bignums (num-test (* -1/2147483648 1/4294967296) -1/9223372036854775808)) (num-test (* -2147483648 4294967296) -9223372036854775808) (num-test (* .000000000000123 .000000000000123) 1.5129e-26) (num-test (* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) 2432902008176640000) (num-test (* 1/98947 2/97499 3/76847) 6/741360956847391) (num-test (* 11/1234 1234/11 11/1234 1234/11 11/1234 1234/11) 1) (num-test (* 12 (/ 13591409 (expt 640320 3/2))) (/ pi)) (num-test (* 1e100 0.001) 1e97) (num-test (* 1e100 1e-100) 1.0) (num-test (* 1e200 1e-200) 1.0) (num-test (* 1e300 1e-300) 1.0) (num-test (* 500009/500029 500057/500041) 250033000513/250035001189) (num-test (* -9223372036854775808 5.551115123125783999999999999999999999984E-17) -5.120000000000001197084708550423347199985E2) (num-test (* -9223372036854775808) -9223372036854775808) (num-test (* 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -1.024000000000000239416941710084669439997E3) (num-test (* 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 3.340955887615246120290922872835723707327E-52) (num-test (* 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 6.162975822039157611655737122931199999952E-33) (num-test (* 9223372036854775807 (/ 9223372036854775807)) 1) (num-test (* 1234567890e24 1e-33) 1.23456789) (num-test (* 1234567890e-24 1e20) 123456.789) (when (provided? 'overflow-checks) (num-test (* 92233720/9221 -92233720/9221 9221/92233720 -9221/92233720) 1) (num-test (* 9221/92233720 -9221/92233720 92233720/9221 -92233720/9221) 1)) (for-each-permutation (lambda args (if (not (< (magnitude (- (apply * args) 0.25+0.25i)) 1e-15)) (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args)))) '(1 1/2 0.5 1+i)) (for-each-permutation (lambda args (if (not (< (magnitude (- (apply * args) 1.0)) 1e-15)) (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args)))) '(5 1/3 0.5 1+i 1/5 3 2.0 0.5-0.5i)) (num-test (* 7/1000 1000/999 999/7 most-positive-fixnum) most-positive-fixnum) (num-test (* 7/1000000 1/999 999/7 (- most-positive-fixnum 775807)) 9223372036854) (num-test (* 7/100000000000 1/999 999/7 (- most-positive-fixnum 36854775807)) 92233720) (num-test (* -0.2554913394465045E0 0.27042187315261135E0) -6.909044658739340841916780452607499999997E-2) (num-test (* -0.4489211233229662E0 -0.42892136850270857E0) 1.925518625654598642702435865603340000003E-1) (num-test (* -0.44586465919973783E0 -0.15168042462027043E0) 6.762894083058839862686475970136690000031E-2) (num-test (* 0.5509395670465355E0 0.3577558280766836E0) 1.971018410289428517174637096677999999998E-1) (num-test (* -0.42780066410606965E0 0.22704747885906007E0) -9.713106223951470697784938095387549999991E-2) (num-test (* 0.20955388816500042E0 0.605628751935113E0) 1.269118597525194529275610775776050864747E-1) (num-test (* 0.9993471610818964E0 -4.363771855901198E9) -4.360923015803940523218504871887199999987E9) (num-test (* 0.10502219375257282E0 3.425205053451057E9) 3.597225487658284459716764716837978363041E8) (num-test (* 0.7768651149081368E0 1.666066330143864E9) 1.294308811011790623456907580692100524906E9) (num-test (* -0.6438389801759042E0 2.8922130868526487E9) -1.862119524290613178578671687454540000003E9) (num-test (* -0.7427680566504474E0 6.763974500466173E9) -5.024064194944440168218138681386184692391E9) (num-test (* -0.8563035843259611E0 2.9100478627456827E9) -2.491884415429230578930028553142970000007E9) (num-test (* 0.6219502737119671E0 2.8868752190811842E-11) 1.795492832679837500144381979439820000005E-11) (num-test (* 0.6767479505813657E0 2.9324524289075574E-11) 1.98453117144053746900587234314118E-11) (num-test (* 0.7944531541461581E0 8.282076647859848E-11) 6.579721915772496180466156449968800000014E-11) (num-test (* -0.4662914070981966E0 -6.921260263903422E-11) 3.22732418734836218212517276876520000001E-11) (num-test (* 0.037804762510578516E0 -3.044514833184461E-11) -1.150971602284721156705916516398760000005E-12) (num-test (* -0.5364168049485208E0 -3.695280705974925E-11) 1.982210669686983584095600640940000000003E-11) (num-test (* 0.10343751426551051E0 4.8902635121181385E19) 5.058367017968254798845671333856350000002E18) (num-test (* -0.45511004829813784E0 1.8210069906740634E19) -8.287585794769196371535086060990559999988E18) (num-test (* -0.9675158737162977E0 8.097401718869682E19) -7.834364698864051180664785816331399999997E19) (num-test (* -0.06573561186185628E0 2.6049125586869125E19) -1.712355208919177984462215919354999999997E18) (num-test (* -0.5574365795036731E0 -8.822383181882661E19) 4.917919103979402413863422702119099999985E19) (num-test (* -0.4222667103024276E0 -1.8561723355961213E19) 7.837997859065477747526525340678799999995E18) (num-test (* -0.8412207478192143E0 2.3416069046402696E-22) -1.969808311420123220453436412175280000003E-22) (num-test (* 0.24291385591230452E0 -9.448120185342916E-21) -2.295079305344524973092760016780319999996E-21) (num-test (* -0.37792600430678414E0 -2.3929024368177364E-21) 9.043400566424941101603791982206959999978E-22) (num-test (* -0.007648867433060369E0 -5.3162210182098465E-21) 4.066306981313632980042734472335849999998E-23) (num-test (* -0.7631807323096114E0 -4.534410248041209E-21) 3.460574533692296555855373976182600000004E-21) (num-test (* 0.4735366300649959E0 -1.3895270471326203E-21) -6.579919552833457409343160757567699999986E-22) (num-test (* -8.64834403600587E9 -0.14057280586223464E0) 1.215721987203268063989050502795104980466E9) (num-test (* -1.5525713051163936E9 0.10621224657238759E0) -1.649020862802360033147528021954240000002E8) (num-test (* 3.297132746298694E9 0.05318660311813239E0) 1.753632908051865357781730185173082351681E8) (num-test (* 2.1659831568875275E9 0.11704159596099262E0) 2.535101255067452830195785975470499999995E8) (num-test (* -5.533403510176525E9 0.37778599060251605E0) -2.090442326495477997892444645726250000003E9) (num-test (* -2.4217306331294374E9 0.6051350227557695E0) -1.465474021787126179631541139079300000002E9) (num-test (* 1.4048311850866513E9 -4.304799039580996E9) -6.047515936334448947178704758694799999987E18) (num-test (* -5.070278162013437E9 -9.116233758795675E9) 4.622184094703138120556628748497500000004E19) (num-test (* 8.452801605894673E9 -9.002885976919611E9) -7.609960904339272295066535438875484466566E19) (num-test (* 6.352601599408395E9 -4.484034289922495E9) -2.84852834019637276707985964548254013062E19) (num-test (* -6.565407710101401E8 -6.718825369609182E9) 4.411182788445701880089696066398200000001E18) (num-test (* -9.37193973536698E9 9.577576231327314E9) -8.976046725088278448381480077370724757202E19) (num-test (* -1.7766859308675253E9 -4.079350537765101E-11) 7.247724707524128390808760574555300000015E-2) (num-test (* 2.3810136983742104E9 9.195156930614704E-11) 2.189379461049416913728349262972160000005E-1) (num-test (* -3.313966320976337E9 -3.44704749912067E-11) 1.142339931889161000998337758579000000001E-1) (num-test (* 6.598963960681895E9 -2.4298605961767928E-11) -1.6034562503651679888964996364737701416E-1) (num-test (* 7.908258993705348E9 1.528909719631646E-11) 1.209101404084048656249131044486427307128E-1) (num-test (* -5.906667889594469E9 5.917852809041966E-11) -3.4954791162514609467168142486054E-1) (num-test (* 4.86261281419926E9 -2.3925611132123714E19) -1.1634098327861323021375513143190574646E29) (num-test (* -9.753392818607462E9 -2.5653634777279775E18) 2.502099772078991953507318766810499999998E28) (num-test (* 1.5861252889272392E9 5.12939252547053E19) 8.135859201483165467280698143134187520016E28) (num-test (* -8.422142961023593E8 1.0428099441045047E19) -8.782694430425160722507674279387100000022E27) (num-test (* -3.109042783121446E9 -4.138252722536039E19) 1.286600476173334775049764879239400000004E29) (num-test (* -6.459303282089468E8 1.8408981660472957E19) -1.18909195659417795593544068516876E28) (num-test (* -1.432764110232635E9 8.98766033001457E-21) -1.287719715580647603395563949195000000001E-11) (num-test (* 8.539623949953406E9 -3.498784805440049E-21) -2.987830652026891151867478398400020599353E-11) (num-test (* 7.336784327799637E9 -1.048985206018761E-21) -7.696178219612118988966933703567504882842E-12) (num-test (* -4.320357143553698E9 2.591531476439043E-21) -1.119634152697768142457549423101400000004E-11) (num-test (* -9.374098076239548E9 5.5773248420603045E-21) -5.2282390072520541300690003822366E-11) (num-test (* 9.118926580475056E9 -1.379170270330765E-21) -1.257655243712018104094987568109512329098E-11) (num-test (* 8.145792307872788E-11 -0.06511382435429458E0) -5.304036895613925967063321178890399999982E-12) (num-test (* -6.1928426627437E-11 0.2526275616632321E0) -1.564482741652978543296795912770000000003E-11) (num-test (* -8.555119338859813E-11 -0.8366318482083728E0) 7.157485304113477734096792042286400000002E-11) (num-test (* 8.243060442429263E-12 0.3939656708074719E0) 3.247482836708180702664407610209699999993E-12) (num-test (* 8.600529286105945E-11 -0.891441509265547E0) -7.666868807288821095008580376914999999987E-11) (num-test (* -7.531046724969747E-11 0.24398797995196886E0) -1.837484877349259372047496586078419999997E-11) (num-test (* -3.7666526619188126E-12 4.659322150343885E9) -1.755004818033008198811983615043067932129E-2) (num-test (* 3.032501107241211E-11 -9.592046453776636E9) -2.908789149178678011789796814619600000006E-1) (num-test (* 7.311626957349528E-11 -9.061108567148174E9) -6.625144566303134478698468496187199999991E-1) (num-test (* 4.898078204161461E-11 8.88014689134599E9) 4.34956539382539434542556734824485778809E-1) (num-test (* 1.278207138618518E-11 -4.279966992086118E9) -5.470684362336102162321405533123999999992E-2) (num-test (* -8.538580654966055E-11 -5.191059833953482E8) 4.432428307696650304902715905351E-2) (num-test (* 4.0761422500127225E-11 1.527607426117321E-11) 6.226745171030000570391027616422499999987E-22) (num-test (* -9.186363051001198E-11 8.557763803549676E-11) -7.861472520412421845045812851184799999979E-21) (num-test (* -9.89183505930065E-11 9.717968160611499E-11) -9.61285381563042758142312881743500000002E-21) (num-test (* 7.440627873114725E-12 -4.535521332601712E-11) -3.374712644646273959960130740919999999997E-22) (num-test (* 8.701410920357686E-11 -7.032883383151379E-12) -6.119600827175551716944456414899399999975E-22) (num-test (* 9.866226673114161E-11 -2.814669610817353E-11) -2.777016839025002299729708883583300000003E-21) (num-test (* 5.192240545105114E-11 -3.366056660574579E19) -1.747737587015645175992519129700599999996E9) (num-test (* -1.372355669576939E-11 -4.819955130360066E19) 6.614692750256090679268960117974000000002E8) (num-test (* 3.637511103766519E-11 -4.071776382810416E19) -1.481113180452716050522430526190399999997E9) (num-test (* 7.446388208685151E-13 2.7760294268649034E19) 2.06713927911698144246650226294134E7) (num-test (* 6.267855179410938E-11 7.471751480940298E19) 4.683185621908299321917798617952399999997E9) (num-test (* -4.336562006766369E-11 8.143188451558233E19) -3.531344165296609191472762946597699999996E9) (num-test (* -1.0432655006975122E-11 -9.379512413340694E-21) 9.785321714202410134613576821466799999983E-32) (num-test (* -8.167646898574611E-11 -5.810795749825724E-21) 4.746052788431460582580726109336400000004E-31) (num-test (* -4.33805459341994E-11 -2.4289860591796017E-21) 1.053707413137706937228749003789799999998E-31) (num-test (* -1.384613082275421E-11 2.2174009100764947E-21) -3.070242308741338958377843646768700000007E-32) (num-test (* -4.910905591314494E-11 -5.456657623752349E-21) 2.679713043437427118620763024640600000007E-31) (num-test (* 1.3653011366548008E-11 -3.925911962906968E-21) -5.3600520653635635667567009719744E-32) (num-test (* 7.641468950470222E19 0.9034599537348024E0) 6.903761184457755820350566254132800000009E19) (num-test (* 5.146778093125584E19 -0.2791459460022878E0) -1.436702239669392041403916711075200000002E19) (num-test (* -8.874303077863696E19 -0.23153988023519345E0) 2.054755071819368785424861291991199999996E19) (num-test (* 7.10798162637783E19 -0.4719034863212067E0) -3.354281310194779040746230255943679999999E19) (num-test (* -9.820386602197546E19 0.03346146041258036E0) -3.286044775256677372510003197965599999991E18) (num-test (* -5.210458089116161E19 0.11173798093222442E0) -5.822060666098160855554015008516199999997E18) (num-test (* 3.257626718953688E18 -6.150510855712356E9) -2.003606849878328222529021336892800000007E28) (num-test (* -7.755105754004988E19 5.514896832715505E9) -4.276860816013589383294629509647750854492E29) (num-test (* 2.426235084788384E19 8.685431434428486E9) 2.10728984727342930836693974581298828125E29) (num-test (* -2.847383850475709E19 -2.412830829567453E9) 6.870255538040273498936753499177000000002E28) (num-test (* 1.4664659669727164E19 -4.8673539253155E9) -7.137808880686241930432174599520111083984E28) (num-test (* -4.24770317054668E19 1.3102543269150825E9) -5.5655714586597020914994623011E28) (num-test (* 2.17116835964837E19 -3.654789326884115E-11) -7.935162947711353824080778955354111999976E8) (num-test (* -1.8125809977916906E17 -5.944782899600832E-11) 1.077540051981345570924422644657920000001E7) (num-test (* -7.915462827540546E19 9.762153025588201E-11) -7.727195939080587759467382669774600000011E9) (num-test (* -4.360953588949649E19 -7.152431005584812E-11) 3.119141966351983288172806713098800000002E9) (num-test (* 3.550776271395866E19 -6.387656982922894E-11) -2.268114084477872045705002835620399999998E9) (num-test (* -8.278954580496595E19 -7.359178231519021E-11) 6.09263023285252303789473682334949999999E9) (num-test (* -5.5022682113038156E19 -8.979630229039327E19) 4.94083339585058897667477175561012E39) (num-test (* 1.1716230943203277E19 5.5764415854118265E19) 6.53348774559675813536051493554405E38) (num-test (* 7.462799608352103E19 6.061883497941003E19) 4.5238621794310193360802344979309E39) (num-test (* -3.2160334983646097E19 -3.8817785710003675E19) 1.248392991757108737054938769406475E39) (num-test (* 5.868090263060238E19 -8.37300331667736E19) -4.913353923516549470233569081168E39) (num-test (* -7.3652924769962656E19 9.725738480757314E19) -7.16329084655549342691442378865984E39) (num-test (* -6.447063647969567E19 4.0587529685661844E-21) -2.616703871973161409821231651015480000002E-1) (num-test (* -3.1999317568381926E17 3.015031281949113E-21) -9.647894346969533174030688093163799999993E-4) (num-test (* -1.5005852398726605E19 5.391316601974659E-21) -8.090130116403600588996007910269500000005E-2) (num-test (* 1.0084552719733576E19 2.78150956101201E-21) 2.805027980846861049488413624776000000002E-2) (num-test (* -7.171404412051077E19 1.4733392992015492E-21) -1.056591195074223176150038792848839999998E-1) (num-test (* -5.909802783283228E19 5.356071274587122E-21) -3.165332492601832012651928738981599999998E-1) (num-test (* 8.272641144282955E-22 -0.16191056182923802E0) -1.339427975482523749443486923949099999995E-22) (num-test (* 8.410471541398583E-21 -0.43256058128353736E0) -3.638038458816019512260007931560879999991E-21) (num-test (* -7.887238384137063E-22 0.5589746137044918E0) -4.408766028968254895651429959583400000002E-22) (num-test (* 4.778995446616728E-21 0.21608373898977795E0) 1.0326632047200663557809034755476E-21) (num-test (* 3.992449163872154E-21 0.9593422165456676E0) 3.830125030315009512425388980010399999991E-21) (num-test (* -9.700320218813958E-21 -0.42620535269852766E0) 4.134328400148261975602018057078279999983E-21) (num-test (* -1.7901566262876555E-21 9.461674014776534E8) -1.693787843332593653628245958251059055323E-12) (num-test (* 1.0928019952544443E-22 8.279199780524873E9) 9.047526039267738313652918648958873748777E-13) (num-test (* 9.942869097320962E-21 9.523169242022762E9) 9.46876251650656124754254949341964721678E-11) (num-test (* -2.7432601692209267E-21 -4.922145522647528E9) 1.350272575938808435595052562419760000003E-11) (num-test (* -5.97929682563092E-21 -6.147792689359443E8) 3.675947731212389417723913477756000000004E-12) (num-test (* -1.3564305221188254E-21 1.0862842413758955E9) -1.4734691006989580907776383331457E-12) (num-test (* -5.446806293721964E-21 -1.5358504316888942E-11) 8.365479797538664267835041412208799999977E-32) (num-test (* -1.0222776562632463E-21 -1.9781477525280056E-11) 2.022216248196737715829186720579279999999E-32) (num-test (* 8.192540157543917E-21 3.3215076993103644E-11) 2.721158521019146605658900627335480000005E-31) (num-test (* 9.685592607330157E-21 6.034805605641166E-11) 5.845066856067266821880143244306199999988E-31) (num-test (* 6.671870463340688E-21 -9.07657686679269E-11) -6.055774510579551477490933797071999999989E-31) (num-test (* -1.109409648670322E-21 -4.7905821901849965E-11) 5.314718104539438656835419223873000000025E-32) (num-test (* -3.9052432481663676E-22 2.0306112771345453E19) -7.930030979680167745084943578652280000005E-3) (num-test (* 8.596834841113507E-21 -9.453548987989818E19) -8.127059931212420192062869827172600000005E-1) (num-test (* 3.946325780779758E-21 -9.084484011754447E19) -3.585033346066809630978128408382600000004E-1) (num-test (* 5.3518824877647604E-21 -6.814116447592617E19) -3.64683504854607466529059878139668000001E-1) (num-test (* -7.456278485417833E-22 9.61914445493285E19) -7.172301984744205963559813785437470719996E-2) (num-test (* -5.0781537010216826E-21 9.216915512986622E19) -4.680491362427717476508990573017719999994E-1) (num-test (* 3.2906792172396555E-22 4.571445785546992E-21) 1.504316163923729767672342114125599999998E-42) (num-test (* 5.39814714322422E-21 6.687033308557664E-21) 3.609758975123575798079875142208000000008E-41) (num-test (* 4.3506183844841724E-21 7.266196706225928E-21) 3.161244897538486151238585450198720000008E-41) (num-test (* 6.910763289107986E-21 3.910584203890238E-21) 2.702512175521023610171407324066800000011E-41) (num-test (* -4.6131515924393325E-21 5.228174479773633E-21) -2.411836142691841383820888561997250000001E-41) (num-test (* -2.1886866436065787E-21 6.29322016055891E-22) -1.377388691069093503544474490121700000002E-42) (num-test (* 19813/30200 41168/38464 2571/31632) 43688873593/765502835200) (num-test (* 16476/12673 40086/15929) 38850408/11874601) (if (provided? 'overflow-checks) (num-test (* 22713/35036 2008/41994 58982/21726 37919/44341 59831/3870) 608349727545125531/546777281752405290)) (num-test (* 26100/43623 64347/64939 51424/56858) 4798021185600/8948293077857) (num-test (* 13336/48674 21323/50854 60055/14813) 4269362918510/9166534724887) (num-test (* 33457/53498 45548/13003 50476/8209 9613/3657) 369717652332927784/10441582621738311) (num-test (* 31186/2829 35725/62132) 557059925/87885714) (num-test (* 28682/22045 54652/61935 19725/39778 14431/165 5682/36504) 54173177045874781/6989848058967345) (num-test (* 6054/59436 53485/47493 65091/13749 59111/51596) 5324119682728535/8557570117787688) (num-test (* 26270/51496 62100/14371 9302/6501 11918/55524) 627970006908375/927532016146043) (num-test (* 6865/57699 53935/1664 25223/46128 13016/30664) 15194818521234275/16975596844836864) (num-test (* 0110/001) 110) (num-test (* 14000000000000 524288) 7340032000000000000) (num-test (* 17500000000000 524288) 9175040000000000000) (num-test (* 1907348632812 524288) 999999999999737856) (num-test (* 524288 14000000000000) 7340032000000000000) (num-test (* 524288 17500000000000) 9175040000000000000) (num-test (* 524288 1907348632812) 999999999999737856) (num-test (* 9223372036854775807 1/9223372036854775807) 1.0) (let ((bes-i0 (lambda (x) ;I0(x) (if (< (abs x) 3.75) (let* ((y (expt (/ x 3.75) 2))) (+ 1.0 (* y (+ 3.5156229 (* y (+ 3.0899424 (* y (+ 1.2067492 (* y (+ 0.2659732 (* y (+ 0.360768e-1 (* y 0.45813e-2))))))))))))) (let* ((ax (abs x)) (y (/ 3.75 ax))) (* (/ (exp ax) (sqrt ax)) (+ 0.39894228 (* y (+ 0.1328592e-1 (* y (+ 0.225319e-2 (* y (+ -0.157565e-2 (* y (+ 0.916281e-2 (* y (+ -0.2057706e-1 (* y (+ 0.2635537e-1 (* y (+ -0.1647633e-1 (* y 0.392377e-2)))))))))))))))))))))) (num-test (bes-i0 1.0) 1.266065877752009) (num-test (bes-i0 2.0) 2.279585302336067) (num-test (bes-i0 5.0) 27.23987182360445) (num-test (bes-i0 10.0) 2815.716628466254) (num-test (bes-i0 50.0) 2.93255291463847587034176447517387076592E20) ;2.932553783849336E+20) arprec (num-test (bes-i0 100.0) 1.073751199431789167620943174959211991306E42)) (unless (or with-bignums (not (provided? 'overflow-checks))) (num-test (* 1/9223372036854775807 1/9223372036854775806) 1.1754943508223e-38) (num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 3.9223808052178e-27) (num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981) 4.3539080668052e-23) (num-test (* 1/98947 2/97499 3/76847 4/61981) 5.2230351951008e-19) (num-test (* 500009/500029 500057/500041 500083/500069) 1.00001999432878) (num-test (* 98947 2/97499 76847 4/61981 5/59981) 304151204360/362470312515139) ;0.00083910652502692 (num-test (* 256 2048 35184372088832) 1.8446744073709551616E19) (num-test (* 64 67108864 4294967296) 1.8446744073709551616E19) (num-test (* 65535/131072 2305843009213693952 1048576/524287) 2.30581222282939585599978637654567059645E18)) (when with-bignums (let ((twos (make-vector 30))) (do ((i 0 (+ i 1)) (t2 1 (* t2 8))) ((= i 30)) (set! (twos i) t2)) (do ((i 0 (+ i 1))) ((= i 29)) (if (not (= (twos (+ i 1)) (* 8 (twos i)))) (format #t "~A * 8 -> ~A (~A)~%" (twos i) (* 8 (twos i)) (twos (+ i 1)))) (if (not (= (+ (twos (+ i 1)) (* 8 (twos i))) (* 2 (twos (+ i 1))))) (format #t "~A + ~A -> ~A~%" (* 8 (twos i)) (twos (+ i 1)) (* 2 (twos (+ i 1))))) (if (not (= (/ (twos (+ i 1)) (twos i)) 8)) (format #t "~A / ~A = ~A (8)~%" (twos (+ i 1)) (twos i) (/ (twos (+ i 1)) (twos i)))) (if (not (= (- (twos (+ i 1)) (* 8 (twos i))) 0)) (format #t "~A - ~A -> ~A~%" (* 8 (twos i)) (twos (+ i 1)) (- (twos (+ i 1)) (* 8 (twos i))))))) (letrec ((factorial (lambda (n i) (if (positive? n) (factorial (- n 1) (* i n)) i)))) (num-test (/ (factorial 100 1) (factorial 99 1)) 100) (num-test (/ (factorial 1000 1) (factorial 999 1)) 1000) (num-test (factorial 100 1) 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000) (num-test (factorial 200 1) 788657867364790503552363213932185062295135977687173263294742533244359449963403342920304284011984623904177212138919638830257642790242637105061926624952829931113462857270763317237396988943922445621451664240254033291864131227428294853277524242407573903240321257405579568660226031904170324062351700858796178922222789623703897374720000000000000000000000000000000000000000000000000) (num-test (* (factorial 3 1) (factorial 5 1) (factorial 7 1)) (factorial 10 1))) (num-test (let () (define (func) (* 1855077841/1311738121 (ash 1 43))) (define (hi) (func)) (hi)) 16317437252872781692928/1311738121) ; g_mul_xi bug (num-test (* 30370004999 30370004999) 922337203639284990001) (num-test (* 12345678901234567890 1e-19) 1.234567890123456789E0) (num-test (* 12345678901234567890123456789 1e-29) 1.2345678901234567890123456789e-1) (num-test (* -1.797693134862315699999999999999999999998E308 -9223372036854775808) 1.658079259093488393947175407121858559998E327) (num-test (* -1/21 -1/2432902008176640000) 1/51090942171709440000) (num-test (* -1/21 1/2432902008176640000) -1/51090942171709440000) (num-test (* -1/2432902008176640000 -1/21) 1/51090942171709440000) (num-test (* -1/2432902008176640000 1/21) -1/51090942171709440000) (num-test (* -1/2432902008176640000 2432902008176640000) -1) (num-test (* -21 -2432902008176640000) 51090942171709440000) (num-test (* -21 2432902008176640000) -51090942171709440000) (num-test (* -2432902008176640000 -21) 51090942171709440000) (num-test (* -2432902008176640000 21) -51090942171709440000) (num-test (* -524288 -17600000000000) 9227468800000000000) (num-test (* -9223372036854775808 -9223372036854775808) 85070591730234615865843651857942052864) (num-test (* -9223372036854775808 9223372036854775807 -9223372036854775808) 784637716923335095394403086170723686146950778700062261248) (num-test (* 0+1e20i 0+1e20i) -1e40) (num-test (* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23) 25852016738884976640000) (num-test (* 1.0e70+i 1.0e70-i) 1.0e140) (num-test (* 1/1024 -1/9765625 -1/512 1/1953125) 1/10000000000000000000) (num-test (* 1/1024 1/9765625 1/512 1/1953125) 1/10000000000000000000) (num-test (* 1/21 -1/2432902008176640000) -1/51090942171709440000) (num-test (* 1/21 1/2432902008176640000) 1/51090942171709440000) (num-test (* 1/2432902008176640000 -1/21) -1/51090942171709440000) (num-test (* 1/2432902008176640000 1/21) 1/51090942171709440000) (num-test (* 1/256 1/256 1/256 1/256 1/256 1/256 1/256 -1/128) (/ most-negative-fixnum)) (num-test (* 1/9223372036854775807 1/9223372036854775806) 1/85070591730234615838173535747377725442) (num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 720/183561983334767209753061626751) (num-test (* 1/98947 2/97499 3/76847 4/61981 5/59981) 120/2756144552405627689570151) (num-test (* 1000000.0 (+ 1.0 1.2345e-10 -1.0)) 1.2345e-4) (num-test (* 1000000.0 (- 1.0 -1.2345e-10 1.0)) 1.2345e-4) (num-test (* 1000000000 1000000000 1000000000) 1000000000000000000000000000) (num-test (* 1024 -9765625 512 -1953125) 10000000000000000000) (num-test (* 1024 9765625 512 1953125) 10000000000000000000) (num-test (* 132120577/12 33292289/6 260046847/4) 1143841133453061178785791/288) (num-test (* 2 12345678901234567890+12345678901234567890i) 2.469135780246913578E19+2.469135780246913578E19i) (num-test (* 2.0e-170 3.0e-170 4.0e170 5.0e170) 120.0) (num-test (* 21 -2432902008176640000) -51090942171709440000) (num-test (* 21 2432902008176640000) 51090942171709440000) (num-test (* 2432902008176640000 -21) -51090942171709440000) (num-test (* 2432902008176640000 21) 51090942171709440000) (num-test (* 4.0e170 5.0e170 2.0e-170 3.0e-170) 120.0) (num-test (* 4294967296 4294967296) 18446744073709551616) (num-test (* 500009/500029 500057/500041 500083/500069) 125037252995542579/125034753009582041) (num-test (* 524288 -19073486328125) -10000000000000000000) (num-test (* 524288 17600000000000) 9227468800000000000) (num-test (* 9223372036854775807 -9223372036854775808) -85070591730234615856620279821087277056) (num-test (* 9223372036854775807 9223372036854775807) 85070591730234615847396907784232501249) (num-test (* 98947 2/97499 76847 4/61981 5/59981) 304151204360/362470312515139) (num-test (* 8736/53718 63349/36593 2595/65149 64793/55654 43939/26485) 1390659088083157464/64205855201422018751) (num-test (* 54969/62648 20435/1782 23198/40155 17874/3641 36734/7395 36402/62041) 13827254253801875273/166253154009320895) (num-test (* 60943/34150 48303/50035 11510/48029 47829/30632 32873/18834 22417/2481 33058/12503 17309/26655) 1265424338804436192426278624740533/72495658400472874898571063803000) (num-test (* 27004/45232 47028/36314 65506/17434 26523/52475 51611/16322 12090/12813 11405/42722) 3271229108161979601346009209/2797073684091589444785715868) (num-test (* 49543/13313 13047/51213 291/3256 62128/1256 22252/50000 6721/49922 20433/22341) 13848375453906602673519/60295540932769356700000) (num-test (* 24886/21411 24103/16998 16669/52061 10869/30910 63499/50270 23235/64564 6966/28625 26608/32424 957/55396 36661/63680) 252953666671747144783991553669663/1509848199529034284126219405993600000) (num-test (* 10658/5373 33874/4120 50218/27624 32003/31997 36890/5232 20975/22222 42566/23821 32593/38877) 79446367034396970532424018904275/268718417239101417993099877056) (num-test (* 47540/33937 9597/40213 20965/57592 33167/35761 51930/46345 5554/50786 22141/42957 38576/15987 33878/10223) 94287693697494661741863470671584800/1654020197364120441179131115365910721) (num-test (* 25521/34695 63478/8947 53875/28904 102/42469 1068/32213 42994/18166 58634/22402 26266/21149 46345/3896 12489/21331) 2213218340996076291055274962125/53325428353972306616141560355198) (num-test (* 40953/64127 12327/6961 22167/29019 49635/32796 7657/16493 22904/2449 61975/28667 20516/6004) 4090451708614082328368601750/97539662436128754819974369) (num-test (* 10109/23696 35613/28646 25222/28402 1339/25272 54032/1074 54456/39833 38346/15060 41802/41388 56761/38781 54798/1261) 8983158114946791370557093367421339/31998667830808722335250880339080) (num-test (* 3039/17717 46858/6352 49984/23638 8924/34958 34932/46369 4022/13488 38433/34538 46750/2645 43883/61392) 6694310491567033247725656525/3103280388958588906030059796) (num-test (* 31536/12807 62185/56296 30389/6526 53321/20781 58342/28759 39269/53225) 108723306155880938114002/2235179806925856029655) (num-test (* 58784/29145 14245/16217 32388/51826 46401/13774 59002/56853 35615/17085 41786/53891 41646/4047 49564/4554 33807/36767) 2545383335773830668541245993741980009984/3950524525412306420222230035841219227) (num-test (* 39890/59976 16641/39135 36632/15382 4037/16674 32789/39049 5621/24393 7230/37552) 4325746891228381220240705/712068637373286863948894448) (num-test (* 64658/532 12056/22843 48004/41965 17525/20404 46987/34608 39890/37132 32167/52059 26352/16429 62428/21665 39941/30015 19743/16456) 24452413077816850567396233613920457829/58345020552056693855433778720676771) (num-test (* 46215/56564 13217/15837 35488/45940 34754/59356 39024/37453 37845/19747 12129/17699 11475/23380 3024/11313) 9665517455334091811247537600/174562349461714107552224378659) (num-test (* 20849/43211 44644/8350 39144/3119 26169/58795 48540/58870 53603/35775 50387/50026) 1503119635914748931419827344/83828469729567613584821875) (num-test (* -1412797070596191471 -15492755620416346417) 21888119755986895161222137392796809407) (num-test (* 16686841096925954110 1491135775021813104) 24882345731730524499708005167300657440) (num-test (* 13262412958100188045 -18379071970155621919) -243750842254847872704698616507823758355) (num-test (* 889503034794263569 -16600674457216690894) -14766350309325860687849239111838240686) (num-test (* 3148165694020236318 -11771070679825280729) -37057280896113409834434531491271315822) (num-test (* -4443818546267181727 -12001052312087213799) 53330498839175802532024121011435050873) (num-test (* 8305259347214213793 -229351169208067535459370186456659711595) -1904820941859811670566233132773219565154696335396051029835) (num-test (* -18273334758510166901 290047155020180552782039318570071650475) -5300128759437251944808204783222405076790289915320785927975) (num-test (* -703280433697652940 91110448009482115063492795153459771021) -64076195390496041906141380919369524419358692517527451740) (num-test (* 15279634596127882146 -220998726467849290098339792307263567896) -3376779786638352686104608499923871317791563686466157184816) (num-test (* -4472497681184076830 325612942672822430032905460436166528379) -1456303131067722058341139305566346079551678140995111358570) (num-test (* -6180420673489141029 -161157288800853703711204405567379740552) 996019839388256252540244286609069684717518686623358308008) (num-test (* 14044956603588468379 10163190459901171254101452124764637970005230126310661589196828892266636678427020930101076689732526935899135126391465178494895371156141265424428405590113790) 142741568963316278148132287599703960511135825069792278910440475692913696263448088587778211787403889397993501704943449376875999977937418748662459138952952917221024170426846410) (num-test (* 2133283347509865817 10577710515843519541178984366353275630877942729579274295972091544607384358263130633386329706527832990861547566574369528634541156662300858851752195966167381) 22565253698228972909216255630133478029433774404794962869038558824053350969301054394347471181756471783852326407546652836376109109470959746153989521923555764579738243072315277) (num-test (* 7812722507014599311 -5055959518947106416800910724733658104378582281318226107212861190073091017493970778425583956006925004399967175604321778956828368132273155364830637407968648) -39500808728232764770485117356353304373275127104839804121600969932458363071148383405901570717732548020267052999198017578112731079638156026910705662052515278317807704170401528) (num-test (* -17560801708050275829 9842515227842383346577123873881045824143545509071137371075701856197189100217561683579562062872293951325890789283651221922663521213150065638405410634222129) -172842458224605375239887212582262805312641302639067963604956593404910080268476692854082531021580381176489626536608405283010496488558204787140272050713264572452317265305619941) (num-test (* 16743386830114877156 7347065846171565625701636575261347705942035850951855454324853850791855951431141198155170102434274509450315416946729031216385536668189501958761688618635668) 123014765528775807847206414290825117502032199391400884957413813554539073118943905948723779020186281150198999824020769031248882909461419778092564985979904308229718874140000208) (num-test (* 12697192948029671719 -11416780209809507417142822520376617951137069007568339428552592261458272400645205700952156716454820410468812274673183389934216970221062627926131479014990611) -144961061169197993494569769162151457365959287966302572862364500950127981616038900865036521107816831702945678695331078399461327412574397914795455218447174498277798426197230309) (num-test (* 17005139720743105479 -29990519259587469661876904501488342396062731024702923152492275204626478246142153608222329335341363164148761307659972897552084842238285026253664841395295138667328930482145590159132144957515157474957872335043653264146346772142483721767458961320947069718037828473530001033848282453826154763424789967441239969918856795769965946388666154136004597297855416503729657013008165049478441197537144135384444157408972370236442813734429031404855591324183846423588871065272526864866155918285777640819778251612915859290336548446745308788013234099839998683451658620461972798204104633072664604846231692505409653434538208644416538994256) -509992970306921990341332390474393215554862069848994183152714032617297815196921655222705396130464246880845576204295466273071779248718654338767559016551390771145212884412809612574391658668778295682412755916528976282396155832617323980694289208942491001345059122414240884660276842648466533488559879226195446807748573906940273568334343093922652142252689341425941673567630236228358747411926991658260241924294146562230425295426217833820067881064577380516936937782688004146531121831211284735538742160763820814174631414364095096099434285754767091040812242751724012532803037860394426031234340719537172735695313262283511554154662650333168783128624) (num-test (* -15877530153400521290 27863984127681242643954505352420303514833683768731313003271701952957204538094398204984051331105594788039352443762851136101330385230866919393696564428736685568762923746771275677491379334452751710169529933675128178840986001684425353245791752781476028565228371147542431713985092322787978914276414008774443194161599919167210582437024618824616489802661351916633993681556274980075051797120207655478780052593534285265078265845445633803877185868676955831374479850746658711791169579387317321983669227930929736238215792068273805543745311609083833407544342964285215427999724272264458975101474080574470499647168865409458531868592) -442411248181132450919255517905812929771246981404050821923231762557171158858876183536414772404562764742655092127161703706239729646027465795612501446223663310668879007072125975886873343449629108246953385822769744013416908613100114754904323190537317463286500657291202287742354250227377164455244103312266617146454847578457073139633297517170508179596166314955134347046515455569689877574427319658085169791949003021426613961459610227430636932814700361914589752207776142403364490846294795496119883683491811246550808038342285518518431538295199537270236275774546666026424361019715280652576803278928827199810150387207105149968313623040090578323680) (num-test (* -14162897687527555611 -23016403916121951319848021112075986869602408568431399211927062304968548663313037929311574133954267816204873252195499803324830278637331653769648377216095499136975244697758388851688873078022850203685120154634090802825656419418077380419130449990938627982123188424119187922828250625318327074513352279785514062876718714640725789938556578327139793467832731546881422469843509318627826856881082450937188956068348931459011923844607158528494902828851692203126881727638511348944908726926619613375594042390434147948508706733126737304560579515324106834237197081860910657003346633962662773394999353766192391746258372744063777808796) 325978973798843759388794644178802841408656469654887121096165875654577046313115917671847505813174070119516580105483409446057747653173640660143855580491229746795572929387698247460831363721394707501497262525550824977473864621747159715947297817600227665840640555029633517390896890601028716769035575763283168066843141870124768085499453574902575378368669494153555135898430469356384416638130459557518713454927909937610851489821263029886989981438507377741962130296498574556444168140838201069779040087521405032426995145166201901368032136008107323350679784004016321425234898132080844200202007395427054392280809376612533414505539109579739614954356) (num-test (* 10844738523441551664 13010289169828379103330191247192587220592807931898339555723704078985668371901953113936581573750666143303899278973814509164982887504269303358034042953769514772858989849512527461308415676004712388964136857232374888643347097138114199889581495448978914022318770898259317738823514820591042321773469959130347470144905381758960436645008051488666423115693738341045851119808222048272924385188356021826450267608127588500233526688704136268009202730309974485584784539415807259862449203760469406037505772435323036790641520939576046423540699016607317147689982042035523118533555744274806239272109508745089640043900389441390176681340) 141093184161152226992592021994885140117836445291515772908453669279294934817987511015413332614094493905560980363483549300117114491702466085602279965168041684355125886388302948336158133555051817733078300668260616983283027038746214728386770752826764135491650323133831923154477800324207350667020747545837613879364064704092093040155243919335078139087599906324684688427176309081290932504214653249366429592335409761783188358003723753633106574740731573467850133547164922532633897844647383889253777956821171583261238607289172489135768839436605233457738153233579088224808850428203888700116300637190661108848906846940291749737998056247719674749760) (num-test (* -16402132873169057380 8202725117980211375579199554494319645475746305836527475507064811368616698686329266053570766100878145903342129595869654087772486685252653587846560946850102095086896668181099435964053041678323706849735936082196618754721606824996486473796843333331029865501790248862590712245450877098960007272754260813822886287008295409755783478345202299352891066800825979067590290793893933819913530599309037639082839491869155044147367415785329077864525961799400923643936705317921900308490987828345313709179960659814100113658528990241758360711799009722683007157350272749544178688961738222930753008443755881419398858537860612954576778456) -134542187307192759584182063854799850608007421111316277594191532129597970622559949723743396309231347084450105499455916612009290113746722460358793168839937004812915757145655285798961178877391232945062437277255128401572171216279188126380587081673725314534095093062983435026047851041796084651601813918099532876684901239903769891552275465470747567830660442193995685219383258617057944010709906130655663966913354414611799232001438943448374556294933488875450563987147224709383408815994320229340710143082135667640802837699940654151297907451396297241124380508001357553893328703788960812706653503939250831164194874527033594779746890593262611805280) (num-test (* -12094905083549825231 -7303327854122277566083382629094740392048421584433028903125893639493993705575691832165314461496849401726460344615713884253150283931509897329926825128629833541892164122168618243719393446304446866677253728405617434021389128710195093788280203239300086905325641224801020413858421914412156234316517981228056539721130386645649016559425091470643854813419057026759188125291655398451427686659900364573485593902992038773538760663063071699966278379037038361219424927031644750173900916227834573604566165762753650347331082640552394430002401423199016978155236550541225512734287851807727860645247391524620773399994302380387697957581) 88333057189654571362020288527489792875655269960629008914349561689924145109953656394378545526256758871407020025766992398117775520525507898420898102744530402370720932219749861094609497366188371774072368034971851022164946370916317410415503705484491514312339956381120953283812334833067601825812118392757289250628861166579446800637104996060739031010579056633535166403083327528575504427815713481850979373113173151813491831551023902022537957860211597622343157802805275942920911544696695931809085743355666792408029743911424760065578742910735408262758198787195579745280191859776661700139596074108035867940154338953640690242795671183308201526211) (num-test (* -81618231044418675360403541307856740187 9751573706924018395) -795906195858402819552264165081526765614024708979523739865) (num-test (* -167600745660011044249531125104202473984 -12960244919927910377) 2172146712516287908809731894157839567367040369214826131968) (num-test (* 90306383312124738690336097936949488486 156109477991590792) 14097682358164298866835386043901377722456291173827620912) (num-test (* 126202800261728727198105694812165074067 -17404362862588500316) -2196479330029905727399352310201914876903532806486592905172) (num-test (* -80093647977875266525946940496137725572 -9499399805878278852) 760841584053111508349403804472960020663660465509267203344) (num-test (* 304052889577333477963637861956318521374 7233536405885618691) 2199377646072361697737485358722028853038393128548297401434) (num-test (* -124787646062877233829165925777950698937 -125798384154373172164515376683173327013) 15698084237137783175768362160964949930745617334715009097620154581879012485181) (num-test (* 259623502197082370239517374851053110076 307089583871541575627915295134832918432) 79727673252974285068387698133566605944659309374400074880377824560177225320832) (num-test (* -245358177397026033963771466683003477163 -285087883756432161967673595037725276963) 69948643556453419103498093570621669430956866597291662675473644085666220495969) (num-test (* 46731711386059374483493216849082745840 -216522280665540473581476116002923812173) -10118456728713381305690589407461434638634240429858378588644634276171257110320) (num-test (* -301422430661955757433852743238845048860 -737194742467573013847855072675441356) 222207031145790358162820429948896977201848379524899474475604149595884654160) (num-test (* 109781582310220385246795023904554278713 -273317662617851276579672019029762858338) -30005245475518685175699313262818315773200953201653075289648004177366787958994) (num-test (* -312236719893391897821327608828679767006 -661158307192284418474080017860142217763949256471548515134335997907628404839044913830388499435166012788226998900468665646723366842553747501004752506346280) 206437901167986463762021023207669068873036145952740267172145693855475451354717023377588805030022300923600718715029262618794758202955817341818233889201852381575043965927328029955969846754837680) (num-test (* -134379788461141842858846278268259347105 -5535479645589936472405910397299739073641612836770238183712206042659632410776896398062277742229906915852933418684231779996404071421767274180368154310128427) 743856583805332082970350662728998610690268824090148728726850517499798631519601137183443104910590855501252539324674812560702657332874686395923181633958702249128106139207076314713649515720653835) (num-test (* 278271843790644800793473851247546123375 -3845690285506025443856370771250487683891303505653819308540635173436088084480277686684743918745832832765066355874381847690771330587033980524869033600561589) -1070147326395532917564114389205677334125034378502074943828571411806344559859053091006175486397820822872698474899835730026158782698085673635033947150554253148685482702599776833910878579880042875) (num-test (* 22345490710865165412267189692679994671 -13168094845644809414256057134926669929759930873747535851687323456073141938879368460977723280750841588750507348317544461824280674332488497533955177541413394) -294247541053147552931885013427268298282376074124656716577088212043667912662239091316191145352314750820026626159649861330384837204227899202392764926604802655267738710003310052268554637728023374) (num-test (* -223445051950608517881717261787296926498 -2609806601119499724524852022247741111662431776874117401343811680374867931883996125145979162937751368655661775097445043144114599069842524778189198926688379) 583148371568187658089071213924575304457465978545376486297236105670932990897420147110485946155066725440999079357995678147717407410446012970360780626554347417807723098476525833332400212113766742) (num-test (* 12604140228725912459681435851589379433 10671266866958584640992033560488052420339425977492420594983497264069815016478448589306666811246532193922229713077112601565462530332258877522384022088660628) 134502144009302626262781543880199144227907004673612064586081220538754991037447647926963488301214672345398823354945333417956344119228084327815583754032364976497975702972112644238248704660063924) (num-test (* -221289678591114384943252477126208006780 20020996887149770966522122735176842174467884990518978494604707026520269232864200848420530223248762875769520715632742683760311747174524709550334825291720803698613541109690224185041740294906022358446325921538593105347423518731748623037078340006459454656405997570119591344894717789372844612253617591807770017562530034107842444403952657949565007792107071767260484233194674888488789619319597151367813735192433631007526015463229060702510632792171187339118004038505860316305860704455466207113207893106982258864355430481457640304138738182009363353560090082819036973601710432437342931523433079941958203038050750205966472435692) -4430439966231074415853738608900692925851705818190624801199561884242897308817127146763274284287396980593383317678766559004881552228480591814939402896201244425805503258878061459604511214900528594870260206969839682573246490602076070316760182753341371682323914671418233629420599310422437691170629449435494697829163966912842611408632129590129483811802031178053300073562716917597174161526976287351465154825036851645956354853960835948518860624747958440181683978083391663149733813297698623499283645627889274004656942800842013709298338912226207338477579862672216831422765369078886850523202897989792734789430796029206661261129141144642117177625405158700499049991760) (num-test (* 180785619668676509441152734583033930295 -11909038209406834057075682058438206007134213485822042209417443270921391661498900475635417780140585878716264253792335317341527677051828500780153492153490249297998660274828986996948999762620400587091118252205695562417522111840305140989214300921122857271717052213225664738544344394774362885331856170636862181712515248810239601812262573113794334115259873527539564296101166439562124016438281173202196876398090029995104489712272260608848551754611421227761245487365953257890749115194455096508613617028024932657498899001119282498614739316599704645009607294747043489655424155986912576002393048535846081096337705941547991821928) -2152982852345560218506186041143281789706715672110278207735389192913214838321097754496849942223194392302524369156102301165660674797665128931611291246607346536492650554391248756408556789391955568308599431054809433808337036546281323840555452571430884302696950144068129601527530304907460164571704857360215834011779559395577299313379666503707563751314135201994045874159291100986903645360754621200008830207429980872071814202801994486961737459218017354210479544121100423399040398021780750351097082070296255480707530391964970754186799748521538525274241709676878827522138880241734356460339681718690408853314007343934035505873192699052380699509877559455199604508760) (num-test (* -196121729286794751535600080816329923561 31755463535476988506639447113088283661031267977524968610501132544098607201258848456920865390506381665724254592728643925608893982794532243733117636645689751360224314774452374503339856173343683819017479955914451013484169313685311530532055735999039466721411777061709328450052490025363788971916050033904534189719389237878257877112162843506491071470067738867693853480174965212750301808781573369342701195147083717623066339671595077736036738235636996351642097684597005928843274525502529735435418805821748637387888409663397547514467435322454217015563134545731593492200855670248739786405074231658957946422903165662016649229286) -6227936422881500100190187768375947805694946596622670066116457374856427496311253030141271922822486386675428302332027411428470488965226898801659352566022706152307022438261392466548357753526474097246042956052374187605144719189465046544498482461077851578811186829094445089366592317045580466302238653533114619908864036973070346979261546801894831273337217021756025770590122176562027129481076270727248949609326868225755958667670279949371399535144788247565199415296122873444199709788941984099349149684384486618280260678252604631431089580057102263617056951788273430713908768738965854953667135156866028646584137788146112300214498814212865170902491169332389942607446) (num-test (* -149247491509558553673630984739524508601 -9241905448313719916485289537122695595500213295294799660583133638026091750542612875183284894676615989153030773719811347110864468582634048542108726080717551794580656021381515769591713295631818532114918070215760259364277583650102628486861397602958930509695263902920994329409932518607260720657755504091822028630927071374796474717671220452208310602827254296323761245420486376569048549643478954846020045263141546849795367522490793641049509748005893155533480849922847230018411440739584477452313387881413141538766185123978087175960946255649923135634987656065468774634483495944248865774633962770893338531522570776854773975281) 1379331204929344851843348280532786532350930013132149419346606977890849868537539899667631713548510207947097949976792337278764045110931774279794402312944786743575421497528669859045492875676005849752425421867514661792129580445000023570590786705609341859529483054902802038173138834528021423393677908655442991197348183257271932188161681770513283703502340499171444058119260228931558784004778969491586252899270869275893402714040693571919281494643765571068045362364213060063345212881008657925426024923296369533374671614852576576041747836643356665301762059898161073609265572267138950725010661453917338098901465732991316661901878681888138048552901254914604845891881) (num-test (* -246070233154436622785727814428081917418 29761582253452470642591719346200231425423204062498655510037025199574178834762931489817919404889920159374886981199608181795387339523762458361385170203883094308920011218315748466148953320570427838912637152446837553950810011344492780712558515815917745810385725989241835877316836808088478276603934260581342710503593237081689944686263274319354100341139245512159619947319496638082702549196795236216458749363904150768879765280332386830831409591769966706351022328535490587838695167807967607003680703048770719240872629379640571077329748828739281770075441660330884779539288220944313294762143588847790653176774089774033399559617) -7323439484151992757431054484912931979861244043627630118213112440051387392428853497035249623931234821362770902740177541812170377563064854590834087655133962963430877452052749127605572395112726398103244974178157574726551814002744001021805127518246639418981066588073652668879613252372759895389345727455380224104332342029151667860553645106555190741775758687650292791318963679857313030729683299101577207875499929500963723267185390425716927303375831321783415003339099100562942730763231688479910689887284950156875532151104047755803876078837921949287811575034368641167438367411569736575067233548122814012421044943430647665260439418887639347030312118291762161708906) (num-test (* 203826295936164259559522643510940430939 428315860474710981601019542870649234168732095026625500771233691514247613083810271191136212287636290276352210600151884730196161003906066671915478570992925366265552107746965374246537358349673161970290367972281768471743836339191023211359427335141701167253694144280251188008871929010775436125645541749886873478179599464478734149706121117222690271210887178499620737860802605991262799781279373870647695125320153193063528861104479576369448865373971847676465682752435142074973627172566791961541105525781297462635428308325033717669972726101583722868689418677558787287897456521530400671342257419067050354522203242849353639864) 87302035331271280954456598486072605056704393103691656908943847729634903654600322194677794243221825233700566108459784062758955025931450719283517278054268553004951352280583820782976072352456972931479389375165173986780482062859853305469143408707179895843295115510597584169486406323435925707638987591151227843652210256611991940374072593149367903739596883229844326054223707236369465710416960023659329202073724249764308867733476242261506975691004092043954515337899900837434270833782490145948781128533218641649564543508314976001614187701395586824982250794852925954991265270537649691628899148413763865280007928191637215283244406869662872539567459561720369352296) (num-test (* -5899540498246269366107488541138263797694914692322476860852796858749106720144552037986906792251681094769894732746138541066810195167688318229720888479512583 5834015210744942902) -34418009003174534626858248456163154666511779871358190892629413477534042866009573638264296461516598238780495750056279721797403178867717911762916049857737963922333901125535866) (num-test (* -7558198374656605586076446665394545534375963428962439959101805545423930654069723860456022097647139432324162475685494459942871728608277717748075653794546685 -2079670855873590264) 15718564882684481784074014915267371190416032453294568239793060140651422710113447422494938907375595456199203928496644205320139985222135619659630853564447794621716315309474840) (num-test (* -9442744083812363570102321552182535031605446031706376100893354933468482520577272174689455502380973733378565213055641110431767353396963744600184737808983381 -7204974197101757391) 68034727473703353914019458883709211780958983263702756416891835054494728840771498925306650413027883039860202168095834137357212487561983607389479135319040711944281262212918971) (num-test (* -10658732210276096534851972646242288663170038580488752611749460640657411087860047053151548660331707024718100598181073744715506934778234716535781332588396176 9193953347013373121) -97995886679587166046252015742839992974979220158813197140160489510432960510418039749924861744197553021702396544307690217470606424904065359660871469041838900287446937257585296) (num-test (* 3330096979672637104536573277593029682675932033891010715180474877149733802060455951241981993421466123791200840797318740359792251505430948855600408060492000 -9413190658845804679) -31346837782105095097578725347257193539696338226258990009265748336528353873277500144838721882313026604404426563737656928378230261942407473822851842589487713775609448642068000) (num-test (* 2224201331350479188470378485954814766783857696988331736807430786504130570570323948774102396158334805040994159865821844362926631687258969480929122732089195 10226747830478556903) 22746346139936030910929166328517425029735137934434969334578972386859485783192993228082340012742115893176871887387993591191632260444955081663604449277961804869872353878963085) (num-test (* -12394770820700925077767705800588617445613665027183406054209162910642613421436080064653443098327137503596792411463268187212855350864330592654862321763110243 336135860956209890623046930607725140868) -4166326961171213704571179876442248501325782360170764344978629523457550315208845439497110652079907652744850691289494398473488033083739905461347650605270023127087625641779424751335704552988710924) (num-test (* 11792778994619176404079667787533709801900490264171877873621265044313417667869688303207909681289642260521608966405181881416781694320672906600599581862090088 -197661229068721548419113517262926820105) -2330975190212228827672814304508257223671550753091700552243633152084831515892056240354560520878171696176381845689952044935988868477421447557890739834031207059212175922089523097911477486879619240) (num-test (* 11608994516281296345925963401821217560860934641820086911326880657644311461955556832927259499969983808078591149768068360172431078248807463030805586293656663 -40654941048774156019243747229920736005) -471962987694958552110784676392477007070112288398143925079396435246284471999814508543057304008480666763661066976653446723271982094424149279649226771823800871458389214002872916339341019732251315) (num-test (* 4821517917539756801293776911844480642406562140007084392649374723119190602353617113036081438891134008988421494142194891002983491670246762173236312873933599 -255528396376819316172341014108564420589) -1232034741571035406264710387186737842510579499938716343220834781077329515145216794636313459582844773420679078031627466542930137302257934575129329529129776153159694412903937370462708576694469811) (num-test (* 7638751115643228563298483305056828584775811590562130101723525925933790010789130133831569153863129513189315440899053288261039147463032870669035935364282061 114438828287750304954799140618669114911) 874169727255956505920153418854946321208907128396839975975317705220623267360648189969313978740314703015845506506608054761304647627635292132043887080298168302864314697920637105700927041824911571) (num-test (* -3653826017463740005170218884285271512636869606149686475539243914909566619638259666405831445823138528809165270360144267462878986866506114069923299116957450 215752050445782448772085819939961259625) -788320455239949216234629350585027855111249573063377172522422069903710014529292638311216050777840734448624510386643245486023092483841464815987597578151663227035102742664709136512524899527956250) (num-test (* -43242564273985683175827997542883970694363047476880657467026050730764924897992516355909421962249292250047896135687573746158665836208681548975073555418266 4424346097667245771102179669235543742385176589624011161914909311078645828684936231569739522607200308028372644149306431599085361996722603718517735348761218) -191320070498733614136284309000213964486426347688040889144514933290125387693498098446328694172047943298442181705949005984031677324306763731212307716485454004382079159622650481983102917517993601466178931324415483972311904823997211920702201161092866663969163567426868740120661073974542958600768774774949607988) (num-test (* -5093597555679260616199210906198149266592665304134802327659606846977583233938836318559188141955851256260954289429418183711191354912372372976165948043123133 -2240632735861652612028397136046974907251405868353380459030143407902436514978447480884513019736738955326732458088791830752499716417751919868492224207936623) 11412881426559848135724717164530530041659963797467536748076144863846600718211858527283843975968920120508569299672573958424908957105703597501013710262110218780710678312197455759181436286391257283676806548463507528765947919856827004176416634630489598937924092540289712219714362500246928243091408698274649199859) (num-test (* 6049789822056553589237940133475342650218069231558204589924996117723031491205673061674252841792149409384720347601549237626288416453061224734057079515141650 -826416247951451524584060567988229017033981218652490450160817307801130685352465013890931297548015267655971295627931896259998420078888499206031390299169584) -4999644605638856588581238481465237523157457201817697008198975191261856978252081380810200468420738807464233192102972784271159116426108806200426852134469939032473362689081653859652824862066224063273799612269941254948709760659691148103622071316554194507524610166457990087959160807415102946877307193349131573600) (num-test (* -1175978338162966145239180473229656000174129248706173549637767835154921467129547950144109700900405904250603515318348888619371004435353505449762899046094747 8633693716102199391202401198009047492431980605560930404972542822133579985462906768067706391388213605203282586546130434156768523403030127356256666478340720) -10153036788469908062299722391986722149392791936544969945546931764708792252481931153733789787389051773529081688846141949513463792442701686406966696738286561777611293604311491896230769507535896070984747493738525389837795316954065260075941524322954935690803870500012809797698319359975893462672845329776468197840) (num-test (* -5083395547684319640767882199938390155755986838939007846911062687871291096073452055061784159768637502151635665247461348347470360218957222873087414506633886 10813098236568616588240471432239693891825284805405416395976866126102880121934298269375465735278296789484402954117593716698067735458182402220278016922449294) -54967255432446073625448401244836956268872685687128644401372608170106281377801209665004925733448944141633739594240156882328181133879414641109484442890809130544146420476457200729843868300396656004198615619691952536924980482714767859804902602805398865249514544806725162402291122143659939645240358379962457176484) (num-test (* -8944626200084865988157251013718979706166428261352840753194709093968177704853157211364231059892647813839391802007588961807572842923682104089512428902387812 3814836951264415657788614449012480613328314590744410079075164918748648723114236698412482309581077603776489883375576245233128800002373843611668945838558629) -34122290543331565327874124324135450224668275222811493728051290368641401807963502623692504750924543845019291736982354932620821594287780848608647686402233097059022704206628297180782771812500512744911371653368388270442874670230118309469599458827222162362901084328510647514081302476000779049412605744638457029748) (num-test (* 5186176030253526423885531264483408352469356233262336223619904269047786350470477526433506158542551137478071074193659876898065998079440819597952826155782068 21428324964794197485898135923805540163916541943812058590308650649384013587098638034673796533027113673143959572855470411726978105342739938341516634354246514986124789451866589211982659199267654387148420461876524076040233779391563396552267276880650559148637067641021059664960876301072636635299261389450890094318429077561092553337025096293793433968243940381587994428364726938534453507046761494257538813861046058298873206568935790790373886840765817404479239485444563488020955730741209738203470138117422899051269778988135668626686262669881048094388220931264751830393793846372816717368806996496715219806062282836392457741918) 111131065300898907482632501071313138589398597291097276435916516379173430095773463468344138866282820740991088290299992221985607057347883717514843661030457396422379155394966857856069231504805779448809986906434617741485942621643754096548512120178021034054648207248963478122178145159262707381679354401629366698488021743300737044695960363216253889163551918513521913593214414139637549577618641974388739304727218804595402055185824193445089425262833385286117064481648652550355832014346131722965510192584901901111154083186713580209077544982897821477349293279848852596241762198202012197892321827305803333334823616660229870976569043453639028059771892706354703750763908127611939169337399882784092285804830644630059487027413697220038110815990084742241055099963659761569486906596326424) (num-test (* -12615422028124847936088012564413126213419674293830655240645918456932358053670311316461359727921727680491520480380615359506308571290338231702217134487397730 21538722931308708400287621200994476771789912594554241036641406577761480056366647329031140922034590767810855360008375309986798226712928670905618807986829790199948665185268081173685941421700542631395958882077936923141152528333121096909688700106365468854487023847026564219531968849793109908193037522063952753477768381591929787242143631287330811801315216116212154423972654430356675401769729358415036943501470085182304183033246682446978634892995900678975109490698283226559860736462409705544079080978470202336645384768211440438501339641775269445439018148409151795830925198162301321965042997632479354427154223366199106583051) -271720079725309675925162538296715595434811519956795637977932956405490708202732964133816538801099235844279338645471102896234318181092598033040518838847055114923365599862266767493227393553801736813141780001130539648588341196802606083178208108557367013886856183999712817955194261262279080641101769944037282423238147653270651419282545398168930625797556638625301898893565965773914460998322350526545278664715332414172614761548301364063397364632709194713561073496860524124460861314674679928692398440036071116570829193414179054372604203478369755566003622621281005164747628075596444178089558747835994702060740334079222508147598079351187013336751322569865313532407367116553748939535664259669808534100091049960040092785009707220249025633808590643620557093069849490009472441113874230) (num-test (* 10381022953674450046578890619826448644067144294659610359943634722044183130638243233110364436029778310048006743033299956844491228999113516347401915490861208 -20974871685432829994714153210121536409377362402944992609230062091789259307033495284524234519701670462495676590513192861649457148897274608767543942797542628100823017887236899471151903799837558453043431373811892813126194662218472834650841742305925226558315372771353677064933578639099452438843500601586038910108679737480263349221244638463171088589123712367802373159421798288708123925853179931628847579314900787361946716531755600236755527982132768286927549323465697241340003870259800347640599467922823203446834792229595507968354687630029075884034263531531423883902851487995214646322431057626558858528344843531280263328354) -217740624416854507100100919338835880277259264187442792458843251425095703739537223785767883764746809214920580060316177442387941385712712426957388995082877226019966428812240179251716274377143798847348759498926420314709056615470455134468678662646006408843897699718742372199854223008996321568642038054564397441209859567556502098420151667437837356649730396360374136203172669776530655738388121236079327354422138744456395348910073462618440421257604563050031602590345028438897601523520973759458890228893913090702884911857207117714231568437403212806578764580006787626657709435954760239671948147344463295520930250155876010414461245194991189183956653772752290656063730950237649394743456230607077768595983629559996700837383822873994717987698780007691157576205450973669241823945091632) (num-test (* -3984492646329789478973994496812455855595578196959138558282015917391108383154917581748539892089090551298072688793487597623310815918942283997753800645644511 22199897116873160263914990610762123553075230334116099569358672964060004245706770678771431369917479502828754815568950371273785689812698287446020480951417047185190067265849637510591502642000414540862689426343523077229502494771352820057572619644085930901096534031496492870227890836816886496090287321502805172125273822231241073590840684742085641304915656543831190976008986490532066597410386596132766422026234488163435487889876791504407434387555507637783709991326338482319227500686541368087892665100076351075069628862376686619537655838590687615291898971286325099164241688147975845320979841704002364545072665891829427213069) -88455326811459002089798581395024759975871889172872668466370443703433800509268320055453743803627754859670391415348970278548381190662701716228279482045339649051139909543850883613464992501666524385524517648069873862957915620016943364950043289963237718026629805297916194484838158010754666017024585366330526135823515744339445036315966714684052345462172808299142368905939297220895721123725415007532441824406115746741972351142687017849809593982432484296719999502992792447259391592152463664807498752410740679664044620898308783634092355737296495489953554685938970593890496829484673393665321572846542839714620847185428664388282452532264810310019327395691530430185946743995669191791841546685206884247468693248673484055915613115527492005264289557719000245333079386593840592027314259) (num-test (* -10672574004830373997900438516438419278676753890756925443116289034080220708922677740383425352837266631691319394850521121221541344600832530724104047804922665 -7307684417326792807224298894786988180161884427390942431653062127076829842696634441114228528164049031680536693195116703321494895319862805505304314401000204515985676763063862569446064343853536464020413910728442475032187317639476018710375702206456631041987826826225461927793241495220512935434301833094232834266749666697332380140380619185254354273073522191066457437931022783436360434167505326773192959291779779370530770935758482422581712556111319611455306383173529090289274267200543081481693078804068524057891845603351773722737987393428313340760607600482724483853560340630587029610437280601010173185018227638972500038072) 77991802747865927212086621295493124451256238920588746597961055391511562690441964216934615500942858653797884925704270904527938466874924049039962754703188019915846345804228044693122758075602494985337649496117180241872910247079655077012999375809878184011356481981590430241786534827516536543734645410817621964035091467871491521760928486006653992134635010794346993161329777270345449763927429735191213854873362673179799811714902439637861750855639857969259787075469241319618538795721956528400353086156169058060112255274542232054021662809196965752800525093125763127895334967094763817500702626282397394521201385439419885607578137159972521677923972708827090645776826953976605193554447841693259586575931864396484621463004541561908426383260772786784541411548146173991869741515701880) (num-test (* 1420855003086789510813111205540636553863493314684153860389816109865085846062678305775289632805233481596171530412925552158799875183492757047174905459819169 13897739053062356545217161606361735964779941697726983959749295377836209520566715597422965426908191354971972501742952706730523748574796773473606175934144970768662226027157110240776527834790487577863781140089347362129598158760833470434895693782503529955845076709376071972727346128409008293671217324995682020009675316075606538241192607139905488719485728099428376369506685875348346231688684483781160648420909364963718027571565217314827671844485031440079254478598236877074793221578612249882886835580737423192061550370069895525711885220268707201966615936769696379335772521903910689934596134239331592980694745008817040569590) 19746672065138309742065153069587996891492444461032276894328314121573439684229636534026409362850111716212254549198595854140809664451286626009917828620279583631575940837712663100442879662416765138504151063632823014639305658882804073655537352377258786105147057375069447099908107785635606190515362082317465738205179108333064680370909383338688734129396788764959056886328471374018961975554190739706996184818378586233017775166959010668462907838359485424792026496574369912033757997469014639705459505746723512361959074802456098328538419933637295482429555127226978561859965498424173552676019033370307387047798600024901453757451579262061785051932535359410827170361533603618131510421439128567361259204833501190218719779570258541358012741265599985490513564378203502703406698160470710) (num-test (* -25117824099635104147178796272946098711514362630774369209876335291088434247131228189812265510495277875692804180473811834186270331245779845635089547499275113671007257221593872123397418355506777725721168216892830217596134983713752526559153149600553468865338887605949011743043425900799896245185282419637806859906582214420191794114207677635194054239563071023206500505880052007267243210206807805387341085613436600843317096291021780624738422589234020279836961194869688005260369009833026575446099544900581955685627511787510900479881434909308757027825050977932238481841909425598834367032841935054158448815026264505726593064239 7846111496222858966) -197077248428250572361351389692146917243277049539013604789802566767174747369897711991559940484392921619974209620152008632450612546796556905740493507885376190913893140368029841033442857949219716681475253727058707723386016055991276120001690579154370788782636181079931076758384034193266737114305362492836167078199155929937891579224024229182935372106924021709421948701131654358516297806197381566809357458374057189773041520552821330635689748583803171230633654728360451100477472934847975252390985102859262992904778849652221553818627134153578436315973777720706502751232660284910468721430874674021521629540714057383398858244828214000543075116874) (num-test (* -12000343217458212092754251360179138661969968218789048702097501439124892987400633614429800307263114371624489988815324366411323242909652002510513570900627875514001409309670202055060404640758548257776155562167062337394219073071639153822126554525439988062676648294108951003012550815746564810508912122306190725453386412796036693387315128514162061147675205485143205925649214342646148112549805850530430229663418469577245456944558387628002442451042105749848177325651852669794048215063957689756465788955050513359977166122710392613631703123491357791351447110169966270916789849428298930624807758982400706608788793481972190953569 15463017349709835150) -185561515374029078700596518575548896805308728003103939537818954646551372890610870275966055765608887701776880889777402229764948269089126750201922167386201171243298907675542965323275634529293654817279957832652909009385491998537031060285890512199675273422070784691446251899120095880199298512230290860589352290462643231396804350623684034400741386070220057232978556614620855818271117742675632435727751812101639747357642295230273344552327870600519422276996860893842363996198017494117619585153346745838853026029459826407782259598477529242420507010652705302341725948095720110508044256096963772599572721279996322424269691990173052929936294150350) (num-test (* 20244597897909303129995907707212050478823487084391413473821544089492035634291726811145005824559631386634261268723753786161463497881725871168747275110149007801865428978596190887145324535224079986377522166727137028753272158887188902047835658826867304220850429481233026043496635847568448251753504834367809877190895369288045026559783632709799678639927825194847005181499299410953860627694080906167346078299421796974815616608326704894611151743720515377248152215241639534004099341398238713597030368980166731393247619511322804984829747216779359780372801101821087516269912916462719248736442644433057333788741151270815989388229 17931151643499274580) 363008954869078360197158713265773114114991766614027768774402465306840646219477262855625957403406166192075865834283840624408916170935610374573318606346031792128003204902147985329385955814330782527184421959263266167048755628089412213360508944817963403092490479480264538027768728303095523018598016863928762335410109567604756183580676503045557867957273324581082608248341332512325136675167966306268035077761004923732568405295901819511346235524577361289712297365403327125212199451099538443576479787130510546755789504852631291774614010584650672707483555436445926222945298928326313943231688436271883746272589347954697213098866117569339490918820) (num-test (* 18134862906191691435095953372467318196853760384894170022863300447691250350836421337333332682828557871096554531436829166444150586004379181099133295174348038948038399079336722004125999533719492457544642570217406286811480006881054375314838605871238868968956868878182133492469763282800195060849734382249696543089869191257451321764806079423169235271658993054867624410589213892458246001270123109841429271429275464249821855221014782727398959126117031823977229309775211695677345378510417534328974531801634095862859684508240122911023047425473036305928743193594967362216559973174709883576295373749738633873828863608550295977368 15082354452174510460) 273516430292774638949326170314933525797985748367549139070674899956657807928629067317576809269188258819686207094298714770978509118959142516619521080722291318367607601498107007447014759288176261262818034997399866363248136237609824401265450913244758024085739876914482935655100890803279961929047974391299795570244708811454483314898873277493486428279875241232025231140855860469097028388778917980779775554139507550577255217032521719099071084956515691364008526064349956553916033914728254580848198941020806723485184338914882588931083516851849558411503129184026079582257756707601984686901646494090820169212279581209612798749779318126482639269280) (num-test (* 19213874382308276075905228027166553836726993832150876980655958901416537033385379180983129528081628446454583401834309285184752924794893846406622935494758142810049493348116192315865522516744262115026742103678965417868790607689989205765793528434388393584537260717130892518011447327847533083474230074174308157934463971640826422302901570010591182715932658037868980053012095115562188975692530473556182305847290196895478280679341869546292639446526021874910117953225154204035612531584978136604161393474554294315903436682283787080297348697922389355209790646124024053098888687638640826064745026930980189268652291562437512941810 3155416591710364359) 60627778016974262766014671335614995348970065077989108071534610098195400001445248886220725085881796599270026085183075312353388418711598523030563716616967792282609748819081238929738105086199457414615236966895805539596649555457494710621217412773036416007129418290246899690911654008867819945724649185574237527152410775686803449108977881160831441280833577932476667657759420192656716352190871667386955409426879693856001112340390304980532208752863058384169885129364117656404549585836664647784765508649117301622797243353610345828189312360124462238989888436478381583689386509617357901461416012201469794664889076397809504626996523928173064949790) (num-test (* -6561903839860415551587224953276060627466820222543175464705113686962550773423611522044145975606965294164125376820288981286542044306677764776675868357117109664125730405280822770267329297542599719353907954399688197248115043785617436343303277493146049939491224480136371029084354063731401026459653680017632996944506546122253686805764620116169065663214526857151412139439538335533979733329962892417175374550305659302592107472151941922230309227785266745974334776462642676959433923828440435340579340133192678341787895007461237846313005612116885419002449356480017828933592324336731295317076205553526568668826499450826560670163 14908715577157091280) -97829557993133908713082095435440645457469053259814412551982534425389603663024461131358343104414088618618030154957456050473312402460589893359522167472060177968099538846750606564761307960896264958539903740023783283814849937681270591589750181462708056758506230073751440847913386576449367635057595344744119561166438538811561109125506233466453974371464999669336530949393433719456191822836826214814780222021267726528396849558417851727452246676857867278196266042327956933753121947589485377148388716839519782819642328655117625818256334190717182923260613562191698788004591479576661108985313450029332968584240383859113741485244318702724563478640) (num-test (* -10378013547095983701124686671659666242518351347561698092030999302329372512356819420877395264401390796163955327080881297568412490286247154759694714275858127906305200295043241717769593877683535229411640745872559018085757273530771413156968541499388413497221629366848027355125816131586610997516488552323667400115617175682996681969687885201321292153656071894385242141321468096793766926179134511319941715949712230831768643024119693594235207988046511542691719002262040067921088838755337917414526554050602539873232518619281766327369577617796816586064895744680567067970817494102948032924671421242699225194947982378019119315136 30004910492448871409155105619400474385) -311391367570036811050052853596227388481520279736812036769684195465110674594690412517879149770622679377262288447706750813509857551308594851067359841826754786725926298013483569424123912020079066150719085450400229896983461212531213110847425940968466564079253939695853896434719530729030897976597410468081535234663568150722646854183317007227669132983719314653861536414057481478039579810285535699518386214012059191958557306338432321511585867535008319640705419431310336566447165302011113284064246284641707577414470505948868362067233709611758700034131461348997580441628136979257037186480770286846026250437141175360847735150981343952303257191661069675154710791360) (num-test (* 6311357747888359229575837883366949670125882865462293491587368290797766017168248637163030339387377997726585769250585768079027576213724941259801478313127113803503561717311996500019522893295813684259416551410025111443510215766297835872165689077882298506134885487991732718254835036694083204758447948541157893533099634169589161496492972953698758234452126564385255035294546278732684663873459439615228706684138982066055370429797835904846166362278557095045056472775166294675997320598469599722704075215700819354957397052721573993997624711445698656580401684113096559767093466880001548887739825916626416328760047783071058963451 -212654096583990292869707082365869207538) -1342136080095566600483524091094048745061145155430997807005186206704767933140306297188996797343723817220160636373424666345108189275851749622201429179882167381735732553825696482751584102093819432866729465599060815670807282181979889263381844726842751894916887860819210652174987999919869623292751389157233409465756974677789790982740267208982768450215563288024088369480574425410032306456026930809228182100949940216614156925537929648841127727165386031716586596638254705402653861723407930666152691102484352058909219619985877341630210918347460471644327858114815713557305185589162775699323253049631349906791700893878999711846225062306568467992135934882289075693638) (num-test (* 25104391676237653962996674810232896003857294806799086059884413856421530328279649263948893056601611073815235439115612155497964541323584159786678357898152394779494741995735881624055133443980324145256438160990490767324719276757840825641421547232460969806196141938571103617707677351907526127993230143577974386169402623023560579220343920203666762052525898442578990183400559087522259053245822827313206196194989095468393682721753147596892214609346047051670610252732846805143964713621673722554204896154742594858056891979146566683467510164875593192581407047920719605560716270697985110227952698114701527191421628561835164291236 -205991315859231724218751687295926841150) -5171286675233738337789203670843122752625713948587464573381323151628930998435518250812603433784823922283042037694290795352461861058217142213862777203850665369756106838860420507328654214723398688455622487003912073924323587826356928211672752672052670663842775836967587150049181838707784871641183683742967716787111671792311389517753578360293551031540853470719098360013225516593755039537796518619542838794169319227197212817921098393499332268929332950035803734983497370378852859829228973012039890600437082235032378948656232679080766068869430262740600476498399803176452431728914806536862849281928869092524387549297345184969051926149006293586531930828748109161400) (num-test (* -25971587288596053786734900662696128734726180676323130693160397208008930123341700520454723462226657743365779183466120836187720332442041321870351823609046027805781414454998487673927365486893294110931852680018706479684281928396163669935417207859889405108139261480861908067489849403284000981453574189898304616775302917687860062501465417706095450121596418236563421425311420755550335597318818628123183624214438801254105808079227429950505879366254661664881055965092586612702279548151277733307180663770432418397550642136953750720624507617115504303570076531620003848642167562950736271141440609700821621532583527124386811144839 -182748557863603655835821910989658558236) 4746270122419629115710902425435990509747636609113505336611751359043717100752575149404352359855260443259846554733621122684788488984010741203981300775978945529551335641218319619542248418128319220383298229263331638090009313676486209764655429828385994626323209879925281409485074778611946493692237774852428345451174837474328995186242262565013937544898941834362941815633750896882758939509605799422068815435202904271722442099465950700886702949580264958171808372530471918175963644209760378395316412115175988232945569517230829200985652504383431054550902852797293952515652017940918628980037316292352828228005975466732028971159947131994753006597870175664981312344004) (num-test (* 2117427896392849163304163145095251890404997781812823978967013619233450901604407363671467658244435728579079751353560538034596183240362499870272373308111405924505741579887345118857908796509418246599428633956038017783178050402412769812823236255234302205027282366926174916871858199918908361186936687654278623156607813451034087735179167324944824913226799346886951212979149617678949292799645035425029596869092844906629996914674904522806258932192931217652241231736891642224851547474205131131019084734780208254203537633402057673465583362982905095029133132240839391503135932501785844503813910210348239157828902668852795945482 -296778668392678698960782643314222141731) -628407431508980610909134894336322264939705333430111861505965183839156278363647883745193463537783397824947515214540990712455315080515980803996660089847066076833542492719707493333185909990202372284811233272987993068106356248349054482194817336258302692039392400931536481136340269417905505366385505196886218794044229758585631131853635721528813397816307666671727692971421531381290925317161326036075629905443938124481334173158440927555118173661486114828362551889594188958723424604273078091320087897088472418346754088900034854230711982602435635574895960156993014703292551046970069204857846207328434544990709459402656908170089318995291341536347275682867153109342) (num-test (* 24743327715258194976385899813930363006464428087412805068703455203318769863096919192538751530954777047772548306936907016751357570434930538612382851621309732767199276228580401695793317612267605312672263736938703887622824117576912830029817460033437752668221355377879837833796222831371174014543622739933433581963103361464022058091243110136610854806189138108937004805781857031030005354158991203388998364340053773883952742645161560754545458260688560269655272249435540890073696261770299845722705104648358053080678920468895189601731801025555650490534399590288852165862135571140382055044665678298182909026026068995867606241201 309156501491030456401354118244509785044) 7649560631695275371386748526795333430293346807872366006552933839286343590101586516802834568317627508914888989005968805867728947519409222814667350103434422356009252082456906520988877859152125402282765775845766265340707473525444185795403554160270722809642681642831847296672303556012796775586274347178092325226458743113317655523655255626670958156216225968018208281266858684283741496986683426354716284780229004376492833583965647875097951642088252875535823145900129967026856898970545720526282798418382467634180690243423325770596949644122541224189780082061715230852249880601371985342796525016176048518593825361248232406051886794538203297084423942036889326397844) (num-test (* 31345149697924857384985323414506591310628538098830133854928154990821019223495435414394178930529373634315044777562902565397455028894455733092896622048288278424884040917250546068175763309233883078972879622697667174865833277342334219810618450605650614585133187005110148963483824629405555603493157452295284935004578187488673124814714326405406894084902824045787647963172437833905574178160343833139650913077173865287057167288286708807322607983179910358234015596109655900840652230258122852488289951986129788952718105898226951651151495867246384586164892018870981480003722043190639707903266193064807571586900961788679579912089 2067227180806746570739122295766566373146995767544546241400900414826379465803168632854028593293108913670556431832056563218709444199286888840721753894461468) 64797545442006646811970698282511426059102976298051534827345388707272469591333019870381858263624490336448197115781363489554169207652559213486772008013638214870324260793199674746523791257170452738018910619029072942848422098770309928561867618844814267276213608306045020686764830302020953883994906997293368193331696747777630621086600981981357507299729947717565760536305785574555255589190221698706036770081438750974356437738060098906046001271392354762036427049946092656701257615490057677558059955825843182799904828201890893555678855718728417223845757559310912618029462136640226686626513375024547351747669476392735304999046232068947570708757930233036922714350584650744960478326257916948676866148362166017752159953504981324652709881831381637989229842766220141292801807437886652) (num-test (* 1965759082776833678304908699214846485256126608825750175641683294458978302204367346739996602241053060915897480812220051082619942907491598551933638540412113496542245474287364500698693202553692963910123752514310355402167440783023542848697962967771951714434359320001430281377747193083851165947498546085410216620013287853719686698746328198021011905482303248172483782066908570502837009924228011993318265674390462360820566174204659723461994730913995303015012684826295802887547970851558451858623353950391701673651959262042520584275132971807158231859672678070714276061110616753309305801080136339206017351200193800253572481467 -11092241138073130060021642325471345789108575712118027611362686690749327689527135459714040658411176246054106270789083336195599640521602432629024562630323934) -21804673765518097879589124792137157558586438669762099454880024920520894260754279593873244443852337739758694535682558790532827482894104906218015712179591886600693703465749571299271429989154199263793230178266758966678432691901731270899259065726530463438316383699558373053423999416350780342222940065486831353604365192968606300436304827279383661172824549131179471364227618431414928702407510473319879188990689163932586727702195573766225861364297410904859137393184592815970592502081722125458353280743087607273547490382023433724488604177909671497082747464946083901888849483505451426245881736990810339421864101129619181017696837017966116165703320918568645290788634265522956017905246042460811062666193790657969385648522736090098231379029903772234867701846824572274796526421531178) (num-test (* -4067457132547237558852016696244696525033953641638067592741078194074861352472861925779476293767777560910963786727886946479865734639031042985368829200802420611189793957001730656623744670821921724417176679009632346904384261431052972127975733031277489967119978909321422086102208644766894305071609385305464547231057263658903212521469801833214062476735046735467944834107695748433481665714184831786462886261252526036621257865158497049125410241033365487816324425563483999957660557670189397770488996359512245971368638615503320507431381893539767352426795415898379765583574977542068222040889423739693921998717145084904555464058 9635268828818063607505341812331931088336041632536136269505180222913464638532245578488168867093853062326136774925531196873279749483997619950077042084971972) -39191042921786100943542578352486285322085069425292685238158202937549417928185097567102615300826629615520476316505465412722375794150552330462353356124896483739321653441446703127728441315609093330694305784991844511900128172079464896650958648496336601612657347012294121239821167759496102233234525084695798195547141521849769350204659392602605928907953707277320590923278178152903602506284861018886300148663530071056792375593665422754923886137410482547324901798328311927545105456397213670390651819229021443747424183114992653572959318104053511452473611466305149349027962240989590453237778130260105665310067480846969449221473610614214933278048389171979184119355459010233147440293881252851501522689209874112819966647846701257081192324007280573826673895648273593609466000383382376) (num-test (* -22047771987573494284336211037167956208924595972749016352929724093971147687332865088249749580556015503923927321586913446367676445848750229391300778587369581738560634537089081840938984779012854694220894920437076215176060179241185151442003472788530160589267677502568156006531439509890061829154786579353177129190813899423306499631144919702707240832059008168851983259611724134448165201725432622521420667808597545410136493805873769372831833878868603946583848422310946469083400330960925084024624317866822897278934924368888332618046649078771617892961267312226309927786691384460940015979582201446635756024251269978545916298961 7481502540911026808093162425787184755732317118387068406204973030847892995155568099553397887864257088525242568880427634318737874025160499293315047534753494) -164950462146458057264341765173378248123415893870534274075422323606836246718538063890359159423074703472625232511667875897808555123518162244263016096627959208397334135559180524195701526029092734741010866589515172934676451385008535538102832400604699294088534999994990970130226363762230944961249818769566697211068918154629209895730969522747736738946126971914549491889482944152891334838234907190697109929512401661529882587076352559260375439428815896053844621297552401396168240947357044985051323834074355418902009161796886350497072010833513601114819625605048943438304411954380599728561071485061414856047768286383287807924135081902458690495890129203192613070824670256334683011083767124852354110322463725619194174195587835939047474059288568764831570274891727391545546467943319734) (num-test (* 22607201423790553279447786193696575272983924506336369475058795405894123712509544256099524616893423762658394830755129501447553593365768543361107397299007141714383407862976654294384881771985218996697067215804348472693636567074361380875512341556932579903687576929186215185312685712277482751425466251201421842248749944123326048360909954588266368306843116245625635467041934524547983478110533044085242847795585598341867070787331785945399446665919396062565614516404861115244243161694059679274045050270546536781907061002623188435269769778378780371158624481539046590932125320888745103158180784231722265376331553893647061533815 10075764395489719205294189472045365742345400155046712954334138069917417587273618147303160957788995022989479371576840422540097479703418600112174202202728054) 227784835187493343385594867881830022845566753253174983274076326016001091958812135049265213053390506720261776960833046225700903422206015373488419693650378821159134369608830936915027161415300759990632038898164509761337714774392506802504397626551196717184785586630245704512525844329038355790338277254618639554796026366029578805283659986085947726260520495140332204643887370987929304924491772630534558682402396784510750317396488402942581973350428066695976988812610467654886227733900635715495731445319565054848075104982244316563526232071957624002266648721592744376122065531440026836549316222728280595228806728872537793522244957258060730038589170810090676474272044568671474692128168357087077816573419470273384256552275636517940058764711467508281344270125535855785388198570146010) (num-test (* 21997874907846585575969651776904015812729615626636027149446399573806943459105370044846476738175828244018281160136531735881270437472624605280356112191272531838028896521621800558410217146758345955334174583639352151367532676985598470747138461153212653362188252002768647808852054182649808145379073620834551216386805267446360709820441771932135218282126427988826945094538034579367527908530151926679515746133600376612899354099328788736038811470295396365432559354070365548930628714861826464935305416998192532029724853617023971964507955475554955277722555849603716733374588174421463022213135839490633927005539569058361144905451 -1400498192750070094581812894241996480373581610489471746158083224360249880335094841398529960182484181641387946900090289855375996313447832474435929084180606) -30807984052781257825246153008277875918087659020905755686964119182052911551148620538090633516362197112383237624321406969368641524681503231262834662890145617622830207559490089313283375890353617292096501953380469351747504928597461154633889236826060654886877907382241867167198409355653371944304660938495445848950444683274236538890057643038410268234731745456035923559528706349316582901179686671568504971088561096469997823300883298811440849031903066114422309644669680078733839046643542078157684064686933779591609758494599988463628362190034612412739669041368897594110022347872452261447359402810277413572637740870748949093642723240662839444216981630862346445890780016393330114883270596630385367407921496982236074288475142085411632630374714528706189796772213264952893973677883306) (num-test (* -270155241925436273159477510619232592261228150696806729750247050 15545126743930076938536195287546926534964892301082800206802745964245668351235397 72127079799316080210744562119267314209211162112457416152560774669179705347659265 58427280233475514109627698916382980237252687770812483048907352594138577656301900 91336330475502063985843547526216808965829995610054777216888670176112782119332811 99495081134815818196404370468895496198561677002653930126818668800341380375657337 6904264296552316628911621065724553059847235903647375662685025031963599691416829398469283631386160328944460790101458427909545198569619131058877708293713734 -16074984786353617526516141164566295497596312655026144270863093715961484079732496604871734572736757225277596743795506589617891195569235287256031608792067121393492186703333733526879481948463529609113624075923052999494363547340563039654910799974388353472433635130983731604982117092991918514078659590068643956240711810902756784590442416249652077644077280371860780741318193975770906075446772544431670392964384669681404295839302410058434872964315897505894833409101781069230919347279857855594782111721176074849502391457684148683668165019969667481755384384017844104770253558111588611189351637275389688093074751942960310850074) 17849860827147993486644896214424106325295064110723402251474432199595968349198253682890653243676378684005650871261983711134190416277366473221365848417375107498764965893729640224952922241531788638514200018520970345581414705756736222535562338748426356003659523260330725662384208724142177900990027225665451069059291754155591197426279006090296512196415617974140965334686090032257444820748820516976632201388937358434205022475303705442914044454220818215336283948743042841946229853366515552653568436171217572212088935263340599371830215580988184775240338748954666846379831467518505260487989636951404886967842600777836444030434816421999334066711024026401362115623932221335906548647785232855815515579448393689650116225664467056283988125816950714780486880294535933597118808163054631168063568847830481653855357008353733414826165759079092633441356914450038756281940532159493763482047244493174370100586359619040444818634156576789665732998111907245928253704097384811414269835758656988678207624731164159069547745777423464124959379113843649940896359346515513936964849811155238140671698227057228045173997904545787593258286212427476788605370334985423461194148838623911634821153061693257996982252745844329344589168264774527631972524787804330730506700000) (num-test (* 6411564443509812216548163965666668398784964137255201222920640150 65325385402074288043601436729391841747319174569548241717675134253657593233436152 63305037198546989906433329294566491017476837189978173607681765241525113921707860 72383582945810879300930057856704905379805338886592055772943486702915907397618845 35525980101796892634292856352740658817031405780112750352735419884048051630180860 47579150292602967366908574298176357632207539947399443701205872093150879604391127 7775494633965874654516687741429737470333189902121089184439228657893110997221737422210698789286625633365548095171257583020272703565350668755439139356570 -7847653632223099338936161226557020783515367997970448568586056286591257384101422312757649765574456754668588904917800060981155642916520580540801153603733496143328839018174649200566737789874193483124577734129346933208306772618814806884416239295732454033604210880463262467564639515484363761639994642888910703066277724414372379965872478153546766131136324967950786993982228851928269842355632200589446224738709869729930285189047112131897218464505263042012855229737941639093204086147932759923796947642895167078971517834730472596647456786099215405165290569214043431009370032818978995463168133051136053246705694337584724712230) -197949741939898550383903354028842356745461597695099989904494711851411610441324234089773644533872304737431480244289438922163630848266242200711131210228027234579469457105291847132071566876246332653149194709623963836885480655282595345693084881617726426841183231475364991154699746506928116505297453355016975688761948609740314324443406930215518937775475617384099331839748494157863510168743547396262979908353122625808170296763676837551973930928848463398657587603606321137626467028732193151671337338929938959296176472483674270114824853018199281637976410726195357458134038379491704909997939715446657856320452698914513791221947734373322868574099599391493563479057703049036936132407025278683219316357543078875410080612067641232277376174351958080693019953378024732243763129075732499165068171168470237875348580987967740148512425201518758344757030205911031119619416763996490581551977913711646761182756531618786226541010835120092904291975494846126923510483263978074437667987560077422810120462938292680423746968095994108344184522240467647491991837793653579480334442342102339933473270535800619630342940590477752278184994533764839125736268376640933720554199782388890444619996919031351334561766248781813883867406045414518951152508504891407920000000) (num-test (* 1669833986019218156514274418186396165434871163342486930502417566 58528969848472951398118375496887849181512821636583415470809040929690124231959506 50098163184827557635697120379841225459445103589988345336880332217224622666020381 90445522698871905833766573423181067004916996574451008349087758531794463581708977 92366726802191504770638415639612204654473958526592425718659284841373421985393966 69096133232785816552402133765198624674167660496399099321713067612475604030259084 323971624832697152056406152359288553860210436839331005469891386690556929684663075996719803995137130737141925308417709520389528780839777347463558171582753 2635514624483961079560488004237441873979133312246005082134175818331132377114926863102436691793380965631848192666106793612266994709357524826644421074908075389316030912936338175907209987972553710900613011802455058538786723149316934049388525865455871552882282353445228425640452635081303490379594663330152071465360003249884180020993032086861074931796165970076448856988084523672973069824258299029863033098237556417571526135639288006133579174344589248428714474318969988990720790226604664141927030250855550010512291136517209169959021730625428868037074528890516086527430801590050720467893089085308995719513895962750896813152) 2413207990093478676325592386500172980330574558867366638913149256222218924700401110600319869300256745035993991818342784487193857053589994816247466074246569162659879368383295411190237107255160498774228460295857931362161062884154872938368166514128474751716517750517217000290486110198899480877593169193610813452614906598055909439037075588626529658637140089909227353944313408987644743661503976835580507054926908821206921014266535160031749397432350114673787218438589065861056449106115395189057409933330355574558853874223262465965933679584884152813357065227868165556818717270584803360466149860292769520737249610469675917864449261901859162854558012721179400237645357401213337423255109839806528503425658270050436129019270883446965562683284298538825840361267548675967778385927410390726055957928634152514415917053614892441910675109517307682075989998558764742821214685548219206933043196677521610851950501225469125512893859254575460130829051324112015464552874242522140166275233893076603452098841950130740353331198999756316969161591691095397245996664755249875720008141774247384884623389430842799829690618405724986702942913150258769060684255363816662231923570491001519802836627028431389746450987110456127797025006251203111629141890634728548553728) (num-test (* -6520062188352981842/3213004995534018829 -3812444292971845716/15284944374811818089) 24857373879807849010516976362973488872/49110602632729971801355498746248797781) (num-test (* -844583948128454879/4750740551331102615 -1309778567130405125/4885884698278749707) 221243590680205607733892613510570975/4642314113048197066962569716783636761) (num-test (* -4579815856418431271/16947444571374397297 7990245706938186906/12540719430158043191) -36593853985314806270746820601513137526/212533147427761354206383017714519654727) (num-test (* -3587966953201943536/3194797554208122281 975954052071387816/2707062718507963111) -3501690886675668292903668827990357376/8648517352177231144330968693325176191) (num-test (* 710265334225408429/567023629756400552 -5578988760400430103/4131535930210536898) -3962562316545608552741467762441538187/2342678499616965424161446427863567696) (num-test (* 18305319006789031727/4480148641441744463 -1641093267260986094/16028097657311023719) -30040735777106040963634910981471804338/71808259944297590021537032075729917897) (num-test (* 522499067029593907/142530390958606446621834761330018829110 1567459634764499377/31663510497342378306792964160850079086) 818996196770998943862055820464495939/4513012530308148429025282037949729145117603192483641232823845248212618993460) (num-test (* 6214041481074460220/139497414619784295310756757536261769729 12187470171919324678/129216394212432939561557938117593031955) 15146689039532873328968703771155061832/3605070583825050709361064709099418651298807367637359842488375232197429738039) (num-test (* 10022419596195177499/91129297586760817507648681092594591108 239769653037576215/24086455608554015268646156321002022494) 104481394312031409685890479072416795/95433990476618390508514520731482064738017476445225501421324446942302103624) (num-test (* 127731839927226607/59760640855511386051149338950192132591 3679984267166095161/269870724770589242613062477043917992045) 470051161348371979221331000573148727/16127647460431744118786930146746069875784110572380855085272434637353123238595) (num-test (* 4919926511230586366/29288587285987487013553554568227355149 -2914615432991234299/34407808954885309804037535414452526052) -7169846869407694119621783007930483717/503878057947370143933800273784055481319429768630967123178484618174989420874) (num-test (* -4322680734125283661/246950524730861178141734701180345535020 11581515233057355754/82204027418720951285150957025638971309) -3575942340708251875937466941988609671/1450023407574517046920597087724458064116343346221474061477327267648859624370) (num-test (* -5552456004563371781/36434418778024040927761226774271610950778609263056622471030041615086459120568 233319937833204741/228703279535756717601739981368829304509550463672786894384479957768850829340) -1295498689806330283646616799874813721/8332671062513255913250553083541810221054209355142441164334390514659539371361850837178162594438925276666798780352514152276296209564179606228713851865120) (num-test (* 7279569964232187047/36316165899095632459738478614507512808578186173163489609755035948221062420580 4568992288187244990/18279847281938710983382796940666233712517527808023718591530848159479207220137) 1108676634263212048809114991909788151/22128465550033953372731954247755694375180631486898426116907313824243654714198100644737500721615620412852035450119116976232805701601749863504629937973982) (num-test (* -8689289043809733973/34365105035540924847908154205433563929060132734873649554594240958996510665976 281724695877043289/3383396067954681850718083474385093262190311835985400909911383280975222535225) -2447987313255021583629117408894957197/116270761252098802423406562021935246701911690887646043563899994409915142686943691634418411056232663942535537938126289647041118885713303684881867869004600) (num-test (* -4176416206981759902/47077361360975682486641492558477246171356187409295624938308162261216397376441 -10870319933050648575/51626085927005484523186190379579228801774286705829757742503501130303410401261) 2670528255498212232918897515060496450/142965876637554026205455979922464979254073063785755559223760631646970673683621524411341782655829702451013418009338618833412062193643308417898164204593653) (num-test (* 4496049401725150702/8024116634872885909638996643719901973664008349644172107626390134736213108465 -5231341280619167012/99267989241776204190444307671763754306088564051099822830201760217121508089279) -23520368834947889555464127765407042424/796537923785319116837266627763277272873506235001122453584405648384893204423914484193595265931840447141766909166026026228531619859740155558402735330646735) (num-test (* -2488955833769033882/80573015130339486598712021266263458487997757617589137912729682647628329090307 17723590657579960683/79078600039601362101827108583564759878924923849842119643649415446502020994810) -22056617181258995266120581914227430703/3185800618738432636378738398589185111057563002909241393794402306079667392482341108052833514927720630087013771419748846412352850012097731569487991234153335) (num-test (* 24410613567363183821142175154197794689/2233491913446620869 -289777146895293391500645889398422195537/12394177861163531771) -7073637953514043162500219088395995153310329907185649946877180402954938102993/27682296026727883467940485833673128999) (num-test (* 15029397898618080393623393093137341347/9939158597399833599 268484092305118852707129202725716126526/9752180454987984749) 1345051417567645337656755504737828287428006597367109244226136136424901090174/32309489404196149853047846865649927217) (num-test (* 175291724581304230067306380062677652261/4791591464449055089 -207911166974886786162808240992513636954/957635297799905137) -36445107018739410292029741836217649994267718828374576884161821761303211252994/4588597118993154438342028473487092193) (num-test (* 208446980882041538439350888438428103817/11756453246592156788 -99855903858077543170703702663212319708/7775813092266901197) -1734555140205305628415286772698507060801514301420325900368570916304368260453/7617998589456250715053087609460739603) (num-test (* -49595797981179247160347259926801311825/16426101929443877636 104499598328969971414586784725010079457/3085074725343747115) -1036548193567594227670217621556353400490405002875929378150074378019016735805/10135150379689493069951723318357604028) (num-test (* -288919818051255959565698296502103975540/9373352185361138021 77343596824463059344208562767410464067/8355013728778983070) -319229970313622361785032672064391711775428287673147624981393545586243098874/1118778374191039878067165437747032921) (num-test (* 301194765217764762175383920433701358543/150076401641721289621709469985978858175 -109319143590504335906407585568245068241/158084148208214805386290412276525928977) -32926353787549066990014316879429253235742017240010356390402491456481443332863/23724700119685440084214937112355810539035473428177368317381421021523605836975) (num-test (* 14575317438235510996984657523859363247/6747043355688580686998987940004831062 -98472042392613093668204392119412188287/152397803267436514292317070561082866275) -1435261276663720115408306632770383012566806521695455296458086302958691687889/1028234585957093005711368462502470683211464374115746651290896689614112234050) (num-test (* 7543367187310376010646193530301789591/61115754966424662873097894247178344192 309940239796651595482411737112678240799/200261667764086238794802895148430893795) 2337993034909171213000031444662193658341848356694420878002930517675329723209/12239143016237439360279809707749702660797878084581096344749106125186707088640) (num-test (* 306232835922656327867425959604977465100/55646521674811091128956181530575055283 45245255551837746690160535427248646677/3669533234425940180962041078287629087) 13855582919684583969821610044729507626133731299765443289084519977056998472700/204196760665922729081584465192637337445710456706084552841012480810023816621) (num-test (* -280037880297253633994139513185953058494/23798550327416056573646642830182072429 13967268482262630670960486883264178489/7947215947745048068401387767511847243) -434596028812829556627014314125713048434599389957141408329542154357763726174/21014690966139335562014814134594464675233042588696546668504776333756662583) (num-test (* 87160410649223805266866345018804635271/204719779683096591635231158476535039583 91197762560765392928084914476898132964/277206223024759381433146631560580134513) 7948834435086720002947247338196997812861466884983039250681993725808882173244/56749596904412078223459353928850191672356004665473536520452927516595919428079) (num-test (* 272801380449749740391855824723351316848/2170368723435176720708253536680067463416474841046765138040214254204061862261 14545537787709209389572055399030228996/8381323291479119825335849511027103148981778425333781230074116361235206363821) 3968042787871071204066360146704950989545352280096012736206796950415592924608/18190561932825050861659739926693806725838682397154479213760300500132465705680046683155463862909993066621811136554677896021527098482779305371951555659281) (num-test (* 58980225701104541897366713189611773567/10973700523953435846969235385386214078292603476932194022615006557054104506344 21633357583056027790037764923811848217/41236459355840549300942497778444413350482341379076368704834339005347182486274) 1275940312921345964633100864283753667394719832288287163056787891633576680039/452516555639171997520308257003811683819837367444947027711901120987864272999978391252372420644671039873982401560595091423172287702745925783369137325922256) (num-test (* -39569537110370574225194522625562874655/36290593978404925051095380486087641410218299612051669925683823165483928853304 39273660356839128453616088747231247259/28875229647500294680887983884278577441525691250738380954940513956990510132534) -1554040560950035541902707236381071410695075315482961522429891905381129320645/1047899235170633560739863801929205639611958070150694189488499584527041043137082563721218908614201921449076002548982308540689571766482794493357171683792336) (num-test (* 8957762734053174688386697837976422606/712105675122280831038408324375785815130945929819518342973925027507219300067 118977607972668646264715307919875588738/36563306353035936296510796886853084280648109576589600551753305930842020963283) 355257727628119695756412145322380851760544279491883270008434507085780737076/8678979318410478400681656718586483785992423192579006235728835173903750764880944673586689792087386144715446501744012435157310426693657188196381455479987) (num-test (* 114386050140129336980347743358441052599/11994188887964574384037137314302737861703229337059619512751326848591488081229 -50822174853799566513638003084407139228/97406657802317796912648600328217961853548397771614449630742570869667560514587) -5813347841057137571369557065847591420664634372223088557679866032754664253572/1168313852626327929522799656188055465298138284154709873285311568978496136227795809646907486798429717114923178357702460243511883684964123937654308495387423) (num-test (* -22147677230189664783449572410799931501/75580058176304394102183955194485040346816524663599269056794063928343401057143 -127672554664595215026114551202414743739/35777311684781371234035985601066874920871049301826919955489852676067316906014) 2827650531865200718433745248471704607394596478050653604940563621773668622239/2704051298527551014378337257898371613519363350219566689647796093438747503077807722203668806231503452508016974614236112792032033672965127824348803574358002) (num-test (* 3468729773587632113679855593063165286551216344725198121609354788619580819847/7106612002452012151 20863200733446307102600190583661606839853255577505815215312643683864543217073/5700246487811068117) 72368805556440529088812813715602124890901251289457147618293618526488567540302416253970205832659523238561757581481150988870947074663135867252252227647831/40509440107213064064897416415172689667) (num-test (* 43306673717838918980731699770600730039727453611468399058203483818093233880231/6173575908538565981 106634227988568775671050783423559067905086861634892257032833451008548321218936/17988169594879808463) 1539324572884864883885215269788177741067901747630436643318399808029602335378536990210735234944615096105103848497832537965483619535769637171783464984418072/37017110149885307295697375341989232401) (num-test (* 61636028396239445662576777415312348317278054920190931147781159688109244233565/149659999183936017 50280832809996410949441105432174396823883728565382915986396125237655209339731/3406752842984125790) 206607389257567119017662603624829733217835095238758046754428174885007999774491792658838812826043033826701244157167565054600950156595290052398436186551401/33990308513391731439280046802638562) (num-test (* -100579490802304807750359433955474958462342659278486016345156932756807754105945/15683759624513404963 7314396152134987983181095955389244247502417255088677055075146925285457081540/950287995699608967) -735678240508074701153113537069655056596152436111651040530896921701439724727486696483134676487497031899584038731663111390949471467249259023050011663755300/14904088498613295322494450308817103221) (num-test (* 25984831699359211750216710442693374608159925357093100400945034699383345074385/10463598404993207796 -2395913226491242076662067669730978955981403048697660449593722338244504668974/7015215522730452775) -6225740195664363384298636893730784883811595661227613249243163802476751022407971476247993440178871949687923603921101094083879668063131450147131783163099/7340439795432595812648347200273983390) (num-test (* 5173661857391320950903772549611256023540539838210520778403003347430938670915/2590493168574884173 100300641976357496491877756123729102910724064566692821682523911939220592349990/15304416107565779147) 518921605664943617990486317157527087053001312760892500249127957517476408720600460633868004681188890038115877413554399588737851074382787744833707113540850/39645985375676570588146199684023740431) (num-test (* 30299639015164203561126609159677900559022306879488518544803392527841364186955/97638167801975054493877206805944332747 -50150465496280036231382225902610460555496341860773955714344071185921583266663/170117675960786609061777750278261277482) -1519541000979732808188648781832621044050652591754537200855596768903085847105531546641139177813880505696192826380113425984545675787584857974943247950981165/16609978191541300835961154615181304582159561006676548938424954151558306303054) (num-test (* -34494394944257769716276791009665812125094062960425641316440943461722789694119/69239821080832171466311153221314488591 -68027404272124217088707268142523090163964888591405843143848585935878552833247/257149529774225346004390673137885895872) 2346564149995340998782934409780604815295734898030424565252099571337345550054284934036215402972664245125313098735082896555892607540059632597741979943574393/17804987432587488254198543762235568841018786223139145264591718687823557996352) (num-test (* 22330754509472350470460807673039908304726422770752644988051418230315708975569/141163736844241522445115344332946835969 -3776092949566234532895208849184634613770861313997034923686862122594334787771/22367110097535579962848998753563258272) -9369222740190326741203615957382420344247102784278353165345406236082475331042528539717966581690645628370939381978953360215380653092335198860022382107411/350824982641632215769272917522017419782283768012468846380070797128085153952) (num-test (* 1376215273451682681102140384578115142238259557166158859699272578561460124263/3593386179017642636485249017714833669104405991325015697577507088650274886871 37146275008876311604039415809582675415172661567487888072055609579242279390723/55424998453085285819414374477780690192979527887019008768378662580126754826472) 51121271019052119686352858568900325361226598163234091421115939503875711782442415328681175322030659510284806538410228985354770913411724825992699509412149/199163423413390889071651575953261174839972499014963134990506980080139461063269751906284862132821075544766093817070661266293471833091996501160433036049112) (num-test (* -88175289711320073148300791156190227927348022787624424521937188958291199926437/38194742314758366741668899229532351990874883495690656157862650973602784662629 93421911195279228911508870033119580111709458306921869937709821511660370035352/66371395138592894543765954603571534463846496049156722497129962530412046587003) -8237504085028962150049531747535213236460729066521397582683209771842938254589363802757604921456170821878391951762499073662677974506165863935238701489400824/2535038334389561782321790943041741331416028402594806464107449488311138037598457377927652600804722340759363172755193254192462811091332303758223034251210887) (num-test (* -88364214910455569163017945328431687038422451206033411348821431934742389780753/43010507830592044720656702803904712217809857004582018186125828892174875808576 10405170283887792832024806983921158923908589830001636723872220129826733402834/4055629711949631304631599195955105801456753694558712994574702123032807265321) -459722351572673455425943766571506569631562018487574498847133029199411842205331593858852090421782204158679934054007027833206633183796877753882057444427001/87217346741895687976684378003169607737518608233754137677854312677618987931466495788077930577814677920791330694741284253568592140275298729115088619596448) (num-test (* -1412797070596191471.0 -15492755620416346417.0) 21888119755986895161222137392796809407.0) (num-test (* 16686841096925954110.0 1491135775021813104.0) 24882345731730524499708005167300657440.0) (num-test (* 13262412958100188045.0 -18379071970155621919.0) -243750842254847872704698616507823758355.0) (num-test (* 889503034794263569.0 -16600674457216690894.0) -14766350309325860687849239111838240686.0) (num-test (* 3148165694020236318.0 -11771070679825280729.0) -37057280896113409834434531491271315822.0) (num-test (* -4443818546267181727.0 -12001052312087213799.0) 53330498839175802532024121011435050873.0) (num-test (* 8305259347214213793.0 -229351169208067535459370186456659711595.0) -1904820941859811670566233132773219565154696335396051029835.0) (num-test (* -18273334758510166901.0 290047155020180552782039318570071650475.0) -5300128759437251944808204783222405076790289915320785927975.0) (num-test (* -703280433697652940.0 91110448009482115063492795153459771021.0) -64076195390496041906141380919369524419358692517527451740.0) (num-test (* 15279634596127882146.0 -220998726467849290098339792307263567896.0) -3376779786638352686104608499923871317791563686466157184816.0) (num-test (* -4472497681184076830.0 325612942672822430032905460436166528379.0) -1456303131067722058341139305566346079551678140995111358570.0) (num-test (* -6180420673489141029.0 -161157288800853703711204405567379740552.0) 996019839388256252540244286609069684717518686623358308008.0) (num-test (* 14044956603588468379.0 10163190459901171254101452124764637970005230126310661589196828892266636678427020930101076689732526935899135126391465178494895371156141265424428405590113790.0) 142741568963316278148132287599703960511135825069792278910440475692913696263448088587778211787403889397993501704943449376875999977937418748662459138952952917221024170426846410.0) (num-test (* 2133283347509865817.0 10577710515843519541178984366353275630877942729579274295972091544607384358263130633386329706527832990861547566574369528634541156662300858851752195966167381.0) 22565253698228972909216255630133478029433774404794962869038558824053350969301054394347471181756471783852326407546652836376109109470959746153989521923555764579738243072315277.0) (num-test (* 7812722507014599311.0 -5055959518947106416800910724733658104378582281318226107212861190073091017493970778425583956006925004399967175604321778956828368132273155364830637407968648.0) -39500808728232764770485117356353304373275127104839804121600969932458363071148383405901570717732548020267052999198017578112731079638156026910705662052515278317807704170401528.0) (num-test (* -17560801708050275829.0 9842515227842383346577123873881045824143545509071137371075701856197189100217561683579562062872293951325890789283651221922663521213150065638405410634222129.0) -172842458224605375239887212582262805312641302639067963604956593404910080268476692854082531021580381176489626536608405283010496488558204787140272050713264572452317265305619941.0) (num-test (* 16743386830114877156.0 7347065846171565625701636575261347705942035850951855454324853850791855951431141198155170102434274509450315416946729031216385536668189501958761688618635668.0) 123014765528775807847206414290825117502032199391400884957413813554539073118943905948723779020186281150198999824020769031248882909461419778092564985979904308229718874140000208.0) (num-test (* 12697192948029671719.0 -11416780209809507417142822520376617951137069007568339428552592261458272400645205700952156716454820410468812274673183389934216970221062627926131479014990611.0) -144961061169197993494569769162151457365959287966302572862364500950127981616038900865036521107816831702945678695331078399461327412574397914795455218447174498277798426197230309.0) (num-test (* 17005139720743105479.0 -29990519259587469661876904501488342396062731024702923152492275204626478246142153608222329335341363164148761307659972897552084842238285026253664841395295138667328930482145590159132144957515157474957872335043653264146346772142483721767458961320947069718037828473530001033848282453826154763424789967441239969918856795769965946388666154136004597297855416503729657013008165049478441197537144135384444157408972370236442813734429031404855591324183846423588871065272526864866155918285777640819778251612915859290336548446745308788013234099839998683451658620461972798204104633072664604846231692505409653434538208644416538994256.0) -509992970306921990341332390474393215554862069848994183152714032617297815196921655222705396130464246880845576204295466273071779248718654338767559016551390771145212884412809612574391658668778295682412755916528976282396155832617323980694289208942491001345059122414240884660276842648466533488559879226195446807748573906940273568334343093922652142252689341425941673567630236228358747411926991658260241924294146562230425295426217833820067881064577380516936937782688004146531121831211284735538742160763820814174631414364095096099434285754767091040812242751724012532803037860394426031234340719537172735695313262283511554154662650333168783128624.0) (num-test (* -15877530153400521290.0 27863984127681242643954505352420303514833683768731313003271701952957204538094398204984051331105594788039352443762851136101330385230866919393696564428736685568762923746771275677491379334452751710169529933675128178840986001684425353245791752781476028565228371147542431713985092322787978914276414008774443194161599919167210582437024618824616489802661351916633993681556274980075051797120207655478780052593534285265078265845445633803877185868676955831374479850746658711791169579387317321983669227930929736238215792068273805543745311609083833407544342964285215427999724272264458975101474080574470499647168865409458531868592.0) -442411248181132450919255517905812929771246981404050821923231762557171158858876183536414772404562764742655092127161703706239729646027465795612501446223663310668879007072125975886873343449629108246953385822769744013416908613100114754904323190537317463286500657291202287742354250227377164455244103312266617146454847578457073139633297517170508179596166314955134347046515455569689877574427319658085169791949003021426613961459610227430636932814700361914589752207776142403364490846294795496119883683491811246550808038342285518518431538295199537270236275774546666026424361019715280652576803278928827199810150387207105149968313623040090578323680.0) (num-test (* -14162897687527555611.0 -23016403916121951319848021112075986869602408568431399211927062304968548663313037929311574133954267816204873252195499803324830278637331653769648377216095499136975244697758388851688873078022850203685120154634090802825656419418077380419130449990938627982123188424119187922828250625318327074513352279785514062876718714640725789938556578327139793467832731546881422469843509318627826856881082450937188956068348931459011923844607158528494902828851692203126881727638511348944908726926619613375594042390434147948508706733126737304560579515324106834237197081860910657003346633962662773394999353766192391746258372744063777808796.0) 325978973798843759388794644178802841408656469654887121096165875654577046313115917671847505813174070119516580105483409446057747653173640660143855580491229746795572929387698247460831363721394707501497262525550824977473864621747159715947297817600227665840640555029633517390896890601028716769035575763283168066843141870124768085499453574902575378368669494153555135898430469356384416638130459557518713454927909937610851489821263029886989981438507377741962130296498574556444168140838201069779040087521405032426995145166201901368032136008107323350679784004016321425234898132080844200202007395427054392280809376612533414505539109579739614954356.0) (num-test (* 10844738523441551664.0 13010289169828379103330191247192587220592807931898339555723704078985668371901953113936581573750666143303899278973814509164982887504269303358034042953769514772858989849512527461308415676004712388964136857232374888643347097138114199889581495448978914022318770898259317738823514820591042321773469959130347470144905381758960436645008051488666423115693738341045851119808222048272924385188356021826450267608127588500233526688704136268009202730309974485584784539415807259862449203760469406037505772435323036790641520939576046423540699016607317147689982042035523118533555744274806239272109508745089640043900389441390176681340.0) 141093184161152226992592021994885140117836445291515772908453669279294934817987511015413332614094493905560980363483549300117114491702466085602279965168041684355125886388302948336158133555051817733078300668260616983283027038746214728386770752826764135491650323133831923154477800324207350667020747545837613879364064704092093040155243919335078139087599906324684688427176309081290932504214653249366429592335409761783188358003723753633106574740731573467850133547164922532633897844647383889253777956821171583261238607289172489135768839436605233457738153233579088224808850428203888700116300637190661108848906846940291749737998056247719674749760.0) (num-test (* -16402132873169057380.0 8202725117980211375579199554494319645475746305836527475507064811368616698686329266053570766100878145903342129595869654087772486685252653587846560946850102095086896668181099435964053041678323706849735936082196618754721606824996486473796843333331029865501790248862590712245450877098960007272754260813822886287008295409755783478345202299352891066800825979067590290793893933819913530599309037639082839491869155044147367415785329077864525961799400923643936705317921900308490987828345313709179960659814100113658528990241758360711799009722683007157350272749544178688961738222930753008443755881419398858537860612954576778456.0) -134542187307192759584182063854799850608007421111316277594191532129597970622559949723743396309231347084450105499455916612009290113746722460358793168839937004812915757145655285798961178877391232945062437277255128401572171216279188126380587081673725314534095093062983435026047851041796084651601813918099532876684901239903769891552275465470747567830660442193995685219383258617057944010709906130655663966913354414611799232001438943448374556294933488875450563987147224709383408815994320229340710143082135667640802837699940654151297907451396297241124380508001357553893328703788960812706653503939250831164194874527033594779746890593262611805280.0) (num-test (* -12094905083549825231.0 -7303327854122277566083382629094740392048421584433028903125893639493993705575691832165314461496849401726460344615713884253150283931509897329926825128629833541892164122168618243719393446304446866677253728405617434021389128710195093788280203239300086905325641224801020413858421914412156234316517981228056539721130386645649016559425091470643854813419057026759188125291655398451427686659900364573485593902992038773538760663063071699966278379037038361219424927031644750173900916227834573604566165762753650347331082640552394430002401423199016978155236550541225512734287851807727860645247391524620773399994302380387697957581.0) 88333057189654571362020288527489792875655269960629008914349561689924145109953656394378545526256758871407020025766992398117775520525507898420898102744530402370720932219749861094609497366188371774072368034971851022164946370916317410415503705484491514312339956381120953283812334833067601825812118392757289250628861166579446800637104996060739031010579056633535166403083327528575504427815713481850979373113173151813491831551023902022537957860211597622343157802805275942920911544696695931809085743355666792408029743911424760065578742910735408262758198787195579745280191859776661700139596074108035867940154338953640690242795671183308201526211.0) (num-test (* -81618231044418675360403541307856740187.0 9751573706924018395.0) -795906195858402819552264165081526765614024708979523739865.0) (num-test (* -167600745660011044249531125104202473984.0 -12960244919927910377.0) 2172146712516287908809731894157839567367040369214826131968.0) (num-test (* 90306383312124738690336097936949488486.0 156109477991590792.0) 14097682358164298866835386043901377722456291173827620912.0) (num-test (* 126202800261728727198105694812165074067.0 -17404362862588500316.0) -2196479330029905727399352310201914876903532806486592905172.0) (num-test (* -80093647977875266525946940496137725572.0 -9499399805878278852.0) 760841584053111508349403804472960020663660465509267203344.0) (num-test (* 304052889577333477963637861956318521374.0 7233536405885618691.0) 2199377646072361697737485358722028853038393128548297401434.0) (num-test (* -124787646062877233829165925777950698937.0 -125798384154373172164515376683173327013.0) 15698084237137783175768362160964949930745617334715009097620154581879012485181.0) (num-test (* 259623502197082370239517374851053110076.0 307089583871541575627915295134832918432.0) 79727673252974285068387698133566605944659309374400074880377824560177225320832.0) (num-test (* -245358177397026033963771466683003477163.0 -285087883756432161967673595037725276963.0) 69948643556453419103498093570621669430956866597291662675473644085666220495969.0) (num-test (* 46731711386059374483493216849082745840.0 -216522280665540473581476116002923812173.0) -10118456728713381305690589407461434638634240429858378588644634276171257110320.0) (num-test (* -301422430661955757433852743238845048860.0 -737194742467573013847855072675441356.0) 222207031145790358162820429948896977201848379524899474475604149595884654160.0) (num-test (* 109781582310220385246795023904554278713.0 -273317662617851276579672019029762858338.0) -30005245475518685175699313262818315773200953201653075289648004177366787958994.0) (num-test (* -312236719893391897821327608828679767006.0 -661158307192284418474080017860142217763949256471548515134335997907628404839044913830388499435166012788226998900468665646723366842553747501004752506346280.0) 206437901167986463762021023207669068873036145952740267172145693855475451354717023377588805030022300923600718715029262618794758202955817341818233889201852381575043965927328029955969846754837680.0) (num-test (* -134379788461141842858846278268259347105.0 -5535479645589936472405910397299739073641612836770238183712206042659632410776896398062277742229906915852933418684231779996404071421767274180368154310128427.0) 743856583805332082970350662728998610690268824090148728726850517499798631519601137183443104910590855501252539324674812560702657332874686395923181633958702249128106139207076314713649515720653835.0) (num-test (* 278271843790644800793473851247546123375.0 -3845690285506025443856370771250487683891303505653819308540635173436088084480277686684743918745832832765066355874381847690771330587033980524869033600561589.0) -1070147326395532917564114389205677334125034378502074943828571411806344559859053091006175486397820822872698474899835730026158782698085673635033947150554253148685482702599776833910878579880042875.0) (num-test (* 22345490710865165412267189692679994671.0 -13168094845644809414256057134926669929759930873747535851687323456073141938879368460977723280750841588750507348317544461824280674332488497533955177541413394.0) -294247541053147552931885013427268298282376074124656716577088212043667912662239091316191145352314750820026626159649861330384837204227899202392764926604802655267738710003310052268554637728023374.0) (num-test (* -223445051950608517881717261787296926498.0 -2609806601119499724524852022247741111662431776874117401343811680374867931883996125145979162937751368655661775097445043144114599069842524778189198926688379.0) 583148371568187658089071213924575304457465978545376486297236105670932990897420147110485946155066725440999079357995678147717407410446012970360780626554347417807723098476525833332400212113766742.0) (num-test (* 12604140228725912459681435851589379433.0 10671266866958584640992033560488052420339425977492420594983497264069815016478448589306666811246532193922229713077112601565462530332258877522384022088660628.0) 134502144009302626262781543880199144227907004673612064586081220538754991037447647926963488301214672345398823354945333417956344119228084327815583754032364976497975702972112644238248704660063924.0) (num-test (* -221289678591114384943252477126208006780.0 20020996887149770966522122735176842174467884990518978494604707026520269232864200848420530223248762875769520715632742683760311747174524709550334825291720803698613541109690224185041740294906022358446325921538593105347423518731748623037078340006459454656405997570119591344894717789372844612253617591807770017562530034107842444403952657949565007792107071767260484233194674888488789619319597151367813735192433631007526015463229060702510632792171187339118004038505860316305860704455466207113207893106982258864355430481457640304138738182009363353560090082819036973601710432437342931523433079941958203038050750205966472435692.0) -4430439966231074415853738608900692925851705818190624801199561884242897308817127146763274284287396980593383317678766559004881552228480591814939402896201244425805503258878061459604511214900528594870260206969839682573246490602076070316760182753341371682323914671418233629420599310422437691170629449435494697829163966912842611408632129590129483811802031178053300073562716917597174161526976287351465154825036851645956354853960835948518860624747958440181683978083391663149733813297698623499283645627889274004656942800842013709298338912226207338477579862672216831422765369078886850523202897989792734789430796029206661261129141144642117177625405158700499049991760.0) (num-test (* 180785619668676509441152734583033930295.0 -11909038209406834057075682058438206007134213485822042209417443270921391661498900475635417780140585878716264253792335317341527677051828500780153492153490249297998660274828986996948999762620400587091118252205695562417522111840305140989214300921122857271717052213225664738544344394774362885331856170636862181712515248810239601812262573113794334115259873527539564296101166439562124016438281173202196876398090029995104489712272260608848551754611421227761245487365953257890749115194455096508613617028024932657498899001119282498614739316599704645009607294747043489655424155986912576002393048535846081096337705941547991821928.0) -2152982852345560218506186041143281789706715672110278207735389192913214838321097754496849942223194392302524369156102301165660674797665128931611291246607346536492650554391248756408556789391955568308599431054809433808337036546281323840555452571430884302696950144068129601527530304907460164571704857360215834011779559395577299313379666503707563751314135201994045874159291100986903645360754621200008830207429980872071814202801994486961737459218017354210479544121100423399040398021780750351097082070296255480707530391964970754186799748521538525274241709676878827522138880241734356460339681718690408853314007343934035505873192699052380699509877559455199604508760.0) (num-test (* -196121729286794751535600080816329923561.0 31755463535476988506639447113088283661031267977524968610501132544098607201258848456920865390506381665724254592728643925608893982794532243733117636645689751360224314774452374503339856173343683819017479955914451013484169313685311530532055735999039466721411777061709328450052490025363788971916050033904534189719389237878257877112162843506491071470067738867693853480174965212750301808781573369342701195147083717623066339671595077736036738235636996351642097684597005928843274525502529735435418805821748637387888409663397547514467435322454217015563134545731593492200855670248739786405074231658957946422903165662016649229286.0) -6227936422881500100190187768375947805694946596622670066116457374856427496311253030141271922822486386675428302332027411428470488965226898801659352566022706152307022438261392466548357753526474097246042956052374187605144719189465046544498482461077851578811186829094445089366592317045580466302238653533114619908864036973070346979261546801894831273337217021756025770590122176562027129481076270727248949609326868225755958667670279949371399535144788247565199415296122873444199709788941984099349149684384486618280260678252604631431089580057102263617056951788273430713908768738965854953667135156866028646584137788146112300214498814212865170902491169332389942607446.0) (num-test (* -149247491509558553673630984739524508601.0 -9241905448313719916485289537122695595500213295294799660583133638026091750542612875183284894676615989153030773719811347110864468582634048542108726080717551794580656021381515769591713295631818532114918070215760259364277583650102628486861397602958930509695263902920994329409932518607260720657755504091822028630927071374796474717671220452208310602827254296323761245420486376569048549643478954846020045263141546849795367522490793641049509748005893155533480849922847230018411440739584477452313387881413141538766185123978087175960946255649923135634987656065468774634483495944248865774633962770893338531522570776854773975281.0) 1379331204929344851843348280532786532350930013132149419346606977890849868537539899667631713548510207947097949976792337278764045110931774279794402312944786743575421497528669859045492875676005849752425421867514661792129580445000023570590786705609341859529483054902802038173138834528021423393677908655442991197348183257271932188161681770513283703502340499171444058119260228931558784004778969491586252899270869275893402714040693571919281494643765571068045362364213060063345212881008657925426024923296369533374671614852576576041747836643356665301762059898161073609265572267138950725010661453917338098901465732991316661901878681888138048552901254914604845891881.0) (num-test (* -246070233154436622785727814428081917418.0 29761582253452470642591719346200231425423204062498655510037025199574178834762931489817919404889920159374886981199608181795387339523762458361385170203883094308920011218315748466148953320570427838912637152446837553950810011344492780712558515815917745810385725989241835877316836808088478276603934260581342710503593237081689944686263274319354100341139245512159619947319496638082702549196795236216458749363904150768879765280332386830831409591769966706351022328535490587838695167807967607003680703048770719240872629379640571077329748828739281770075441660330884779539288220944313294762143588847790653176774089774033399559617.0) -7323439484151992757431054484912931979861244043627630118213112440051387392428853497035249623931234821362770902740177541812170377563064854590834087655133962963430877452052749127605572395112726398103244974178157574726551814002744001021805127518246639418981066588073652668879613252372759895389345727455380224104332342029151667860553645106555190741775758687650292791318963679857313030729683299101577207875499929500963723267185390425716927303375831321783415003339099100562942730763231688479910689887284950156875532151104047755803876078837921949287811575034368641167438367411569736575067233548122814012421044943430647665260439418887639347030312118291762161708906.0) (num-test (* 203826295936164259559522643510940430939.0 428315860474710981601019542870649234168732095026625500771233691514247613083810271191136212287636290276352210600151884730196161003906066671915478570992925366265552107746965374246537358349673161970290367972281768471743836339191023211359427335141701167253694144280251188008871929010775436125645541749886873478179599464478734149706121117222690271210887178499620737860802605991262799781279373870647695125320153193063528861104479576369448865373971847676465682752435142074973627172566791961541105525781297462635428308325033717669972726101583722868689418677558787287897456521530400671342257419067050354522203242849353639864.0) 87302035331271280954456598486072605056704393103691656908943847729634903654600322194677794243221825233700566108459784062758955025931450719283517278054268553004951352280583820782976072352456972931479389375165173986780482062859853305469143408707179895843295115510597584169486406323435925707638987591151227843652210256611991940374072593149367903739596883229844326054223707236369465710416960023659329202073724249764308867733476242261506975691004092043954515337899900837434270833782490145948781128533218641649564543508314976001614187701395586824982250794852925954991265270537649691628899148413763865280007928191637215283244406869662872539567459561720369352296.0) (num-test (* -5899540498246269366107488541138263797694914692322476860852796858749106720144552037986906792251681094769894732746138541066810195167688318229720888479512583.0 5834015210744942902.0) -34418009003174534626858248456163154666511779871358190892629413477534042866009573638264296461516598238780495750056279721797403178867717911762916049857737963922333901125535866.0) (num-test (* -7558198374656605586076446665394545534375963428962439959101805545423930654069723860456022097647139432324162475685494459942871728608277717748075653794546685.0 -2079670855873590264.0) 15718564882684481784074014915267371190416032453294568239793060140651422710113447422494938907375595456199203928496644205320139985222135619659630853564447794621716315309474840.0) (num-test (* -9442744083812363570102321552182535031605446031706376100893354933468482520577272174689455502380973733378565213055641110431767353396963744600184737808983381.0 -7204974197101757391.0) 68034727473703353914019458883709211780958983263702756416891835054494728840771498925306650413027883039860202168095834137357212487561983607389479135319040711944281262212918971.0) (num-test (* -10658732210276096534851972646242288663170038580488752611749460640657411087860047053151548660331707024718100598181073744715506934778234716535781332588396176.0 9193953347013373121.0) -97995886679587166046252015742839992974979220158813197140160489510432960510418039749924861744197553021702396544307690217470606424904065359660871469041838900287446937257585296.0) (num-test (* 3330096979672637104536573277593029682675932033891010715180474877149733802060455951241981993421466123791200840797318740359792251505430948855600408060492000.0 -9413190658845804679.0) -31346837782105095097578725347257193539696338226258990009265748336528353873277500144838721882313026604404426563737656928378230261942407473822851842589487713775609448642068000.0) (num-test (* 2224201331350479188470378485954814766783857696988331736807430786504130570570323948774102396158334805040994159865821844362926631687258969480929122732089195.0 10226747830478556903.0) 22746346139936030910929166328517425029735137934434969334578972386859485783192993228082340012742115893176871887387993591191632260444955081663604449277961804869872353878963085.0) (num-test (* -12394770820700925077767705800588617445613665027183406054209162910642613421436080064653443098327137503596792411463268187212855350864330592654862321763110243.0 336135860956209890623046930607725140868.0) -4166326961171213704571179876442248501325782360170764344978629523457550315208845439497110652079907652744850691289494398473488033083739905461347650605270023127087625641779424751335704552988710924.0) (num-test (* 11792778994619176404079667787533709801900490264171877873621265044313417667869688303207909681289642260521608966405181881416781694320672906600599581862090088.0 -197661229068721548419113517262926820105.0) -2330975190212228827672814304508257223671550753091700552243633152084831515892056240354560520878171696176381845689952044935988868477421447557890739834031207059212175922089523097911477486879619240.0) (num-test (* 11608994516281296345925963401821217560860934641820086911326880657644311461955556832927259499969983808078591149768068360172431078248807463030805586293656663.0 -40654941048774156019243747229920736005.0) -471962987694958552110784676392477007070112288398143925079396435246284471999814508543057304008480666763661066976653446723271982094424149279649226771823800871458389214002872916339341019732251315.0) (num-test (* 4821517917539756801293776911844480642406562140007084392649374723119190602353617113036081438891134008988421494142194891002983491670246762173236312873933599.0 -255528396376819316172341014108564420589.0) -1232034741571035406264710387186737842510579499938716343220834781077329515145216794636313459582844773420679078031627466542930137302257934575129329529129776153159694412903937370462708576694469811.0) (num-test (* 7638751115643228563298483305056828584775811590562130101723525925933790010789130133831569153863129513189315440899053288261039147463032870669035935364282061.0 114438828287750304954799140618669114911.0) 874169727255956505920153418854946321208907128396839975975317705220623267360648189969313978740314703015845506506608054761304647627635292132043887080298168302864314697920637105700927041824911571.0) (num-test (* -3653826017463740005170218884285271512636869606149686475539243914909566619638259666405831445823138528809165270360144267462878986866506114069923299116957450.0 215752050445782448772085819939961259625.0) -788320455239949216234629350585027855111249573063377172522422069903710014529292638311216050777840734448624510386643245486023092483841464815987597578151663227035102742664709136512524899527956250.0) (num-test (* -43242564273985683175827997542883970694363047476880657467026050730764924897992516355909421962249292250047896135687573746158665836208681548975073555418266.0 4424346097667245771102179669235543742385176589624011161914909311078645828684936231569739522607200308028372644149306431599085361996722603718517735348761218.0) -191320070498733614136284309000213964486426347688040889144514933290125387693498098446328694172047943298442181705949005984031677324306763731212307716485454004382079159622650481983102917517993601466178931324415483972311904823997211920702201161092866663969163567426868740120661073974542958600768774774949607988.0) (num-test (* -5093597555679260616199210906198149266592665304134802327659606846977583233938836318559188141955851256260954289429418183711191354912372372976165948043123133.0 -2240632735861652612028397136046974907251405868353380459030143407902436514978447480884513019736738955326732458088791830752499716417751919868492224207936623.0) 11412881426559848135724717164530530041659963797467536748076144863846600718211858527283843975968920120508569299672573958424908957105703597501013710262110218780710678312197455759181436286391257283676806548463507528765947919856827004176416634630489598937924092540289712219714362500246928243091408698274649199859.0) (num-test (* 6049789822056553589237940133475342650218069231558204589924996117723031491205673061674252841792149409384720347601549237626288416453061224734057079515141650.0 -826416247951451524584060567988229017033981218652490450160817307801130685352465013890931297548015267655971295627931896259998420078888499206031390299169584.0) -4999644605638856588581238481465237523157457201817697008198975191261856978252081380810200468420738807464233192102972784271159116426108806200426852134469939032473362689081653859652824862066224063273799612269941254948709760659691148103622071316554194507524610166457990087959160807415102946877307193349131573600.0) (num-test (* -1175978338162966145239180473229656000174129248706173549637767835154921467129547950144109700900405904250603515318348888619371004435353505449762899046094747.0 8633693716102199391202401198009047492431980605560930404972542822133579985462906768067706391388213605203282586546130434156768523403030127356256666478340720.0) -10153036788469908062299722391986722149392791936544969945546931764708792252481931153733789787389051773529081688846141949513463792442701686406966696738286561777611293604311491896230769507535896070984747493738525389837795316954065260075941524322954935690803870500012809797698319359975893462672845329776468197840.0) (num-test (* -5083395547684319640767882199938390155755986838939007846911062687871291096073452055061784159768637502151635665247461348347470360218957222873087414506633886.0 10813098236568616588240471432239693891825284805405416395976866126102880121934298269375465735278296789484402954117593716698067735458182402220278016922449294.0) -54967255432446073625448401244836956268872685687128644401372608170106281377801209665004925733448944141633739594240156882328181133879414641109484442890809130544146420476457200729843868300396656004198615619691952536924980482714767859804902602805398865249514544806725162402291122143659939645240358379962457176484.0) (num-test (* -8944626200084865988157251013718979706166428261352840753194709093968177704853157211364231059892647813839391802007588961807572842923682104089512428902387812.0 3814836951264415657788614449012480613328314590744410079075164918748648723114236698412482309581077603776489883375576245233128800002373843611668945838558629.0) -34122290543331565327874124324135450224668275222811493728051290368641401807963502623692504750924543845019291736982354932620821594287780848608647686402233097059022704206628297180782771812500512744911371653368388270442874670230118309469599458827222162362901084328510647514081302476000779049412605744638457029748.0) (num-test (* 5186176030253526423885531264483408352469356233262336223619904269047786350470477526433506158542551137478071074193659876898065998079440819597952826155782068.0 21428324964794197485898135923805540163916541943812058590308650649384013587098638034673796533027113673143959572855470411726978105342739938341516634354246514986124789451866589211982659199267654387148420461876524076040233779391563396552267276880650559148637067641021059664960876301072636635299261389450890094318429077561092553337025096293793433968243940381587994428364726938534453507046761494257538813861046058298873206568935790790373886840765817404479239485444563488020955730741209738203470138117422899051269778988135668626686262669881048094388220931264751830393793846372816717368806996496715219806062282836392457741918.0) 111131065300898907482632501071313138589398597291097276435916516379173430095773463468344138866282820740991088290299992221985607057347883717514843661030457396422379155394966857856069231504805779448809986906434617741485942621643754096548512120178021034054648207248963478122178145159262707381679354401629366698488021743300737044695960363216253889163551918513521913593214414139637549577618641974388739304727218804595402055185824193445089425262833385286117064481648652550355832014346131722965510192584901901111154083186713580209077544982897821477349293279848852596241762198202012197892321827305803333334823616660229870976569043453639028059771892706354703750763908127611939169337399882784092285804830644630059487027413697220038110815990084742241055099963659761569486906596326424.0) (num-test (* -12615422028124847936088012564413126213419674293830655240645918456932358053670311316461359727921727680491520480380615359506308571290338231702217134487397730.0 21538722931308708400287621200994476771789912594554241036641406577761480056366647329031140922034590767810855360008375309986798226712928670905618807986829790199948665185268081173685941421700542631395958882077936923141152528333121096909688700106365468854487023847026564219531968849793109908193037522063952753477768381591929787242143631287330811801315216116212154423972654430356675401769729358415036943501470085182304183033246682446978634892995900678975109490698283226559860736462409705544079080978470202336645384768211440438501339641775269445439018148409151795830925198162301321965042997632479354427154223366199106583051.0) -271720079725309675925162538296715595434811519956795637977932956405490708202732964133816538801099235844279338645471102896234318181092598033040518838847055114923365599862266767493227393553801736813141780001130539648588341196802606083178208108557367013886856183999712817955194261262279080641101769944037282423238147653270651419282545398168930625797556638625301898893565965773914460998322350526545278664715332414172614761548301364063397364632709194713561073496860524124460861314674679928692398440036071116570829193414179054372604203478369755566003622621281005164747628075596444178089558747835994702060740334079222508147598079351187013336751322569865313532407367116553748939535664259669808534100091049960040092785009707220249025633808590643620557093069849490009472441113874230.0) (num-test (* 10381022953674450046578890619826448644067144294659610359943634722044183130638243233110364436029778310048006743033299956844491228999113516347401915490861208.0 -20974871685432829994714153210121536409377362402944992609230062091789259307033495284524234519701670462495676590513192861649457148897274608767543942797542628100823017887236899471151903799837558453043431373811892813126194662218472834650841742305925226558315372771353677064933578639099452438843500601586038910108679737480263349221244638463171088589123712367802373159421798288708123925853179931628847579314900787361946716531755600236755527982132768286927549323465697241340003870259800347640599467922823203446834792229595507968354687630029075884034263531531423883902851487995214646322431057626558858528344843531280263328354.0) -217740624416854507100100919338835880277259264187442792458843251425095703739537223785767883764746809214920580060316177442387941385712712426957388995082877226019966428812240179251716274377143798847348759498926420314709056615470455134468678662646006408843897699718742372199854223008996321568642038054564397441209859567556502098420151667437837356649730396360374136203172669776530655738388121236079327354422138744456395348910073462618440421257604563050031602590345028438897601523520973759458890228893913090702884911857207117714231568437403212806578764580006787626657709435954760239671948147344463295520930250155876010414461245194991189183956653772752290656063730950237649394743456230607077768595983629559996700837383822873994717987698780007691157576205450973669241823945091632.0) (num-test (* -3984492646329789478973994496812455855595578196959138558282015917391108383154917581748539892089090551298072688793487597623310815918942283997753800645644511.0 22199897116873160263914990610762123553075230334116099569358672964060004245706770678771431369917479502828754815568950371273785689812698287446020480951417047185190067265849637510591502642000414540862689426343523077229502494771352820057572619644085930901096534031496492870227890836816886496090287321502805172125273822231241073590840684742085641304915656543831190976008986490532066597410386596132766422026234488163435487889876791504407434387555507637783709991326338482319227500686541368087892665100076351075069628862376686619537655838590687615291898971286325099164241688147975845320979841704002364545072665891829427213069.0) -88455326811459002089798581395024759975871889172872668466370443703433800509268320055453743803627754859670391415348970278548381190662701716228279482045339649051139909543850883613464992501666524385524517648069873862957915620016943364950043289963237718026629805297916194484838158010754666017024585366330526135823515744339445036315966714684052345462172808299142368905939297220895721123725415007532441824406115746741972351142687017849809593982432484296719999502992792447259391592152463664807498752410740679664044620898308783634092355737296495489953554685938970593890496829484673393665321572846542839714620847185428664388282452532264810310019327395691530430185946743995669191791841546685206884247468693248673484055915613115527492005264289557719000245333079386593840592027314259.0) (num-test (* -10672574004830373997900438516438419278676753890756925443116289034080220708922677740383425352837266631691319394850521121221541344600832530724104047804922665.0 -7307684417326792807224298894786988180161884427390942431653062127076829842696634441114228528164049031680536693195116703321494895319862805505304314401000204515985676763063862569446064343853536464020413910728442475032187317639476018710375702206456631041987826826225461927793241495220512935434301833094232834266749666697332380140380619185254354273073522191066457437931022783436360434167505326773192959291779779370530770935758482422581712556111319611455306383173529090289274267200543081481693078804068524057891845603351773722737987393428313340760607600482724483853560340630587029610437280601010173185018227638972500038072.0) 77991802747865927212086621295493124451256238920588746597961055391511562690441964216934615500942858653797884925704270904527938466874924049039962754703188019915846345804228044693122758075602494985337649496117180241872910247079655077012999375809878184011356481981590430241786534827516536543734645410817621964035091467871491521760928486006653992134635010794346993161329777270345449763927429735191213854873362673179799811714902439637861750855639857969259787075469241319618538795721956528400353086156169058060112255274542232054021662809196965752800525093125763127895334967094763817500702626282397394521201385439419885607578137159972521677923972708827090645776826953976605193554447841693259586575931864396484621463004541561908426383260772786784541411548146173991869741515701880.0) (num-test (* 1420855003086789510813111205540636553863493314684153860389816109865085846062678305775289632805233481596171530412925552158799875183492757047174905459819169.0 13897739053062356545217161606361735964779941697726983959749295377836209520566715597422965426908191354971972501742952706730523748574796773473606175934144970768662226027157110240776527834790487577863781140089347362129598158760833470434895693782503529955845076709376071972727346128409008293671217324995682020009675316075606538241192607139905488719485728099428376369506685875348346231688684483781160648420909364963718027571565217314827671844485031440079254478598236877074793221578612249882886835580737423192061550370069895525711885220268707201966615936769696379335772521903910689934596134239331592980694745008817040569590.0) 19746672065138309742065153069587996891492444461032276894328314121573439684229636534026409362850111716212254549198595854140809664451286626009917828620279583631575940837712663100442879662416765138504151063632823014639305658882804073655537352377258786105147057375069447099908107785635606190515362082317465738205179108333064680370909383338688734129396788764959056886328471374018961975554190739706996184818378586233017775166959010668462907838359485424792026496574369912033757997469014639705459505746723512361959074802456098328538419933637295482429555127226978561859965498424173552676019033370307387047798600024901453757451579262061785051932535359410827170361533603618131510421439128567361259204833501190218719779570258541358012741265599985490513564378203502703406698160470710.0) (num-test (* -25117824099635104147178796272946098711514362630774369209876335291088434247131228189812265510495277875692804180473811834186270331245779845635089547499275113671007257221593872123397418355506777725721168216892830217596134983713752526559153149600553468865338887605949011743043425900799896245185282419637806859906582214420191794114207677635194054239563071023206500505880052007267243210206807805387341085613436600843317096291021780624738422589234020279836961194869688005260369009833026575446099544900581955685627511787510900479881434909308757027825050977932238481841909425598834367032841935054158448815026264505726593064239.0 7846111496222858966.0) -197077248428250572361351389692146917243277049539013604789802566767174747369897711991559940484392921619974209620152008632450612546796556905740493507885376190913893140368029841033442857949219716681475253727058707723386016055991276120001690579154370788782636181079931076758384034193266737114305362492836167078199155929937891579224024229182935372106924021709421948701131654358516297806197381566809357458374057189773041520552821330635689748583803171230633654728360451100477472934847975252390985102859262992904778849652221553818627134153578436315973777720706502751232660284910468721430874674021521629540714057383398858244828214000543075116874.0) (num-test (* -12000343217458212092754251360179138661969968218789048702097501439124892987400633614429800307263114371624489988815324366411323242909652002510513570900627875514001409309670202055060404640758548257776155562167062337394219073071639153822126554525439988062676648294108951003012550815746564810508912122306190725453386412796036693387315128514162061147675205485143205925649214342646148112549805850530430229663418469577245456944558387628002442451042105749848177325651852669794048215063957689756465788955050513359977166122710392613631703123491357791351447110169966270916789849428298930624807758982400706608788793481972190953569.0 15463017349709835150.0) -185561515374029078700596518575548896805308728003103939537818954646551372890610870275966055765608887701776880889777402229764948269089126750201922167386201171243298907675542965323275634529293654817279957832652909009385491998537031060285890512199675273422070784691446251899120095880199298512230290860589352290462643231396804350623684034400741386070220057232978556614620855818271117742675632435727751812101639747357642295230273344552327870600519422276996860893842363996198017494117619585153346745838853026029459826407782259598477529242420507010652705302341725948095720110508044256096963772599572721279996322424269691990173052929936294150350.0) (num-test (* 20244597897909303129995907707212050478823487084391413473821544089492035634291726811145005824559631386634261268723753786161463497881725871168747275110149007801865428978596190887145324535224079986377522166727137028753272158887188902047835658826867304220850429481233026043496635847568448251753504834367809877190895369288045026559783632709799678639927825194847005181499299410953860627694080906167346078299421796974815616608326704894611151743720515377248152215241639534004099341398238713597030368980166731393247619511322804984829747216779359780372801101821087516269912916462719248736442644433057333788741151270815989388229.0 17931151643499274580.0) 363008954869078360197158713265773114114991766614027768774402465306840646219477262855625957403406166192075865834283840624408916170935610374573318606346031792128003204902147985329385955814330782527184421959263266167048755628089412213360508944817963403092490479480264538027768728303095523018598016863928762335410109567604756183580676503045557867957273324581082608248341332512325136675167966306268035077761004923732568405295901819511346235524577361289712297365403327125212199451099538443576479787130510546755789504852631291774614010584650672707483555436445926222945298928326313943231688436271883746272589347954697213098866117569339490918820.0) (num-test (* 18134862906191691435095953372467318196853760384894170022863300447691250350836421337333332682828557871096554531436829166444150586004379181099133295174348038948038399079336722004125999533719492457544642570217406286811480006881054375314838605871238868968956868878182133492469763282800195060849734382249696543089869191257451321764806079423169235271658993054867624410589213892458246001270123109841429271429275464249821855221014782727398959126117031823977229309775211695677345378510417534328974531801634095862859684508240122911023047425473036305928743193594967362216559973174709883576295373749738633873828863608550295977368.0 15082354452174510460.0) 273516430292774638949326170314933525797985748367549139070674899956657807928629067317576809269188258819686207094298714770978509118959142516619521080722291318367607601498107007447014759288176261262818034997399866363248136237609824401265450913244758024085739876914482935655100890803279961929047974391299795570244708811454483314898873277493486428279875241232025231140855860469097028388778917980779775554139507550577255217032521719099071084956515691364008526064349956553916033914728254580848198941020806723485184338914882588931083516851849558411503129184026079582257756707601984686901646494090820169212279581209612798749779318126482639269280.0) (num-test (* 19213874382308276075905228027166553836726993832150876980655958901416537033385379180983129528081628446454583401834309285184752924794893846406622935494758142810049493348116192315865522516744262115026742103678965417868790607689989205765793528434388393584537260717130892518011447327847533083474230074174308157934463971640826422302901570010591182715932658037868980053012095115562188975692530473556182305847290196895478280679341869546292639446526021874910117953225154204035612531584978136604161393474554294315903436682283787080297348697922389355209790646124024053098888687638640826064745026930980189268652291562437512941810.0 3155416591710364359.0) 60627778016974262766014671335614995348970065077989108071534610098195400001445248886220725085881796599270026085183075312353388418711598523030563716616967792282609748819081238929738105086199457414615236966895805539596649555457494710621217412773036416007129418290246899690911654008867819945724649185574237527152410775686803449108977881160831441280833577932476667657759420192656716352190871667386955409426879693856001112340390304980532208752863058384169885129364117656404549585836664647784765508649117301622797243353610345828189312360124462238989888436478381583689386509617357901461416012201469794664889076397809504626996523928173064949790.0) (num-test (* -6561903839860415551587224953276060627466820222543175464705113686962550773423611522044145975606965294164125376820288981286542044306677764776675868357117109664125730405280822770267329297542599719353907954399688197248115043785617436343303277493146049939491224480136371029084354063731401026459653680017632996944506546122253686805764620116169065663214526857151412139439538335533979733329962892417175374550305659302592107472151941922230309227785266745974334776462642676959433923828440435340579340133192678341787895007461237846313005612116885419002449356480017828933592324336731295317076205553526568668826499450826560670163.0 14908715577157091280.0) -97829557993133908713082095435440645457469053259814412551982534425389603663024461131358343104414088618618030154957456050473312402460589893359522167472060177968099538846750606564761307960896264958539903740023783283814849937681270591589750181462708056758506230073751440847913386576449367635057595344744119561166438538811561109125506233466453974371464999669336530949393433719456191822836826214814780222021267726528396849558417851727452246676857867278196266042327956933753121947589485377148388716839519782819642328655117625818256334190717182923260613562191698788004591479576661108985313450029332968584240383859113741485244318702724563478640.0) (num-test (* -10378013547095983701124686671659666242518351347561698092030999302329372512356819420877395264401390796163955327080881297568412490286247154759694714275858127906305200295043241717769593877683535229411640745872559018085757273530771413156968541499388413497221629366848027355125816131586610997516488552323667400115617175682996681969687885201321292153656071894385242141321468096793766926179134511319941715949712230831768643024119693594235207988046511542691719002262040067921088838755337917414526554050602539873232518619281766327369577617796816586064895744680567067970817494102948032924671421242699225194947982378019119315136.0 30004910492448871409155105619400474385.0) -311391367570036811050052853596227388481520279736812036769684195465110674594690412517879149770622679377262288447706750813509857551308594851067359841826754786725926298013483569424123912020079066150719085450400229896983461212531213110847425940968466564079253939695853896434719530729030897976597410468081535234663568150722646854183317007227669132983719314653861536414057481478039579810285535699518386214012059191958557306338432321511585867535008319640705419431310336566447165302011113284064246284641707577414470505948868362067233709611758700034131461348997580441628136979257037186480770286846026250437141175360847735150981343952303257191661069675154710791360.0) (num-test (* 6311357747888359229575837883366949670125882865462293491587368290797766017168248637163030339387377997726585769250585768079027576213724941259801478313127113803503561717311996500019522893295813684259416551410025111443510215766297835872165689077882298506134885487991732718254835036694083204758447948541157893533099634169589161496492972953698758234452126564385255035294546278732684663873459439615228706684138982066055370429797835904846166362278557095045056472775166294675997320598469599722704075215700819354957397052721573993997624711445698656580401684113096559767093466880001548887739825916626416328760047783071058963451.0 -212654096583990292869707082365869207538.0) -1342136080095566600483524091094048745061145155430997807005186206704767933140306297188996797343723817220160636373424666345108189275851749622201429179882167381735732553825696482751584102093819432866729465599060815670807282181979889263381844726842751894916887860819210652174987999919869623292751389157233409465756974677789790982740267208982768450215563288024088369480574425410032306456026930809228182100949940216614156925537929648841127727165386031716586596638254705402653861723407930666152691102484352058909219619985877341630210918347460471644327858114815713557305185589162775699323253049631349906791700893878999711846225062306568467992135934882289075693638.0) (num-test (* 25104391676237653962996674810232896003857294806799086059884413856421530328279649263948893056601611073815235439115612155497964541323584159786678357898152394779494741995735881624055133443980324145256438160990490767324719276757840825641421547232460969806196141938571103617707677351907526127993230143577974386169402623023560579220343920203666762052525898442578990183400559087522259053245822827313206196194989095468393682721753147596892214609346047051670610252732846805143964713621673722554204896154742594858056891979146566683467510164875593192581407047920719605560716270697985110227952698114701527191421628561835164291236.0 -205991315859231724218751687295926841150.0) -5171286675233738337789203670843122752625713948587464573381323151628930998435518250812603433784823922283042037694290795352461861058217142213862777203850665369756106838860420507328654214723398688455622487003912073924323587826356928211672752672052670663842775836967587150049181838707784871641183683742967716787111671792311389517753578360293551031540853470719098360013225516593755039537796518619542838794169319227197212817921098393499332268929332950035803734983497370378852859829228973012039890600437082235032378948656232679080766068869430262740600476498399803176452431728914806536862849281928869092524387549297345184969051926149006293586531930828748109161400.0) (num-test (* -25971587288596053786734900662696128734726180676323130693160397208008930123341700520454723462226657743365779183466120836187720332442041321870351823609046027805781414454998487673927365486893294110931852680018706479684281928396163669935417207859889405108139261480861908067489849403284000981453574189898304616775302917687860062501465417706095450121596418236563421425311420755550335597318818628123183624214438801254105808079227429950505879366254661664881055965092586612702279548151277733307180663770432418397550642136953750720624507617115504303570076531620003848642167562950736271141440609700821621532583527124386811144839.0 -182748557863603655835821910989658558236.0) 4746270122419629115710902425435990509747636609113505336611751359043717100752575149404352359855260443259846554733621122684788488984010741203981300775978945529551335641218319619542248418128319220383298229263331638090009313676486209764655429828385994626323209879925281409485074778611946493692237774852428345451174837474328995186242262565013937544898941834362941815633750896882758939509605799422068815435202904271722442099465950700886702949580264958171808372530471918175963644209760378395316412115175988232945569517230829200985652504383431054550902852797293952515652017940918628980037316292352828228005975466732028971159947131994753006597870175664981312344004.0) (num-test (* 2117427896392849163304163145095251890404997781812823978967013619233450901604407363671467658244435728579079751353560538034596183240362499870272373308111405924505741579887345118857908796509418246599428633956038017783178050402412769812823236255234302205027282366926174916871858199918908361186936687654278623156607813451034087735179167324944824913226799346886951212979149617678949292799645035425029596869092844906629996914674904522806258932192931217652241231736891642224851547474205131131019084734780208254203537633402057673465583362982905095029133132240839391503135932501785844503813910210348239157828902668852795945482.0 -296778668392678698960782643314222141731.0) -628407431508980610909134894336322264939705333430111861505965183839156278363647883745193463537783397824947515214540990712455315080515980803996660089847066076833542492719707493333185909990202372284811233272987993068106356248349054482194817336258302692039392400931536481136340269417905505366385505196886218794044229758585631131853635721528813397816307666671727692971421531381290925317161326036075629905443938124481334173158440927555118173661486114828362551889594188958723424604273078091320087897088472418346754088900034854230711982602435635574895960156993014703292551046970069204857846207328434544990709459402656908170089318995291341536347275682867153109342.0) (num-test (* 24743327715258194976385899813930363006464428087412805068703455203318769863096919192538751530954777047772548306936907016751357570434930538612382851621309732767199276228580401695793317612267605312672263736938703887622824117576912830029817460033437752668221355377879837833796222831371174014543622739933433581963103361464022058091243110136610854806189138108937004805781857031030005354158991203388998364340053773883952742645161560754545458260688560269655272249435540890073696261770299845722705104648358053080678920468895189601731801025555650490534399590288852165862135571140382055044665678298182909026026068995867606241201.0 309156501491030456401354118244509785044.0) 7649560631695275371386748526795333430293346807872366006552933839286343590101586516802834568317627508914888989005968805867728947519409222814667350103434422356009252082456906520988877859152125402282765775845766265340707473525444185795403554160270722809642681642831847296672303556012796775586274347178092325226458743113317655523655255626670958156216225968018208281266858684283741496986683426354716284780229004376492833583965647875097951642088252875535823145900129967026856898970545720526282798418382467634180690243423325770596949644122541224189780082061715230852249880601371985342796525016176048518593825361248232406051886794538203297084423942036889326397844.0) (num-test (* 31345149697924857384985323414506591310628538098830133854928154990821019223495435414394178930529373634315044777562902565397455028894455733092896622048288278424884040917250546068175763309233883078972879622697667174865833277342334219810618450605650614585133187005110148963483824629405555603493157452295284935004578187488673124814714326405406894084902824045787647963172437833905574178160343833139650913077173865287057167288286708807322607983179910358234015596109655900840652230258122852488289951986129788952718105898226951651151495867246384586164892018870981480003722043190639707903266193064807571586900961788679579912089.0 2067227180806746570739122295766566373146995767544546241400900414826379465803168632854028593293108913670556431832056563218709444199286888840721753894461468.0) 64797545442006646811970698282511426059102976298051534827345388707272469591333019870381858263624490336448197115781363489554169207652559213486772008013638214870324260793199674746523791257170452738018910619029072942848422098770309928561867618844814267276213608306045020686764830302020953883994906997293368193331696747777630621086600981981357507299729947717565760536305785574555255589190221698706036770081438750974356437738060098906046001271392354762036427049946092656701257615490057677558059955825843182799904828201890893555678855718728417223845757559310912618029462136640226686626513375024547351747669476392735304999046232068947570708757930233036922714350584650744960478326257916948676866148362166017752159953504981324652709881831381637989229842766220141292801807437886652.0) (num-test (* 1965759082776833678304908699214846485256126608825750175641683294458978302204367346739996602241053060915897480812220051082619942907491598551933638540412113496542245474287364500698693202553692963910123752514310355402167440783023542848697962967771951714434359320001430281377747193083851165947498546085410216620013287853719686698746328198021011905482303248172483782066908570502837009924228011993318265674390462360820566174204659723461994730913995303015012684826295802887547970851558451858623353950391701673651959262042520584275132971807158231859672678070714276061110616753309305801080136339206017351200193800253572481467.0 -11092241138073130060021642325471345789108575712118027611362686690749327689527135459714040658411176246054106270789083336195599640521602432629024562630323934.0) -21804673765518097879589124792137157558586438669762099454880024920520894260754279593873244443852337739758694535682558790532827482894104906218015712179591886600693703465749571299271429989154199263793230178266758966678432691901731270899259065726530463438316383699558373053423999416350780342222940065486831353604365192968606300436304827279383661172824549131179471364227618431414928702407510473319879188990689163932586727702195573766225861364297410904859137393184592815970592502081722125458353280743087607273547490382023433724488604177909671497082747464946083901888849483505451426245881736990810339421864101129619181017696837017966116165703320918568645290788634265522956017905246042460811062666193790657969385648522736090098231379029903772234867701846824572274796526421531178.0) (num-test (* -4067457132547237558852016696244696525033953641638067592741078194074861352472861925779476293767777560910963786727886946479865734639031042985368829200802420611189793957001730656623744670821921724417176679009632346904384261431052972127975733031277489967119978909321422086102208644766894305071609385305464547231057263658903212521469801833214062476735046735467944834107695748433481665714184831786462886261252526036621257865158497049125410241033365487816324425563483999957660557670189397770488996359512245971368638615503320507431381893539767352426795415898379765583574977542068222040889423739693921998717145084904555464058.0 9635268828818063607505341812331931088336041632536136269505180222913464638532245578488168867093853062326136774925531196873279749483997619950077042084971972.0) -39191042921786100943542578352486285322085069425292685238158202937549417928185097567102615300826629615520476316505465412722375794150552330462353356124896483739321653441446703127728441315609093330694305784991844511900128172079464896650958648496336601612657347012294121239821167759496102233234525084695798195547141521849769350204659392602605928907953707277320590923278178152903602506284861018886300148663530071056792375593665422754923886137410482547324901798328311927545105456397213670390651819229021443747424183114992653572959318104053511452473611466305149349027962240989590453237778130260105665310067480846969449221473610614214933278048389171979184119355459010233147440293881252851501522689209874112819966647846701257081192324007280573826673895648273593609466000383382376.0) (num-test (* -22047771987573494284336211037167956208924595972749016352929724093971147687332865088249749580556015503923927321586913446367676445848750229391300778587369581738560634537089081840938984779012854694220894920437076215176060179241185151442003472788530160589267677502568156006531439509890061829154786579353177129190813899423306499631144919702707240832059008168851983259611724134448165201725432622521420667808597545410136493805873769372831833878868603946583848422310946469083400330960925084024624317866822897278934924368888332618046649078771617892961267312226309927786691384460940015979582201446635756024251269978545916298961.0 7481502540911026808093162425787184755732317118387068406204973030847892995155568099553397887864257088525242568880427634318737874025160499293315047534753494.0) -164950462146458057264341765173378248123415893870534274075422323606836246718538063890359159423074703472625232511667875897808555123518162244263016096627959208397334135559180524195701526029092734741010866589515172934676451385008535538102832400604699294088534999994990970130226363762230944961249818769566697211068918154629209895730969522747736738946126971914549491889482944152891334838234907190697109929512401661529882587076352559260375439428815896053844621297552401396168240947357044985051323834074355418902009161796886350497072010833513601114819625605048943438304411954380599728561071485061414856047768286383287807924135081902458690495890129203192613070824670256334683011083767124852354110322463725619194174195587835939047474059288568764831570274891727391545546467943319734.0) (num-test (* 22607201423790553279447786193696575272983924506336369475058795405894123712509544256099524616893423762658394830755129501447553593365768543361107397299007141714383407862976654294384881771985218996697067215804348472693636567074361380875512341556932579903687576929186215185312685712277482751425466251201421842248749944123326048360909954588266368306843116245625635467041934524547983478110533044085242847795585598341867070787331785945399446665919396062565614516404861115244243161694059679274045050270546536781907061002623188435269769778378780371158624481539046590932125320888745103158180784231722265376331553893647061533815.0 10075764395489719205294189472045365742345400155046712954334138069917417587273618147303160957788995022989479371576840422540097479703418600112174202202728054.0) 227784835187493343385594867881830022845566753253174983274076326016001091958812135049265213053390506720261776960833046225700903422206015373488419693650378821159134369608830936915027161415300759990632038898164509761337714774392506802504397626551196717184785586630245704512525844329038355790338277254618639554796026366029578805283659986085947726260520495140332204643887370987929304924491772630534558682402396784510750317396488402942581973350428066695976988812610467654886227733900635715495731445319565054848075104982244316563526232071957624002266648721592744376122065531440026836549316222728280595228806728872537793522244957258060730038589170810090676474272044568671474692128168357087077816573419470273384256552275636517940058764711467508281344270125535855785388198570146010.0) (num-test (* 21997874907846585575969651776904015812729615626636027149446399573806943459105370044846476738175828244018281160136531735881270437472624605280356112191272531838028896521621800558410217146758345955334174583639352151367532676985598470747138461153212653362188252002768647808852054182649808145379073620834551216386805267446360709820441771932135218282126427988826945094538034579367527908530151926679515746133600376612899354099328788736038811470295396365432559354070365548930628714861826464935305416998192532029724853617023971964507955475554955277722555849603716733374588174421463022213135839490633927005539569058361144905451.0 -1400498192750070094581812894241996480373581610489471746158083224360249880335094841398529960182484181641387946900090289855375996313447832474435929084180606.0) -30807984052781257825246153008277875918087659020905755686964119182052911551148620538090633516362197112383237624321406969368641524681503231262834662890145617622830207559490089313283375890353617292096501953380469351747504928597461154633889236826060654886877907382241867167198409355653371944304660938495445848950444683274236538890057643038410268234731745456035923559528706349316582901179686671568504971088561096469997823300883298811440849031903066114422309644669680078733839046643542078157684064686933779591609758494599988463628362190034612412739669041368897594110022347872452261447359402810277413572637740870748949093642723240662839444216981630862346445890780016393330114883270596630385367407921496982236074288475142085411632630374714528706189796772213264952893973677883306.0) (num-test (* -270155241925436273159477510619232592261228150696806729750247050.0 15545126743930076938536195287546926534964892301082800206802745964245668351235397.0 72127079799316080210744562119267314209211162112457416152560774669179705347659265.0 58427280233475514109627698916382980237252687770812483048907352594138577656301900.0 91336330475502063985843547526216808965829995610054777216888670176112782119332811.0 99495081134815818196404370468895496198561677002653930126818668800341380375657337.0 6904264296552316628911621065724553059847235903647375662685025031963599691416829398469283631386160328944460790101458427909545198569619131058877708293713734.0 -16074984786353617526516141164566295497596312655026144270863093715961484079732496604871734572736757225277596743795506589617891195569235287256031608792067121393492186703333733526879481948463529609113624075923052999494363547340563039654910799974388353472433635130983731604982117092991918514078659590068643956240711810902756784590442416249652077644077280371860780741318193975770906075446772544431670392964384669681404295839302410058434872964315897505894833409101781069230919347279857855594782111721176074849502391457684148683668165019969667481755384384017844104770253558111588611189351637275389688093074751942960310850074.0) 17849860827147993486644896214424106325295064110723402251474432199595968349198253682890653243676378684005650871261983711134190416277366473221365848417375107498764965893729640224952922241531788638514200018520970345581414705756736222535562338748426356003659523260330725662384208724142177900990027225665451069059291754155591197426279006090296512196415617974140965334686090032257444820748820516976632201388937358434205022475303705442914044454220818215336283948743042841946229853366515552653568436171217572212088935263340599371830215580988184775240338748954666846379831467518505260487989636951404886967842600777836444030434816421999334066711024026401362115623932221335906548647785232855815515579448393689650116225664467056283988125816950714780486880294535933597118808163054631168063568847830481653855357008353733414826165759079092633441356914450038756281940532159493763482047244493174370100586359619040444818634156576789665732998111907245928253704097384811414269835758656988678207624731164159069547745777423464124959379113843649940896359346515513936964849811155238140671698227057228045173997904545787593258286212427476788605370334985423461194148838623911634821153061693257996982252745844329344589168264774527631972524787804330730506700000.0) (num-test (* 6411564443509812216548163965666668398784964137255201222920640150.0 65325385402074288043601436729391841747319174569548241717675134253657593233436152.0 63305037198546989906433329294566491017476837189978173607681765241525113921707860.0 72383582945810879300930057856704905379805338886592055772943486702915907397618845.0 35525980101796892634292856352740658817031405780112750352735419884048051630180860.0 47579150292602967366908574298176357632207539947399443701205872093150879604391127.0 7775494633965874654516687741429737470333189902121089184439228657893110997221737422210698789286625633365548095171257583020272703565350668755439139356570.0 -7847653632223099338936161226557020783515367997970448568586056286591257384101422312757649765574456754668588904917800060981155642916520580540801153603733496143328839018174649200566737789874193483124577734129346933208306772618814806884416239295732454033604210880463262467564639515484363761639994642888910703066277724414372379965872478153546766131136324967950786993982228851928269842355632200589446224738709869729930285189047112131897218464505263042012855229737941639093204086147932759923796947642895167078971517834730472596647456786099215405165290569214043431009370032818978995463168133051136053246705694337584724712230.0) -197949741939898550383903354028842356745461597695099989904494711851411610441324234089773644533872304737431480244289438922163630848266242200711131210228027234579469457105291847132071566876246332653149194709623963836885480655282595345693084881617726426841183231475364991154699746506928116505297453355016975688761948609740314324443406930215518937775475617384099331839748494157863510168743547396262979908353122625808170296763676837551973930928848463398657587603606321137626467028732193151671337338929938959296176472483674270114824853018199281637976410726195357458134038379491704909997939715446657856320452698914513791221947734373322868574099599391493563479057703049036936132407025278683219316357543078875410080612067641232277376174351958080693019953378024732243763129075732499165068171168470237875348580987967740148512425201518758344757030205911031119619416763996490581551977913711646761182756531618786226541010835120092904291975494846126923510483263978074437667987560077422810120462938292680423746968095994108344184522240467647491991837793653579480334442342102339933473270535800619630342940590477752278184994533764839125736268376640933720554199782388890444619996919031351334561766248781813883867406045414518951152508504891407920000000.0) (num-test (* 1669833986019218156514274418186396165434871163342486930502417566.0 58528969848472951398118375496887849181512821636583415470809040929690124231959506.0 50098163184827557635697120379841225459445103589988345336880332217224622666020381.0 90445522698871905833766573423181067004916996574451008349087758531794463581708977.0 92366726802191504770638415639612204654473958526592425718659284841373421985393966.0 69096133232785816552402133765198624674167660496399099321713067612475604030259084.0 323971624832697152056406152359288553860210436839331005469891386690556929684663075996719803995137130737141925308417709520389528780839777347463558171582753.0 2635514624483961079560488004237441873979133312246005082134175818331132377114926863102436691793380965631848192666106793612266994709357524826644421074908075389316030912936338175907209987972553710900613011802455058538786723149316934049388525865455871552882282353445228425640452635081303490379594663330152071465360003249884180020993032086861074931796165970076448856988084523672973069824258299029863033098237556417571526135639288006133579174344589248428714474318969988990720790226604664141927030250855550010512291136517209169959021730625428868037074528890516086527430801590050720467893089085308995719513895962750896813152.0) 2413207990093478676325592386500172980330574558867366638913149256222218924700401110600319869300256745035993991818342784487193857053589994816247466074246569162659879368383295411190237107255160498774228460295857931362161062884154872938368166514128474751716517750517217000290486110198899480877593169193610813452614906598055909439037075588626529658637140089909227353944313408987644743661503976835580507054926908821206921014266535160031749397432350114673787218438589065861056449106115395189057409933330355574558853874223262465965933679584884152813357065227868165556818717270584803360466149860292769520737249610469675917864449261901859162854558012721179400237645357401213337423255109839806528503425658270050436129019270883446965562683284298538825840361267548675967778385927410390726055957928634152514415917053614892441910675109517307682075989998558764742821214685548219206933043196677521610851950501225469125512893859254575460130829051324112015464552874242522140166275233893076603452098841950130740353331198999756316969161591691095397245996664755249875720008141774247384884623389430842799829690618405724986702942913150258769060684255363816662231923570491001519802836627028431389746450987110456127797025006251203111629141890634728548553728.0)) (let ((val1 (catch #t (lambda () (* 1.0 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (* 1.0 -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (if with-bignums (begin (num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 1099511627776/12157665459056928801) (num-test (expt 2 40) 1099511627776) (num-test (expt 3 40) 12157665459056928801)) (if (provided? 'overflow-checks) (num-test (let ((n 40) (s 1)) (do ((i 0 (+ i 1))) ((= i n) s) (set! s (* s 2/3)))) 9.043772683816628192400549525035572818665E-8))) (test (* 0 1 "hi") 'error) (test (* 0.0 "hi") 'error) (test (* 0.0+0.0i "hi") 'error) (test (* 0/1 "hi") 'error) (test (* 1 0.0 #\a) 'error) (test (* 2 2 2.0 2) 16.0) (test (nan? (* +nan.0 0)) #t) (test (nan? (* +inf.0 0)) #t) (test (infinite? (* +inf.0 +inf.0)) #t) (catch #t (lambda () (* #() 1)) (lambda (type info) (test (apply format #f info) "* first argument, #(), is a vector but should be a number"))) (catch #t (lambda () (* #() 1.0)) (lambda (type info) (test (apply format #f info) "* first argument, #(), is a vector but should be a number"))) (catch #t (lambda () (* #() 1.0+i)) (lambda (type info) (test (apply format #f info) "* first argument, #(), is a vector but should be a number"))) (catch #t (lambda () (* 1 #())) (lambda (type info) (test (apply format #f info) "* second argument, #(), is a vector but should be a number"))) (catch #t (lambda () (* 2.0 #())) (lambda (type info) (test (apply format #f info) "* second argument, #(), is a vector but should be a number"))) (catch #t (lambda () (* 1 2 #())) (lambda (type info) (test (apply format #f info) "* third argument, #(), is a vector but should be a number"))) (catch #t (lambda () (* 1 2 3 #())) (lambda (type info) (test (apply format #f info) "* fourth argument, #(), is a vector but should be a number"))) (for-each (lambda (arg) (test (* arg +nan.0) 'error) (test (* +nan.0 arg) 'error) (test (* arg +inf.0) 'error) (test (* +inf.0 arg) 'error) (test (* 0 arg +nan.0) 'error) (test (* 0 +nan.0 arg) 'error) (test (* 0 arg +inf.0) 'error) (test (* 0 +inf.0 arg) 'error) (test (* 0 arg) 'error) (test (* 0.0 arg) 'error) (test (* 1 arg) 'error) (test (* 1.0 arg) 'error) (test (* 1/2 arg) 'error) (test (* 1+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (unless with-bignums (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (make-float-vector (* (ash 1 43) (ash 1 43))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (make-float-vector (* (ash 1 2) (ash 1 43) (ash 1 43))))) (define (hi) (func)) (hi)) 'error)) (test (real? (* 0 0+1e18i)) #t) ; 0 or 0.0 ;;; -------------------------------------------------------------------------------- ;;; + ;;; -------------------------------------------------------------------------------- (num-test (+ -0.0) 0.0) (num-test (+ -0.0+0.00000001i) -0.0+0.00000001i) (num-test (+ -1.0) -1.0) (num-test (+ -1.0+1.0i -1.0+1.0i) -2.0+2.0i) (num-test (+ -1.0+1.0i 0) -1.0+1.0i) (num-test (+ -1.0+1.0i 0.0) -1.0+1.0i) (num-test (+ -1.0+1.0i 0.0+1.0i) -1.0+2.0i) (num-test (+ -1.0+1.0i 1) 0.0+1.0i) (num-test (+ -1.0+1.0i 1.0) 0.0+1.0i) (num-test (+ -1.0+1.0i 1.0+1.0i) 0.0+2.0i) (num-test (+ -1.0+1.0i 1/1) 0.0+1.0i) (num-test (+ -1.0+1.0i 123.4) 122.4+1.0i) (num-test (+ -1.0+1.0i 1234) 1233.0+1.0i) (num-test (+ -1.0+1.0i 1234/11) 111.18181818181819+1.0i) (num-test (+ -1.0+1.0i) -1.0+1.0i) (num-test (+ -10) -10) (num-test (+ -10/3) -10/3) (num-test (+ -1234000000) -1234000000) (num-test (+ -1234000000.0) -1234000000.0) (num-test (+ -1234000000/10) -1234000000/10) (num-test (+ -2/2) -2/2) (num-test (+ 0 0) 0) (num-test (+ 0 0.0+1.0i) 0.0+1.0i) (num-test (+ 0 1 0) 1) (num-test (+ 0 1 0.0+1.0i) 1.0+1.0i) (num-test (+ 0 1 1.0) 2.0) (num-test (+ 0 1 1/1) 2) (num-test (+ 0 1 1234) 1235) (num-test (+ 0 1) 1) (num-test (+ 0 1.0 0) 1.0) (num-test (+ 0 1.0 0.0+1.0i) 1.0+1.0i) (num-test (+ 0 1.0 1.0) 2.0) (num-test (+ 0 1.0 1/1) 2.0) (num-test (+ 0 1.0 1234) 1235.0) (num-test (+ 0 1.0) 1.0) (num-test (+ 0 1.0+1.0i 0) 1.0+1.0i) (num-test (+ 0 1.0+1.0i 0.0+1.0i) 1.0+2.0i) (num-test (+ 0 1.0+1.0i 1.0) 2.0+1.0i) (num-test (+ 0 1.0+1.0i 1/1) 2.0+1.0i) (num-test (+ 0 1.0+1.0i 1234) 1235.0+1.0i) (num-test (+ 0 1.0+1.0i) 1.0+1.0i) (num-test (+ 0 123.4) 123.4) (num-test (+ 0 1234/11) 1234/11) (num-test (+ 0.0 -1.0+1.0i -1.0+1.0i) -2.0+2.0i) (num-test (+ 0.0 -1.0+1.0i 0.0) -1.0+1.0i) (num-test (+ 0.0 -1.0+1.0i 1) 0.0+1.0i) (num-test (+ 0.0 -1.0+1.0i 1.0+1.0i) 0.0+2.0i) (num-test (+ 0.0 -1.0+1.0i 123.4) 122.4+1.0i) (num-test (+ 0.0 -1.0+1.0i 1234/11) 111.18181818181819+1.0i) (num-test (+ 0.0 0 -1.0+1.0i) -1.0+1.0i) (num-test (+ 0.0 0 0.0) 0.0) (num-test (+ 0.0 0 1) 1.0) (num-test (+ 0.0 0 1.0+1.0i) 1.0+1.0i) (num-test (+ 0.0 0 123.4) 123.4) (num-test (+ 0.0 0 1234/11) 112.18181818181819) (num-test (+ 0.0 0.0 -1.0+1.0i) -1.0+1.0i) (num-test (+ 0.0 0.0 0.0) 0.0) (num-test (+ 0.0 0.0 1) 1.0) (num-test (+ 0.0 0.0 1.0+1.0i) 1.0+1.0i) (num-test (+ 0.0 0.0 123.4) 123.4) (num-test (+ 0.0 0.0 1234/11) 112.18181818181819) (num-test (+ 0.0 0.0+1.0i -1.0+1.0i) -1.0+2.0i) (num-test (+ 0.0 0.0+1.0i 0.0) 0.0+1.0i) (num-test (+ 0.0 0.0+1.0i 1) 1.0+1.0i) (num-test (+ 0.0 0.0+1.0i 1.0+1.0i) 1.0+2.0i) (num-test (+ 0.0 0.0+1.0i 123.4) 123.4+1.0i) (num-test (+ 0.0 0.0+1.0i 1234/11) 112.18181818181819+1.0i) (num-test (+ 0.0 1 -1.0+1.0i) 0.0+1.0i) (num-test (+ 0.0 1 0.0) 1.0) (num-test (+ 0.0 1 1.0) 2.0) (num-test (+ 0.0 1 1/1) 2.0) (num-test (+ 0.0 1 1234) 1235.0) (num-test (+ 0.0 1) 1.0) (num-test (+ 0.0 1.0 0) 1.0) (num-test (+ 0.0 1.0 0.0+1.0i) 1.0+1.0i) (num-test (+ 0.0 1.0 1.0) 2.0) (num-test (+ 0.0 1.0 1/1) 2.0) (num-test (+ 0.0 1.0 1234) 1235.0) (num-test (+ 0.0 1.0) 1.0) (num-test (+ 0.0 1.0+1.0i 0) 1.0+1.0i) (num-test (+ 0.0 1.0+1.0i 0.0+1.0i) 1.0+2.0i) (num-test (+ 0.0 1.0+1.0i 1.0) 2.0+1.0i) (num-test (+ 0.0 1.0+1.0i 1/1) 2.0+1.0i) (num-test (+ 0.0 1.0+1.0i 1234) 1235.0+1.0i) (num-test (+ 0.0 1.0+1.0i) 1.0+1.0i) (num-test (+ 0.0 123.4 -1.0+1.0i) 122.4+1.0i) (num-test (+ 0.0 123.4 0.0) 123.4) (num-test (+ 0.0 123.4 1) 124.4) (num-test (+ 0.0 123.4 1.0+1.0i) 124.4+1.0i) (num-test (+ 0.0 123.4 123.4) 246.8) (num-test (+ 0.0 123.4 1234/11) 235.58181818181819) (num-test (+ 0.0 1234 -1.0+1.0i) 1233.0+1.0i) (num-test (+ 0.0 1234 0.0) 1234.0) (num-test (+ 0.0 1234 1) 1235.0) (num-test (+ 0.0 1234 1.0+1.0i) 1235.0+1.0i) (num-test (+ 0.0 1234 123.4) 1357.4) (num-test (+ 0.0 1234 1234/11) 1346.18181818181824) (num-test (+ 0.0 1234/11 -1.0+1.0i) 111.18181818181819+1.0i) (num-test (+ 0.0 1234/11 0.0) 112.18181818181819) (num-test (+ 0.0 1234/11 1) 113.18181818181819) (num-test (+ 0.0 1234/11 1.0+1.0i) 113.18181818181819+1.0i) (num-test (+ 0.0 1234/11 123.4) 235.58181818181819) (num-test (+ 0.0 1234/11 1234/11) 224.36363636363637) (num-test (+ 0.0) 0.0) (num-test (+ 0.0+1.0i -1.0+1.0i) -1.0+2.0i) (num-test (+ 0.0+1.0i 0.0) 0.0+1.0i) (num-test (+ 0.0+1.0i 1) 1.0+1.0i) (num-test (+ 0.0+1.0i 1.0+1.0i) 1.0+2.0i) (num-test (+ 0.0+1.0i 123.4) 123.4+1.0i) (num-test (+ 0.0+1.0i 1234/11) 112.18181818181819+1.0i) (num-test (+ 1 -1.0+1.0i) 0.0+1.0i) (num-test (+ 1 0.0) 1.0) (num-test (+ 1 1 -1.0+1.0i) 1.0+1.0i) (num-test (+ 1 1 0.0) 2.0) (num-test (+ 1 1 1) 3) (num-test (+ 1 1 1.0+1.0i) 3.0+1.0i) (num-test (+ 1 1 123.4) 125.4) (num-test (+ 1 1 1234/11) 1256/11) (num-test (+ 1 1.0 -1.0+1.0i) 1.0+1.0i) (num-test (+ 1 1.0 0.0) 2.0) (num-test (+ 1 1.0 1) 3.0) (num-test (+ 1 1.0 1.0+1.0i) 3.0+1.0i) (num-test (+ 1 1.0 123.4) 125.4) (num-test (+ 1 1.0 1234/11) 114.18181818181819) (num-test (+ 1 1.0+1.0i -1.0+1.0i) 1.0+2.0i) (num-test (+ 1 1.0+1.0i 0.0) 2.0+1.0i) (num-test (+ 1 1.0+1.0i 1) 3.0+1.0i) (num-test (+ 1 1.0+1.0i 1.0+1.0i) 3.0+2.0i) (num-test (+ 1 1.0+1.0i 123.4) 125.4+1.0i) (num-test (+ 1 1.0+1.0i 1234/11) 114.18181818181819+1.0i) (num-test (+ 1 123.4) 124.4) (num-test (+ 1 1234/11) 1245/11) (num-test (+ 1.0 -1.0+1.0i 0) 0.0+1.0i) (num-test (+ 1.0 -1.0+1.0i 0.0+1.0i) 0.0+2.0i) (num-test (+ 1.0 -1.0+1.0i 1.0) 1.0+1.0i) (num-test (+ 1.0 -1.0+1.0i 1/1) 1.0+1.0i) (num-test (+ 1.0 -1.0+1.0i 1234) 1234.0+1.0i) (num-test (+ 1.0 -1.0+1.0i) 0.0+1.0i) (num-test (+ 1.0 0 0) 1.0) (num-test (+ 1.0 0 0.0+1.0i) 1.0+1.0i) (num-test (+ 1.0 0 1.0) 2.0) (num-test (+ 1.0 0 1/1) 2.0) (num-test (+ 1.0 0 1234) 1235.0) (num-test (+ 1.0 0) 1.0) (num-test (+ 1.0 0.0 0) 1.0) (num-test (+ 1.0 0.0 0.0+1.0i) 1.0+1.0i) (num-test (+ 1.0 0.0 1.0) 2.0) (num-test (+ 1.0 0.0 1/1) 2.0) (num-test (+ 1.0 0.0 1234) 1235.0) (num-test (+ 1.0 0.0) 1.0) (num-test (+ 1.0 0.0+1.0i 0) 1.0+1.0i) (num-test (+ 1.0 0.0+1.0i 0.0+1.0i) 1.0+2.0i) (num-test (+ 1.0 0.0+1.0i 1.0) 2.0+1.0i) (num-test (+ 1.0 0.0+1.0i 1/1) 2.0+1.0i) (num-test (+ 1.0 0.0+1.0i 1234) 1235.0+1.0i) (num-test (+ 1.0 0.0+1.0i) 1.0+1.0i) (num-test (+ 1.0 1 0) 2.0) (num-test (+ 1.0 1 0.0+1.0i) 2.0+1.0i) (num-test (+ 1.0 1 1.0) 3.0) (num-test (+ 1.0 1 1/1) 3.0) (num-test (+ 1.0 1 1234) 1236.0) (num-test (+ 1.0 1) 2.0) (num-test (+ 1.0 1.0 0) 2.0) (num-test (+ 1.0 1.0 0.0+1.0i) 2.0+1.0i) (num-test (+ 1.0 1.0 1.0) 3.0) (num-test (+ 1.0 1.0 1/1) 3.0) (num-test (+ 1.0 1.0 1234) 1236.0) (num-test (+ 1.0 1.0) 2.0) (num-test (+ 1.0 1.0+1.0i 0) 2.0+1.0i) (num-test (+ 1.0 1.0+1.0i 0.0+1.0i) 2.0+2.0i) (num-test (+ 1.0 1.0+1.0i 1.0) 3.0+1.0i) (num-test (+ 1.0 1.0+1.0i 1/1) 3.0+1.0i) (num-test (+ 1.0 1.0+1.0i 1234) 1236.0+1.0i) (num-test (+ 1.0 1.0+1.0i) 2.0+1.0i) (num-test (+ 1.0 123.4 -1.0+1.0i) 123.4+1.0i) (num-test (+ 1.0 123.4 0.0) 124.4) (num-test (+ 1.0 123.4 1) 125.4) (num-test (+ 1.0 123.4 1.0+1.0i) 125.4+1.0i) (num-test (+ 1.0 123.4 123.4) 247.8) (num-test (+ 1.0 123.4 1234/11) 236.58181818181819) (num-test (+ 1.0 1234 -1.0+1.0i) 1234.0+1.0i) (num-test (+ 1.0 1234 0.0) 1235.0) (num-test (+ 1.0 1234 1) 1236.0) (num-test (+ 1.0 1234 1.0+1.0i) 1236.0+1.0i) (num-test (+ 1.0 1234 123.4) 1358.4) (num-test (+ 1.0 1234 1234/11) 1347.18181818181824) (num-test (+ 1.0 1234/11 -1.0+1.0i) 112.18181818181819+1.0i) (num-test (+ 1.0 1234/11 0.0) 113.18181818181819) (num-test (+ 1.0 1234/11 1) 114.18181818181819) (num-test (+ 1.0 1234/11 1.0+1.0i) 114.18181818181819+1.0i) (num-test (+ 1.0 1234/11 123.4) 236.58181818181819) (num-test (+ 1.0 1234/11 1234/11) 225.36363636363637) (num-test (+ 1.0) 1.0) (num-test (+ 1.0+1.0i -1.0+1.0i 0) 0.0+2.0i) (num-test (+ 1.0+1.0i -1.0+1.0i 0.0+1.0i) 0.0+3.0i) (num-test (+ 1.0+1.0i -1.0+1.0i 1.0) 1.0+2.0i) (num-test (+ 1.0+1.0i -1.0+1.0i 1/1) 1.0+2.0i) (num-test (+ 1.0+1.0i -1.0+1.0i 1234) 1234.0+2.0i) (num-test (+ 1.0+1.0i -1.0+1.0i) 0.0+2.0i) (num-test (+ 1.0+1.0i 0 0) 1.0+1.0i) (num-test (+ 1.0+1.0i 0 0.0+1.0i) 1.0+2.0i) (num-test (+ 1.0+1.0i 0 1.0) 2.0+1.0i) (num-test (+ 1.0+1.0i 0 1/1) 2.0+1.0i) (num-test (+ 1.0+1.0i 0 1234) 1235.0+1.0i) (num-test (+ 1.0+1.0i 0) 1.0+1.0i) (num-test (+ 1.0+1.0i 0.0 0) 1.0+1.0i) (num-test (+ 1.0+1.0i 0.0 0.0+1.0i) 1.0+2.0i) (num-test (+ 1.0+1.0i 0.0 1.0) 2.0+1.0i) (num-test (+ 1.0+1.0i 0.0 1/1) 2.0+1.0i) (num-test (+ 1.0+1.0i 0.0 1234) 1235.0+1.0i) (num-test (+ 1.0+1.0i 0.0) 1.0+1.0i) (num-test (+ 1.0+1.0i 0.0+1.0i 0) 1.0+2.0i) (num-test (+ 1.0+1.0i 0.0+1.0i 0.0+1.0i) 1.0+3.0i) (num-test (+ 1.0+1.0i 0.0+1.0i 1.0) 2.0+2.0i) (num-test (+ 1.0+1.0i 0.0+1.0i 1/1) 2.0+2.0i) (num-test (+ 1.0+1.0i 0.0+1.0i 1234) 1235.0+2.0i) (num-test (+ 1.0+1.0i 0.0+1.0i) 1.0+2.0i) (num-test (+ 1.0+1.0i 1 0) 2.0+1.0i) (num-test (+ 1.0+1.0i 1 0.0+1.0i) 2.0+2.0i) (num-test (+ 1.0+1.0i 1 1.0) 3.0+1.0i) (num-test (+ 1.0+1.0i 1 1/1) 3.0+1.0i) (num-test (+ 1.0+1.0i 1 1234) 1236.0+1.0i) (num-test (+ 1.0+1.0i 1) 2.0+1.0i) (num-test (+ 1.0+1.0i 1.0 0) 2.0+1.0i) (num-test (+ 1.0+1.0i 1.0 0.0+1.0i) 2.0+2.0i) (num-test (+ 1.0+1.0i 1.0 1.0) 3.0+1.0i) (num-test (+ 1.0+1.0i 1.0 1/1) 3.0+1.0i) (num-test (+ 1.0+1.0i 1.0 1234) 1236.0+1.0i) (num-test (+ 1.0+1.0i 1.0) 2.0+1.0i) (num-test (+ 1.0+1.0i 1.0+1.0i 0) 2.0+2.0i) (num-test (+ 1.0+1.0i 1.0+1.0i 0.0+1.0i) 2.0+3.0i) (num-test (+ 1.0+1.0i 1.0+1.0i 1.0) 3.0+2.0i) (num-test (+ 1.0+1.0i 1.0+1.0i 1/1) 3.0+2.0i) (num-test (+ 1.0+1.0i 1.0+1.0i 1234) 1236.0+2.0i) (num-test (+ 1.0+1.0i 1.0+1.0i) 2.0+2.0i) (num-test (+ 1.0+1.0i 123.4 0) 124.4+1.0i) (num-test (+ 1.0+1.0i 123.4 0.0+1.0i) 124.4+2.0i) (num-test (+ 1.0+1.0i 123.4 1.0) 125.4+1.0i) (num-test (+ 1.0+1.0i 123.4 1/1) 125.4+1.0i) (num-test (+ 1.0+1.0i 123.4 1234) 1358.4+1.0i) (num-test (+ 1.0+1.0i 123.4) 124.4+1.0i) (num-test (+ 1.0+1.0i 1234 0) 1235.0+1.0i) (num-test (+ 1.0+1.0i 1234 0.0+1.0i) 1235.0+2.0i) (num-test (+ 1.0+1.0i 1234 1.0) 1236.0+1.0i) (num-test (+ 1.0+1.0i 1234 1/1) 1236.0+1.0i) (num-test (+ 1.0+1.0i 1234 1234) 2469.0+1.0i) (num-test (+ 1.0+1.0i 1234) 1235.0+1.0i) (num-test (+ 1.0+1.0i 1234/11 0) 113.18181818181819+1.0i) (num-test (+ 1.0+1.0i 1234/11 0.0+1.0i) 113.18181818181819+2.0i) (num-test (+ 1.0+1.0i 1234/11 1.0) 114.18181818181819+1.0i) (num-test (+ 1.0+1.0i 1234/11 1/1) 114.18181818181819+1.0i) (num-test (+ 1.0+1.0i 1234/11 1234) 1347.18181818181824+1.0i) (num-test (+ 1.0+1.0i 1234/11) 113.18181818181819+1.0i) (num-test (+ 10) 10) (num-test (+ 123.4 -1.0+1.0i -1.0+1.0i) 121.4+2.0i) (num-test (+ 123.4 -1.0+1.0i 0.0) 122.4+1.0i) (num-test (+ 123.4 -1.0+1.0i 1) 123.4+1.0i) (num-test (+ 123.4 -1.0+1.0i 1.0+1.0i) 123.4+2.0i) (num-test (+ 123.4 -1.0+1.0i 123.4) 245.8+1.0i) (num-test (+ 123.4 -1.0+1.0i 1234/11) 234.58181818181819+1.0i) (num-test (+ 123.4 0 -1.0+1.0i) 122.4+1.0i) (num-test (+ 123.4 0 0.0) 123.4) (num-test (+ 123.4 0 1) 124.4) (num-test (+ 123.4 0 1.0+1.0i) 124.4+1.0i) (num-test (+ 123.4 0 123.4) 246.8) (num-test (+ 123.4 0 1234/11) 235.58181818181819) (num-test (+ 123.4 0.0 -1.0+1.0i) 122.4+1.0i) (num-test (+ 123.4 0.0 0.0) 123.4) (num-test (+ 123.4 0.0 1) 124.4) (num-test (+ 123.4 0.0 1.0+1.0i) 124.4+1.0i) (num-test (+ 123.4 0.0 123.4) 246.8) (num-test (+ 123.4 0.0 1234/11) 235.58181818181819) (num-test (+ 123.4 0.0+1.0i -1.0+1.0i) 122.4+2.0i) (num-test (+ 123.4 0.0+1.0i 0.0) 123.4+1.0i) (num-test (+ 123.4 0.0+1.0i 1) 124.4+1.0i) (num-test (+ 123.4 0.0+1.0i 1.0+1.0i) 124.4+2.0i) (num-test (+ 123.4 0.0+1.0i 123.4) 246.8+1.0i) (num-test (+ 123.4 0.0+1.0i 1234/11) 235.58181818181819+1.0i) (num-test (+ 123.4 1 -1.0+1.0i) 123.4+1.0i) (num-test (+ 123.4 1 0.0) 124.4) (num-test (+ 123.4 1 1) 125.4) (num-test (+ 123.4 1 1.0+1.0i) 125.4+1.0i) (num-test (+ 123.4 1 123.4) 247.8) (num-test (+ 123.4 1 1234/11) 236.58181818181819) (num-test (+ 123.4 1.0 -1.0+1.0i) 123.4+1.0i) (num-test (+ 123.4 1.0 0.0) 124.4) (num-test (+ 123.4 1.0 1) 125.4) (num-test (+ 123.4 1.0 1.0+1.0i) 125.4+1.0i) (num-test (+ 123.4 1.0 123.4) 247.8) (num-test (+ 123.4 1.0 1234/11) 236.58181818181819) (num-test (+ 123.4 1.0+1.0i -1.0+1.0i) 123.4+2.0i) (num-test (+ 123.4 1.0+1.0i 0.0) 124.4+1.0i) (num-test (+ 123.4 1.0+1.0i 1) 125.4+1.0i) (num-test (+ 123.4 1.0+1.0i 1.0+1.0i) 125.4+2.0i) (num-test (+ 123.4 1.0+1.0i 123.4) 247.8+1.0i) (num-test (+ 123.4 1.0+1.0i 1234/11) 236.58181818181819+1.0i) (num-test (+ 123.4 1/1 -1.0+1.0i) 123.4+1.0i) (num-test (+ 123.4 123.4 0) 246.8) (num-test (+ 123.4 123.4 0.0+1.0i) 246.8+1.0i) (num-test (+ 123.4 123.4 1.0) 247.8) (num-test (+ 123.4 123.4 1/1) 247.8) (num-test (+ 123.4 123.4 1234) 1480.79999999999995) (num-test (+ 123.4 123.4) 246.8) (num-test (+ 123.4 1234 0) 1357.4) (num-test (+ 123.4 1234 0.0+1.0i) 1357.4+1.0i) (num-test (+ 123.4 1234 1.0) 1358.4) (num-test (+ 123.4 1234 1/1) 1358.4) (num-test (+ 123.4 1234 1234) 2591.4) (num-test (+ 123.4 1234) 1357.4) (num-test (+ 123.4 1234/11 0) 235.58181818181819) (num-test (+ 123.4 1234/11 0.0+1.0i) 235.58181818181819+1.0i) (num-test (+ 123.4 1234/11 1.0) 236.58181818181819) (num-test (+ 123.4 1234/11 1/1) 236.58181818181819) (num-test (+ 123.4 1234/11 1234) 1469.58181818181811) (num-test (+ 123.4 1234/11) 235.58181818181819) (num-test (+ 1234 0) 1234) (num-test (+ 1234 0.0+1.0i) 1234.0+1.0i) (num-test (+ 1234 1.0) 1235.0) (num-test (+ 1234 1/1) 1235) (num-test (+ 1234 1234) 2468) (num-test (+ 1234/11 -1.0+1.0i) 111.18181818181819+1.0i) (num-test (+ 1234/11 0.0) 112.18181818181819) (num-test (+ 1234/11 1) 1245/11) (num-test (+ 1234/11 1.0+1.0i) 113.18181818181819+1.0i) (num-test (+ 1234/11 123.4) 235.58181818181819) (num-test (+ 1234/11 1234/11) 2468/11) (num-test (+ 1234000000.0) 1234000000.0) (num-test (+ 2) 2) (num-test (+ 2/2) 2/2) (for-each-permutation (lambda args (if (not (= (apply + args) 3+i)) (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args)))) '(1 1/2 0.5 1+i)) (for-each-permutation (lambda args (if (not (zero? (apply + args))) (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args)))) '(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i)) (num-test (+ 10.0+0.i) 10.0) (num-test (+ +10.+.0i) 10.0) (test (integer? (+ 1/2 1/2)) #t) (test (real? (+ 1+i 1-i)) #t) (test (integer? (+ 1/100 99/100 (- most-positive-fixnum 2))) #t) ; of course reversing the args won't work (test (integer? (+ 1/1000 999/1000 (- most-positive-fixnum 9223372036854775807))) #t) (num-test (+ 1/1000 999/1000 (- most-positive-fixnum 9223372036854775807)) 1) (test (integer? (+ 1/1000 999/1000 (- most-positive-fixnum 9200000000000000000))) #t) (num-test (+ 1/1000 999/1000 (- most-positive-fixnum 9200000000000000000)) 23372036854775808) (test (+ (rootlet) 1) 'error) (test (< (+ 0.7 8388608) 8388609) #t) ; false in clisp! (num-test (+ -1.797693134862315699999999999999999999998E308 -9223372036854775808) -1.797693134862315699999999999999999999998E308) (num-test (+ -9223372036854775808 5.551115123125783999999999999999999999984E-17) -9.223372036854775807999999999999999944489E18) (num-test (+ -9223372036854775808 9223372036854775807 -9223372036854775808) -9.223372036854775809e18) (num-test (+ -9223372036854775808) -9223372036854775808) (num-test (+ 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -9.223372036854775807999999999999999888978E18) (num-test (+ 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 1.665876638023977952217059999999999999994E-16) (num-test (+ 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 1.665334536937735199999999999999999999992E-16) (num-test (+ 9223372036854775807 -9223372036854775808) -1) (num-test (+ 0.(*)) 1.0) (num-test (+ 0.(+)) 0.0) (when (provided? 'overflow-checks) (num-test (+ 1/9223372036854775807 1/9223372036854775807) 2/9223372036854775807) (num-test (+ 10000000/9223372036854775807 1/3) 3.333333333344175355058188377674583355698E-1) (num-test (+ 1073741824 1073741824 1073741824 1073741824) (* 4 1073741824)) (num-test (+ 268435456/129140163 129140163/268435456 7/19 29/19) 2933929486555791403/658650172313567232) (num-test (+ 268435456/129140163 129140163/268435456 7/29 29/19) 4.327416192871913348352681814704887193821E0) (num-test (+ -9223372036854775808 9223372036854775807) -1) (num-test (+ -9221/92233720 -92233720/9221 9221/92233720 92233720/9221) 0)) (num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2)) -9223372036854775808) (num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2) 1) -9223372036854775807) (num-test (+ (/ most-negative-fixnum 2) (/ most-negative-fixnum 2) -1) (if with-bignums -9223372036854775809 -9.223372036854776e+18)) (if (provided? 'overflow-checks) (num-test (- (/ most-negative-fixnum 2) (/ most-positive-fixnum 2) 1) (if with-bignums -18446744073709551617/2 -9.223372036854776e+18))) (num-test (* 3037000499 3037000500) 9223372033963249500) (num-test (* 3037000499 3037000499) 9223372030926249001) ;(num-test (* 3037000500 3037000500) (if with-bignums 9223372037000250000 9.223372037000249e+18)) ;(num-test (/ (* (/ 3037000499) (/ 3037000498))) 9223372027889248502) (when (provided? 'overflow-checks) (num-test (/ (* (/ 3037000500) (/ 3037000500))) (if with-bignums 9223372037000250000 9.223372037000251e+18)) (num-test (/ 3037000499 (/ 3037000499)) 9223372030926249001) (num-test (/ 3037000500 (/ 3037000500)) (if with-bignums 9223372037000250000 9.223372037000251e+18))) (num-test (+ 0.6049332056786565E0 -0.9611373574853808E0) -3.562041518067242999999999999999999999981E-1) (num-test (+ -0.4763715667865308E0 0.25936932107685584E0) -2.170022457096749600000000000000000000008E-1) (num-test (+ 0.2666481927718355E0 -0.04984768063142031E0) 2.168005121404151899999999999999999999994E-1) (num-test (+ -0.29478659758474846E0 0.3371004337672615E0) 4.231383618251304000000000000000000000076E-2) (num-test (+ 0.8203063910979178E0 0.28968607542857916E0) 1.109992466526496959999999999999999999999E0) (num-test (+ -0.08207985138263585E0 0.4368723951711785E0) 3.5479254378854265E-1) (num-test (+ -0.8659875373355486E0 -6.631430771196765E9) -6.6314307720627525373355486E9) (num-test (+ 0.15071385783307878E0 -7.154424279496395E9) -7.154424279345681142166921220000000000013E9) (num-test (+ -0.8969642760814789E0 -2.4070067380831727E8) -2.407006747052815460814789000000000000005E8) (num-test (+ -0.9610362081435054E0 9.070410778399954E9) 9.070410777438917634019580537500000000004E9) (num-test (+ 0.5129052501104072E0 -7.47841120327471E9) -7.478411202761804451427678737500000000008E9) (num-test (+ 0.3840242289740675E0 7.793048210060242E9) 7.793048210444265928192817499999999999991E9) (num-test (+ 0.07603066126204616E0 5.215008470388369E-11) 7.603066131419624470388369000000000000006E-2) (num-test (+ -0.17187858025312586E0 -5.116645189173968E-11) -1.718785803042923118917396799999999999997E-1) (num-test (+ 0.2521315816245864E0 8.603210607505339E-11) 2.521315817106185060750533899999999999992E-1) (num-test (+ -0.3557185853193914E0 -2.0371324697272998E-11) -3.557185853397627246972729979999999999995E-1) (num-test (+ 0.7142792289542045E0 -7.106356053331326E-11) 7.142792288831409394666867399999999999997E-1) (num-test (+ 0.4380415886629452E0 -3.069969538383403E-11) 4.380415886322455046161659700000000000005E-1) (num-test (+ 0.24798614227178573E0 3.972393639614975E19) 3.972393639614975000024798614227178572989E19) (num-test (+ -0.5210677288128815E0 4.846393336901129E19) 4.846393336901128999947893227118711850007E19) (num-test (+ 0.5825404819115E0 1.9710987361264255E19) 1.971098736126425500058254048191149998548E19) (num-test (+ 0.9105175208730549E0 2.391166552096775E19) 2.391166552096775000091051752087305489998E19) (num-test (+ 0.48414423368371695E0 -9.696117779740095E19) -9.696117779740094999951585576631628304997E19) (num-test (+ 0.25780758450697716E0 6.094683117025535E19) 6.094683117025535000025780758450697715991E19) (num-test (+ 0.9824539149570484E0 -5.4680066990812835E-21) 9.824539149570483999945319933009187165013E-1) (num-test (+ -0.9520982941158654E0 3.2513564801568073E-21) -9.520982941158653999967486435198431927013E-1) (num-test (+ 0.0630170624560149E0 -9.858852595793203E-21) 6.301706245601489999014114740420679700008E-2) (num-test (+ 0.24705141169888878E0 1.4582081178692862E-22) 2.470514116988887800001458208117869286195E-1) (num-test (+ 0.7440948700757135E0 -3.0932442581890818E-21) 7.440948700757134999969067557418109181978E-1) (num-test (+ -0.5055970869515372E0 4.0277457257516025E-21) -5.055970869515371999959722542742483974988E-1) (num-test (+ 1.672355787134947E9 0.0064909681594120805E0) 1.6723557871414380296981083695625E9) (num-test (+ -9.694504381396599E9 -0.8925470085542831E0) -9.694504382289146008554283099999999999987E9) (num-test (+ -1.6695005924298635E9 -0.34426964741306E0) -1.669500592774133147413059987073324919041E9) (num-test (+ -6.085591212594774E9 0.5107956920100049E0) -6.085591212083978307989995100000000000004E9) (num-test (+ 7.457486660952688E9 -0.4323787588338597E0) 7.457486660520309458329226237499999999989E9) (num-test (+ -8.790796444526546E9 0.911415263281967E0) -8.790796443615130736718033019187146237507E9) (num-test (+ 9.667548804251982E9 -1.266547751029956E8) 9.54089402914898613522949218749999999999E9) (num-test (+ -6.169561898845145E9 9.627911197121864E9) 3.458349298276719318847656250000000000009E9) (num-test (+ -9.870287253215279E9 9.004242781937655E8) -8.969862975021513478950500488281249999995E9) (num-test (+ -8.175630881172554E9 -4.08632236263908E9) -1.226195324381163404760742187500000000002E10) (num-test (+ 2.9069444232153206E9 -7.961831315741894E9) -5.054886892526573399999999999999999999977E9) (num-test (+ -7.003647401371184E9 -1.768371514817526E9) -8.772018916188710000000000000000000000001E9) (num-test (+ -6.418847599138249E9 2.755257250162372E-11) -6.418847599138248999972447427498376279997E9) (num-test (+ 2.3093152687241793E9 1.2205440142364766E-11) 2.309315268724179300012205440142364766011E9) (num-test (+ 8.634577667577518E9 -9.065714034538668E-11) 8.634577667577518463044108484654613319994E9) (num-test (+ 1.711283212591781E9 -3.235019197733951E-11) 1.71128321259178090092285000333516049E9) (num-test (+ 2.583886638357791E9 -8.199109798920928E-11) 2.583886638357790946878458120760790719997E9) (num-test (+ -7.517123950474774E9 5.2057802142431697E-11) -7.51712395047477399994794219785756830298E9) (num-test (+ 3.266571938086574E9 -4.4782768261898355E19) -4.478276825863178306191342592239379882812E19) (num-test (+ 2.1000389219899452E9 -8.547158903365463E19) -8.547158903155459107801005480000000000002E19) (num-test (+ -3.9140926801217155E9 7.387959860641422E19) 7.387959860250012731987828450000000000009E19) (num-test (+ -7.087607465790431E9 7.96875093387599E19) 7.968750933167229781420956900000000000008E19) (num-test (+ -8.341000808926519E9 6.9360028397637304E19) 6.936002838929630319107348100000000000009E19) (num-test (+ -5.507940634743809E9 9.760028858210094E19) 9.760028857659299936525619099999999999989E19) (num-test (+ 8.492522971238823E9 -2.8253881864964467E-22) 8.492522971238822937011718749999717461174E9) (num-test (+ 1.2731765723336241E9 -5.8473937102910264E-21) 1.273176572333624099999999999994152606294E9) (num-test (+ 9.654280758878323E9 -4.2332114049658973E-22) 9.654280758878322601318359374999576678861E9) (num-test (+ -6.864618926120946E9 -1.245648314796599E-21) -6.864618926120946000000000000001245648334E9) (num-test (+ -3.9916044043798673E8 1.697737588450543E-21) -3.991604404379867299999999999983022624115E8) (num-test (+ -7.818041624198686E9 4.635421587404246E-21) -7.818041624198685999999999999995364578418E9) (num-test (+ 2.0609929543990767E-12 -0.2126306554359736E0) -2.126306554339126070456009232999999999998E-1) (num-test (+ -1.5923091695877845E-11 0.515731533720818E0) 5.157315337048949444413677540931484848253E-1) (num-test (+ 4.794527092905871E-11 -0.9066947202676092E0) -9.0669472021966392907094129E-1) (num-test (+ -8.63854477728633E-11 0.3122982022565777E0) 3.122982021701922522271366999999999999999E-1) (num-test (+ -7.577966666552416E-11 -0.24137602092437593E0) -2.413760210001555966655241600000000000004E-1) (num-test (+ -4.971730475882754E-11 -0.8202688719750202E0) -8.202688720247375047588275400000000000012E-1) (num-test (+ -5.249369194379291E-11 -8.546120620321186E9) -8.546120620321186000052493691943792910002E9) (num-test (+ 8.280786962526793E-11 5.758373397436368E9) 5.758373397436367988669233650875267930002E9) (num-test (+ 6.370323595535815E-11 -8.470663335712393E9) -8.470663335712392999936296764044641849996E9) (num-test (+ 3.59771226839467E-11 3.5042505440266216E8) 3.504250544026621600359771226839466999997E8) (num-test (+ -3.945501687396375E-11 -5.082779978069177E9) -5.082779978069177000039455016873963749988E9) (num-test (+ 9.780590963267516E-11 -5.05591945120475E9) -5.055919451204750060937350340367324839998E9) (num-test (+ 6.323293597096768E-11 -7.208898910487284E-11) -8.856053133905159999999999999999999999986E-12) (num-test (+ -4.549781732354749E-11 -6.095452636416357E-11) -1.064523436877110600000000000000000000002E-10) (num-test (+ -5.372680267837374E-11 2.0748354219485134E-11) -3.297844845888860599999999999999999999998E-11) (num-test (+ 3.550879553916665E-11 -4.374873254056574E-11) -8.239937001399090000000000000000000000007E-12) (num-test (+ -6.746002242414832E-11 3.0803985031459436E-11) -3.665603739268888400000000000000000000013E-11) (num-test (+ -7.902512161494214E-11 -8.907842858073236E-11) -1.681035501956744999999999999999999999998E-10) (num-test (+ -4.1465935469350415E-11 6.244210696961323E19) 6.24421069696132299999999999999585340645E19) (num-test (+ 4.921297536286578E-11 -1.694436650099881E19) -1.694436650099880999999999999995078702462E19) (num-test (+ -7.879478980672654E-11 6.41757969360492E19) 6.41757969360491970559999999999212052103E19) (num-test (+ -8.200749317872953E-11 -9.490225542618815E19) -9.490225542618815000000000000008200749324E19) (num-test (+ -7.572981329795812E-11 -3.350367078181029E19) -3.350367078181029000000000000007572981326E19) (num-test (+ -5.955255565125549E-11 -5.009913629288125E19) -5.00991362928812500000000000000595525556E19) (num-test (+ -9.818180775332558E-11 -7.926156011681593E-21) -9.818180776125173601168159300000000000011E-11) (num-test (+ -5.2466438379505935E-12 8.468830229031857E-21) -5.246643829481763270968143000000000000009E-12) (num-test (+ 3.582774358441715E-11 3.6865211729351863E-22) 3.582774358478580211729351862999999999999E-11) (num-test (+ 7.169296413565744E-11 -9.974881413980864E-21) 7.169296412568255858601913599999999999987E-11) (num-test (+ -9.615073655516977E-11 4.9552491300097786E-21) -9.615073655021452086999022140000000000005E-11) (num-test (+ 6.7696956269187E-11 4.1431488006404866E-21) 6.769695627333015423852294397336791395272E-11) (num-test (+ -4.663397365185298E19 0.9758464195927673E0) -4.663397365185297999902415358040723270005E19) (num-test (+ -4.77977261393851E19 0.04145189313162445E0) -4.779772613938509999995854810686837555009E19) (num-test (+ 7.195364554121596E19 0.5169917736820715E0) 7.195364554121596000051699177368207149992E19) (num-test (+ -7.766254779507882E19 0.5919134938460356E0) -7.766254779507881999940808650615396440016E19) (num-test (+ -8.411122653901408E19 -0.14463225181516137E0) -8.411122653901408000014463225181516137013E19) (num-test (+ -9.101920591747218E19 0.23349918704239836E0) -9.101920591747217999976650081295760164003E19) (num-test (+ 7.037477746142529E18 -3.250947575909365E9) 7.037477742891581424090634999999999999988E18) (num-test (+ -6.864341752972099E19 -4.0510449339565725E9) -6.864341753377203493395657250000000000004E19) (num-test (+ -5.329540273290228E19 8.14869777458878E9) -5.329540272475358222541121959686279296875E19) (num-test (+ -9.726234388247201E19 2.053976989398215E9) -9.726234388041803301060178494453430175781E19) (num-test (+ -1.910324088450308E19 6.247052535748024E9) -1.910324087825602746425197601318359375E19) (num-test (+ -6.079933001949367E18 6.316829148809886E9) -6.07993299563253785119011402130126953125E18) (num-test (+ -4.499107911798452E19 9.659763881732633E-11) -4.499107911798451999999999999990340236126E19) (num-test (+ -3.0972208018542522E19 -9.077209886078653E-11) -3.097220801854252200000000000009077209882E19) (num-test (+ -2.3000547840875442E19 -3.2043634522621155E-11) -2.300054784087544200000000000003204363456E19) (num-test (+ 2.124555308489292E19 2.252166800652451E-11) 2.124555308489292000000000000002252166802E19) (num-test (+ -7.74280238703686E19 1.7289553748884322E-11) -7.74280238703685999999999999999827104461E19) (num-test (+ -8.119446783121816E19 -4.3461802389685114E-11) -8.11944678312181600000000000000434618023E19) (num-test (+ -4.70848534032654E18 -4.698316648967506E19) -5.16916518300016E19) (num-test (+ 2.853799842810312E19 -5.56805968603395E19) -2.714259843223638E19) (num-test (+ -2.9128622996090335E19 -5.153369106520702E19) -8.0662314061297355E19) (num-test (+ -5.415993984772977E19 4.481932558278175E19) -9.34061426494802E18) (num-test (+ -1.4652301908531261E19 7.89284449966826E19) 6.4276143088151335352E19) (num-test (+ -8.241911630479252E19 5.377001886877124E19) -2.864909743602128E19) (num-test (+ -6.923631123395076E19 7.100129853298664E-22) -6.923631123395076E19) (num-test (+ -5.864213410820717E19 -2.649878514627326E-21) -5.864213410820717E19) (num-test (+ 8.660575002861176E19 2.751926085897399E-21) 8.660575002861176E19) (num-test (+ -3.0252871646631318E19 6.852831573716124E-21) -3.0252871646631318E19) (num-test (+ -9.155476807340938E19 -5.552907466957205E-21) -9.155476807340938E19) (num-test (+ -4.03382621358461E19 6.670808279457885E-21) -4.03382621358461E19) (num-test (+ 8.842980509187577E-21 0.5028466982188534E0) 5.028466982188534000088429805091875769998E-1) (num-test (+ 1.7292043381396136E-21 0.19490424064972922E0) 1.949042406497292200017292043381396136E-1) (num-test (+ -5.854820918836103E-21 -0.6700030154364615E0) -6.700030154364615000058548209188361029995E-1) (num-test (+ -2.152396491682048E-21 0.5002930268902921E0) 5.002930268902920999978476035083179519998E-1) (num-test (+ -1.0897149666610629E-21 0.16555534170490604E0) 1.655553417049060399989102850333389370996E-1) (num-test (+ 6.321421497987867E-24 -0.08008112131564671E0) -8.008112131564670999999367857850201213302E-2) (num-test (+ -6.1552667309563055E-21 7.235074489769488E9) 7.23507448976948833465576171874384473328E9) (num-test (+ -2.2311335001219955E-22 1.220011008333989E9) 1.220011008333988904953002929687276886647E9) (num-test (+ 8.523565724937177E-23 -4.1650242034123087E9) -4.165024203412308699999999999999914764338E9) (num-test (+ -2.4400041303825447E-21 4.435554678685388E9) 4.435554678685387611389160156247559995867E9) (num-test (+ -3.4479065449345757E-22 8.491084033112451E8) 8.491084033112450838088989257809052093456E8) (num-test (+ -7.919939059912893E-21 -7.610637842585286E9) -7.610637842585286000000000000007919939044E9) (num-test (+ 4.4958602369105625E-21 5.758376768873417E-11) 5.758376769323003023691056249999999999989E-11) (num-test (+ 2.4375297386412195E-21 9.417086717671841E-11) 9.41708671791559397386412194999999999998E-11) (num-test (+ 1.0040647133383462E-21 3.4701016271268983E-12) 3.470101628130963013338346199999999999999E-12) (num-test (+ -3.885093055726793E-21 -8.523534862249969E-11) -8.523534862638478305572679299999999999995E-11) (num-test (+ 1.027951323422187E-21 -7.65508060829868E-11) -7.655080608195884867657781300000000000011E-11) (num-test (+ -9.83813940552434E-21 -5.048380063082019E-11) -5.048380064065832940552434000000000000001E-11) (num-test (+ -7.640856498925806E-21 -5.743808556015994E19) -5.743808556015994E19) (num-test (+ 8.053891045717591E-21 4.0840032650134725E19) 4.0840032650134725E19) (num-test (+ -4.794782783871528E-21 -3.431216587740782E18) -3.431216587740782E18) (num-test (+ 1.860870988390988E-21 -3.757945694933625E19) -3.757945694933625E19) (num-test (+ 5.445498222566789E-21 7.575823566817991E19) 7.575823566817991E19) (num-test (+ 2.631896745307223E-21 4.906449817201212E19) 4.906449817201212E19) (num-test (+ -6.61689881073516E-21 5.357007670385275E-21) -1.25989114034988500000000000000000000001E-21) (num-test (+ 3.0173001109587537E-21 5.2947222461350496E-21) 8.312022357093803300000000000000000000009E-21) (num-test (+ -8.792518441030627E-21 -1.0516787854168774E-21) -9.84419722644750439999999999999999999997E-21) (num-test (+ 7.349451992884509E-21 -8.427997362671486E-21) -1.078545369786976999999999999999999999993E-21) (num-test (+ -7.881179611953633E-21 3.2080446524364824E-21) -4.673134959517150599999999999999999999987E-21) (num-test (+ -9.614117725927607E-21 -5.35667712698602E-21) -1.4970794852913627E-20) (num-test (+ 763661/10959 314049/215772 801211/520111) 29795593575023947/409959352197876) (num-test (+ 754684/707399 364133/66140) 43928874261/6683909980) (num-test (+ 440608/272315 551945/732519 640011/210080) 45409303060766899/8381179896953760) (num-test (+ 6567/58532 12009/41861 51413/44691) 169671941552201/109502248051932) (num-test (+ 24362/18498 57440/40727 22449/57480) 22502908640629/7217265880680) (num-test (+ 31721/56074 60995/54239) 5140748949/3041397686) (num-test (+ 53838/33670 41433/21212 18707/18707 38145/30697 18708/22768) 51605878718885969/7799478725530310) (num-test (+ 28104/38994 16087/7686 61878/25480) 238289915659/45455695740) (num-test (+ 19084/1172 31274/36894 58813/47401 21693/36339) 58866653148990514/3103363080883923) (num-test (+ 46622/34221 37123/47024 30488/35441) 2816139009923/934950024624) (num-test (+ 5132/18296 39996/45879 41433/58822 63206/41458) 72097712837475423/21322935628641329) (num-test (+ 2203/36057 55977/14559 48383/64098 9101/28942) 134587284141221743/27051518778595353) (num-test (+ 32375/41641 50274/42858 18792/37422 7370/20399) 1314683476492406/467198461232349) (num-test (+ 13733/12161 54393/23682 3717/60389) 2888390497365/828182803618) (num-test (+ 62280/7667 54471/23126 54070/62784) 31558604335387/2783011331232) (num-test (+ 11072/35120 33950/8514 59489/8783 38683/16720) 66811589960405/4989817212336) (num-test (+ 20220/12370 24149/50379 63926/10436) 2679308820467/325179618414) (num-test (+ 26718/50103 44333/20749 6375/11441 47216/19118) 12699871541397230/2229293103730143) (num-test (+ 38673/65491 57303/2569 40991/55309) 219956905519979/9305538976111) (num-test (+ 1/98947 2/97499 3/76847) 51641766530/741360956847391) (test (> (+ 123456789/3 3/123456789 -123456789/3 -3/123456789) 2e-12) #f) ; it's really 0, but fp inaccuracies catch us (num-test (+ 1e100 -1e100) 0.0) (num-test (+ 1e100 1e100) 2e100) (num-test (+ 1e200 -1e200) 0.0) (num-test (+ 1e300 -1e300) 0.0) (num-test (+ 500009/500029 500057/500041) 500068002022/250035001189) (num-test (+ 0.5 -0.5 1/2) 0.5) (num-test (+ 1 1/2 0.5 3.0+5.5i) 5.0+5.5i) (num-test (+ 1/2 0.5) 1.0) (num-test (+ 3 4) 7 ) (num-test (+ 3) '3 ) (num-test (+) 0 ) (num-test (+ 123123123123123 123123123123123) 246246246246246) ;(test (+ 9007199254740996.0 -9007199254740995) 1.0) ; these are fake...(anything nearby is probably bad: (+ 9007199254740995.0 -9007199254740994): 2.0 ;(test (+ -9007199254740996.0 9007199254740995) -1.0) ;(test (+ -9007199254740996 -9007199254740995) 1) ;(test (+ 9007199254740996 -9007199254740995.0) 1.0) (unless (or with-bignums (not (provided? 'overflow-checks))) (num-test (+ 3/4 4611686018427387904) 4.61168601842738790475E18) (num-test (+ 1/17179869184 1073741824) 1.073741824000000000058207660913467407227E9) (num-test (+ 1/8589934592 1073741824) 1.073741824000000000116415321826934814453E9) (num-test (+ 100000 1/142857142857140) 1.000000000000000000070000000000001400001E5) (num-test (+ 4611686018427387904 3/4) 4.61168601842738790475E18) (num-test (+ -63 8 1/9223372036854775807) -55.0) (num-test (+ 8 8 1/9223372036854775807) 16.0) (num-test (+ -1 -63 1/9223372036854775807) -64.0) (num-test (+ 32768 -1 562949953421312/281474976710655) 32769.0) (num-test (+ -63 262144 70368744177664/35184372088831) 262083.0) (num-test (+ 2147483648 -1 8589934592/4294967295) 2147483649.0) (num-test (+ 8589934592/4294967295 2147483648 -1) 2147483649.0) (num-test (+ 8589934592/4294967295 -1 2147483648) 2147483649.0) (num-test (+ -1 8589934592/4294967295 2147483648) 2147483649.0)) ; (num-test (+ 4611686018427387904 4611686018427387904) 9.223372036854775808e18) ; (num-test (+ most-positive-fixnum most-positive-fixnum) 1.8446744073709551614e19) ; (num-test (+ most-negative-fixnum most-negative-fixnum) -1.8446744073709551616e19) (let () ; opt_d_dd_ff_add_mul (define (f) (let ((sum (float-vector 1 2 3))) (do ((i 0 (+ i 1))) ((= i 3) sum) (float-vector-set! sum i (+ (sum i) (* (sum i) (sum i))))))) (test (f) #r(2.0 6.0 12.0))) (let () (define (add1) (+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99)) (num-test (add1) 4950) (define (add2) (+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999)) (num-test (add2) 499500) (define (add3) (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 (+ 10 (+ 11 (+ 12 (+ 13 (+ 14 (+ 15 (+ 16 (+ 17 (+ 18 (+ 19 (+ 20 (+ 21 (+ 22 (+ 23 (+ 24 (+ 25 (+ 26 (+ 27 (+ 28 (+ 29 (+ 30 (+ 31 (+ 32 (+ 33 (+ 34 (+ 35 (+ 36 (+ 37 (+ 38 (+ 39 (+ 40 (+ 41 (+ 42 (+ 43 (+ 44 (+ 45 (+ 46 (+ 47 (+ 48 (+ 49 (+ 50 (+ 51 (+ 52 (+ 53 (+ 54 (+ 55 (+ 56 (+ 57 (+ 58 (+ 59 (+ 60 (+ 61 (+ 62 (+ 63 (+ 64 (+ 65 (+ 66 (+ 67 (+ 68 (+ 69 (+ 70 (+ 71 (+ 72 (+ 73 (+ 74 (+ 75 (+ 76 (+ 77 (+ 78 (+ 79 (+ 80 (+ 81 (+ 82 (+ 83 (+ 84 (+ 85 (+ 86 (+ 87 (+ 88 (+ 89 (+ 90 (+ 91 (+ 92 (+ 93 (+ 94 (+ 95 (+ 96 (+ 97 (+ 98 (+ 99)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (num-test (add3) 4950) (define (add4) (+ 1 (+ 2 (+ 3 (+ 4 (+ 5 (+ 6 (+ 7 (+ 8 (+ 9 (+ 10 (+ 11 (+ 12 (+ 13 (+ 14 (+ 15 (+ 16 (+ 17 (+ 18 (+ 19 (+ 20 (+ 21 (+ 22 (+ 23 (+ 24 (+ 25 (+ 26 (+ 27 (+ 28 (+ 29 (+ 30 (+ 31 (+ 32 (+ 33 (+ 34 (+ 35 (+ 36 (+ 37 (+ 38 (+ 39 (+ 40 (+ 41 (+ 42 (+ 43 (+ 44 (+ 45 (+ 46 (+ 47 (+ 48 (+ 49 (+ 50 (+ 51 (+ 52 (+ 53 (+ 54 (+ 55 (+ 56 (+ 57 (+ 58 (+ 59 (+ 60 (+ 61 (+ 62 (+ 63 (+ 64 (+ 65 (+ 66 (+ 67 (+ 68 (+ 69 (+ 70 (+ 71 (+ 72 (+ 73 (+ 74 (+ 75 (+ 76 (+ 77 (+ 78 (+ 79 (+ 80 (+ 81 (+ 82 (+ 83 (+ 84 (+ 85 (+ 86 (+ 87 (+ 88 (+ 89 (+ 90 (+ 91 (+ 92 (+ 93 (+ 94 (+ 95 (+ 96 (+ 97 (+ 98 (+ 99 (+ 100 (+ 101 (+ 102 (+ 103 (+ 104 (+ 105 (+ 106 (+ 107 (+ 108 (+ 109 (+ 110 (+ 111 (+ 112 (+ 113 (+ 114 (+ 115 (+ 116 (+ 117 (+ 118 (+ 119 (+ 120 (+ 121 (+ 122 (+ 123 (+ 124 (+ 125 (+ 126 (+ 127 (+ 128 (+ 129 (+ 130 (+ 131 (+ 132 (+ 133 (+ 134 (+ 135 (+ 136 (+ 137 (+ 138 (+ 139 (+ 140 (+ 141 (+ 142 (+ 143 (+ 144 (+ 145 (+ 146 (+ 147 (+ 148 (+ 149 (+ 150 (+ 151 (+ 152 (+ 153 (+ 154 (+ 155 (+ 156 (+ 157 (+ 158 (+ 159 (+ 160 (+ 161 (+ 162 (+ 163 (+ 164 (+ 165 (+ 166 (+ 167 (+ 168 (+ 169 (+ 170 (+ 171 (+ 172 (+ 173 (+ 174 (+ 175 (+ 176 (+ 177 (+ 178 (+ 179 (+ 180 (+ 181 (+ 182 (+ 183 (+ 184 (+ 185 (+ 186 (+ 187 (+ 188 (+ 189 (+ 190 (+ 191 (+ 192 (+ 193 (+ 194 (+ 195 (+ 196 (+ 197 (+ 198 (+ 199 (+ 200 (+ 201 (+ 202 (+ 203 (+ 204 (+ 205 (+ 206 (+ 207 (+ 208 (+ 209 (+ 210 (+ 211 (+ 212 (+ 213 (+ 214 (+ 215 (+ 216 (+ 217 (+ 218 (+ 219 (+ 220 (+ 221 (+ 222 (+ 223 (+ 224 (+ 225 (+ 226 (+ 227 (+ 228 (+ 229 (+ 230 (+ 231 (+ 232 (+ 233 (+ 234 (+ 235 (+ 236 (+ 237 (+ 238 (+ 239 (+ 240 (+ 241 (+ 242 (+ 243 (+ 244 (+ 245 (+ 246 (+ 247 (+ 248 (+ 249 (+ 250 (+ 251 (+ 252 (+ 253 (+ 254 (+ 255 (+ 256 (+ 257 (+ 258 (+ 259 (+ 260 (+ 261 (+ 262 (+ 263 (+ 264 (+ 265 (+ 266 (+ 267 (+ 268 (+ 269 (+ 270 (+ 271 (+ 272 (+ 273 (+ 274 (+ 275 (+ 276 (+ 277 (+ 278 (+ 279 (+ 280 (+ 281 (+ 282 (+ 283 (+ 284 (+ 285 (+ 286 (+ 287 (+ 288 (+ 289 (+ 290 (+ 291 (+ 292 (+ 293 (+ 294 (+ 295 (+ 296 (+ 297 (+ 298 (+ 299 (+ 300 (+ 301 (+ 302 (+ 303 (+ 304 (+ 305 (+ 306 (+ 307 (+ 308 (+ 309 (+ 310 (+ 311 (+ 312 (+ 313 (+ 314 (+ 315 (+ 316 (+ 317 (+ 318 (+ 319 (+ 320 (+ 321 (+ 322 (+ 323 (+ 324 (+ 325 (+ 326 (+ 327 (+ 328 (+ 329 (+ 330 (+ 331 (+ 332 (+ 333 (+ 334 (+ 335 (+ 336 (+ 337 (+ 338 (+ 339 (+ 340 (+ 341 (+ 342 (+ 343 (+ 344 (+ 345 (+ 346 (+ 347 (+ 348 (+ 349 (+ 350 (+ 351 (+ 352 (+ 353 (+ 354 (+ 355 (+ 356 (+ 357 (+ 358 (+ 359 (+ 360 (+ 361 (+ 362 (+ 363 (+ 364 (+ 365 (+ 366 (+ 367 (+ 368 (+ 369 (+ 370 (+ 371 (+ 372 (+ 373 (+ 374 (+ 375 (+ 376 (+ 377 (+ 378 (+ 379 (+ 380 (+ 381 (+ 382 (+ 383 (+ 384 (+ 385 (+ 386 (+ 387 (+ 388 (+ 389 (+ 390 (+ 391 (+ 392 (+ 393 (+ 394 (+ 395 (+ 396 (+ 397 (+ 398 (+ 399 (+ 400 (+ 401 (+ 402 (+ 403 (+ 404 (+ 405 (+ 406 (+ 407 (+ 408 (+ 409 (+ 410 (+ 411 (+ 412 (+ 413 (+ 414 (+ 415 (+ 416 (+ 417 (+ 418 (+ 419 (+ 420 (+ 421 (+ 422 (+ 423 (+ 424 (+ 425 (+ 426 (+ 427 (+ 428 (+ 429 (+ 430 (+ 431 (+ 432 (+ 433 (+ 434 (+ 435 (+ 436 (+ 437 (+ 438 (+ 439 (+ 440 (+ 441 (+ 442 (+ 443 (+ 444 (+ 445 (+ 446 (+ 447 (+ 448 (+ 449 (+ 450 (+ 451 (+ 452 (+ 453 (+ 454 (+ 455 (+ 456 (+ 457 (+ 458 (+ 459 (+ 460 (+ 461 (+ 462 (+ 463 (+ 464 (+ 465 (+ 466 (+ 467 (+ 468 (+ 469 (+ 470 (+ 471 (+ 472 (+ 473 (+ 474 (+ 475 (+ 476 (+ 477 (+ 478 (+ 479 (+ 480 (+ 481 (+ 482 (+ 483 (+ 484 (+ 485 (+ 486 (+ 487 (+ 488 (+ 489 (+ 490 (+ 491 (+ 492 (+ 493 (+ 494 (+ 495 (+ 496 (+ 497 (+ 498 (+ 499 (+ 500 (+ 501 (+ 502 (+ 503 (+ 504 (+ 505 (+ 506 (+ 507 (+ 508 (+ 509 (+ 510 (+ 511 (+ 512 (+ 513 (+ 514 (+ 515 (+ 516 (+ 517 (+ 518 (+ 519 (+ 520 (+ 521 (+ 522 (+ 523 (+ 524 (+ 525 (+ 526 (+ 527 (+ 528 (+ 529 (+ 530 (+ 531 (+ 532 (+ 533 (+ 534 (+ 535 (+ 536 (+ 537 (+ 538 (+ 539 (+ 540 (+ 541 (+ 542 (+ 543 (+ 544 (+ 545 (+ 546 (+ 547 (+ 548 (+ 549 (+ 550 (+ 551 (+ 552 (+ 553 (+ 554 (+ 555 (+ 556 (+ 557 (+ 558 (+ 559 (+ 560 (+ 561 (+ 562 (+ 563 (+ 564 (+ 565 (+ 566 (+ 567 (+ 568 (+ 569 (+ 570 (+ 571 (+ 572 (+ 573 (+ 574 (+ 575 (+ 576 (+ 577 (+ 578 (+ 579 (+ 580 (+ 581 (+ 582 (+ 583 (+ 584 (+ 585 (+ 586 (+ 587 (+ 588 (+ 589 (+ 590 (+ 591 (+ 592 (+ 593 (+ 594 (+ 595 (+ 596 (+ 597 (+ 598 (+ 599 (+ 600 (+ 601 (+ 602 (+ 603 (+ 604 (+ 605 (+ 606 (+ 607 (+ 608 (+ 609 (+ 610 (+ 611 (+ 612 (+ 613 (+ 614 (+ 615 (+ 616 (+ 617 (+ 618 (+ 619 (+ 620 (+ 621 (+ 622 (+ 623 (+ 624 (+ 625 (+ 626 (+ 627 (+ 628 (+ 629 (+ 630 (+ 631 (+ 632 (+ 633 (+ 634 (+ 635 (+ 636 (+ 637 (+ 638 (+ 639 (+ 640 (+ 641 (+ 642 (+ 643 (+ 644 (+ 645 (+ 646 (+ 647 (+ 648 (+ 649 (+ 650 (+ 651 (+ 652 (+ 653 (+ 654 (+ 655 (+ 656 (+ 657 (+ 658 (+ 659 (+ 660 (+ 661 (+ 662 (+ 663 (+ 664 (+ 665 (+ 666 (+ 667 (+ 668 (+ 669 (+ 670 (+ 671 (+ 672 (+ 673 (+ 674 (+ 675 (+ 676 (+ 677 (+ 678 (+ 679 (+ 680 (+ 681 (+ 682 (+ 683 (+ 684 (+ 685 (+ 686 (+ 687 (+ 688 (+ 689 (+ 690 (+ 691 (+ 692 (+ 693 (+ 694 (+ 695 (+ 696 (+ 697 (+ 698 (+ 699 (+ 700 (+ 701 (+ 702 (+ 703 (+ 704 (+ 705 (+ 706 (+ 707 (+ 708 (+ 709 (+ 710 (+ 711 (+ 712 (+ 713 (+ 714 (+ 715 (+ 716 (+ 717 (+ 718 (+ 719 (+ 720 (+ 721 (+ 722 (+ 723 (+ 724 (+ 725 (+ 726 (+ 727 (+ 728 (+ 729 (+ 730 (+ 731 (+ 732 (+ 733 (+ 734 (+ 735 (+ 736 (+ 737 (+ 738 (+ 739 (+ 740 (+ 741 (+ 742 (+ 743 (+ 744 (+ 745 (+ 746 (+ 747 (+ 748 (+ 749 (+ 750 (+ 751 (+ 752 (+ 753 (+ 754 (+ 755 (+ 756 (+ 757 (+ 758 (+ 759 (+ 760 (+ 761 (+ 762 (+ 763 (+ 764 (+ 765 (+ 766 (+ 767 (+ 768 (+ 769 (+ 770 (+ 771 (+ 772 (+ 773 (+ 774 (+ 775 (+ 776 (+ 777 (+ 778 (+ 779 (+ 780 (+ 781 (+ 782 (+ 783 (+ 784 (+ 785 (+ 786 (+ 787 (+ 788 (+ 789 (+ 790 (+ 791 (+ 792 (+ 793 (+ 794 (+ 795 (+ 796 (+ 797 (+ 798 (+ 799 (+ 800 (+ 801 (+ 802 (+ 803 (+ 804 (+ 805 (+ 806 (+ 807 (+ 808 (+ 809 (+ 810 (+ 811 (+ 812 (+ 813 (+ 814 (+ 815 (+ 816 (+ 817 (+ 818 (+ 819 (+ 820 (+ 821 (+ 822 (+ 823 (+ 824 (+ 825 (+ 826 (+ 827 (+ 828 (+ 829 (+ 830 (+ 831 (+ 832 (+ 833 (+ 834 (+ 835 (+ 836 (+ 837 (+ 838 (+ 839 (+ 840 (+ 841 (+ 842 (+ 843 (+ 844 (+ 845 (+ 846 (+ 847 (+ 848 (+ 849 (+ 850 (+ 851 (+ 852 (+ 853 (+ 854 (+ 855 (+ 856 (+ 857 (+ 858 (+ 859 (+ 860 (+ 861 (+ 862 (+ 863 (+ 864 (+ 865 (+ 866 (+ 867 (+ 868 (+ 869 (+ 870 (+ 871 (+ 872 (+ 873 (+ 874 (+ 875 (+ 876 (+ 877 (+ 878 (+ 879 (+ 880 (+ 881 (+ 882 (+ 883 (+ 884 (+ 885 (+ 886 (+ 887 (+ 888 (+ 889 (+ 890 (+ 891 (+ 892 (+ 893 (+ 894 (+ 895 (+ 896 (+ 897 (+ 898 (+ 899 (+ 900 (+ 901 (+ 902 (+ 903 (+ 904 (+ 905 (+ 906 (+ 907 (+ 908 (+ 909 (+ 910 (+ 911 (+ 912 (+ 913 (+ 914 (+ 915 (+ 916 (+ 917 (+ 918 (+ 919 (+ 920 (+ 921 (+ 922 (+ 923 (+ 924 (+ 925 (+ 926 (+ 927 (+ 928 (+ 929 (+ 930 (+ 931 (+ 932 (+ 933 (+ 934 (+ 935 (+ 936 (+ 937 (+ 938 (+ 939 (+ 940 (+ 941 (+ 942 (+ 943 (+ 944 (+ 945 (+ 946 (+ 947 (+ 948 (+ 949 (+ 950 (+ 951 (+ 952 (+ 953 (+ 954 (+ 955 (+ 956 (+ 957 (+ 958 (+ 959 (+ 960 (+ 961 (+ 962 (+ 963 (+ 964 (+ 965 (+ 966 (+ 967 (+ 968 (+ 969 (+ 970 (+ 971 (+ 972 (+ 973 (+ 974 (+ 975 (+ 976 (+ 977 (+ 978 (+ 979 (+ 980 (+ 981 (+ 982 (+ 983 (+ 984 (+ 985 (+ 986 (+ 987 (+ 988 (+ 989 (+ 990 (+ 991 (+ 992 (+ 993 (+ 994 (+ 995 (+ 996 (+ 997 (+ 998 (+ 999)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (num-test (add4) 499500)) #| ;;; similar -- 1 million lines and 1 million levels of nesting in a let with a million locals: (define size 1000000) (define calls 100) (call-with-output-file "t231-1.scm" (lambda (p) (format p "(set! (*s7* 'gc-stats) 6)~%~%") (format p "(define (f~D)~% (let ((x 0))~%" size) (do ((i 0 (+ i 1))) ((= i size)) (format p " (set! x (+ x ~D))~%" (random 10))) (format p " ))~%~%") (format p "(define (test-f~D)~%" size) (format p " (let ((sum (f~D)))~%" size) (format p " (display sum) (newline)~%") (format p " (do ((i 0 (+ i 1)))~%") (format p " ((= i ~D))~%" calls) (format p " (unless (= (f~D) sum)~%" size) (format p " (display \"oops\")))))~%~%") (format p "(test-f~D)~%~%" size) (format p "(let ((g_0 (lambda (x) (+ x ~D)))~%" (random 10)) (do ((i 1 (+ i 1))) ((= i size)) (format p " (g_~D (lambda (x) (+ x ~D)))~%" i (random 10))) (format p " )~%") (format p " (let ((call-g (lambda ()~%") (format p " ") (do ((i 0 (+ i 1))) ((= i size)) (format p "(g_~D " i) (if (= (modulo i 10) 9) (format p "~% "))) (format p "1)~% ") (do ((i 1 (+ i 1))) ((= i size)) (format p ")") (if (= (modulo i 80) 79) (format p "~% "))) (format p ")))~%") (format p " (define (test-g)~%") (format p " (let ((sum (call-g)))~%") (format p " (display sum) (newline)~%") (format p " (do ((i 0 (+ i 1)))~%") (format p " ((= i ~D))~%" calls) (format p " (unless (= (call-g) sum)~%") (format p " (display \"yow\")))))~%~%") (format p " (test-g)))~%"))) (load "t231-1.scm") |# (let () (define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (num-test (fact 7) 5040) (num-test (fact 20) 2432902008176640000) (do ((i 2 (+ i 1))) ((= i 21)) (num-test (* i (fact (- i 1))) (fact i)) (num-test (/ (* i (fact (- i 1)))) (/ (fact i)))) (if with-bignums (begin (num-test (fact 21) 51090942171709440000) (num-test (fact 32) 263130836933693530167218012160000000) (do ((i 20 (+ i 1))) ((= i 40)) (num-test (* i (fact (- i 1))) (fact i)))))) (num-test (let ((pi2 0.0) (ais (vector 1 -3 -2 -3 1 0))) (do ((i 1 (+ i 1)) (two 2 (* two 2))) ((= i 30) (* 36 pi2)) (set! pi2 (+ pi2 (/ (vector-ref ais (modulo (- i 1) 6)) (* two i i)))))) (* pi pi)) (num-test (let ((log2 0.0) (ais (vector 2 -10 -7 -10 2 -1))) (do ((i 1 (+ i 1)) (two 2 (* two 2))) ((= i 30) (* 2 log2)) (set! log2 (+ log2 (/ (vector-ref ais (modulo (- i 1) 6)) (* two i i)))))) (* (log 2) (log 2))) (unless (or with-bignums (not (provided? 'overflow-checks))) (num-test (+ 1/9223372036854775807 1/9223372036854775806) 2.168404344971e-19) (num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 0.00030764243484887) (num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981) 0.00021755369744252) (num-test (+ 1/98947 2/97499 3/76847 4/61981) 0.00013419396686117) (num-test (+ 500009/500029 500057/500041 500083/500069) 3.00001999583261) (num-test (+ 98947 2/97499 76847 4/61981 5/59981) 175794.00016841)) ;;; this test was bogus: (when with-bignums (test (< (abs (- (do ((x0 11/2) (x1 61/11) (i 0 (+ i 1))) ((= i 100) x1) (let ((tmp x1)) (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1))) (set! x0 tmp))) 6)) ; was 100 because float precision not high enough! .00001) #t) (let-temporarily (((*s7* 'bignum-precision) 1024)) (test (< (abs (- (do ((x0 (bignum (* 1.0 11/2))) (x1 61/11) (i 0 (+ i 1))) ((= i 100) x1) (let ((tmp x1)) (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1))) (set! x0 tmp))) 6)) ; was 100 because float precision not high enough! .00001) #t))) ;; in floats this heads for 100: ;; (do ((x0 (exact->inexact 11/2)) (x1 (exact->inexact 61/11)) (i 0 (+ i 1))) ((= i 100) x1) (let ((tmp x1)) (set! x1 (- 111 (/ (- 1130 (/ 3000 x0)) x1))) (set! x0 tmp))) ;; but in fact if 2048 (or > 256 probably) bits of precision, floats go to 6 just as with big ratios! (when with-bignums (num-test (+ 9223372036854775807 .1) 9.2233720368547758071E18) (num-test (+ .1 9223372036854775807) 9.2233720368547758071E18) (num-test (+ 8796093022208 1855077841/1311738121) 11538170533094188269009/1311738121) (num-test (+ 8796093022208 (bignum 1855077841/1311738121)) (bignum 11538170533094188269009/1311738121)) (num-test (+ 0.999999995 8388608) 8388608.999999995) (num-test (+ (+ 1.0e-30 1.0e30) -1.0e30) (+ 1.0e-30 (+ 1.0e30 -1.0e30))) (num-test (+ 11111111111111113.0 (+ -11111111111111111.0 7.5111111111111)) (+ (+ 11111111111111113.0 -11111111111111111.0) 7.5111111111111)) (num-test (+ -1000000000 -1000000000 -1000000000) -3000000000) (num-test (+ -8589934591 -4611686018427387904) -4611686027017322495) (num-test (+ -8589934591 4611686018427387904) 4611686009837453313) (num-test (+ -9223372036854775807 -1) -9223372036854775808) (num-test (+ -9223372036854775807 1) -9223372036854775806) (num-test (+ -9223372036854775808 -9223372036854775808) -18446744073709551616) (num-test (+ 1 1/2 0+9223372036854775808.0i 0-i) 1.5+9.223372036854775807E18i) (num-test (+ 1 1/2 9223372036854775808.0 0+i) 9.2233720368547758095E18+1.0i) (num-test (+ 1 1/2 9223372036854775808.0 0-i) 9.2233720368547758095E18-1.0i) (num-test (+ 1 1/2 9223372036854775808.0) 9.2233720368547758095E18) (num-test (+ 1.0 12345678901234567890) 1.2345678901234567891E19) (num-test (+ 1.0e80+i 1.0e80+i) 2.0e80+2.0i) (num-test (+ 1.0e80+i 1.0e80-i) 2.0e80) (num-test (+ 1.5 9223372036854775808.0) 9.2233720368547758095E18) (num-test (+ 1/1231234567891234567891 1/4) 1231234567891234567895/4924938271564938271564) (num-test (+ 1/2147483648 1/2147483647) 4294967295/4611686016279904256) (num-test (+ 1/3 (* 13835058055282163710 2/3)) 9223372036854775807) ; would be nice if this worked... (num-test (+ 1/65537 -1/65536) -1/4295032832) (num-test (+ 1/65537 -1/65538) 1/4295163906) (num-test (+ 1/65537 1/65536) 131073/4295032832) (num-test (+ 1/65537 1/65538) 131075/4295163906) (num-test (+ 1/9223372036854775807 1/9223372036854775806) 18446744073709551613/85070591730234615838173535747377725442) (num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 56471455498794722585779775/183561983334767209753061626751) (num-test (+ 1/98947 2/97499 3/76847 4/61981 5/59981) 599609438061905323469/2756144552405627689570151) (num-test (+ 10 9223372036854775800) 9223372036854775810) (num-test (+ 1000000000 1000000000 1000000000) 3000000000) (num-test (+ 1073741825 1073741825) 2147483650) (num-test (+ 1099511627775 9223372036854775807) 9223373136366403582) (num-test (+ 1180591620717411303424+i 1+1180591620717411303424i) 1.180591620717411303425E21+1.180591620717411303425E21i) (num-test (+ 1180591620717411303424.0+i 1+1180591620717411303424.0i) 1.180591620717411303425E21+1.180591620717411303425E21i) (num-test (+ 12345678901234567890+12345678901234567890i 12345678901234567890-12345678901234567890i) 2.469135780246913578E19) (num-test (+ 132120577/12 33292289/6 260046847/4) 244711424/3) (num-test (+ 18446744082299486212 1) 18446744082299486213) (num-test (+ 1e400 1e399) 1.1e400) (num-test (+ 2147483647 1) 2147483648) (num-test (+ 2147483647 2) 2147483649) (num-test (+ 2147483647 4611686018427387904) 4611686020574871551) (num-test (+ 2147483648 -1) 2147483647) (num-test (+ 2147483648 -2) 2147483646) (num-test (+ 2147483648 1) 2147483649) (num-test (+ 2147483648 4611686018427387904) 4611686020574871552) (num-test (+ 2147483648) 2147483648) (num-test (+ 2147483649 -1) 2147483648) (num-test (+ 2147483649 -4611686018427387904 -2147483649 4611686018427387904) 0) (num-test (+ 2147483649 4611686018427387904 2147483649 4611686018427387904) 9223372041149743106) (num-test (+ 2147483649 4611686018427387904) 4611686020574871553) (num-test (+ 3 9223372036854775807/4) 9223372036854775819/4) (num-test (+ 3 9223372036854775808/4) 2305843009213693955) (num-test (+ 3/2 9223372036854775808.0) 9.2233720368547758095E18) (num-test (+ 3/4 9223372036854775807/4) 4611686018427387905/2) (num-test (+ 3/4 9223372036854775808) 36893488147419103235/4) (num-test (+ 4611686018427387904 -1) 4611686018427387903) (num-test (+ 4611686018427387904 -4611686018427387904) 0) (num-test (+ 4611686018427387904 1) 4611686018427387905) ; (expt 2 62) + 1 -- should work in both cases (num-test (+ 4611686018427387904 4611686018427387904) 9223372036854775808) (num-test (+ 4611686018427387904 4611686018427387906) 9223372036854775810) (num-test (+ 500009/500029 500057/500041 500083/500069) 375106759202738205/125034753009582041) (num-test (+ 8589934591 -4611686018427387904) -4611686009837453313) (num-test (+ 8589934591 4611686018427387904) 4611686027017322495) (num-test (+ 8589934592 4611686018427387904) 4611686027017322496) (num-test (+ 9223372036854775800 10) 9223372036854775810) (num-test (+ 9223372036854775807 -1) 9223372036854775806) (num-test (+ 9223372036854775807 1) 9223372036854775808) (num-test (+ 9223372036854775807 2) 9223372036854775809) (num-test (+ 9223372036854775807 9223372036854775807) 18446744073709551614) (num-test (+ 9223372036854775807/4 3) 9223372036854775819/4) (num-test (+ 9223372036854775807/4 3/4 4611686018427387905/2) 4611686018427387905) (num-test (+ 9223372036854775807/4 3/4) 4611686018427387905/2) (num-test (+ 9223372036854775807/4 4611686018427387905/3) 46116860184273879041/12) (num-test (+ 9223372036854775808 -1) 9223372036854775807) (num-test (+ 9223372036854775808 -2) 9223372036854775806) (num-test (+ 9223372036854775808 1) 9223372036854775809) (num-test (+ 9223372036854775808 3/4) 36893488147419103235/4) (num-test (+ 9223372036854775808.0 3.4) 9.2233720368547758114E18) (num-test (+ 9223372036854775808.0+1.5i 3.4) 9.2233720368547758114E18+1.5i) (num-test (+ 9223372036854775808/4 3) 2305843009213693955) (num-test (+ 9223372036854775808/9223372036854775808) 1) (num-test (+ 9223372036854775809 -1) 9223372036854775808) (num-test (+ 9223372041149743106 -9223372041149743106) 0) (num-test (+ 9223372041149743106 9223372041149743106) 18446744082299486212) (num-test (+ 98947 2/97499 76847 4/61981 5/59981) 63720106179329487759/362470312515139) (num-test (+ 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488 576460752303423488) 9223372036854775808) (num-test (+ -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488 -576460752303423488) -9223372036854775808) ; this fits in both cases = -(expt 2 63) (num-test (+ 12766/44484 39852/43605 31122/19043 51508/63811 36845/41288 28101/14083 56682/37410 47892/22120 39412/22980 60124/55166 42856/59693) 208780620213964670464533749059169842219977/15202497819117370814835285951563379420520) (num-test (+ 63216/39382 57676/45091 53354/2630 1048/39076 16116/23210 42095/55806 27474/26658 50811/59328) 191349291372060004326881331664759/7211602793633848370218614932160) (num-test (+ 59885/27233 26245/45891 40482/5828 51990/36443 9623/46196) 34799310234648621493801/3065498111736131980788) (num-test (+ 37870/11132 60558/48391 53644/64989 60943/2780 9073/15664 15430/61388 55088/37713) 49618689694342545850764990997/1671112820517946923490092720) (num-test (+ 37890/11488 45896/14037 3589/36071 22835/41473 42331/17823 42800/56681) 420312190408065989902262231/40617147626636993628447504) (num-test (+ 26660/49395 52605/23369 30235/15203 37926/38348 54028/49472 32407/12923 20689/1984 27919/46263) 69930317632493223450434305725419/3428000885137780298513956804672) (num-test (+ 56351/21775 14958/21250 13859/32508 24968/65124 885/6861 3913/38588 90/55711 12269/37075 6579/33653) 201796703852921650643001395969752/41522567198031666874435508825625) (num-test (+ 8582/48034 27069/11031 29676/5507 56684/32514 25699/47391 44069/2704 18193/3289) 5684819414248430672302049/176897854654356635413328) (num-test (+ 421240/871225 1021193/39462 252094/592111 2478/11660) 32043461749854904862/1186809749708031735) (num-test (+ 149278/597089 747410/315908 218673/956214 174632/245649 45750/515909) 165277142441527691870266634/45353662154623612097256297) (num-test (+ 361087/1038423 629417/722796 693707/392139 237025/961767 88560/187279) 2426130069686588061565863289/654491499930590555724694236) (num-test (+ 94466/1038229 807503/592385 802950/953585 954630/176875) 6384533383241957925411/829875721759976907875) (num-test (+ 913461/774815 817965/788155 237677/532117 542827/225728 343160/431483) 2183257313717880748058258989/372346251755101707126455360) (num-test (+ 888429/600657 680124/108845 265059/727366 395224/748135) 20445657641208104518701/2371792747070499020510) (num-test (+ 37622/1698 9183/57409 12127/36899 11451/26597 64339/35514) 14092685195493114237067/566256574856769105474) (num-test (+ 24122/8583 41997/57541 42760/57555 40699/12923 30325/37640) 1518749441232333398909/184353450944764326984) (num-test (+ 16104/12728 32020/64625 35345/37481 29241/50823 13216/61075 11245/2022) 751811438787510154499/83010789184720173150) (num-test (+ 4312/48465 44171/56694 8599/3231 46048/62568 2132/45901 24407/26161) 455702434782048082459/86885567283849955830) (num-test (+ 59496/7030 37058/2679 2158/41193 48873/59329 52768/30853 34749/39139) 339576145632874325598832/13177075606485410552535) (num-test (+ 131/58542 41136/2572 43951/20070 63439/14560 33259/63731 10981/51495 49078/63698 10727/32805 29362/30842) 51962727546984124809096307414129847/2051626916225689647807786049306080) (num-test (+ 16640/40785 56062/38132 43843/29406 5867/50944 19248/58540) 1083456041462784832133/284138789764221200640) (num-test (+ 34314/54910 54195/13905 32762/15225 20808/42764 20977/59771 26320/20306 53116/23035 30385/31200 57396/3367 58378/6806 5724/29599) 39875514688522166158239445824103603/1051980164901898842922034228906400) (num-test (+ 40391/35273 27957/29448 52381/18500 60009/3366 27528/2124 62426/65445 43110/25891 40183/26944 30274/1504 27638/40611) 15253761502587455936752727098716743/251570544261187774378167518568000) (num-test (+ 52269/62857 21518/38958 29849/9192 27730/2604 20427/36068) 116322789710447328047/7340588373519969288) (num-test (+ 17009115185923538769 -12047631083067675031) 4961484102855863738) (num-test (+ 12677011568664239747 3269056182420253574) 15946067751084493321) (num-test (+ 9315504781982082433 13857624532376678678) 23173129314358761111) (num-test (+ 15226508728194069537 11481952022080775416) 26708460750274844953) (num-test (+ 7461641943684774743 12249026721402718630) 19710668665087493373) (num-test (+ 1180469445886971055 -3208456171287181032) -2027986725400209977) (num-test (+ 18358552990465743315 221529797579218180385160273426219343697) 221529797579218180403518826416685087012) (num-test (+ -14819874956616484359 30498815629431206969122152847973230849) 30498815629431206954302277891356746490) (num-test (+ -11781881800334342169 112219460388643619332860331282276228017) 112219460388643619321078449481941885848) (num-test (+ 3570694277032201957 284821691832196381859344006870088122712) 284821691832196381862914701147120324669) (num-test (+ -17005463295060938595 69162171850264911722979835561124066203) 69162171850264911705974372266063127608) (num-test (+ 15647113311796203488 150750467185419235519670165664526735459) 150750467185419235535317278976322938947) (num-test (+ -14330150541101371097 -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886421335353882155416908) -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886435665504423256788005) (num-test (+ 7406427184711759740 -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336084100766391093756252) -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336076694339206381996512) (num-test (+ 8819522415901031498 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363793325150672647162846) 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363802144673088548194344) (num-test (+ -7242932332215698200 -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159009687703010657137320) -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159016930635342872835520) (num-test (+ 9794320575955609492 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470325394342993771343357) 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470335188663569726952849) (num-test (+ -18404048401680891243 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224482801864925665484770) 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224464397816523984593527) (num-test (+ -10763220363947284865 -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521301209899829037444385) -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521311973120192984729250) (num-test (+ -12742462236537568498 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747534683311506465130527) 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747521940849269927562029) (num-test (+ 9991390529516174614 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538345749595968764873879) 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538355740986498281048493) (num-test (+ 831234034418847630 -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606507809487462642341164) -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606506978253428223493534) (num-test (+ -6996572501442843347 -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314889561060687692538144) -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314896557633189135381491) (num-test (+ -8920936222630165483 -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973494705119572045938607) -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973503626055794676104090) (num-test (+ -243510292488206214847646757340020705642 5940577100149745132) -243510292488206214841706180239870960510) (num-test (+ 35446324064743728955945058978206455057 -6248622708755929572) 35446324064743728949696436269450525485) (num-test (+ -285342226760657637664173494795024413673 -11942737781617905307) -285342226760657637676116232576642318980) (num-test (+ 180790435817422032042321866247362452865 12401641959336396832) 180790435817422032054723508206698849697) (num-test (+ -179994871947239535956826388240542999950 13573822506399140772) -179994871947239535943252565734143859178) (num-test (+ -308198027295905163635866438671452347268 -8790069282378476990) -308198027295905163644656507953830824258) (num-test (+ -139324757925833055762410227358605285566 -190622873846936719063564661032771271922) -329947631772769774825974888391376557488) (num-test (+ 332866352618304570046318203427223999347 147978646177673305481282943528696833018) 480844998795977875527601146955920832365) (num-test (+ -39471620476300923970352914034802271156 28992893610776120142668950821916856486) -10478726865524803827683963212885414670) (num-test (+ 274120253734611965146455315763505869288 254675910805265090692978775702306142625) 528796164539877055839434091465812011913) (num-test (+ -122086811464559635596206661886176775901 287312583034687582188356355813963609701) 165225771570127946592149693927786833800) (num-test (+ 288576174771266329955482943556556984728 -57843540651903655425270706396868707777) 230732634119362674530212237159688276951) (num-test (+ -47977736580820486006305788441965482221 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126881113426109906085249657168046936670489) 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126833135689529085599243351379604971188268) (num-test (+ 21225484205143479814642328762121362291 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974867770082516862899595554460170417713940) 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974888995566722006379410196788932539076231) (num-test (+ -193095363331703875886398909106293703000 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388168068485304437343508442251302846768269976) 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388167875389941105639632555852393740474566976) (num-test (+ -14827657635864183514988182371035598180 -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660185258676369175307019300952192657194576) -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660200086334005039490534289134563692792756) (num-test (+ 54301423175725658626298504084995819705 -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941312995898184903431893212829646845766101) -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941258694475009177773266914325561849946396) (num-test (+ 195114404067053480147948948510253723990 -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176374041758276069255591562198514767063594) -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176178927354209015775443613250004513339604) (num-test (+ -308030589512186791277525017840002670741 -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550454815591457829485684936036414823492160) -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550762846180970016276962461054254826162901) (num-test (+ -172649878347923210775992373331623646864 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447760919715595005106669653475931803053499) 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447588269837247081895893661102600179406635) (num-test (+ 17539006966816771902104329685391462527 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507917720426571969997513984360849930719808) 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507935259433538786769416088690535322182335) (num-test (+ 244901855797156286376563377540855746602 -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760396535767621855642720080219960822554492) -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760151633911824699356343516842419966807890) (num-test (+ -119403662992279138748600939857239307122 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953732384499190437432898387573320391878853) 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953612980836198158294149786633463152571731) (num-test (+ 313963939617834410089002930298454269912 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864354021315490712575535559549015858088608) 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864667985255108546985624562479314312358520) (num-test (+ 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160643580198590073658869 -17993015014355471903) 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160625587183575718186966) (num-test (+ 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942609010590873980143878 15372278140141207703) 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942624382869014121351581) (num-test (+ -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044148223082253439210893 -14793401891248640808) -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044163016484144687851701) (num-test (+ 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149274871082481174186606 8699133332160461067) 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149283570215813334647673) (num-test (+ -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146471920873844686294838 -13079925952361275418) -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146485000799797047570256) (num-test (+ -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311445471793936775767736 -9381557743227419896) -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311454853351680003187632) (num-test (+ -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094956858541960962483734293877093635361160 277811698220276334443479876776376776138) -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094679046843740686149290814000317258585022) (num-test (+ 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240709059499894818265755197559390728940140016 -118940994129137705779355371753506018694) 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240708940558900689128049418204018975434121322) (num-test (+ -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454778025302197744540571159656556971614966757 120224841184491944160266976391113485817) -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454777905077356560048626999389580580501480940) (num-test (+ 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237448178553189381274150213236222139873594 106674783386899772113212633712093787897) 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237554853336576281046263425869934233661491) (num-test (+ -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448907193562300482925125162731530249763801 192969103435503875767216559494769734726) -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448714224458864979049357946172035480029075) (num-test (+ 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994228143957746922511631911996296931168332 -211230038021470285136061932161632203274) 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994016913919725452226495850064135298965058) (num-test (+ -2935941510094051560788359387128767361559188973149773593522440619832472030019457317998381634585179453958737810428870232715146002408187749944694186205812791 -1221176156661231926164756142840452419679061324806989304452215660535991083923207702827717652226257158321829748247784282139952864899457896871473184473608543) -4157117666755283486953115529969219781238250297956762897974656280368463113942665020826099286811436612280567558676654514855098867307645646816167370679421334) (num-test (+ -1338674579024795395027232680327531457830908239605718353094975139226848400289367913459076082700361212506196070727982446232782659114647371030398516119682505 -1298372177520411182435886041880377054374169787570856408996533471838082317927648953576721017727347029007573543972764860712708420553928791798580799809858729) -2637046756545206577463118722207908512205078027176574762091508611064930718217016867035797100427708241513769614700747306945491079668576162828979315929541234) (num-test (+ -2072456075229532951804023218627137969798924912365258263779029006567941400203608770518731715660383378937120213112973528605594220795605977413985543331908189 -9744489461776287963808523409593616918248399004543154581056479712028497082820841423941781438667661074968238703192056877665754560746003512076830245760254982) -11816945537005820915612546628220754888047323916908412844835508718596438483024450194460513154328044453905358916305030406271348781541609489490815789092163171) (num-test (+ -2570682164188734368809161664810917340861573482754788446510182252413437925852206735928397938304353826925422441004271229738766803460790995673395984247950088 656920705293329551826685120408221577679101260931105312141757138825917579070505267306626244216341686712802796891966598838285570807961966448181138356047523) -1913761458895404816982476544402695763182472221823683134368425113587520346781701468621771694088012140212619644112304630900481232652829029225214845891902565) (num-test (+ 7846359203342053693101523606887617345982401999003795257520576318451663998927274759872692123323796450295314377046602880394071105863527900699633560551732837 3683380639347829102597675045842249667669675715600522157867595962635108482512780509393310714588544837398923613138772339053021025559943198965234376657126821) 11529739842689882795699198652729867013652077714604317415388172281086772481440055269266002837912341287694237990185375219447092131423471099664867937208859658) (num-test (+ -11692323148567132684205145901751681947225824260005631214936266006610207543813382900867093989444659986091234552140689684476541703112098935301322850961583953 -8534276689564199122569555420819240948691777228327984555753862457592427992599992931175844172478864477440165366128106812103785256271256853749622592560655914) -20226599838131331806774701322570922895917601488333615770690128464202635536413375832042938161923524463531399918268796496580326959383355789050945443522239867) (num-test (+ -10734754884168724884333968138739681643742524619139397687680049322697740991391014196697040576174049452737571835233123127815762146577096625434481167057340772 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797378799103456094203126081464905326203083057134061673694975250599375795827437561275156235513192978645909947341297774926450637694325145427434486258223666250272) 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797368064348571925478241747496766586521439314609442534297287570550053098086446170260959538472616804596457209769462541803322821932178568330809051777056608909500) (num-test (+ 1982582032974021971225071139786536402936929744496433027195224299475980201425925452469321205602618940472354066218156609448199804973454183972974358405933935 -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565757325842468006824235119684861972224857533964558963441079998949499582965764591461900562931342373507763081479989957632695010603500633322408246084430203281475) -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565755343260435032802263894613722185688454597034814467008052803725200106985563165536448093610136770888822609125923739476085562403695659868224273110071797347540) (num-test (+ 11532228364136654310006206557545352284448588590560137249197311142901246089838098630841794341370689745410654263817911440601934362503092628725755210859171724 -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425483901920822837775032295913486152631638908227467242772081310515646217115760180349854601959031626524004201825198439309850266508687796415478396821644422350208) -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425472369692458701120722289706928607279354459638876682634832113204503315869670342251223760164690255834258791170934621398409664574325293322849671066433563178484) (num-test (+ -2603756427337798371354526130541868239006085657393372011847827118826669474695402075575479286172808099892726251004549675772420422527946534088483901153485670 -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463663570751134804664228918188923926951933302878771189484614604311920655871182974081898031051411394311700207305532216445616083858025977851570522763537300875989) -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463666174507562142462600272715054468820172308964428582856626452139039482540657669483973606530697567119800100031783220995291856278448505798104611247438454361659) (num-test (+ -5929887196386997518766568868806997104240129372360669348628384183712406620199102166145939206783172815805659513128544493795329100599632286529420772709366102 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250682015641747568282510036326125505522447591703308661608718100933027549520132308555240654655887041040427813131621391320267698106519650611462269033902177180035) 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250676085754551181284991269757256698525343351573936300939369472548843837113512109453074508716680257867612007472108262775773902777419050979175739613129467813933) (num-test (+ -8848084327536592532063677611386811805244460767433749071435930786126721080365289638381557872263825830664387392539638767251180242665642373539064690745095464 -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033893238864631158195280554850035949666897861529711006187241710164902350100555999894332438423857208747342184052953230247487231455921360593096823760117493579248) -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033902086948958694787812618527647336478703105990478439936313146095688476821636365183970819981729472573172848440345769886254482636164026235470362824808238674712) (num-test (+ -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679396721657020438979754 12553426083939460917) -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679384168230936499518837) (num-test (+ 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269660274683400619225321 11620128128044940816) 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269671894811528664166137) (num-test (+ -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936248281049628734475702 2380166482232871816) -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936245900883146501603886) (num-test (+ -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203373153221004361953729 -10586442965055062759) -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203383739663969417016488) (num-test (+ 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642592954601418753021512 -12227722924075527556) 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642580726878494677493956) (num-test (+ -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662935026125770444036994 -7349798942312432150) -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662942375924712756469144) (num-test (+ 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391843039459733925494003066841874935048611 -66646390577667468207341453008390168215) 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391776393069156258025795725388866544880396) (num-test (+ 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506419828208611247177336492131262918439281 -164048419232636429449474429717211197442) 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506255779789378610747887017701545707241839) (num-test (+ -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300146993858360430784079225137421074839819 117460076430162201914796277915447781936) -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300029533781930268582164428859505627057883) (num-test (+ 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707453499030166286828319347894538505334235 -59175168207571178843658955348404514921) 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707394323861958715649475688939190100819314) (num-test (+ 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851829184120171969918537718488250577987049 -151873924489040812813761508259707631973) 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851677310195682929105723956979990870355076) (num-test (+ 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821222597665222975816418433744748143385431 -43245950360315656184924888243641533635) 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821179351714862660160233508856504501851796) (num-test (+ 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830415574905929299482373462584995162798576853564481617711234957058703455021082855018642616999836886763535412642684228990890160568207941504887072856663966242787 1954009743321912552050341299974626734964446274711484506734354360114801426013796892421541915293157994203607853436799102383078659985249097057923578528366737) 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830417528915672621394925512926295137425311818010756329195741691413063569822508868815535038541752179921529616250537665789992543646867926753984130780242494609524) (num-test (+ 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730196110477118156871579503345757821268248575583821695674912517830056856597644827244194658166928026249459511837772775196175188368236573504643083995409774002567 -5513982495816270388232134254127393284677692173792609278582774509636977743203029647121158805174638642867428501907786521939155900331399058909602425073976766) 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730190596494622340601191271211503693874963897891647903065633935055547219619901624214547537008122851610816644409270867409653249212336242105584174392984700025801) (num-test (+ -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550976844117943559190671369193871330514473741920389633762695829790016565565261170688485790141638094160105909405353382982945608773290740598479367828342651860878 3451570547959142767282758882796967240086418127970526029661337442068316209707489088420708984628065070358319478649952710478991064476168799556496237099109563) -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550973392547395600047904086434988533547233655502261663236666168452574497249051463199397369432653466095035551085874733030235129782226264429679811332105552751315) (num-test (+ 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623397410528064697616617917065021866397277409044449982605591256067763430930720398889239414812509701319783809830072841056369381573100589260104551934136733317845 -9461623592584966196513107657889418526847060851423069480904645009418813160370721071067349946095573698635859409908288864150475056170059858850823883834932131) 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623387948904472112650421403957363976978750561983598559536110351422754012117560028168168347462563605746085173970662932767505231098044419200245701110252898385714) (num-test (+ 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787710331228500533067546198458251241005176280410230146430275074766072259256583499095689284871987010372039977403712023630453400259082684930755893684499232318008 12330599952818018622104330691506128012101935028731995985677032980931398338453806827555760801312052792065671886621851470997557806941112316627790755867100463) 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787722661828453351086168302788942747133188382345258878426260751799053190654921952902516840632788322424832043075598645481924397816889626043072521475255099418471) (num-test (+ -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027771176714559050403098437684091684851207513969915720607528045624635094984539637789113651579846373399975502788877555747414523231999341294756679330384323996 764238600803843266244444637050072967342049538611688895792923539838804953492110953673720766879606601435939162680753428779068917662740403667549850724878795) -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027006938113755207136853993047041611883865464431304031711735122084796290031047526835439930812966766798539563626196802318635454314336600891089129479659445201) (num-test (+ 6243894672855694190803081952962387322599009058758027960092936187687064819462191583137945440936085088260632250436567758576422207449236613172605950116622271404444221039084346501796818945639456207912207604248991842124079786471250102192718092353598850889806607728696519257402580732995770031331187089424192803722612735557735028710899438934171272639518928194764526910590046378401600819132587804143949995694950116915803127294011661411525934100144319021440919928013617766507409909846670172516021888661284467975865076091834094160862228180625536450124272957206172214541444266874056050295270719541605687740822711659847211976891 11877496607682442993105675644902145742318375725225741293060927105303783712520284640625374957608051032540491531573337817824773543104969422017506696018037874641947740606655370938613842356322585858034851150595788166740174872996252792014218946552442572806242471174234462119454014379628228878122072189387777413014452140618318641689597452676091677588204537830401725113931418426919671512011822864583481449136550835952005765386885680701637038206002172218712504732572449659704181315669255320876647592649071711438131711904976335957846353867776093588236311654631696625859173554395714740218099921290128795607292259527492722462071) 18121391280538137183908757597864533064917384783983769253153863292990848531982476223763320398544136120801123782009905576401195750554206035190112646134660146046391961645739717440410661301962042065947058754844780008864254659467502894206937038906041423696049078902930981376856595112623998909453259278811970216737064876176053670400496891610262950227723466025166252024521464805321272331144410668727431444831500952867808892680897342113162972306146491240153424660586067426211591225515925493392669481310356179413996787996810430118708582048401630038360584611837868840400617821269770790513370640831734483348114971187339934438962) (num-test (+ -24023960171862805266003610953999097357395283354964456554686635290239019705581779621120391229617494503580661676939681517550103414632840981987397485411400553792707518662609532504246677658012933762605038799352109564432278094548068984563394926376371580465135388578139331334464060067790936072127680597181415407099723844313625277987147283697141407959289588588489162704824409673099509423520008795428217612706997355591985894255450783091681112776112997887084157623388943538145736618168104404283342039105202585543852590302154958791010622670839015475427693311663800177428904406869645066988663292128104453773413982185343111560886 -31939808827732134714870375774276102357277346245583282398423150631754622253109692213928642228787888509211781331649081002266227303203259124984426497846441848502574293640959494009564992092503141598640200823656998243767453860939156780549404892392521391484933772285520949470194562525777116137058001008184603332597820522016200623301007194309404025522056113671560767212894303567191067178003014955596425115379852712737129325098876542459702682095445350281859042779889411325882123213577906096942649941285655935053362468972482748617111598313960198743596285343178242282172686940700127068972627110105953098737923773182254460772630) -55963768999594939980873986728275199714672629600547738953109785921993641958691471835049033458405383012792443008588762519816330717836100106971823983257842402295281812303569026513811669750516075361245239623009107808199731955487225765112799818768892971950069160863660280804658622593568052209185681605366018739697544366329825901288154478006545433481345702260049929917718713240290576601523023751024642728086850068329115219354327325551383794871558348168943200403278354864027859831746010501225991980390858520597215059274637707408122220984799214219023978654842042459601591347569772135961290402234057552511337755367597572333516) (num-test (+ 14513652183174940741664411990199277445706189147726874603036586212536012746892966848269748909379750612027025331446918381470766609543142456872580466135425754204680927122749772612276850998180593344389487924747722210296498854143380696064338777945015153982467675141485724865534995199700908286263993697988986805404864429385840512740226775506122190698806967785494289035976495492863456705096841250592980439363856397663738211335801835896091823148249303370609165910779981271035234045185574995335952208702661648744928539539455138167482396767268362221492607154709559716065850417221174683768503217544145599044845325824451589309835 -12814535978730024053359592817368712576084646962861720729844389627130663192435154658607204342320327460695280260731620465435530495952836598646143907272825807563512741964987882356778796849529260646503692618525570185450780889283642116889481314560395290434301143877809550098309214046129802023655714098730144464028249594406616074059558969757405392170810220921023905546104487938441503430332099605473144930508420331873995741851604525954472341693863067199617721032815462094767522339305487934030130207039176659398466616780628644572276059410087128533031562978399689702766028716401176531098447698206272762966470643604141938670152) 1699116204444916688304819172830564869621542184865153873192196585405349554457812189662544567059423151331745070715297916035236113590305858226436558862599946641168185157761890255498054148651332697885795306222152024845717964859738579174857463384619863548166531263676174767225781153571106262608279599258842341376614834979224438680667805748716798527996746864470383489872007554421953274764741645119835508855436065789742469484197309941619481454386236170991444877964519176267711705880087061305822001663484989346461922758826493595206337357181233688461044176309870013299821700819998152670055519337872836078374682220309650639683) (num-test (+ 11356479761814008572465147431830778885327227506593483181241437802252618729479905490826767363633131720717461693888023278837835457496021519184903984385091047829540007466025527592005114414671285638168997562037691602144751434208304408870143450743278437854754504713023422097017723330207792526222436928747286558205279330508360438281011315147578105966454344087225699378388309094140949428028313539634103047841948634832398526343605363013644180832752120081735152285507591096001749463421326282317713079361827765412853023201330345752038722069405404812511739634687282327711258974520622248165974215116400638833123609666501349513623 -2451734542868054449539778460457497703609327132304922810342762480808881050209276687756391911546806187586640918078231508181876445466503459873508196878629364924241891220686182517218825181707207808769770392864734466652524094735160185556148554260517746279303022469784592528209667497664672945900929888144529727881050106027775707933311860110618130543481573815538047460723253898548348335762406437618625388229555824532715231231491787570056329865617082709588903922431713098922691537317839185452018617461891748518176708607861270770493263960554805373552348256747200291438630960804647686832667981625018361034564086859426490014044) 8904745218945954122925368971373281181717900374288560370898675321443737679270628803070375452086325533130820775809791770655959012029518059311395787506461682905298116245339345074786289232964077829399227169172957135492227339473144223313994896482760691575451482243238829568808055832543119580321507040602756830324229224480584730347699455036959975422972770271687651917665055195592601092265907102015477659612392810299683295112113575443587850967135037372146248363075877997079057926103487096865694461899936016894676314593469074981545458108850599438959391377940082036272628013715974561333306233491382277798559522807074859499579) (num-test (+ -1814184401790217165873937825605141478060935014868566665644215718762341535891730598045990231798382966074312671040257824056876679135909008140059087311700216658095793352051583071432744886316274989901835606602224927350560604355249919901932382803472476702792978322468747380191775778902733911968522382089332819162367884984027854067607561808704316828316820133400099093450636968732151876570835173932998599031643640476109466728761033062776578175554441947411139184426213290292577467587355369954997241091769769542810051228504545831588488726789173405585678190671534386784806998695797717346491308862362775748058331375692317599945 15466182953987394334491149436346080039471412309427279110582769586053943302670765125931570041904640518032832554998553018838321871748542118021556398569294085708441934948186080236498081517178574839977996802813431873543309853609838200338534343580791382510179184571852290959723696010410340740895530535423959476873857191548113125728667781953125153120447892632916574768078583174099545013854248664119997703948998871566374080719541931440495888606776561795893839624084254684939434035018741535261951124673664746010067859317726891535170781460914710499572006592206360512398012457295755926986236618644330364227754380084585899275327) 13651998552197177168617211610740938561410477294558712444938553867291601766779034527885579810106257551958519883958295194781445192612633109881497311257593869050346141596134497165065336630862299850076161196211206946192749249254588280436601960777318905807386206249383543579531920231507606828927008153334626657711489306564085271661060220144420836292131072499516475674627946205367393137283413490186999104917355231090264613990780898377719310431222119848482700439658041394646856567431386165306953883581894976467257808089222345703582292734125537093986328401534826125613205458599958209639745309781967588479696048708893581675382) (num-test (+ -27127130599753372624001250456405972983012981437652156246797208697430661165612459362971759027335854588888552031022264244768883843080959804690580574272908031271224646245152017114094021048441971097191444782106551075175878815012595015584723250801765859461211934306789890718268168352614164589637346918581658850565274510502652089457352942736418509881708568727739912127781455473660768550022762222130489047215089836402367851853412705556570667960548570630054608024914653686223423908494006675057953013815512203710764854485332282975729323105427143207127239069826750682633272289409910001698385240596625059970587393681128674617278 5719655139276246085992066702308194672442413085748146924567717361937179810269300239821879673460959112727066470468217892213025828988023367028158410455624528688729907493639908638553730770145274142147983721694721139760883483821883267129411125364089207412089113869427479340283853501026803387874124668123626271531796990801822527792189514551888019206405597994403243358155410088320317141454525417323186389587327532772638942220300149829241141659063128602316305332848477566686425551944956989370838072872906293845914921103561360871571846865478762953536949621421094416539099628942010528483544062050170673327754206501716239719529) -21407475460477126538009183754097778310570568351904009322229491335493481355343159123149879353874895476161485560554046352555858014092936437662422163817283502582494738751512108475540290278296696955043461060411829935414995331190711748455312125437676652049122820437362411377984314851587361201763222250458032579033477519700829561665163428184530490675302970733336668769626045385340451408568236804807302657627762303629728909633112555727329526301485442027738302692066176119536998356549049685687114940942605909864849933381770922104157476239948380253590289448405656266094172660467899473214841178546454386642833187179412434897749) (num-test (+ -6069217517368004039/4076344942716985944 -399587800008780737/578697755310708616) -321318766345655960630110128852941297/147435729263904928853096856396980844) (num-test (+ -41285036778370718/305793940074617155 -1396094619926552183/15846027887642356854) -1081121118676718273499338028514700537/4845619302294419132297197085940230370) (num-test (+ 15975644088444536091/18063939613598316583 17501188199168431305/2979264551795273683) 363736076920798535449296038324193823968/53817254956563877935003279344562385189) (num-test (+ 10197734562406803221/17452826108659293487 14639450560606090654/236781760961536951) 257914422508077920978698094723491089669/4132510899763835955061848877304138137) (num-test (+ -16810360766832230069/13652857552883800956 5011749175730438558/4169057419710079215) -184295743992738197672588473692806043/6324394120121667288243293659228081060) (num-test (+ 2234573531734039025/1128831476977636536 5842177084459535064/10255356071975483971) 29511180623959738330730559435115466579/11576568741659658592450950022331964456) (num-test (+ 2268894928233321367/45672733521488298991909987382109984899 -10510750087507287356/187832098427494353069556175466145198255) -53883392376116199828369509984040539934420061636271022459/8578805378260910951788610598591490227836321974082207035230408675959411151245) (num-test (+ 14273433611429514043/7774518083776389556784045601066955324 17247074371340283485/225579726714102822702316919752160926694) 1676942472465190408518249346164012571239098147062478293991/876886832336064155131767120243155911448808491410701588797601053820468509428) (num-test (+ -384768590020206817/26284423885474502132625533495652664626 -913687410374243983/254477371735734658619949996700223764026) -10160887225658731404416073535892287983824191154410167550/557399258996959835387173465565070652935481894323496556880024318994528462023) (num-test (+ -4465222504572200650/89674568206322981678158378582739708537 4148550863841320780/74302497820894496090312266744880513261) 2118016946376507498169590394563632549990739165791772590/350686547828419379316750498534703170285368675911953477374458878558215968903) (num-test (+ -4466938407638238142/281859125741189685767904931589784285893 7302241525893379697/204618108204962312932373858463395271264) 1144186926000295881841982161759159994442430111060328362933/57673481089466829503954266461746705742702466399988738560842837126631263478752) (num-test (+ 6692616266348342275/280491911593106290120490189988812804382 5414100524539959087/183579771905991028181574615911067652873) 2747240373316006570071525025488180559154305534334705425309/51492641151737853299832848099101317109893853469394209716061486746077629289486) (num-test (+ -2794289802081124319/15768464977850217600859580216291365931410230647587457388598921425875331529149 10869776169503285673/33805119742344157512165738805682358903614971418053290198565741206390317449856) 76938383491719886409504555688515759257937029058461512747558964579607347503639994773101488934213/533054846729186819415263583890627325668798847177803707144003483502948153457972377767011992167761176556555806720273883868208938866192358148729990609852544) (num-test (+ -253222140119290489/2123024034843473393742534167007121513293496410591072104903085284304117612082 17957334013642389787/32058972871090153103034645121513493401113378486125580864856088310966601405847) 30005809992231287609744177955201962181880644831204431411802631067134766877061419104162728517351/68061969937719269465960475690278941280799593161143759512261685488134507341176789799765185182008442410081522124548392827986923668912612728349293792643454) (num-test (+ -13318881947309618/3105936147298438543619802738126617974207009907186580731552500517452462642139 1850968757748704519/36469179946212878965111748233319050931475015876401494718861814560453153824935) 5263262069792987469108717688485565287648879759118200779949761992573778798556738644541735401311/113270944257273905484832818286307416845956086746130199501242465128236430928807948126409718436237517505516279133169796919230385184900609912160483959935965) (num-test (+ -9937822914683494298/36414156259035675966580098631253549474580108307284844243190992829476777586283 -13712605099585970325/17758145954890657915358548152198427387923366136638180213650029984340849686198) -675810254607579372158951115566887998278519717754376916387787672973408477396668549189167387350979/646647901672150721610792561233068038707362067627156669418022102308446036384411330678972562863413004325878365438890328206637571985169324874284800419222034) (num-test (+ 2479135971595944301/28169711053558469409458629766960029324030958129245230797895768033968717159836 3427244662960653095/28446538857424788738244844756675951434179713170118835630969510829753715142438) 83533664807147783700314944003289704497366290621039272787320536148072960487262393639109696219129/400665390043739792096386856839000624247597803909916773326187593475005945995926511155915226239317839405221783416485999405286913042389632370302962776360084) (num-test (+ 14865500635281371370/56222262470894935247131881777606182311286871927285650835673424014252462156319 6436092572090050725/19282524131572095520593158313261757267758159099923763177708581262473988426947) 648496060602737474174747620183913927791943082591316359990137585798909535115053578637078811588665/1084107132826611778585714784136700465449309125114745313342842325649687943726086785657821763235618936882528385000712567133180567926723616940173290425928093) (num-test (+ 340196811925805824067049620503247332111/14422464039094716975 51285507111580975533385007190438537498/3230944134273302873) 1838820276033673324738967436225477772648372110186756083453/46598175588880723338390245118389369175) (num-test (+ -210449319160504160992731982827917332322/5436857856220342451 251628249079137248539965770847855056283/4323109210037952829) 458271632943884346915405609513071881239303671882386130695/23504130271893362375786510953364243879) (num-test (+ -40984360445255688839942109197081457275/6593417935076565019 -138094174027187773198981391229349265879/7135512300754720691) -1202957011856131413678873259651070808566709454882536663726/47047414779755620074837011989046108129) (num-test (+ -289704472880230079383856507128133962457/10452740760651010288 -55251460678415911958671096669490155237/10333740726609314202) -1785630052601050832889834016432677758176770083879794496285/54007956451514283340719766211063255088) (num-test (+ 276702099951674677215621541062877777467/3899918017008359516 42623843937285717338660228144403811741/1973785812353331893) 712380176058162142132059442064597996057720566915757732387/7697602851312240113570356856612843788) (num-test (+ -323480614013303716597188084301661616596/12957985934572321773 -72966206939397711493108854138997499334/4539020357040680881) -2413780175334213399707013296172687953960842714316410700258/58816561943270580900205343368941122013) (num-test (+ 65443777543319569578713907336699651721/218804857459609839540825438673960136766 -61986861924091374470669233802827103921/65997977315012279293170493460332070399) -9243869541956614722377007489838492339200370508580665293676272508698701352807/14440678019033825487758061900150103876633207457375858942267120523885980189634) (num-test (+ 75417845823236070411341994633288547531/70553457686181702397810927701121800017 -7132208259849175775323757110664708879/24379326462014713478002790304943339422) 1335434330716260509518880689691257567128541829706203586134358870209350816139/1720045777955364955754847231620711706115121721983605654691934662747636370174) (num-test (+ -144692585186931942602350348772472248638/135233395864627580439431775527364081053 282512666765911374279543408363363928190/317835040256607665191397469890906044457) -7783226336195038987381961251409043080655184208289882004756343793157154115496/42981911818671667582796085276418080952868666330715445603855323471628969373221) (num-test (+ 44888992584766727877549626240272070725/30583318432547259097085073976959329092 8004917623696885952432014881247978821/22005016116109025986417835664774768346) 616299974987760892931461886440810919939264155149950328291076750435394215691/336493207496148335911511951044490614757807556827643881435283379298939260916) (num-test (+ 78378756441281199312006031491361997668/175125578595003447448566412156266355477 41128705932035853424044828385766740319/216359823601433445464965619660717081261) 24160702340946845080381231961736762955784254747832931999121777482667650876511/37890139292913914697800186893609983979783140570423836226844401085057321416497) (num-test (+ -36669293296367265584135816683983780855/7341750629088488427994322429098120058 -110335983484012479290765295565662258281/5944410911181873015545360879141666465) -1028036623331099574157832708037007047972965676333418398303213384036005227873/43642382546729990922161061763293407461832155878510163500678954788762454970) (num-test (+ 228535455883892721240720366651075744967/13353170075841095813026701300679754576855418298534901819672803635370738730013 50622643250826426975012800479360461693/18462345430382979738234695697296360785230118465695284267226773073149552698303) 4895273294635392498665165879164922265508724130843670837390305811645771221742112327485665544066552056189958877583010/246530838530831602270074647792752210668736478466245992891169449973883874207653264921203783108295835419855394180777469634862446033810927048792871560267939) (num-test (+ 11355068601761731966774720678777239425/4604724775053993730579400400679579947095967462408565975449642189823843820753 140083339434585694465706029861026468774/44667214322013486680993684507177513903616004462434123967566781106229226297333) 1152244506542792151980649054527153167035843960949499862764543674633978109831264344257976000890169981044543787620347/205680228421222079539939271800361418862113882206694593495620042859527547538342323521609420336002641308832164587573546802806916292021672743366881933951749) (num-test (+ -1347509007210283053816302848714698886/1127513773036247565111791991337919355855664936242166138889250311777351432819 -29464928273311615445392112247506626497/61933028109313748081628643142485450090725737246358993405254280723087421657760) -116677425670791909053501267317366054796703074907755330120413752187834449333299886015456661052906469074533366060403/69830342199092322009251417145364324484174202256910311362396720371574344280505889954115533896831727771442604285956749924105078563356474162416148250025440) (num-test (+ -324250487660721070279458563122233299722/81069650926979269606211148691445887485067008319429991878657612702576019034861 221744296343315457943731256980089803078/69422237643162665956763790134527973903052044485041686255401689654420090859107) -1511153903564243978242173323335554031611949546418082039382510246845821774680210236992700372319944685567533765722032/1876012190766999122356500320654631447623282613780323887424324139799202291067983209550065997185860196433399782230215269625922714982832188312141580824109709) (num-test (+ -5518324152042099343909980322067306333/114786626838714403445081775763480415805466836213320421844559660900880511042496 -34415425451618992284220085078832944671/96012285963709194218263616278916829663708037691620330613749177799086889040577) -121088040955051148243092870850103339772063863319219725752028251933576579890093496821887384992074112246777968211161/297862876779681729593084954525306275464788137269287692384941959703420459939692410434239827100068259769782676124741025632728203586961467995819025176090816) (num-test (+ -14763921690861243371082340598041267817/5580497386043551028888310256097864185640794395615400088682607872958152738111 -37917865546640067592937379176813765341/6460563866107795917092814416816176677900242086501650458839130903088333290440) -306983808565398982164654624310995401934900925070311336095043743767915008644459192438083753301097540174379867380331/36053159767181973313125557585868206969047484351694148822117591172786449966899079869470557965303954072842600790897257698854023751399649072014440219958840) (num-test (+ -50167218239107621378232529938205077788547946059832391744348095230748591585676/15685777859540025727 2959973815535345735348053015389999235839609978295604181643547897863515739931/7556072538495923601) -332637648328710384664787658442281566361265475773778265650094684540358159241317316408573560734439/118522875329417757148187346888166482927) (num-test (+ 36275100136090483878026478935942224245036692059657264537598788566553406654319/7192442039871568876 31833552596558882106090352174644817045294359487590746360517241517440556146007/5115621724114081523) 6795584791386081942310910570767193224876510928834120433155946649367201608618436115134135392229/603177258173744207443043238127434068) (num-test (+ 1518304705177739493483387141342904186483658277690975456045607777812450680478/1837349761252804045 -98159070764971437450169149833809835519268242923913777966502463698396945141091/17238232824535200528) -154179655228376218743158291724235398278770272999447263973992852061897564252670941977524115620711/31672662964580000612902147746364535760) (num-test (+ -16820231344048323866426670709751443650129113909724546927974450301780935205864/4879137683452153951 41987219452495799378686134495924115238909423831017150785452046648616005475639/10470103987572807938) 28751853386830083847297108941057082854166610198448421498169760256533906032780671559334244751257/51085078915429149801779227663330863038) (num-test (+ 106981694162678522688926793970551228214793665448093395251834862896418045995969/12359470989873920972 57736849967187961211538031441400807467468650239660040144967046985609433512403/9148121311784151716) 211534804819567028232303054650327703050869189253958355919997046592895748577556985792570078031065/14133242495605447754080611005730273494) (num-test (+ 32477400086615533920132766925666506741908300936974348739732763951610256880146/9045135183308696243 -27444990730472195954051975667481893116650518055101159075033425831129583042846/14815776448343565085) 232934248044934592851252865496377968609159820017147884670610366058217203617961573611006127074832/134010700820948737148715427669965475655) (num-test (+ -110053921687226074580746319073262192216481755737797790655164396095655530752161/255625377233605953547425802301922658850 104095037267817888539158192425982072195078148060302393917025130946535913363779/52156238014583575190277280296975732513) 20869334635774913818120011435677143948904421430726712952150525645851498022294865158343391008006649321440592131083557/13332458017563665620865770931104425383051282278510599570476131200251352190050) (num-test (+ -29732769078100192507326444863945498799317005912797369958801703828462203585495/153426302667449722633466432797809987061 36094569840376017510791155197897623093337784636438580042046806320700826250193/73286165979315961333009750429763545174) 3358855747298609357265422062476767573626163217619249414656940907348235709105513077913806378841119674678021275101643/11244025482879487592663298816607141776071841230792806495601092332558428993614) (num-test (+ -5942892427460131788264792587455286675871284855854073854440582948253436001319/42136930106315714728428443448730580823 4013357443728612356640061171485791666303136232331145404661874650095235381569/4039594279673425548586623641599574814) 48367895947790658831309709091377784501687363167039737892874371817395083020674648576881857510385191335175551957207/56738700606823969419119152217721454504573192499839513549171731025354063974) (num-test (+ 83833896550100013648317056712064289497247852876055488793078639582729685477353/188580876675619574786621140720273228537 -94310653397371924313725082402708514144086936359594289802762093989853507835016/223423274286761439988276492107364036191) 945257965914081840217765265999453398105151083284254483307155736205796420255026737575918161700355729594975143830831/42133356934734885127066999419230498520039134905254787577957770920054881982567) (num-test (+ -14753992026457621496269953958381833108089826525439816493815533773338622353285/187171041855711408638339193132645929319 41340837577662628944845446369855468662228665858415210386857356535970453143469/322471558852595372991189266479896691326) 993354944176102401496932276511264091214577507066786487301109889019709943488537161608732610457423116833164991120567/20119112546425211128699888199278894685207186285215928241217590790016852128998) (num-test (+ 1370528773439579327226257222995383030603284075640526658282329726447335048230/305600505683287165495713194488435114383 65450762047588146235054351616480175308174618406941901794570541085963681607527/78934496562987400429145916504112602768) 2234440886428442112499564751364146150136438855986167755259621093816030535881959724370423862435538502079424185584609/2680269118389404699570998335430047660909241475691839354273569734988880268016) (num-test (+ -76890617375308981455205142622328108690129081798840077873315966300000409208129/15716637731576156581128288257209679492686622162926707938907282962815471734862 38716252217351070567267262306332875768795464072349655597599997486613800623507/8966639693620677733207403249675415446338239705879120765911896990394928596139) -80961151400006413290662155450270992168701818633203071886556882897757813544592915596861717853520674107309124394292702460320442121704840951425284048212897/140925427734207212133604717335369986754855062343668899363006574618520848268718851310007161609443093589067206438198588881828988648068282656538084484897818) (num-test (+ -43290760758277846058307167265569849910514905939554272559141355223092464986939/39390771697068809730875092892395235497943839933482798653607450783947201796777 -34021960935937170163894986285771504067448629886312440795733904794894095253649/106500928228745564800818258673435811176493306775154643113582742982704678574998) -5950657500399238361998292872481533631424138885403498309639150240712482075115081624153513501886127772738596607451116548616099047843190357858736503567640395/4195153749384427435979718872073512266029328962522899010907363614544821318917440413166534226890289043064894115954085809567292470182917919104836361549181446) (num-test (+ 17906146982204022925114071077515882010955693727109005464426577098738402001871/11978213712662686419384559301746021856683603106261241838035626618416021524231 37108371752538653389309509075248119316034595087990649061240232817571629131708/23044877611981158676785639370406786635050056158699399001947422631523989139615) 857136973087880657664203854652754375000000796400911171478039451763440064550649429609696307332611304395324153178602635490321877797571177424460384122636213/276036469018466057777760709173569478463866562650149880633721199971933767458324034017734890892482223472007882939609440193626728031771767304374122564511065) (num-test (+ -77062185592993847534024832256462395143306675613123510837298699277378172890089/108133793614758275822883834459865239455798743725021300772336023406871185253111 11169356025540464491224577661206910726665825152149521753528516637690366838655/6369000033300801574913390611244042297918207179453133439308688067382050608197) 716975776667538986425481530620118513423964367153518065425241139444161780269039780459555836804116752462325735011822817367819625929553250251515977390346172/688704135133337463423649074673019029541747166391680122270752018123634233590688096940261480888455237095078029621363428114402137147558304641222314936350867) (num-test (+ 13583698920327742567560325715281067532806062839142769830536738488850089822247/37364394142255392010559408553278838878570049727027927213977555360874308098434 89809462356450792524214360688853318641058652796345720882094866396911421360072/67457610947238032712889230619376608100793287037427539672885124981055281513463) 4272000026182362299819817378001862956001381379478285995446709640464951377212652125169846305230835604666564953883168949950485767679005929254184987140738609/2520512763327523955464432226120154092742373168521113224665257966793820057379494860454732800329019773731110452438496395974166220481124541266348389100216942) (num-test (+ -56124163112538495128545947597589743957824668875494126834084658670528264380488/4752969512023182700122983723156599300062332404522277372984645779569746369511 -24794747728228571193100294011820993825205231022194400752319729320185378063197/98168688073468429337427023004226732413974455700654808087001957859427678524065) -5627484141989830997868845457242226973925524393512774885292323552602180052845805156311097870316601631410500655735815037997645271136502511615781690896430387/466592781448509275992390948177487068548424631274164031114910250651063315574511979617153568070687706304645818907382693929886654490427484894987856595782215) (num-test (+ 17009115185923538769.0 -12047631083067675031.0) 4961484102855863738.0) (num-test (+ 12677011568664239747.0 3269056182420253574.0) 15946067751084493321.0) (num-test (+ 9315504781982082433.0 13857624532376678678.0) 23173129314358761111.0) (num-test (+ 15226508728194069537.0 11481952022080775416.0) 26708460750274844953.0) (num-test (+ 7461641943684774743.0 12249026721402718630.0) 19710668665087493373.0) (num-test (+ 1180469445886971055.0 -3208456171287181032.0) -2027986725400209977.0) (num-test (+ 18358552990465743315.0 221529797579218180385160273426219343697.0) 221529797579218180403518826416685087012.0) (num-test (+ -14819874956616484359.0 30498815629431206969122152847973230849.0) 30498815629431206954302277891356746490.0) (num-test (+ -11781881800334342169.0 112219460388643619332860331282276228017.0) 112219460388643619321078449481941885848.0) (num-test (+ 3570694277032201957.0 284821691832196381859344006870088122712.0) 284821691832196381862914701147120324669.0) (num-test (+ -17005463295060938595.0 69162171850264911722979835561124066203.0) 69162171850264911705974372266063127608.0) (num-test (+ 15647113311796203488.0 150750467185419235519670165664526735459.0) 150750467185419235535317278976322938947.0) (num-test (+ -14330150541101371097.0 -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886421335353882155416908.0) -13054027994001826312503071338715966858478218093171762021549815587520723118772963817341751396703629529810372702877555022105594068768886435665504423256788005.0) (num-test (+ 7406427184711759740.0 -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336084100766391093756252.0) -4059250217961011548005203450962458026528281798230141192186669580689721046971433745892994467792118611646113962840750314719233572760336076694339206381996512.0) (num-test (+ 8819522415901031498.0 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363793325150672647162846.0) 7274905269237471130619913887005155660991437201841760414347836177003483932007334374478344594178179032728521106519295465031750530183363802144673088548194344.0) (num-test (+ -7242932332215698200.0 -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159009687703010657137320.0) -10558564312909325527488520195600871241245891651644550509993750377630234801225525279855157008009255586978047154906058790342845859331159016930635342872835520.0) (num-test (+ 9794320575955609492.0 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470325394342993771343357.0) 13380937715397052566925484435342184213544885758759259410983243841206628594840271850190097746775475837233042430565529099681550277688470335188663569726952849.0) (num-test (+ -18404048401680891243.0 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224482801864925665484770.0) 6690884608978704096379677348142836785900717005050936986370615083929607190833180925295418079551348559691161519822750772440155040888224464397816523984593527.0) (num-test (+ -10763220363947284865.0 -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521301209899829037444385.0) -30985722824355332972176356513316569304601382411274079243859710673739383446566598659878378034375348869471278415635671865753349734809209959160389615096293457362383744562507969316522225741589739150453090393424063226271167062127000223628785686999799282795143706407082119829140399988180879618548495395684946331608899565543458192773899200054228140747414544792128323269250618482622488195333106891323515989863192944848391405358725993695671970811097285270641251816244586360288952156538400321933146150313939864593445583603568771077260174826348411367609521412133720180359748539721570562669201065857989876521311973120192984729250.0) (num-test (+ -12742462236537568498.0 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747534683311506465130527.0) 8711131313747826394504271797986775572294949693272674156076339989631171694968899228610359983845552623710580616605402899155485071497929100432998183040757832449369366844015907530612334721882095163137705867337969942902346066961718232788529860214990099385213558935023241940238638069647809530490438245386869385682221280939688108487754251075630026707075310465788398213293782900699868609660892232563106662995330591906155134237356516622436517046191466823447743155250482328613449506396571170001248589926831956459700467126756876526930443317428628239358666456771112897986098390410773312792390699312960051747521940849269927562029.0) (num-test (+ 9991390529516174614.0 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538345749595968764873879.0) 7879872958436992955898278403297937595295396115022400543178444946646147916754852888072481665174663073269556311758611700754643170639645548596647557683044355930340624784190093631808382820554407595007761070026239341594197877214157118335743842022627898879376346092898666610367809537340994845045475091410516226225078052019727419030585524815982151736622865401299588936172760762386183577504972623377661437665668080131418564228642443266935225613702941906491478788336262289516199380144218708241406077806669686589734333554945412904560108150202389909124657090061223183441083590340175629756198442568877659538355740986498281048493.0) (num-test (+ 831234034418847630.0 -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606507809487462642341164.0) -744676478858160349467117341859049692149463503380690495147216354303526704924280287782902146026018180364963325847811379182950159627878800024734206345960410146056000392683000433501805629464626281031086102425271022388473812300724085127447081771317912465921636737545371909901577246384446144919253141375367648958387948463576516115079816552636772639965957498569187848459747361493535081532845254971492261148968198806736512864867151355002902241562014241077734122599581732704243705918200179789271894804233542502502119523149682814025979598424744685548054183678652651244898867735764030968089217841214778606506978253428223493534.0) (num-test (+ -6996572501442843347.0 -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314889561060687692538144.0) -16567158719848992553565776505785820491834685475229611199353714982570065913508303466008005931649515528390057456882757990896824841386431756898386429000065518724021230756426613661219891419166146764347562529640689229693578574350948436847247856000438153789455857903402883189892697143647998643667467614427922009931545254965075041050860609824086811877108940020349157317276288348430058535959434983921323332907180869396258655826781438419383792024592535415693101119109484610789291889841197827977530804650015884500878613240443324806805475203272442094530735476095374446946252236490708915034012846683015547314896557633189135381491.0) (num-test (+ -8920936222630165483.0 -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973494705119572045938607.0) -18738991973681679876688842391791783563249057933653045519186959571392922172943405646958686202208790537612746921398028331540617848217445632123805070077600768524509025758950743971128222843292926773668584735575066246660802064630842300367821042873152766467703905048558085377302000898639290554395913805527529259855535801856020623830262396582180677933562523957295341539162448074423901242873918231922121053192425691524797238343327318801359521456598967984637483081312932069399045363737622797213185099130529375169698811801965974416555301085043300426947769193582129151016159057101028336667142913854943018973503626055794676104090.0) (num-test (+ -243510292488206214847646757340020705642.0 5940577100149745132.0) -243510292488206214841706180239870960510.0) (num-test (+ 35446324064743728955945058978206455057.0 -6248622708755929572.0) 35446324064743728949696436269450525485.0) (num-test (+ -285342226760657637664173494795024413673.0 -11942737781617905307.0) -285342226760657637676116232576642318980.0) (num-test (+ 180790435817422032042321866247362452865.0 12401641959336396832.0) 180790435817422032054723508206698849697.0) (num-test (+ -179994871947239535956826388240542999950.0 13573822506399140772.0) -179994871947239535943252565734143859178.0) (num-test (+ -308198027295905163635866438671452347268.0 -8790069282378476990.0) -308198027295905163644656507953830824258.0) (num-test (+ -139324757925833055762410227358605285566.0 -190622873846936719063564661032771271922.0) -329947631772769774825974888391376557488.0) (num-test (+ 332866352618304570046318203427223999347.0 147978646177673305481282943528696833018.0) 480844998795977875527601146955920832365.0) (num-test (+ -39471620476300923970352914034802271156.0 28992893610776120142668950821916856486.0) -10478726865524803827683963212885414670.0) (num-test (+ 274120253734611965146455315763505869288.0 254675910805265090692978775702306142625.0) 528796164539877055839434091465812011913.0) (num-test (+ -122086811464559635596206661886176775901.0 287312583034687582188356355813963609701.0) 165225771570127946592149693927786833800.0) (num-test (+ 288576174771266329955482943556556984728.0 -57843540651903655425270706396868707777.0) 230732634119362674530212237159688276951.0) (num-test (+ -47977736580820486006305788441965482221.0 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126881113426109906085249657168046936670489.0) 984809271313988066640898939725532304075331399066274624928410251834520283291912387208948664716457549646483445981126833135689529085599243351379604971188268.0) (num-test (+ 21225484205143479814642328762121362291.0 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974867770082516862899595554460170417713940.0) 11839789093732539327981861490012713257538550745921177905266671749716203131127256902110452504526721633943016923389974888995566722006379410196788932539076231.0) (num-test (+ -193095363331703875886398909106293703000.0 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388168068485304437343508442251302846768269976.0) 4389392021031719669078675478621418677903292147307684123866099084349756491860737402449105804868232530632178577388167875389941105639632555852393740474566976.0) (num-test (+ -14827657635864183514988182371035598180.0 -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660185258676369175307019300952192657194576.0) -7256545787852407071411458891023580461638051949278710509801472046178301830006724297747051044450550248499056073213660200086334005039490534289134563692792756.0) (num-test (+ 54301423175725658626298504084995819705.0 -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941312995898184903431893212829646845766101.0) -13385853291610595576947504757201441006088030688464261540642594993520424631577281077984278942244446266776534612440941258694475009177773266914325561849946396.0) (num-test (+ 195114404067053480147948948510253723990.0 -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176374041758276069255591562198514767063594.0) -8373866462448797623435948949281383906369538962237624940506813188612614128993186653340202956656303504523161255703176178927354209015775443613250004513339604.0) (num-test (+ -308030589512186791277525017840002670741.0 -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550454815591457829485684936036414823492160.0) -11922204352024596469278978325035646517433105521287613403902396944414655739824695945028308092245747333098422116078042326104667969967224788442970266049942774583538734406057081597034454910987815490244451193242377705191422489528853976486607580169986057592557285271953385769215318545520155212402919465580052078255078759756709086185424029620805084776442744700501748376290562843380642608395240491162047933014854466267084965223593172702334466729933986413870670083326499598274393380692146118979961818816348097032083332695128587696590646086980241100792624502607816103195636761141133903550762846180970016276962461054254826162901.0) (num-test (+ -172649878347923210775992373331623646864.0 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447760919715595005106669653475931803053499.0) 22180935775581457002090790736532281654456312526625354262953960635330604551829750571440878712430708012807252279301365732385899228826740712544768476577874129759972563823209525283326887563301081200476495752033290851190327066070873711444930389093339915885090143783170994309089448293499799071372787520776773788274677288230540162485916160484352398851925328125588729604931589867889917097887951581817207079060016091919559509735997493084833476849835444339835031436580214492450731100723026312163752403946315983551266206214298679421644737804098691991631489261658890937663698502561036246447588269837247081895893661102600179406635.0) (num-test (+ 17539006966816771902104329685391462527.0 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507917720426571969997513984360849930719808.0) 15609797782337099611892065465036826453911053690739041627254619195700021040383385710184052653282070244915503750549545390475671883312314708978681904377133928647935359080875691628246716591529028104762422990155477702994042953196747769893182153631482194578269859879402160062955490194674372351117284129320011166238130774752386987036267064693133554447596069886693581191241594745541512444806003236372840085705813835001957163976961730871756250344335996073970142337882238844723800849054637237549515249957267772181010402413375667537558243971058326641257721901094391380667244006959028327507935259433538786769416088690535322182335.0) (num-test (+ 244901855797156286376563377540855746602.0 -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760396535767621855642720080219960822554492.0) -22138106346578776369849317622304392466030036563754663379976505966920461958652141160336156065177498990718609170201272980114106671808245437660234479124938853665375934080221740523696180221118540569603989748587853373569525751680828044059607889572522502629277877343410298879764820905044284757389006201848194571453112545228115550224254565141563427486518108434758694923122284117299374156393942906293546318323661938734959824887786185558612820887463537294120950912969343488704744978847504513710882720654330147775174336365363311173472002077960424794151168301281665765411704505095008907760151633911824699356343516842419966807890.0) (num-test (+ -119403662992279138748600939857239307122.0 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953732384499190437432898387573320391878853.0) 26272999248235953724172008428088697264933069743507017434844709711501131900922919455931092196539942532993887162365511473221418376205773427597933886270411672062672089518774390132453916538404354895529975888201032175628249480896964400801763570333497287321002961557096975786141940970260074557095118887294558700145949117395512768347250531196100831164663613049206690894640391431616112104502483838173255614981302462548882276825096564828583591963617871547373532874400764134244496979962241959713525053686209002866840900623246072884125102845824992994967009109046451949348656842486048332953612980836198158294149786633463152571731.0) (num-test (+ 313963939617834410089002930298454269912.0 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864354021315490712575535559549015858088608.0) 23286645405607099799151331553995799851855144387826191186590140820016670502830395945076644578998873585162998873396623634135231418574284200209367505115739462344028303923666952261030907434438322884189133236837089851688275865098623902644385995630973049587854251981548128145516004461191094062488421288607625783540996659060285661398859383778209495884203323937672739376151794507745282074538961033778823733980759695886879886017489555795079194346438911010371103435094677167286870898482214310646392174423422237727456012197253183422715313378603607058548706460095379882633958651034759773864667985255108546985624562479314312358520.0) (num-test (+ 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160643580198590073658869.0 -17993015014355471903.0) 2000877973959266893810594143560134441447453310844726478119781029700338468704683515329516333146806175216349912753585564808803731447160625587183575718186966.0) (num-test (+ 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942609010590873980143878.0 15372278140141207703.0) 5492930533666246223206322654398877802091439062008700770880939594548305919677404080859141226095489505872709347538974725998600861651942624382869014121351581.0) (num-test (+ -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044148223082253439210893.0 -14793401891248640808.0) -13405500833215428652808705089190188280715732437731292502890523313631564795139560159124390691283401484515088713758307366404145018349044163016484144687851701.0) (num-test (+ 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149274871082481174186606.0 8699133332160461067.0) 9945195259699924701593703207751086973468898794114625092150620088406276196469184233537941913755508476427888065765634203723512911676149283570215813334647673.0) (num-test (+ -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146471920873844686294838.0 -13079925952361275418.0) -1785165974800693006461065312083337532938610906605533088558498259067461510781028452552786542598361030690629530721209490413999022804146485000799797047570256.0) (num-test (+ -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311445471793936775767736.0 -9381557743227419896.0) -4861207515430071951958387366611380234482792653010151054346367776006873932152600469133110239669746470475230906073865131648496652783311454853351680003187632.0) (num-test (+ -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094956858541960962483734293877093635361160.0 277811698220276334443479876776376776138.0) -6638723469626495957966112633999375479181736600737250559572415894485618850919815869703127084789143821420728194272094679046843740686149290814000317258585022.0) (num-test (+ 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240709059499894818265755197559390728940140016.0 -118940994129137705779355371753506018694.0) 1983880417172931934469534542170437296262471214582817006917470485544552211448284732460451903536334682269123998240708940558900689128049418204018975434121322.0) (num-test (+ -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454778025302197744540571159656556971614966757.0 120224841184491944160266976391113485817.0) -9354509264984586574958285335910611806441061705184818350015454221731287473282231343722010109181841005578131927454777905077356560048626999389580580501480940.0) (num-test (+ 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237448178553189381274150213236222139873594.0 106674783386899772113212633712093787897.0) 4389359421234641412950681847970318834150108533025088077429496538447029921663033978550089607257809597829358374972237554853336576281046263425869934233661491.0) (num-test (+ -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448907193562300482925125162731530249763801.0 192969103435503875767216559494769734726.0) -9319417879153488839579936799737117639058244394679644240663244688680826325564084529474537634510092069422987165268448714224458864979049357946172035480029075.0) (num-test (+ 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994228143957746922511631911996296931168332.0 -211230038021470285136061932161632203274.0) 1394404616168163951844558734723678125985464491792846741433683801962971891047718103736551854371207400145441134823994016913919725452226495850064135298965058.0) (num-test (+ -2935941510094051560788359387128767361559188973149773593522440619832472030019457317998381634585179453958737810428870232715146002408187749944694186205812791.0 -1221176156661231926164756142840452419679061324806989304452215660535991083923207702827717652226257158321829748247784282139952864899457896871473184473608543.0) -4157117666755283486953115529969219781238250297956762897974656280368463113942665020826099286811436612280567558676654514855098867307645646816167370679421334.0) (num-test (+ -1338674579024795395027232680327531457830908239605718353094975139226848400289367913459076082700361212506196070727982446232782659114647371030398516119682505.0 -1298372177520411182435886041880377054374169787570856408996533471838082317927648953576721017727347029007573543972764860712708420553928791798580799809858729.0) -2637046756545206577463118722207908512205078027176574762091508611064930718217016867035797100427708241513769614700747306945491079668576162828979315929541234.0) (num-test (+ -2072456075229532951804023218627137969798924912365258263779029006567941400203608770518731715660383378937120213112973528605594220795605977413985543331908189.0 -9744489461776287963808523409593616918248399004543154581056479712028497082820841423941781438667661074968238703192056877665754560746003512076830245760254982.0) -11816945537005820915612546628220754888047323916908412844835508718596438483024450194460513154328044453905358916305030406271348781541609489490815789092163171.0) (num-test (+ -2570682164188734368809161664810917340861573482754788446510182252413437925852206735928397938304353826925422441004271229738766803460790995673395984247950088.0 656920705293329551826685120408221577679101260931105312141757138825917579070505267306626244216341686712802796891966598838285570807961966448181138356047523.0) -1913761458895404816982476544402695763182472221823683134368425113587520346781701468621771694088012140212619644112304630900481232652829029225214845891902565.0) (num-test (+ 7846359203342053693101523606887617345982401999003795257520576318451663998927274759872692123323796450295314377046602880394071105863527900699633560551732837.0 3683380639347829102597675045842249667669675715600522157867595962635108482512780509393310714588544837398923613138772339053021025559943198965234376657126821.0) 11529739842689882795699198652729867013652077714604317415388172281086772481440055269266002837912341287694237990185375219447092131423471099664867937208859658.0) (num-test (+ -11692323148567132684205145901751681947225824260005631214936266006610207543813382900867093989444659986091234552140689684476541703112098935301322850961583953.0 -8534276689564199122569555420819240948691777228327984555753862457592427992599992931175844172478864477440165366128106812103785256271256853749622592560655914.0) -20226599838131331806774701322570922895917601488333615770690128464202635536413375832042938161923524463531399918268796496580326959383355789050945443522239867.0) (num-test (+ -10734754884168724884333968138739681643742524619139397687680049322697740991391014196697040576174049452737571835233123127815762146577096625434481167057340772.0 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797378799103456094203126081464905326203083057134061673694975250599375795827437561275156235513192978645909947341297774926450637694325145427434486258223666250272.0) 17059878151450238567815178684522345445687980385106446646013863901583786249398194029757376950491550197185231926262467028755342392379269039238766592672298850588065335172902157386017520689203005559576263548017475991638498600879259882041932152385436968424098224966518534467302264172016376096778201462205990822825056602379115848799619564610033123837036507127427054121975400703490855123544706355545059512146550901507159940126280812512339749605195422987937677650572797368064348571925478241747496766586521439314609442534297287570550053098086446170260959538472616804596457209769462541803322821932178568330809051777056608909500.0) (num-test (+ 1982582032974021971225071139786536402936929744496433027195224299475980201425925452469321205602618940472354066218156609448199804973454183972974358405933935.0 -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565757325842468006824235119684861972224857533964558963441079998949499582965764591461900562931342373507763081479989957632695010603500633322408246084430203281475.0) -5591374624026484498020036332218412149978824230210339582240360391202660977358546150723165491729699122647688030937226316069237264083850854032732663284717882873051337566653841254365703461654061656817936193716386141166210237666314879751427421825450110467888973152907618520704486700443275358649289847595635931220181024199692771066498714511145489237541761266539978351840438236927937894376002981658065431416811632941197501676956304254109064936038146674412392128883565755343260435032802263894613722185688454597034814467008052803725200106985563165536448093610136770888822609125923739476085562403695659868224273110071797347540.0) (num-test (+ 11532228364136654310006206557545352284448588590560137249197311142901246089838098630841794341370689745410654263817911440601934362503092628725755210859171724.0 -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425483901920822837775032295913486152631638908227467242772081310515646217115760180349854601959031626524004201825198439309850266508687796415478396821644422350208.0) -25776236925500995542036591604259749301547568770017466769502569415611770276300787105037848049555500555975152877716727294374436703766730618054071617947449695177320842403963009384468257891933593584757723535299746543328292715942626303315235241470269740287031317322772461137186093930239744879822272349431389779234805703118929710210161489122272898252221025966631463842234537744822906696719691188223105175714602909117904182229960075276443648211003011686250829474364425472369692458701120722289706928607279354459638876682634832113204503315869670342251223760164690255834258791170934621398409664574325293322849671066433563178484.0) (num-test (+ -2603756427337798371354526130541868239006085657393372011847827118826669474695402075575479286172808099892726251004549675772420422527946534088483901153485670.0 -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463663570751134804664228918188923926951933302878771189484614604311920655871182974081898031051411394311700207305532216445616083858025977851570522763537300875989.0) -10844269742362409682236511127219508926736627172993604953084481596070757241623728297275447608738915355190715664012379562650777199088096670239050254578284071100042116609747208178716191571268815994455064584659920497876052406993834873124981417288518101426395560764186717660091472734401090302285129741058888303693710456902635092811413971399734306158050053239768185860958896447298052082493590498954512083131068867270078638929796561440903919430094619437872896595720463666174507562142462600272715054468820172308964428582856626452139039482540657669483973606530697567119800100031783220995291856278448505798104611247438454361659.0) (num-test (+ -5929887196386997518766568868806997104240129372360669348628384183712406620199102166145939206783172815805659513128544493795329100599632286529420772709366102.0 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250682015641747568282510036326125505522447591703308661608718100933027549520132308555240654655887041040427813131621391320267698106519650611462269033902177180035.0) 24544958491142793859949310604465694574872439331169358241746200808802938771527900616394258199996170862256988647191747967628756772368808644819831481350919782560499270148419601775750932556119448001824346026042068416905254113155445053931789404515589532235225580737103411251232560863878948880220469490014568323308965914171394449781093816607870593225534700167342589927524232815571862258490314644577819742372918446373756857848586825568514909823940075182825283229026250676085754551181284991269757256698525343351573936300939369472548843837113512109453074508716680257867612007472108262775773902777419050979175739613129467813933.0) (num-test (+ -8848084327536592532063677611386811805244460767433749071435930786126721080365289638381557872263825830664387392539638767251180242665642373539064690745095464.0 -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033893238864631158195280554850035949666897861529711006187241710164902350100555999894332438423857208747342184052953230247487231455921360593096823760117493579248.0) -15917950175678012281826361248776190984758236997789474333609547749168308439513527143790323694526378056113636462939674273462177686456811495629631337058042159570336251822399402513133598701991665209363955263097315081570618652783181494594400709239428597117944511110842795526862595552977665064029517628515465251448116061875878430407784298951946811321795808932206846491091803276390661869369638950672478828532423383951689632136029256108992610781912267083149156104328033902086948958694787812618527647336478703105990478439936313146095688476821636365183970819981729472573172848440345769886254482636164026235470362824808238674712.0) (num-test (+ -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679396721657020438979754.0 12553426083939460917.0) -16314775600714318471451792035636584056297958597339492996728118376578145765736873313518831390349547274517050864260054903974054712997529177834428786007341762649083404743713562157667828894017440065599882523458121037421757904691003094608420565550031561905074671735751685371533975894842331113347413787808917193134135744321547478500861021485075363990553639161661734684228250909589741380076008551020384304303171431833670236949934603973673998262066558668396388979463892768199916011368116729432353268535563246463324517035331079693172060671712718486388759443825620676228470068291448236914050793177812037679384168230936499518837.0) (num-test (+ 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269660274683400619225321.0 11620128128044940816.0) 20637030084881771176788188367974505419050866216433677435050410899110162793040751338330447574748263391136356400036001988938659722098883893353523409458775455519257672423829361150611806294256710309281788819450225670112435352092313483086404714074567539245791066202051788986426960935796927738180831688497683293306590464598379493141645539253898709000874685535467854788184424886911457134522632486730390913239660179785071885982403741669161655812015114272497907946919026898579927936299607156006210124954460880383605958519412435713868501997649784658832599101777001703519408664662715322044086646014163774269671894811528664166137.0) (num-test (+ -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936248281049628734475702.0 2380166482232871816.0) -9838804688358141062268493389453191808060717708062736103828856866310283812230958467655270667206937622979717683919584610288962829724022506216738929136418489468786902364550847498615864720240589837282441807174290461916292258263929411081218952357662703079709351365960916688275651864441386750529258343003652300629003597744958152243494244227986280506395347894285277364095898602965258114321853474000520432831298793365139040664543928707100657375292032051256485942532600998813627925626928634068613637417702688610315924917761411247617905738119218110678854564441914784262998574445847209847985439514580300936245900883146501603886.0) (num-test (+ -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203373153221004361953729.0 -10586442965055062759.0) -30961575335426221869515496362216292453766907587859856766456625722888557357647164641922707199324601608700561081422636642523431947551124957385652791834855425829101761914145137205962610515642614866296480715893528289170482422505734612327038754622917335073993027434927547277037587173529054849390646376806910407207016292483185533697336599641898250465186168797820802225861771331652801064811222606773495565340386327294310913503461903243119204619412324538886439122443769008953829820425376589389335553937319588224864611583436327810214798652896733118881040503785110481197462772022447173744898802421806800203383739663969417016488.0) (num-test (+ 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642592954601418753021512.0 -12227722924075527556.0) 8835746018617511846981408800319983340292665114153404569022025834059427359831684523399830234196625160662387716033871154398104436720494608541518837969397374272734698261557358249258503982414578618525420572597611597792132117034895074841909295420434392963714805547538976612884853497014341345150095544449860198192757839489063747595073430612069212219930749783824683135433987509303139260133564905961552149844964215891730262218278214035649706577154652729844092199333026620127958228847111442161350881527928460177763370427262298116900358910460957772350452949782281117704005514462730290063772968929608448642580726878494677493956.0) (num-test (+ -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662935026125770444036994.0 -7349798942312432150.0) -5455184800550144006991157215735481579353213544152145628297990102571936052187486515129266239245491863623978659179559754999567936067584384479787934704340911556625153536160778495579370425428019248950494107696016864499055854257192071541354806671987402367524770228296322497224645429524493838356022616251290117624472061673033274133156467148770562815676767117605001434288573911556053311048284534341905722947046607192815465807736361991479044698448267471087552952494477144251510778491315012457514838113324210534577956298926109164909779987221094000880908857594198276812276890284008572664102792405452379662942375924712756469144.0) (num-test (+ 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391843039459733925494003066841874935048611.0 -66646390577667468207341453008390168215.0) 27233955893140063612427006607965940109569052437681267421929959186535416115028420267622879017163568256526042146282241931623674996867133390355390677118211537487769195270234259640386625552763891339073878417517169618832945750393661600092643257470064376916337734385887099957095417541169462231630821139075814859604097878094729685589777579267192538715202397220666651307185763054526407234767132218634060693076054116575833737797189157152326979078121760900891899319809724675232853322526718686306470372869701173824664984405178677187081936624687293494821338781534163633206006387449585716391776393069156258025795725388866544880396.0) (num-test (+ 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506419828208611247177336492131262918439281.0 -164048419232636429449474429717211197442.0) 15030400024888781078933103028897733817304421960545019199443871381537070197157227994520524631721701055962609956080413517776229513420814407790533237358129529547793422514837651333555776540939235592155512951229106778709351772195248438493792786143040421233061520515971787881798980515709417481015662862327435825812557205663033601853937647320838585333754027488605638576977560072206293290493215523194883494322543800546276353830683084405428005815296131527861252717516620765986589669237487765523936713749717927502645633123584240464131140829496052170285171610845098023517906586134613874506255779789378610747887017701545707241839.0) (num-test (+ -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300146993858360430784079225137421074839819.0 117460076430162201914796277915447781936.0) -10227062646189307616073129048534031298512434237226774743330733206156788005874968173984804649812506029813402205606562016228122184161577517837608957023376079537037472977098465137152327215807765130656192272994478964341604278041664840636982572214751638093860605132350960802560601354006634296348422600320863531059118477125143903734159707623839282511184908969206873548650544269932394344952983661665472663102992782521888857016369837211403335306200813816060883478434441858442549261115972947741929087886423170398410216855322384956160289855500229952405068604320121652911887067414460828300029533781930268582164428859505627057883.0) (num-test (+ 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707453499030166286828319347894538505334235.0 -59175168207571178843658955348404514921.0) 27989453264793973121573869640708223239762902243991948581280654553806618470632044367386680716040316895884976837122054709584963028986161694425215067648887944710852278135008221491665079705797192389681328802747226171436158375378499411314855257919224316919346771317457123252623293612958336691335423245293660257386649100685560072354549579281852792682734916555498283053758141666658137856828164206947320523255487437004565021167276952652515632644458005291855624829941937578229983628962137595011570216766689546500517528191189928660433013004254032861383790553611840534023221000900694995707394323861958715649475688939190100819314.0) (num-test (+ 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851829184120171969918537718488250577987049.0 -151873924489040812813761508259707631973.0) 1178650930337394440162727078866515771626896502845852711186000991913866844090831426017480263676964607121490209778220339316756171449922437605552456088105443130477974682689512446683178356259305893852096425478878588001446154476458310269704392486398646169362313605456233489086567865316333034897433650974160168545492823208575634152241341906068149887959566983066154182855136114289266802474404127414747112706158621650063987662749553991791509795764642256261917497984177610694405881831052199417235241109412927893781778469398975117797578753730248539151297798807326284978255001046995523851677310195682929105723956979990870355076.0) (num-test (+ 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821222597665222975816418433744748143385431.0 -43245950360315656184924888243641533635.0) 28233332719950979786871881804755080223325040620170668729385709165879717973040387558150293205758215739710262749733170837042434162049732587908182282319848154049410849721309988807368466228286699721201975848741931128639324322061892706638973259354962358866000024260698793885547287093369940035337370984725857550291339492871017395328145015077506882578124550084937438336881072124376107623716831044079223921566902242543198986921476998895559488862309653154914291349588095330683589871173449191854284433182368052817373384461363574550061788800329400860372148193491004593903732351395815409821179351714862660160233508856504501851796.0) (num-test (+ 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830415574905929299482373462584995162798576853564481617711234957058703455021082855018642616999836886763535412642684228990890160568207941504887072856663966242787.0 1954009743321912552050341299974626734964446274711484506734354360114801426013796892421541915293157994203607853436799102383078659985249097057923578528366737.0) 17311283930487575047109155431670372891723312431004343097275158353815289445461275098157423001160013464866170709729134076291306322952612660169010483426086431377525432637844274608988581691477819008626983761905899834444008235608280930166913911248710072733217113558125600345343437000427963292980921009445490627620344145866648036116660335905940809860199697939729919140888034303887423527841395304960072549430314367914315102150378504502158659627719016733307736583749830417528915672621394925512926295137425311818010756329195741691413063569822508868815535038541752179921529616250537665789992543646867926753984130780242494609524.0) (num-test (+ 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730196110477118156871579503345757821268248575583821695674912517830056856597644827244194658166928026249459511837772775196175188368236573504643083995409774002567.0 -5513982495816270388232134254127393284677692173792609278582774509636977743203029647121158805174638642867428501907786521939155900331399058909602425073976766.0) 1135960177108146621604027872788612991247811085764456406834564014092038611848908717507207251239454266163702244932570537009884467598603226302482406831131219148530146321028801515381981782506355042255201016953375149829517466449677312249611502599434850555618739830488706171667035140895674806873502543300909514568759918040129665855731078258004983486524477103833885001539135541445685573269814159175744401893663504523858005835387122082112362666991112899837534230326730190596494622340601191271211503693874963897891647903065633935055547219619901624214547537008122851610816644409270867409653249212336242105584174392984700025801.0) (num-test (+ -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550976844117943559190671369193871330514473741920389633762695829790016565565261170688485790141638094160105909405353382982945608773290740598479367828342651860878.0 3451570547959142767282758882796967240086418127970526029661337442068316209707489088420708984628065070358319478649952710478991064476168799556496237099109563.0) -30369736932762868789456108597366835061749107555998091727589163626331595118680326568212941898571309672187038272915036839449380083450246957904300051802617002374912724325419651633014408152565340519439718081357147324136023867003917288524338643759680061563616479323818330115572573568245719292922176485298767387601922362893307843067637295955606642841006993776777666041277965868780958830666697755738164183356399977211227424725670822944234275611849032230010745799964550973392547395600047904086434988533547233655502261663236666168452574497249051463199397369432653466095035551085874733030235129782226264429679811332105552751315.0) (num-test (+ 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623397410528064697616617917065021866397277409044449982605591256067763430930720398889239414812509701319783809830072841056369381573100589260104551934136733317845.0 -9461623592584966196513107657889418526847060851423069480904645009418813160370721071067349946095573698635859409908288864150475056170059858850823883834932131.0) 24749014370880469345815230363662696846133977441600857690896762642529872426102613384561609594131771018575590861342023688138502403609639138062665279129058939911797019091643704220495944170754490238422880589600838613701783818105188827633578438439212856537589855796204839275633245851474930725845096235668385012500773524750522781174430369067441632028068262240870795850561389232369373523415592833273932285308223863420210049445377497367753786125779044716949754454461623387948904472112650421403957363976978750561983598559536110351422754012117560028168168347462563605746085173970662932767505231098044419200245701110252898385714.0) (num-test (+ 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787710331228500533067546198458251241005176280410230146430275074766072259256583499095689284871987010372039977403712023630453400259082684930755893684499232318008.0 12330599952818018622104330691506128012101935028731995985677032980931398338453806827555760801312052792065671886621851470997557806941112316627790755867100463.0) 19070246171469235561279483225919489206942407814032615339351735800304747459507922411906751965555240682457214768298108831815622470433175555196912899313888991765436434867025639919521068437191248198117664398275835972573354886915721765715992151871453808224011999677700078879590132676060988550961950472536029228350169237717222998397029428440792110955380302156159849645211726041489206565536560827557279129751110297078563108009278363910936720061216511798518178957070787722661828453351086168302788942747133188382345258878426260751799053190654921952902516840632788322424832043075598645481924397816889626043072521475255099418471.0) (num-test (+ -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027771176714559050403098437684091684851207513969915720607528045624635094984539637789113651579846373399975502788877555747414523231999341294756679330384323996.0 764238600803843266244444637050072967342049538611688895792923539838804953492110953673720766879606601435939162680753428779068917662740403667549850724878795.0) -20895998178036569919774658790651496115060841511658297683195804524712012347695091074325978179977718571444320688167469052862702339462089668992243209990795362064005869602003990235714500149401994013174762139297327430396441552225926368085284222509085197484452650071390132794942944512235132641643003294762547138305644086106533258432786768644384855008506026923783604514268955071498269812887794817192371944269611642901807443894686178438687102834127061425955994253034824027006938113755207136853993047041611883865464431304031711735122084796290031047526835439930812966766798539563626196802318635454314336600891089129479659445201.0) (num-test (+ 6243894672855694190803081952962387322599009058758027960092936187687064819462191583137945440936085088260632250436567758576422207449236613172605950116622271404444221039084346501796818945639456207912207604248991842124079786471250102192718092353598850889806607728696519257402580732995770031331187089424192803722612735557735028710899438934171272639518928194764526910590046378401600819132587804143949995694950116915803127294011661411525934100144319021440919928013617766507409909846670172516021888661284467975865076091834094160862228180625536450124272957206172214541444266874056050295270719541605687740822711659847211976891.0 11877496607682442993105675644902145742318375725225741293060927105303783712520284640625374957608051032540491531573337817824773543104969422017506696018037874641947740606655370938613842356322585858034851150595788166740174872996252792014218946552442572806242471174234462119454014379628228878122072189387777413014452140618318641689597452676091677588204537830401725113931418426919671512011822864583481449136550835952005765386885680701637038206002172218712504732572449659704181315669255320876647592649071711438131711904976335957846353867776093588236311654631696625859173554395714740218099921290128795607292259527492722462071.0) 18121391280538137183908757597864533064917384783983769253153863292990848531982476223763320398544136120801123782009905576401195750554206035190112646134660146046391961645739717440410661301962042065947058754844780008864254659467502894206937038906041423696049078902930981376856595112623998909453259278811970216737064876176053670400496891610262950227723466025166252024521464805321272331144410668727431444831500952867808892680897342113162972306146491240153424660586067426211591225515925493392669481310356179413996787996810430118708582048401630038360584611837868840400617821269770790513370640831734483348114971187339934438962.0) (num-test (+ -24023960171862805266003610953999097357395283354964456554686635290239019705581779621120391229617494503580661676939681517550103414632840981987397485411400553792707518662609532504246677658012933762605038799352109564432278094548068984563394926376371580465135388578139331334464060067790936072127680597181415407099723844313625277987147283697141407959289588588489162704824409673099509423520008795428217612706997355591985894255450783091681112776112997887084157623388943538145736618168104404283342039105202585543852590302154958791010622670839015475427693311663800177428904406869645066988663292128104453773413982185343111560886.0 -31939808827732134714870375774276102357277346245583282398423150631754622253109692213928642228787888509211781331649081002266227303203259124984426497846441848502574293640959494009564992092503141598640200823656998243767453860939156780549404892392521391484933772285520949470194562525777116137058001008184603332597820522016200623301007194309404025522056113671560767212894303567191067178003014955596425115379852712737129325098876542459702682095445350281859042779889411325882123213577906096942649941285655935053362468972482748617111598313960198743596285343178242282172686940700127068972627110105953098737923773182254460772630.0) -55963768999594939980873986728275199714672629600547738953109785921993641958691471835049033458405383012792443008588762519816330717836100106971823983257842402295281812303569026513811669750516075361245239623009107808199731955487225765112799818768892971950069160863660280804658622593568052209185681605366018739697544366329825901288154478006545433481345702260049929917718713240290576601523023751024642728086850068329115219354327325551383794871558348168943200403278354864027859831746010501225991980390858520597215059274637707408122220984799214219023978654842042459601591347569772135961290402234057552511337755367597572333516.0) (num-test (+ 14513652183174940741664411990199277445706189147726874603036586212536012746892966848269748909379750612027025331446918381470766609543142456872580466135425754204680927122749772612276850998180593344389487924747722210296498854143380696064338777945015153982467675141485724865534995199700908286263993697988986805404864429385840512740226775506122190698806967785494289035976495492863456705096841250592980439363856397663738211335801835896091823148249303370609165910779981271035234045185574995335952208702661648744928539539455138167482396767268362221492607154709559716065850417221174683768503217544145599044845325824451589309835.0 -12814535978730024053359592817368712576084646962861720729844389627130663192435154658607204342320327460695280260731620465435530495952836598646143907272825807563512741964987882356778796849529260646503692618525570185450780889283642116889481314560395290434301143877809550098309214046129802023655714098730144464028249594406616074059558969757405392170810220921023905546104487938441503430332099605473144930508420331873995741851604525954472341693863067199617721032815462094767522339305487934030130207039176659398466616780628644572276059410087128533031562978399689702766028716401176531098447698206272762966470643604141938670152.0) 1699116204444916688304819172830564869621542184865153873192196585405349554457812189662544567059423151331745070715297916035236113590305858226436558862599946641168185157761890255498054148651332697885795306222152024845717964859738579174857463384619863548166531263676174767225781153571106262608279599258842341376614834979224438680667805748716798527996746864470383489872007554421953274764741645119835508855436065789742469484197309941619481454386236170991444877964519176267711705880087061305822001663484989346461922758826493595206337357181233688461044176309870013299821700819998152670055519337872836078374682220309650639683.0) (num-test (+ 11356479761814008572465147431830778885327227506593483181241437802252618729479905490826767363633131720717461693888023278837835457496021519184903984385091047829540007466025527592005114414671285638168997562037691602144751434208304408870143450743278437854754504713023422097017723330207792526222436928747286558205279330508360438281011315147578105966454344087225699378388309094140949428028313539634103047841948634832398526343605363013644180832752120081735152285507591096001749463421326282317713079361827765412853023201330345752038722069405404812511739634687282327711258974520622248165974215116400638833123609666501349513623.0 -2451734542868054449539778460457497703609327132304922810342762480808881050209276687756391911546806187586640918078231508181876445466503459873508196878629364924241891220686182517218825181707207808769770392864734466652524094735160185556148554260517746279303022469784592528209667497664672945900929888144529727881050106027775707933311860110618130543481573815538047460723253898548348335762406437618625388229555824532715231231491787570056329865617082709588903922431713098922691537317839185452018617461891748518176708607861270770493263960554805373552348256747200291438630960804647686832667981625018361034564086859426490014044.0) 8904745218945954122925368971373281181717900374288560370898675321443737679270628803070375452086325533130820775809791770655959012029518059311395787506461682905298116245339345074786289232964077829399227169172957135492227339473144223313994896482760691575451482243238829568808055832543119580321507040602756830324229224480584730347699455036959975422972770271687651917665055195592601092265907102015477659612392810299683295112113575443587850967135037372146248363075877997079057926103487096865694461899936016894676314593469074981545458108850599438959391377940082036272628013715974561333306233491382277798559522807074859499579.0) (num-test (+ -1814184401790217165873937825605141478060935014868566665644215718762341535891730598045990231798382966074312671040257824056876679135909008140059087311700216658095793352051583071432744886316274989901835606602224927350560604355249919901932382803472476702792978322468747380191775778902733911968522382089332819162367884984027854067607561808704316828316820133400099093450636968732151876570835173932998599031643640476109466728761033062776578175554441947411139184426213290292577467587355369954997241091769769542810051228504545831588488726789173405585678190671534386784806998695797717346491308862362775748058331375692317599945.0 15466182953987394334491149436346080039471412309427279110582769586053943302670765125931570041904640518032832554998553018838321871748542118021556398569294085708441934948186080236498081517178574839977996802813431873543309853609838200338534343580791382510179184571852290959723696010410340740895530535423959476873857191548113125728667781953125153120447892632916574768078583174099545013854248664119997703948998871566374080719541931440495888606776561795893839624084254684939434035018741535261951124673664746010067859317726891535170781460914710499572006592206360512398012457295755926986236618644330364227754380084585899275327.0) 13651998552197177168617211610740938561410477294558712444938553867291601766779034527885579810106257551958519883958295194781445192612633109881497311257593869050346141596134497165065336630862299850076161196211206946192749249254588280436601960777318905807386206249383543579531920231507606828927008153334626657711489306564085271661060220144420836292131072499516475674627946205367393137283413490186999104917355231090264613990780898377719310431222119848482700439658041394646856567431386165306953883581894976467257808089222345703582292734125537093986328401534826125613205458599958209639745309781967588479696048708893581675382.0) (num-test (+ -27127130599753372624001250456405972983012981437652156246797208697430661165612459362971759027335854588888552031022264244768883843080959804690580574272908031271224646245152017114094021048441971097191444782106551075175878815012595015584723250801765859461211934306789890718268168352614164589637346918581658850565274510502652089457352942736418509881708568727739912127781455473660768550022762222130489047215089836402367851853412705556570667960548570630054608024914653686223423908494006675057953013815512203710764854485332282975729323105427143207127239069826750682633272289409910001698385240596625059970587393681128674617278.0 5719655139276246085992066702308194672442413085748146924567717361937179810269300239821879673460959112727066470468217892213025828988023367028158410455624528688729907493639908638553730770145274142147983721694721139760883483821883267129411125364089207412089113869427479340283853501026803387874124668123626271531796990801822527792189514551888019206405597994403243358155410088320317141454525417323186389587327532772638942220300149829241141659063128602316305332848477566686425551944956989370838072872906293845914921103561360871571846865478762953536949621421094416539099628942010528483544062050170673327754206501716239719529.0) -21407475460477126538009183754097778310570568351904009322229491335493481355343159123149879353874895476161485560554046352555858014092936437662422163817283502582494738751512108475540290278296696955043461060411829935414995331190711748455312125437676652049122820437362411377984314851587361201763222250458032579033477519700829561665163428184530490675302970733336668769626045385340451408568236804807302657627762303629728909633112555727329526301485442027738302692066176119536998356549049685687114940942605909864849933381770922104157476239948380253590289448405656266094172660467899473214841178546454386642833187179412434897749.0)) (test (+ 1 #f) 'error) (test (+ 1 #t) 'error) (test (+ 1 + 2) 'error) (test (+ 1 - 2) 'error) (test (+ 1 2 . 3) 'error) (test (+ 1 . 2) 'error) ;; check error arg number (catch #t (lambda () (+ 1 #())) (lambda (type info) (test (apply format #f info) "+ second argument, #(), is a vector but should be a number"))) (catch #t (lambda () (+ 1.0 #())) (lambda (type info) (test (apply format #f info) "+ second argument, #(), is a vector but should be a number"))) (catch #t (lambda () (+ 23 #())) (lambda (type info) (test (apply format #f info) "+ second argument, #(), is a vector but should be a number"))) (catch #t (lambda () (+ #() 1)) (lambda (type info) (test (apply format #f info) "+ first argument, #(), is a vector but should be a number"))) (catch #t (lambda () (+ #() 1.0)) (lambda (type info) (test (apply format #f info) "+ first argument, #(), is a vector but should be a number"))) (catch #t (lambda () (+ 1 2 #())) (lambda (type info) (test (apply format #f info) "+ third argument, #(), is a vector but should be a number"))) (catch #t (lambda () (+ 1 2 3 #())) (lambda (type info) (test (apply format #f info) "+ fourth argument, #(), is a vector but should be a number"))) (num-test (+ most-positive-fixnum most-positive-fixnum) 1.844674407370955e+19) (num-test (+ most-negative-fixnum most-positive-fixnum) -1) ;;; these 4 are a problem (the overflow stuff in gcc gives inccorect results) ;(num-test (+ most-positive-fixnum 1) 9.223372036854776e+18) ;(num-test (- most-negative-fixnum 1) -9.223372036854776e+18) ;(num-test (+ most-negative-fixnum -1 most-positive-fixnum) (+ most-negative-fixnum most-positive-fixnum -1)) ;(num-test (+ most-negative-fixnum -100000 most-positive-fixnum) (+ most-negative-fixnum most-positive-fixnum -100000)) ;;; an optimizer test (let () (define (hi a b c) (+ (+ 1 (* 2 b)) (+ a (* b c)) (+ (* a b) c) (+ (* a 3) 4))) (num-test (hi 5 6 7) 116)) (for-each (lambda (arg) (test (+ arg +nan.0) 'error) (test (+ +nan.0 arg) 'error) (test (+ arg +inf.0) 'error) (test (+ +inf.0 arg) 'error) (test (+ arg) 'error) (test (+ 0 arg) 'error) (test (+ 0.0 arg) 'error) (test (+ 1 arg) 'error) (test (+ 1/2 arg) 'error) (test (+ 1.0 arg) 'error) (test (+ 1+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (unless with-bignums ;; g_add|subtract_x1 (test (let ((false #f)) (define (func) (do () ((not false) (+ (*s7* 'most-positive-fixnum) 1)))) (type-of (func))) 'float?) (test (let ((false #f)) (define (func) (do () ((not false) (- (*s7* 'most-negative-fixnum) 1)))) (type-of (func))) 'float?)) ;;; -------------------------------------------------------------------------------- ;;; - ;;; -------------------------------------------------------------------------------- (num-test (- -0) 0) (num-test (- -0.0) 0.0) (num-test (- -0.0+0.00000001i) 0.0-0.00000001i) (num-test (- -1.0 0.0) -1.0) (num-test (- -1.0) 1.0) (num-test (- -1.0+1.0i -1.0+1.0i) 0.0) (num-test (- -1.0+1.0i 0) -1.0+1.0i) (num-test (- -1.0+1.0i 0.0) -1.0+1.0i) (num-test (- -1.0+1.0i 0.0+1.0i) -1.0) (num-test (- -1.0+1.0i 1) -2.0+1.0i) (num-test (- -1.0+1.0i 1.0) -2.0+1.0i) (num-test (- -1.0+1.0i 1.0+1.0i) -2.0) (num-test (- -1.0+1.0i 1/1) -2.0+1.0i) (num-test (- -1.0+1.0i 123.4) -124.4+1.0i) (num-test (- -1.0+1.0i 1234) -1235.0+1.0i) (num-test (- -1.0+1.0i 1234/11) -113.18181818181819+1.0i) (num-test (- -1.0+1.0i) 1.0-1.0i) (num-test (- -10) 10) (num-test (- -10/3) 10/3) (num-test (- -1234000000) 1234000000) (num-test (- -1234000000.0) 1234000000.0) (num-test (- -1234000000/10) 1234000000/10) (num-test (- -2 0) -2) (num-test (- -2) 2) (num-test (- -2/2 0/1) -2/2) (num-test (- 0 -1.0+1.0i) 1.0-1.0i) (num-test (- 0 0) 0) (num-test (- 0 0.0) 0.0) (num-test (- 0 1 -1.0+1.0i) 0.0-1.0i) (num-test (- 0 1 0.0) -1.0) (num-test (- 0 1 1) -2) (num-test (- 0 1 1.0+1.0i) -2.0-1.0i) (num-test (- 0 1 123.4) -124.4) (num-test (- 0 1 1234/11) -1245/11) (num-test (- 0 1.0 -1.0+1.0i) 0.0-1.0i) (num-test (- 0 1.0 0.0) -1.0) (num-test (- 0 1.0 1) -2.0) (num-test (- 0 1.0 1.0+1.0i) -2.0-1.0i) (num-test (- 0 1.0 123.4) -124.4) (num-test (- 0 1.0 1234/11) -113.18181818181819) (num-test (- 0 1.0+1.0i -1.0+1.0i) 0.0-2.0i) (num-test (- 0 1.0+1.0i 0.0) -1.0-1.0i) (num-test (- 0 1.0+1.0i 1) -2.0-1.0i) (num-test (- 0 1.0+1.0i 1.0+1.0i) -2.0-2.0i) (num-test (- 0 1.0+1.0i 123.4) -124.4-1.0i) (num-test (- 0 1.0+1.0i 1234/11) -113.18181818181819-1.0i) (num-test (- 0 123.4) -123.4) (num-test (- 0 1234/11) -1234/11) (num-test (- 0.0 -1.0+1.0i -1.0+1.0i) 2.0-2.0i) (num-test (- 0.0 -1.0+1.0i 0.0) 1.0-1.0i) (num-test (- 0.0 -1.0+1.0i 1) 0.0-1.0i) (num-test (- 0.0 -1.0+1.0i 1.0+1.0i) 0.0-2.0i) (num-test (- 0.0 -1.0+1.0i 123.4) -122.4-1.0i) (num-test (- 0.0 -1.0+1.0i 1234/11) -111.18181818181819-1.0i) (num-test (- 0.0 0 -1.0+1.0i) 1.0-1.0i) (num-test (- 0.0 0 0.0) 0.0) (num-test (- 0.0 0 1) -1.0) (num-test (- 0.0 0 1.0+1.0i) -1.0-1.0i) (num-test (- 0.0 0 123.4) -123.4) (num-test (- 0.0 0 1234/11) -112.18181818181819) (num-test (- 0.0 0.0 -1.0+1.0i) 1.0-1.0i) (num-test (- 0.0 0.0 0.0) 0.0) (num-test (- 0.0 0.0 1) -1.0) (num-test (- 0.0 0.0 1.0+1.0i) -1.0-1.0i) (num-test (- 0.0 0.0 123.4) -123.4) (num-test (- 0.0 0.0 1234/11) -112.18181818181819) (num-test (- 0.0 0.0+1.0i -1.0+1.0i) 1.0-2.0i) (num-test (- 0.0 0.0+1.0i 0.0) 0.0-1.0i) (num-test (- 0.0 0.0+1.0i 1) -1.0-1.0i) (num-test (- 0.0 0.0+1.0i 1.0+1.0i) -1.0-2.0i) (num-test (- 0.0 0.0+1.0i 123.4) -123.4-1.0i) (num-test (- 0.0 0.0+1.0i 1234/11) -112.18181818181819-1.0i) (num-test (- 0.0 1 -1.0+1.0i) 0.0-1.0i) (num-test (- 0.0 1 0.0) -1.0) (num-test (- 0.0 1 1.0) -2.0) (num-test (- 0.0 1 1/1) -2.0) (num-test (- 0.0 1 1234) -1235.0) (num-test (- 0.0 1) -1.0) (num-test (- 0.0 1.0 0) -1.0) (num-test (- 0.0 1.0 0.0+1.0i) -1.0-1.0i) (num-test (- 0.0 1.0 1.0) -2.0) (num-test (- 0.0 1.0 1/1) -2.0) (num-test (- 0.0 1.0 1234) -1235.0) (num-test (- 0.0 1.0) -1.0) (num-test (- 0.0 1.0+1.0i 0) -1.0-1.0i) (num-test (- 0.0 1.0+1.0i 0.0+1.0i) -1.0-2.0i) (num-test (- 0.0 1.0+1.0i 1.0) -2.0-1.0i) (num-test (- 0.0 1.0+1.0i 1/1) -2.0-1.0i) (num-test (- 0.0 1.0+1.0i 1234) -1235.0-1.0i) (num-test (- 0.0 1.0+1.0i) -1.0-1.0i) (num-test (- 0.0 123.4 -1.0+1.0i) -122.4-1.0i) (num-test (- 0.0 123.4 0.0) -123.4) (num-test (- 0.0 123.4 1) -124.4) (num-test (- 0.0 123.4 1.0+1.0i) -124.4-1.0i) (num-test (- 0.0 123.4 123.4) -246.8) (num-test (- 0.0 123.4 1234/11) -235.58181818181819) (num-test (- 0.0 1234 -1.0+1.0i) -1233.0-1.0i) (num-test (- 0.0 1234 0.0) -1234.0) (num-test (- 0.0 1234 1) -1235.0) (num-test (- 0.0 1234 1.0+1.0i) -1235.0-1.0i) (num-test (- 0.0 1234 123.4) -1357.4) (num-test (- 0.0 1234 1234/11) -1346.18181818181824) (num-test (- 0.0 1234/11 -1.0+1.0i) -111.18181818181819-1.0i) (num-test (- 0.0 1234/11 0.0) -112.18181818181819) (num-test (- 0.0 1234/11 1) -113.18181818181819) (num-test (- 0.0 1234/11 1.0+1.0i) -113.18181818181819-1.0i) (num-test (- 0.0 1234/11 123.4) -235.58181818181819) (num-test (- 0.0 1234/11 1234/11) -224.36363636363637) (num-test (- 0.0) -0.0) (num-test (- 0.0+1.0i -1.0+1.0i) 1.0) (num-test (- 0.0+1.0i 0.0) 0.0+1.0i) (num-test (- 0.0+1.0i 1) -1.0+1.0i) (num-test (- 0.0+1.0i 1.0+1.0i) -1.0) (num-test (- 0.0+1.0i 123.4) -123.4+1.0i) (num-test (- 0.0+1.0i 1234/11) -112.18181818181819+1.0i) (num-test (- 0/1) 0/1) (num-test (- 1 0) 1) (num-test (- 1 0.0+1.0i) 1.0-1.0i) (num-test (- 1 1 0) 0) (num-test (- 1 1 0.0+1.0i) 0.0-1.0i) (num-test (- 1 1 1.0) -1.0) (num-test (- 1 1 1/1) -1) (num-test (- 1 1 1234) -1234) (num-test (- 1 1) 0) (num-test (- 1 1.0 0) 0.0) (num-test (- 1 1.0 0.0+1.0i) 0.0-1.0i) (num-test (- 1 1.0 1.0) -1.0) (num-test (- 1 1.0 1/1) -1.0) (num-test (- 1 1.0 1234) -1234.0) (num-test (- 1 1.0) 0.0) (num-test (- 1 1.0+1.0i 0) 0.0-1.0i) (num-test (- 1 1.0+1.0i 0.0+1.0i) 0.0-2.0i) (num-test (- 1 1.0+1.0i 1.0) -1.0-1.0i) (num-test (- 1 1.0+1.0i 1/1) -1.0-1.0i) (num-test (- 1 1.0+1.0i 1234) -1234.0-1.0i) (num-test (- 1 1.0+1.0i) 0.0-1.0i) (num-test (- 1 123.4) -122.4) (num-test (- 1 1234/11) -1223/11) (num-test (- 1.0 -1.0+1.0i 0) 2.0-1.0i) (num-test (- 1.0 -1.0+1.0i 0.0+1.0i) 2.0-2.0i) (num-test (- 1.0 -1.0+1.0i 1.0) 1.0-1.0i) (num-test (- 1.0 -1.0+1.0i 1/1) 1.0-1.0i) (num-test (- 1.0 -1.0+1.0i 1234) -1232.0-1.0i) (num-test (- 1.0 -1.0+1.0i) 2.0-1.0i) (num-test (- 1.0 0 0) 1.0) (num-test (- 1.0 0 0.0+1.0i) 1.0-1.0i) (num-test (- 1.0 0 1.0) 0.0) (num-test (- 1.0 0 1/1) 0.0) (num-test (- 1.0 0 1234) -1233.0) (num-test (- 1.0 0) 1.0) (num-test (- 1.0 0.0 0) 1.0) (num-test (- 1.0 0.0 0.0+1.0i) 1.0-1.0i) (num-test (- 1.0 0.0 1.0) 0.0) (num-test (- 1.0 0.0 1/1) 0.0) (num-test (- 1.0 0.0 1234) -1233.0) (num-test (- 1.0 0.0) 1.0) (num-test (- 1.0 0.0+1.0i 0) 1.0-1.0i) (num-test (- 1.0 0.0+1.0i 0.0+1.0i) 1.0-2.0i) (num-test (- 1.0 0.0+1.0i 1.0) 0.0-1.0i) (num-test (- 1.0 0.0+1.0i 1/1) 0.0-1.0i) (num-test (- 1.0 0.0+1.0i 1234) -1233.0-1.0i) (num-test (- 1.0 0.0+1.0i) 1.0-1.0i) (num-test (- 1.0 1 0) 0.0) (num-test (- 1.0 1 0.0+1.0i) 0.0-1.0i) (num-test (- 1.0 1 1.0) -1.0) (num-test (- 1.0 1 1/1) -1.0) (num-test (- 1.0 1 1234) -1234.0) (num-test (- 1.0 1) 0.0) (num-test (- 1.0 1.0 0) 0.0) (num-test (- 1.0 1.0 0.0+1.0i) 0.0-1.0i) (num-test (- 1.0 1.0 1.0) -1.0) (num-test (- 1.0 1.0 1/1) -1.0) (num-test (- 1.0 1.0 1234) -1234.0) (num-test (- 1.0 1.0) 0.0) (num-test (- 1.0 1.0+1.0i 0) 0.0-1.0i) (num-test (- 1.0 1.0+1.0i 0.0+1.0i) 0.0-2.0i) (num-test (- 1.0 1.0+1.0i 1.0) -1.0-1.0i) (num-test (- 1.0 1.0+1.0i 1/1) -1.0-1.0i) (num-test (- 1.0 1.0+1.0i 1234) -1234.0-1.0i) (num-test (- 1.0 1.0+1.0i) 0.0-1.0i) (num-test (- 1.0 123.4 -1.0+1.0i) -121.4-1.0i) (num-test (- 1.0 123.4 0.0) -122.4) (num-test (- 1.0 123.4 1) -123.4) (num-test (- 1.0 123.4 1.0+1.0i) -123.4-1.0i) (num-test (- 1.0 123.4 123.4) -245.8) (num-test (- 1.0 123.4 1234/11) -234.58181818181819) (num-test (- 1.0 1234 -1.0+1.0i) -1232.0-1.0i) (num-test (- 1.0 1234 0.0) -1233.0) (num-test (- 1.0 1234 1) -1234.0) (num-test (- 1.0 1234 1.0+1.0i) -1234.0-1.0i) (num-test (- 1.0 1234 123.4) -1356.4) (num-test (- 1.0 1234 1234/11) -1345.18181818181824) (num-test (- 1.0 1234/11 -1.0+1.0i) -110.18181818181819-1.0i) (num-test (- 1.0 1234/11 0.0) -111.18181818181819) (num-test (- 1.0 1234/11 1) -112.18181818181819) (num-test (- 1.0 1234/11 1.0+1.0i) -112.18181818181819-1.0i) (num-test (- 1.0 1234/11 123.4) -234.58181818181819) (num-test (- 1.0 1234/11 1234/11) -223.36363636363637) (num-test (- 1.0) -1.0) (num-test (- 1.0+1.0i -1.0+1.0i 0) 2.0) (num-test (- 1.0+1.0i -1.0+1.0i 0.0+1.0i) 2.0-1.0i) (num-test (- 1.0+1.0i -1.0+1.0i 1.0) 1.0) (num-test (- 1.0+1.0i -1.0+1.0i 1/1) 1.0) (num-test (- 1.0+1.0i -1.0+1.0i 1234) -1232.0) (num-test (- 1.0+1.0i -1.0+1.0i) 2.0) (num-test (- 1.0+1.0i 0 0) 1.0+1.0i) (num-test (- 1.0+1.0i 0 0.0+1.0i) 1.0) (num-test (- 1.0+1.0i 0 1.0) 0.0+1.0i) (num-test (- 1.0+1.0i 0 1/1) 0.0+1.0i) (num-test (- 1.0+1.0i 0 1234) -1233.0+1.0i) (num-test (- 1.0+1.0i 0) 1.0+1.0i) (num-test (- 1.0+1.0i 0.0 0) 1.0+1.0i) (num-test (- 1.0+1.0i 0.0 0.0+1.0i) 1.0) (num-test (- 1.0+1.0i 0.0 1.0) 0.0+1.0i) (num-test (- 1.0+1.0i 0.0 1/1) 0.0+1.0i) (num-test (- 1.0+1.0i 0.0 1234) -1233.0+1.0i) (num-test (- 1.0+1.0i 0.0) 1.0+1.0i) (num-test (- 1.0+1.0i 0.0+1.0i 0) 1.0) (num-test (- 1.0+1.0i 0.0+1.0i 0.0+1.0i) 1.0-1.0i) (num-test (- 1.0+1.0i 0.0+1.0i 1.0) 0.0) (num-test (- 1.0+1.0i 0.0+1.0i 1/1) 0.0) (num-test (- 1.0+1.0i 0.0+1.0i 1234) -1233.0) (num-test (- 1.0+1.0i 0.0+1.0i) 1.0) (num-test (- 1.0+1.0i 1 0) 0.0+1.0i) (num-test (- 1.0+1.0i 1 0.0+1.0i) 0.0) (num-test (- 1.0+1.0i 1 1.0) -1.0+1.0i) (num-test (- 1.0+1.0i 1 1/1) -1.0+1.0i) (num-test (- 1.0+1.0i 1 1234) -1234.0+1.0i) (num-test (- 1.0+1.0i 1) 0.0+1.0i) (num-test (- 1.0+1.0i 1.0 0) 0.0+1.0i) (num-test (- 1.0+1.0i 1.0 0.0+1.0i) 0.0) (num-test (- 1.0+1.0i 1.0 1.0) -1.0+1.0i) (num-test (- 1.0+1.0i 1.0 1/1) -1.0+1.0i) (num-test (- 1.0+1.0i 1.0 1234) -1234.0+1.0i) (num-test (- 1.0+1.0i 1.0) 0.0+1.0i) (num-test (- 1.0+1.0i 1.0+1.0i 0) 0.0) (num-test (- 1.0+1.0i 1.0+1.0i 0.0+1.0i) 0.0-1.0i) (num-test (- 1.0+1.0i 1.0+1.0i 1.0) -1.0) (num-test (- 1.0+1.0i 1.0+1.0i 1/1) -1.0) (num-test (- 1.0+1.0i 1.0+1.0i 1234) -1234.0) (num-test (- 1.0+1.0i 1.0+1.0i) 0.0) (num-test (- 1.0+1.0i 123.4 -1.0+1.0i) -121.4) (num-test (- 1.0+1.0i 123.4 0.0) -122.4+1.0i) (num-test (- 1.0+1.0i 123.4 1) -123.4+1.0i) (num-test (- 1.0+1.0i 123.4 1.0+1.0i) -123.4) (num-test (- 1.0+1.0i 123.4 123.4) -245.8+1.0i) (num-test (- 1.0+1.0i 123.4 1234/11) -234.58181818181819+1.0i) (num-test (- 1.0+1.0i 1234 -1.0+1.0i) -1232.0) (num-test (- 1.0+1.0i 1234 0.0) -1233.0+1.0i) (num-test (- 1.0+1.0i 1234 1) -1234.0+1.0i) (num-test (- 1.0+1.0i 1234 1.0+1.0i) -1234.0) (num-test (- 1.0+1.0i 1234 123.4) -1356.4+1.0i) (num-test (- 1.0+1.0i 1234 1234/11) -1345.18181818181824+1.0i) (num-test (- 1.0+1.0i 1234/11 -1.0+1.0i) -110.18181818181819) (num-test (- 1.0+1.0i 1234/11 0.0) -111.18181818181819+1.0i) (num-test (- 1.0+1.0i 1234/11 1) -112.18181818181819+1.0i) (num-test (- 1.0+1.0i 1234/11 1.0+1.0i) -112.18181818181819) (num-test (- 1.0+1.0i 1234/11 123.4) -234.58181818181819+1.0i) (num-test (- 1.0+1.0i 1234/11 1234/11) -223.36363636363637+1.0i) (num-test (- 1.0+1.0i) -1.0-1.0i) (num-test (- 10/3) -10/3) (num-test (- 123.4 -1.0+1.0i 0) 124.4-1.0i) (num-test (- 123.4 -1.0+1.0i 0.0+1.0i) 124.4-2.0i) (num-test (- 123.4 -1.0+1.0i 1.0) 123.4-1.0i) (num-test (- 123.4 -1.0+1.0i 1/1) 123.4-1.0i) (num-test (- 123.4 -1.0+1.0i 1234) -1109.59999999999991-1.0i) (num-test (- 123.4 -1.0+1.0i) 124.4-1.0i) (num-test (- 123.4 0 0) 123.4) (num-test (- 123.4 0 0.0+1.0i) 123.4-1.0i) (num-test (- 123.4 0 1.0) 122.4) (num-test (- 123.4 0 1/1) 122.4) (num-test (- 123.4 0 1234) -1110.59999999999991) (num-test (- 123.4 0) 123.4) (num-test (- 123.4 0.0 0) 123.4) (num-test (- 123.4 0.0 0.0+1.0i) 123.4-1.0i) (num-test (- 123.4 0.0 1.0) 122.4) (num-test (- 123.4 0.0 1/1) 122.4) (num-test (- 123.4 0.0 1234) -1110.59999999999991) (num-test (- 123.4 0.0) 123.4) (num-test (- 123.4 0.0+1.0i 0) 123.4-1.0i) (num-test (- 123.4 0.0+1.0i 0.0+1.0i) 123.4-2.0i) (num-test (- 123.4 0.0+1.0i 1.0) 122.4-1.0i) (num-test (- 123.4 0.0+1.0i 1/1) 122.4-1.0i) (num-test (- 123.4 0.0+1.0i 1234) -1110.59999999999991-1.0i) (num-test (- 123.4 0.0+1.0i) 123.4-1.0i) (num-test (- 123.4 1 0) 122.4) (num-test (- 123.4 1 0.0+1.0i) 122.4-1.0i) (num-test (- 123.4 1 1.0) 121.4) (num-test (- 123.4 1 1/1) 121.4) (num-test (- 123.4 1 1234) -1111.59999999999991) (num-test (- 123.4 1) 122.4) (num-test (- 123.4 1.0 0) 122.4) (num-test (- 123.4 1.0 0.0+1.0i) 122.4-1.0i) (num-test (- 123.4 1.0 1.0) 121.4) (num-test (- 123.4 1.0 1/1) 121.4) (num-test (- 123.4 1.0 1234) -1111.59999999999991) (num-test (- 123.4 1.0) 122.4) (num-test (- 123.4 1.0+1.0i 0) 122.4-1.0i) (num-test (- 123.4 1.0+1.0i 0.0+1.0i) 122.4-2.0i) (num-test (- 123.4 1.0+1.0i 1.0) 121.4-1.0i) (num-test (- 123.4 1.0+1.0i 1/1) 121.4-1.0i) (num-test (- 123.4 1.0+1.0i 1234) -1111.59999999999991-1.0i) (num-test (- 123.4 1.0+1.0i) 122.4-1.0i) (num-test (- 123.4 123.4 -1.0+1.0i) 1.0-1.0i) (num-test (- 123.4 123.4 0.0) 0.0) (num-test (- 123.4 123.4 1) -1.0) (num-test (- 123.4 123.4 1.0+1.0i) -1.0-1.0i) (num-test (- 123.4 123.4 123.4) -123.4) (num-test (- 123.4 123.4 1234/11) -112.18181818181819) (num-test (- 123.4 1234 -1.0+1.0i) -1109.59999999999991-1.0i) (num-test (- 123.4 1234 0.0) -1110.59999999999991) (num-test (- 123.4 1234 1) -1111.59999999999991) (num-test (- 123.4 1234 1.0+1.0i) -1111.59999999999991-1.0i) (num-test (- 123.4 1234 123.4) -1234.0) (num-test (- 123.4 1234 1234/11) -1222.78181818181815) (num-test (- 123.4 1234/11 -1.0+1.0i) 12.21818181818182-1.0i) (num-test (- 123.4 1234/11 0.0) 11.21818181818182) (num-test (- 123.4 1234/11 1) 10.21818181818182) (num-test (- 123.4 1234/11 1.0+1.0i) 10.21818181818182-1.0i) (num-test (- 123.4 1234/11 123.4) -112.18181818181819) (num-test (- 123.4 1234/11 1234/11) -100.96363636363635) (num-test (- 1234 -1.0+1.0i) 1235.0-1.0i) (num-test (- 1234 0.0) 1234.0) (num-test (- 1234 1) 1233) (num-test (- 1234 1.0+1.0i) 1233.0-1.0i) (num-test (- 1234 123.4) 1110.59999999999991) (num-test (- 1234 1234/11) 12340/11) (num-test (- 1234/11 0) 1234/11) (num-test (- 1234/11 0.0+1.0i) 112.18181818181819-1.0i) (num-test (- 1234/11 1.0) 111.18181818181819) (num-test (- 1234/11 1/1) 1223/11) (num-test (- 1234/11 1234) -12340/11) (num-test (- 1234000000) -1234000000) (num-test (- 1234000000/10) -1234000000/10) (num-test (- 2/2) -2/2) (num-test (- 1/2 0.5e0) 0.0e0) (num-test (- 1000000000000000000/3 1000000000000000001/3) -1/3) (num-test (- 3 0 3 5 -6) 1) (num-test (- 3 4) -1 ) (num-test (- 3) -3 ) (call-with-exit (lambda (ok) (for-each-permutation (lambda args (unless (= (apply - args) (- (car args) (apply + (cdr args)))) (format *stderr* "~A: ~A != ~A?~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args)))) (ok))) '(1 1/2 0.5 1+i)))) (call-with-exit (lambda (ok) (for-each-permutation (lambda args (unless (= (apply - args) (+ (car args) (- (apply + (cdr args))))) (format *stderr* "~A: (- ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply - args)) (ok))) '(1 1/2 0.5 1+i -1/2 -1 -0.5 -1-i)))) (num-test (- -1.797693134862315699999999999999999999998E308 -9223372036854775808) -1.797693134862315699999999999999999999998E308) (num-test (- -9223372036854775808 -9223372036854775808) 0) (num-test (- -9223372036854775808 5.551115123125783999999999999999999999984E-17) -9.223372036854775808000000000000000055511E18) (num-test (- -9223372036854775808 9223372036854775807 -9223372036854775808) -9223372036854775807) (if with-bignums (num-test (- -9223372036854775808) 9223372036854775808)) (num-test (- 1.110223024625156799999999999999999999997E-16 -9223372036854775808) 9.223372036854775808000000000000000111022E18) (num-test (- 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 5.545694112263356477829399999999999999977E-17) (num-test (- 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) -5.551115123125783999999999999999999999984E-17) (num-test (- 9223372036854775807 9223372036854775807) 0) (num-test (- .(1.1)) -1.1) (num-test (- 1. .()) -1.0) (num-test (- 1/9223372036854775807 1/9223372036854775807) 0) (num-test (- 1/98947 2/97499 3/76847) -36656755224/741360956847391) (num-test (- 500009/500029 500057/500041) -18001284/250035001189) ;;; (test (let () (define (func) (do () (#t (- 1855077841/1311738121 -1 4478554083/3166815962)))) (define (hi) (func)) (hi)) 4154033219546687401/4154033219546687402) ;;; this ^ depends on treating it as (- r1 (+ r2 r3)) not (- (- r1 r2) r3) ;(test (- 9007199254740996.0 9007199254740995) 1.0) (unless (or with-bignums (not (provided? 'overflow-checks))) (num-test (- 8 -1/9223372036854775807 1/9223372036854775807) 8.0) ; (num-test (- most-positive-fixnum most-negative-fixnum) 1.8446744073709551615E19) ; (num-test (- most-negative-fixnum most-positive-fixnum) -1.8446744073709551615E19) ;;; currently s7's optimizer screws up these cases ) (num-test (- -0.011326914400453525E0 -0.6668141757661364E0) 6.554872613656828749999999999999999999976E-1) (num-test (- -0.46185382764946437E0 0.7488210697846337E0) -1.210674897434098070000000000000000000001E0) (num-test (- -0.35834120541234993E0 -0.30919976341834987E0) -4.914144199400005999999999999999999999972E-2) (num-test (- 0.44705025064976966E0 -0.9277893553610955E0) 1.374839606010865160000000000000000000002E0) (num-test (- -0.47647537517067917E0 0.29158058381073604E0) -7.680559589814152099999999999999999999997E-1) (num-test (- -0.021697999002707746E0 0.1779871773524142E0) -1.996851763551219460000000000000000000001E-1) (num-test (- 0.4179484378019861E0 9.9990307469939E9) -9.999030746575951861270279525000000000019E9) (num-test (- -0.7475415524823718E0 1.3993312799214797E9) -1.399331280669021252482371799999999999998E9) (num-test (- 0.2519442433861928E0 -6.699632771871848E9) 6.699632772123792243386192799999999999993E9) (num-test (- -0.5124988631497671E0 2.7959244812290273E9) -2.795924481741526163149767100000000000009E9) (num-test (- -0.6870193827604301E0 4.851102442573468E9) -4.851102443260487591073418381249999999995E9) (num-test (- 0.7609656780357723E0 7.481252865855436E8) -7.481252858245779544715519187499999999991E8) (num-test (- -0.6301276042170191E0 -7.099314875214215E-11) -6.301276041460259512478578500000000000002E-1) (num-test (- -0.4139053484357884E0 -2.897413526398709E-11) -4.139053484068142647360129100000000000006E-1) (num-test (- -0.6944623060197281E0 -3.291569879873739E-11) -6.94462305986812401201262610000000000001E-1) (num-test (- -0.2057822500703933E0 3.6505182026159854E-11) -2.057822501068984820261598540000000000004E-1) (num-test (- -0.8792706674467908E0 8.094527736950817E-11) -8.792706675277360773695081699999999999978E-1) (num-test (- -0.6888184243601332E0 9.127622796988807E-11) -6.888184244514094279698880700000000000006E-1) (num-test (- -0.980711030497252E0 8.752272461345245E19) -8.752272461345245000098071103049725200009E19) (num-test (- 0.8035082489836539E0 -3.903355151264917E19) 3.90335515126491700008035082489836539001E19) (num-test (- -0.7537841372394811E0 -5.879942447417834E19) 5.879942447417833999924621586276051889998E19) (num-test (- -0.6877475951546845E0 -2.3972266191169642E19) 2.397226619116964199931225240484531550001E19) (num-test (- -0.43128282112433525E0 -5.422824998003439E19) 5.422824998003438999956871717887566474998E19) (num-test (- 0.29538116818276694E0 1.1291858990580939E19) -1.129185899058093899970461883181723306002E19) (num-test (- 0.9166687388673976E0 6.395175407123937E-21) 9.166687388673975999936048245928760629984E-1) (num-test (- 0.41840538498193025E0 -2.6655662412599155E-21) 4.18405384981930250002665566241259915501E-1) (num-test (- -0.8036940092501853E0 6.7473779576832565E-21) -8.036940092501853000067473779576832565009E-1) (num-test (- 0.8555054025209989E0 -7.939970418096797E-21) 8.55505402520998900007939970418096796999E-1) (num-test (- 0.3365495704567003E0 8.694519827555395E-21) 3.365495704567002999913054801724446050001E-1) (num-test (- -0.7430322011471231E0 7.430332379292914E-22) -7.430322011471231000007430332379292914019E-1) (num-test (- 5.102372414731216E9 -0.5073635765350494E0) 5.102372415238580007199111899999999999994E9) (num-test (- 4.629827365822252E9 0.6534380055543355E0) 4.629827365168814268005234812499999999993E9) (num-test (- 7.218192507117569E9 0.9781542046565127E0) 7.21819250613941476507004979999999999999E9) (num-test (- 6.595760326622413E8 0.7339510561932947E0) 6.595760319282902834902380148437500000014E8) (num-test (- 7.191166637703489E9 0.80792475493853E0) 7.191166636895564548650337188817616151937E9) (num-test (- -7.95531405213956E9 0.5353636841430115E0) -7.955314052674923429931585718750000000006E9) (num-test (- 5.438904545553836E8 6.533536518165114E9) -5.98964606360973083972930908203125E9) (num-test (- -7.389650313101625E8 -9.983943153365381E9) 9.244978122055218499999999999999999999979E9) (num-test (- 8.364404619492165E9 -7.600563055115287E9) 1.596496767460745161181640624999999999997E10) (num-test (- 2.070813748323649E9 6.421052769114957E9) -4.350239020791307926177978515625E9) (num-test (- -2.8555256820439434E9 -3.4077342921686625E8) -2.514752252827077150000000000000000000005E9) (num-test (- 9.147878229420991E8 8.439982790150545E9) -7.525194967208446025848388671875E9) (num-test (- -4.315772980070098E9 -6.48869466068404E-11) -4.315772980070097999935113053393159599999E9) (num-test (- -3.5186299785635023E9 3.990046539849716E-11) -3.518629978563502300039900465398497159997E9) (num-test (- 2.5645532837267537E9 8.566645694205622E-13) 2.564553283726753699999143335430579437802E9) (num-test (- 6.145110896031829E9 -9.242734002954773E-11) 6.145110896031828880402485933779547730013E9) (num-test (- -6.6836855975624E9 9.117930361283473E-11) -6.683685597562399864287956647362834729995E9) (num-test (- -1.7472828462085754E8 -5.125838712019503E-11) -1.747282846208575399487416128798049699998E8) (num-test (- 9.05675399397055E9 9.086705650502484E19) -9.0867056495968086006029449462890625E19) (num-test (- -5.834806594586836E9 9.981576053842906E19) -9.981576054426386659458683599999999999999E19) (num-test (- 3.047010922754272E9 1.1715352070471352E19) -1.171535206742434107724572801589965820312E19) (num-test (- 7.294295638574767E9 2.845702947515113E19) -2.845702946785683436142523288726806640625E19) (num-test (- 8.264143132493019E9 -1.6322956072452289E19) 1.632295608071643213249301910400390625E19) (num-test (- -9.597823287256088E9 3.954126758718671E19) -3.95412675967845332872560880000000000001E19) (num-test (- 3.229389511771705E9 -4.329831377266493E-21) 3.229389511771705150604248046879329831377E9) (num-test (- 6.897089200279753E9 2.4428208790287663E-21) 6.897089200279752731323242187497557179116E9) (num-test (- 2.3579775300187545E9 4.729400988996349E-21) 2.357977530018754499999999999995270599018E9) (num-test (- 1.6718929117460046E9 5.8162277016717065E-21) 1.671892911746004599999999999994183772301E9) (num-test (- 2.537177500868296E9 1.4856605280697543E-21) 2.537177500868296146392822265623514339469E9) (num-test (- 6.117674696930935E9 -1.6187214719634357E-21) 6.117674696930934906005859375001618721474E9) (num-test (- 4.1877888304549216E-11 -0.06920550501017497E0) 6.920550505205285830454921600000000000007E-2) (num-test (- 9.61054846124015E-11 0.885309193732889E0) -8.85309193636783481398417376384291797877E-1) (num-test (- 2.5559085051828467E-11 -0.8112181469812297E0) 8.112181470067887850518284670000000000006E-1) (num-test (- -1.4549570208293283E-12 -0.5049325945871657E0) 5.049325945857107429791706717000000000005E-1) (num-test (- -7.091628047158497E-11 0.61946884965934E0) -6.194688497302562955729347334266968816526E-1) (num-test (- 2.877466355456826E-11 0.4496491857374E0) -4.49649185708625317645189543551619872451E-1) (num-test (- 1.3041612488449928E-12 5.408018587130755E9) -5.40801858713075542449820755750115500719E9) (num-test (- -5.379752339715717E-11 -4.009594691514288E9) 4.009594691514287999946202476602842829998E9) (num-test (- 7.023042501342336E-12 -3.4153434285746374E9) 3.415343428574637400007023042501342336004E9) (num-test (- 6.968174934871611E-11 4.713087404332662E9) -4.713087404332661628653462781901283890003E9) (num-test (- -5.153562653896506E-11 -8.44732228013254E8) 8.447322280132540463885888851797849400006E8) (num-test (- -8.424177457818745E-11 1.6817117809824567E9) -1.681711780982456700084241774578187449998E9) (num-test (- 3.374755984316538E-11 8.893678266883364E-11) -5.518922282566826000000000000000000000009E-11) (num-test (- -8.684123447823306E-11 -7.888825869147879E-11) -7.952975786754269999999999999999999999987E-12) (num-test (- 7.788477523205632E-11 1.741674745286914E-11) 6.046802777918717999999999999999999999988E-11) (num-test (- 6.546622477606044E-11 -4.7719651007530584E-11) 1.131858757835910240000000000000000000001E-10) (num-test (- -1.8595152377503265E-11 5.7288738553553045E-11) -7.588389093105630999999999999999999999984E-11) (num-test (- -8.184033550427558E-11 -8.834399228929296E-11) 6.503656785017380000000000000000000000234E-12) (num-test (- 5.749469292140762E-11 7.493129199779113E19) -7.493129199779112999999999999994250530697E19) (num-test (- -5.2285095120702066E-11 -2.0611179974216552E19) 2.061117997421655199999999999994771490491E19) (num-test (- -8.84727820032067E-11 4.7423077384022024E19) -4.742307738402202400000000000008847278205E19) (num-test (- 3.437676989338625E-11 -3.5368755480277647E19) 3.536875548027764700000000000003437676988E19) (num-test (- 2.2665031619145437E-11 -6.072845659234921E19) 6.072845659234921000000000000002266503153E19) (num-test (- -8.429070146313393E-11 5.134329153614969E18) -5.134329153614969000000000000084290701453E18) (num-test (- -9.009531819191212E-11 2.301790665456671E-22) -9.009531819214229906654566710000000000025E-11) (num-test (- -2.706942469371907E-11 9.282350542107287E-21) -2.706942470300142054210728700000000000001E-11) (num-test (- 5.358266626996117E-11 -4.409057695582885E-22) 5.358266627040207576955828850000000000004E-11) (num-test (- -7.189537285608088E-11 9.569273217393917E-21) -7.189537286565015321739391700000000000027E-11) (num-test (- -4.160295905335358E-11 5.930867524794025E-21) -4.160295905928444752479402499999999999992E-11) (num-test (- 6.7922062777334035E-12 -7.747524338474154E-22) 6.792206278508155933847415400000000000006E-12) (num-test (- -9.038821102045805E19 0.04779131019959271E0) -9.038821102045805000004779131019959271002E19) (num-test (- 2.2020595055495963E19 -0.424631558292516E0) 2.202059505549596300042463155829251600002E19) (num-test (- -8.164003027214308E19 0.6832198147365239E0) -8.164003027214308000068321981473652389997E19) (num-test (- -3.878233560364984E19 -0.28756619113600546E0) -3.878233560364983999971243380886399453999E19) (num-test (- 7.0829003521450525E19 -0.6071548125948544E0) 7.08290035214505250006071548125948544E19) (num-test (- 5.968540808784698E19 0.7674294173432648E0) 5.968540808784697999923257058265673519995E19) (num-test (- -2.2143621795153547E19 -2.443529365769125E9) -2.214362179271001763423087500000000000004E19) (num-test (- -9.77092538926342E18 5.903189771537687E8) -9.770925389853738977153768658638000488281E18) (num-test (- 9.974714452399537E19 -6.980456691485629E9) 9.974714453097582669148562899999999999991E19) (num-test (- 1.7428950527159094E18 3.68843657888816E9) 1.742895049027472821111839771270751953125E18) (num-test (- -1.1094381875350845E19 -7.157723640671709E9) -1.109438186819312135932829100000000000002E19) (num-test (- -3.638795590369631E19 6.9246542750294075E9) -3.638795591062096427502940750000000000005E19) (num-test (- -5.66543282261991E19 -5.1005028153082024E-11) -5.665432822619909999999999999994899497189E19) (num-test (- -3.901527864456216E19 -1.064153465992923E-12) -3.901527864456215999999999999999893584646E19) (num-test (- 1.1477489418879848E19 3.327888063907735E-11) 1.147748941887984799999999999996672111937E19) (num-test (- 3.508978072054437E19 9.238453417997638E-11) 3.508978072054436999999999999990761546584E19) (num-test (- -4.7642024461416964E19 -4.758309941438892E-11) -4.764202446141696399999999999995241690065E19) (num-test (- -8.307715835429606E19 3.313910202186439E-11) -8.307715835429606000000000000003313910214E19) (num-test (- 2.704675010192592E18 -2.6840207147078365E19) 2.9544882157270957E19) (num-test (- -9.860969100714668E18 -4.719594638795429E19) 3.7334977287239622E19) (num-test (- 7.87799781828944E18 -6.657221298850535E19) 7.4450210806794789744E19) (num-test (- -3.3937781740759863E19 4.783805995045389E19) -8.1775841691213753E19) (num-test (- -1.0747572720102216E19 -1.7144708598072445E19) 6.397135877970229E18) (num-test (- 1.3938845733158445E19 5.604369854609131E19) -4.2104852812932865E19) (num-test (- 6.0938348303695315E19 1.1005522580049531E-21) 6.0938348303695315E19) (num-test (- -2.4870844028694925E19 1.5391650322730598E-22) -2.4870844028694925E19) (num-test (- 7.323118607079343E19 6.637280375859432E-21) 7.323118607079343E19) (num-test (- -4.181201584825501E19 4.768935182006663E-21) -4.181201584825501E19) (num-test (- 4.1225910279381205E19 6.117191687463543E-21) 4.1225910279381205E19) (num-test (- 6.438313875980151E17 -1.4883489002691529E-21) 6.438313875980151E17) (num-test (- -4.573961206963222E-21 0.3586300020381973E0) -3.586300020381973000045739612069632220001E-1) (num-test (- 7.74206782371325E-22 0.23168389210368656E0) -2.316838921036865599992257932176286750005E-1) (num-test (- 8.572446613640605E-21 0.6114581963443891E0) -6.114581963443890999914275533863593949978E-1) (num-test (- -8.539467934859551E-21 0.33474735899049E0) -3.347473589904900182020371578704711119401E-1) (num-test (- -5.55811309570968E-21 -0.9637216018651454E0) 9.637216018651453999944418869042903199998E-1) (num-test (- -6.705839413964189E-21 0.3787619614522374E0) -3.787619614522374000067058394139641890005E-1) (num-test (- 1.338539206480238E-22 6.683968625235106E9) -6.683968625235106468200683593749866146082E9) (num-test (- -9.64078167549023E-21 3.291420859310843E9) -3.291420859310842990875244140634640781671E9) (num-test (- -9.26536204591093E-22 2.9839295142529476E8) -2.98392951425294760000000000000926536205E8) (num-test (- -3.647737608953592E-21 6.115300020921433E8) -6.115300020921432971954345703161477376078E8) (num-test (- 1.4069763806331204E-21 -1.183109060480878E9) 1.18310906048087800000000000000140697638E9) (num-test (- -6.0037865798761924E-21 -7.442246743849378E9) 7.442246743849377999999999999993996213425E9) (num-test (- -5.994118986299138E-21 -9.091558282012836E-11) 9.091558281413424101370086199999999999991E-11) (num-test (- 6.969393585974241E-21 3.435352867093995E-11) -3.435352866397055641402575899999999999989E-11) (num-test (- -6.278554484817533E-22 -4.7211920270841604E-11) 4.721192027021374855151824670000000000001E-11) (num-test (- -8.603262886304741E-21 1.7296517702077242E-11) -1.729651771068050488630474100000000000006E-11) (num-test (- 4.104502790901735E-21 -4.8473213720301105E-11) 4.847321372440560779090173499999999999986E-11) (num-test (- -4.449725859444968E-21 -8.944265568403936E-11) 8.944265567958963414055503200000000000002E-11) (num-test (- 4.828216540804827E-21 -1.1712152029346877E19) 1.1712152029346877E19) (num-test (- -5.65034940464881E-21 -9.445303840982011E19) 9.445303840982011E19) (num-test (- -7.24107519738777E-21 2.340578690102746E19) -2.340578690102746E19) (num-test (- 1.7659593956231534E-21 -8.048768257390671E18) 8.048768257390671E18) (num-test (- -3.0538518255248124E-21 8.834631867521575E19) -8.834631867521575E19) (num-test (- 8.57952908388053E-21 -5.730742870111307E19) 5.730742870111307E19) (num-test (- -4.5090103564928485E-21 1.8907114777916313E-21) -6.399721834284479799999999999999999999996E-21) (num-test (- -3.8487625143236447E-22 5.354282198078924E-21) -5.739158449511288470000000000000000000003E-21) (num-test (- 2.6660110440404615E-22 3.833744224501756E-22) -1.167733180461294499999999999999999999996E-22) (num-test (- -7.503762004261027E-22 -9.623906576475644E-21) 8.873530376049541300000000000000000000014E-21) (num-test (- -9.113431042260725E-21 -3.5516521546085545E-21) -5.561778887652170499999999999999999999997E-21) (num-test (- -3.4813735333296525E-21 -2.6602650182385188E-21) -8.211085150911336999999999999999999999942E-22) (num-test (- 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99) -4948) (unless (or with-bignums (not (provided? 'overflow-checks))) (num-test (- 1/9223372036854775807 1/9223372036854775806) -1.1754943508223e-38) (num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) -0.00028742959363084) (num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981) -0.00019734085622449) (num-test (- 1/98947 2/97499 3/76847 4/61981) -0.00011398112564314) (num-test (- 500009/500029 500057/500041 500083/500069) -1.00009999119288) (num-test (- 98947 2/97499 76847 4/61981 5/59981) 22099.999831591) (test (< (abs (- (/ 1/98947 2/97499 3/76847 4/61981) 195556288.07955816413500830)) 1e-8) #t)) (when with-bignums (num-test (- 9223372036854775807 .1) 9.223372036854775806899999999999999994449E18) (num-test (- .1 9223372036854775807) -9.223372036854775806899999999999999994449E18) (num-test (- 8796093022208 1855077841/1311738121) 11538170533090478113327/1311738121) (num-test (- 8796093022208 (bignum 1855077841/1311738121)) (bignum 11538170533090478113327/1311738121)) (num-test (- -4611686018427387904 4611686018427387906) -9223372036854775810) (num-test (- -9223372036854775800 10) -9223372036854775810) (num-test (- 1/9223372036854775807 1/9223372036854775806) -1/85070591730234615838173535747377725442) (num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) -52761146275983172771170709/183561983334767209753061626751) (num-test (- 1/98947 2/97499 3/76847 4/61981 5/59981) -543899925850203550003/2756144552405627689570151) (num-test (- 1e40+1e30i 1e40-1e30i) 0+2e30i) (num-test (- 2 12345678901234567890+12345678901234567890i) -12345678901234567888-12345678901234567890i) (num-test (- 500009/500029 500057/500041 500083/500069) -125047255383687283/125034753009582041) (num-test (- 9223372036854775807 -9223372036854775808) 18446744073709551615) (num-test (- 98947 2/97499 76847 4/61981 5/59981) 8010593845541429507/362470312515139) (num-test (- most-negative-fixnum) 9223372036854775808) (num-test (- 3872339191937382556 13437882608410293981) -9565543416472911425) (num-test (- 12702320881720530101 13823645380834800545) -1121324499114270444) (num-test (- 10222969257152373972 -3454292165863475982) 13677261423015849954) (num-test (- 591233951053628288 -17639978232337836611) 18231212183391464899) (num-test (- -7878405903223218778 9050739027069287469) -16929144930292506247) (num-test (- 11347120771894057376 8443917396834074370) 2903203375059983006) (num-test (- 7831959259127703467 -257470007821066702597399141202130667973) 257470007821066702605231100461258371440) (num-test (- 1092406341647857980 -325710450166845666190895573961860069495) 325710450166845666191987980303507927475) (num-test (- -4220606126689357919 73461013742902296577411907972196819778) -73461013742902296581632514098886177697) (num-test (- -5112059189225304080 334306213789148650102245018234146620793) -334306213789148650107357077423371924873) (num-test (- 3093346224554776175 -204967241927023874963787190016588249299) 204967241927023874966880536241143025474) (num-test (- -5735747638156472357 -3881750746805128137401544408305666047) 3881750746805128131665796770149193690) (num-test (- 17639095392510638323 13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131453861285495087665017) -13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131436222190102577026694) (num-test (- 16304056910692545233 1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417465834928609990708982) -1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417449530871699298163749) (num-test (- -10347586523508777315 12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173691528917744363375331) -12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173701876504267872152646) (num-test (- 16875252323587344863 -10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527788318592431794213674) 10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527805193844755381558537) (num-test (- 8574302739232756920 2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503759011790017443478716) -2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503750437487278210721796) (num-test (- -17657597319577965851 -470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715357800461845632614015) 470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715340142864526054648164) (num-test (- 11472336850218354926 16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290339231792790773612376) -16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290327759455940555257450) (num-test (- 12682607562584942903 32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884157735553718792115929) -32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884145052946156207173026) (num-test (- 14621880654476679971 -10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579655168106377696154728) 10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579669789987032172834699) (num-test (- -3220156644655019630 -8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543667539444686619670713) 8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543664319288041964651083) (num-test (- 11628988978410243120 21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111014116286675587727714) -21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111002487297697177484594) (num-test (- -15960716439913426281 18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592227795474197104696127) -18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592243756190637018122408) (num-test (- -181065640455671431985325539445069267017 14120143334024043377) -181065640455671431999445682779093310394) (num-test (- -91295299684959299024846233061686623774 6891102275697080803) -91295299684959299031737335337383704577) (num-test (- -252582289949155881579950873916766853744 883304029266526072) -252582289949155881580834177946033379816) (num-test (- -10104159950635417603045689770006558103 17251490913777465304) -10104159950635417620297180683784023407) (num-test (- 288463495341489091297108607960869684860 -16376960611483226267) 288463495341489091313485568572352911127) (num-test (- 204661965092367792468062569536290631004 7774991291341524479) 204661965092367792460287578244949106525) (num-test (- 174559967167400201536723778015754014369 168183438971818617783400303174116396891) 6376528195581583753323474841637617478) (num-test (- -253300708624436983509156598368557395374 -77166863757693227553099778725240875400) -176133844866743755956056819643316519974) (num-test (- -38587765028356074196061530813295290944 5999161273284748726648331130480323187) -44586926301640822922709861943775614131) (num-test (- -236400856885875891058508662756360145662 222191413471626205952456600591947275777) -458592270357502097010965263348307421439) (num-test (- 212937903940173587742882129816769611096 336470165768472077447806282475185249734) -123532261828298489704924152658415638638) (num-test (- -264812595676159375893264580577855253845 -247068943830535581577267897204259299723) -17743651845623794315996683373595954122) (num-test (- -1725732715479127274526681751197327660 -2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500508887739763323997191435566266331339917) 2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500507162007047844869916908884515134012257) (num-test (- -220007189346579184019349894240059989979 9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517057595815179415042385175627374957565803) -9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517277603004525994226404525521615017555782) (num-test (- 139683266109784685815165642637380856544 5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108688202931002414214353708335212597807345) -5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108548519664892629528538542692575216950801) (num-test (- 239160165978290709841254489756277328273 5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464958986304380141364542178714472948085275) -5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464719826138401850654700924224716670757002) (num-test (- 315772704643232632782106484978382006176 -3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184616218582046814434719444842678248982224) 3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184931991286690047067501551327656630988400) (num-test (- 82735713197488344149642668226610301853 -12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097816492579684543651922277865558518876774) 12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097899228292882031996071920533785129178627) (num-test (- 63472235942371758467270296983419551089 -7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656218937984504828452980698439495961392749596) 7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656219001456740770824739165709792944812300685) (num-test (- -284018520801241078671538235859630240269 -5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682401429552174530714298081464588450842581) 5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682117411031373289635626543228728820602312) (num-test (- -171812101820192353275910956459431262142 11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870235074909890698574792562001595287630131) -11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870406887011710890928068472958054718892273) (num-test (- -243638660221338112796448050030955119997 -32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408826226326879491415484319411662301650468948) 32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408825982688219270077371522963612270695348951) (num-test (- -126332081511349770866908261827634312283 31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799809203410103682003414364238243553515261) -31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799935535491615031774281272500071187827544) (num-test (- 219979452670016849533060110266815720199 3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063325766995908926108582896362623757323811) -3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063105787543238909259049836252356941603612) (num-test (- 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493643522748210870974797 -1855792162818946202) 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493645378540373689920999) (num-test (- -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396746566100575461602162 18009081534399282710) -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396764575182109860884872) (num-test (- -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580214088920441698992069 -4827559068742614723) -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580209261361372956377346) (num-test (- 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693871318067007752043113 17597810481352184048) 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693853720256526399859065) (num-test (- -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778775472609306735864748 -3892174127829225880) -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778771580435178906638868) (num-test (- 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676743031117653237018365 -12861394200627120797) 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676755892511853864139162) (num-test (- 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971731015312020770945603825344926844435936044 236396022362585261770052671762207864597) 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971730778915998408360342055292255082228071447) (num-test (- 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903680828294561265828775791256812588754280222 -276673555533799047589626400978981416789) 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903681104968116799627823380883213567735697011) (num-test (- -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565826229169313660087149542130819663319659 -157671440495648010763311068579191828684) -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565668557728818012076386231062240471490975) (num-test (- 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053785280430612875488847226724390758938740 54361107931665215623681874454167019934) 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053730919322681210273223544849936591918806) (num-test (- 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942391817131531474661895913650810587431606 -50508350367572393968128467319633674717) 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942442325481899047055864042118130221106323) (num-test (- 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306794511840379704578900504784165956486985 170502882789371639987361620116696459267) 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306624008957590332938913143164049260027718) (num-test (- -10859007735074693411217019392659638207496329895257318665547454149984863458541990037760564769787816800806064437172810158051442267508476778676439633382657890 -7558060977666720080449823996328496253877735754811271086853901493753796001778345391546991917892931500169890406340928835457635973812901681485438886367096185) -3300946757407973330767195396331141953618594140446047578693552656231067456763644646213572851894885300636174030831881322593806293695575097191000747015561705) (num-test (- 9842028993407961669727766131360795288615020071102475108883839785397865740828387076847892646234215787999498419839351470775471313077046438080666908734795616 8259939762466350877481193620364896193464602165170783019804380181692322874550956777598992104871440502758410340359413403619753571535498118388286469082729503) 1582089230941610792246572510995899095150417905931692089079459603705542866277430299248900541362775285241088079479938067155717741541548319692380439652066113) (num-test (- 3122315115429970622394662815735050825423438028108957393747131991771456957037829402044934484343765915727397519247940959221091465331254497476137639859816450 10737995515603450913722681305571315249864367824351372254572936648132763616823019940208526402092654554035074813865303483747097673960803093638463005072804384) -7615680400173480291328018489836264424440929796242414860825804656361306659785190538163591917748888638307677294617362524526006208629548596162325365212987934) (num-test (- 11618335890332522671268040181306950825004789685088262996478365976802329054158653675768163009290064139158450983598701977173152384425333441365287895694522192 -13130287008197231017935223399369698658354829835061356451363818961959486828237111511740029441613108087354987794332115218978284937263725126538295501305403242) 24748622898529753689203263580676649483359619520149619447842184938761815882395765187508192450903172226513438777930817196151437321689058567903583396999925434) (num-test (- -4829477140897377009195646150061276059814366801005389903693533021027427566117360765323647260121062827801190746646296803957067548167571028717513392985791293 10716557117391614298810040587314742187092120526669273567183969821384063434473189717686678450880765426943205955814024872764413373364846268902370055526485180) -15546034258288991308005686737376018246906487327674663470877502842411491000590550483010325711001828254744396702460321676721480921532417297619883448512276473) (num-test (- 1560421244904974852620371975782132605421448226892487453928759432083522187778803424020804578027100625536441377609275030418285893555753560195716001014786650 -11797558308994912054526619290334311429749533070145154703018977152548370444659962978040151671210413666186432921816690953994784423526183449271023503069393845) 13357979553899886907146991266116444035170981297037642156947736584631892632438766402060956249237514291722874299425965984413070317081937009466739504084180495) (num-test (- -7701347923966912534344428538744620884561375267012102797292378941649984539207353887059064943586048644516121387166836442084007442716291792933061162738380376 5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642478870844024835907350391770605391526921411004262446196112836319091260967898895009427182171643279100998182191816962677328417390867021108292139204864164048286) -5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642486572191948802819884736199144136147805972379529458298910128698032910952438102363314241236586865149642698313204129513770501398309737400085072266026902428662) (num-test (- 9733743430220591762422540139212426729307515492818443460852332805653889275463385649305231919846970974905736816260992940027028218064265519723018527155353151 -29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453255593120138178690189726206775893096279000909079330468718593887702543025737308336025198677457129910473491269839827087491228569718246503140134413881896746751) 29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453265326863568399281952148746915105523008308424572148912179446220508196915012771721674503909376976881448397006656088080431255597936310768659857432409052099902) (num-test (- -276731217243271862683214238489380950428392903790808046630969592255272629537001990355375434170910931115552132394269672247616298060929507021008951190291387 100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150102261744547461816282538319258966892339056695718919291240188920586288417893106046698069355647145603908383687239983874164793005765733782432717429040621674) -100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150378992961790733678965752557748347842767449599509727337871158512841561047430108037053444789818056535023935819634253546412409303826663289453726380230913061) (num-test (- 8505070389896098095621766692413480203366379968950158493268895987250690600795955783113900096527432416791184386061684833478921638080978014176210898461637606 -16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728677459134022062202283647690649100602260948409511070624300011106517649666031530376191755817891213910847547809248990517666613043010292627100428536737652546738) 16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728685964204411958300379269457341514082464314789480020782793280002504900356632326331974869717987741343264338993635052202500091964648373605114604747636114184344) (num-test (- -12618010259109779267590315037969998053964054382853891516547435925972388025118492931596200697357628900783311183940584302426381939302632641549019984810957030 -30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476306906983993748299291616038887011943864441807818857508443930272872365334665976442185494702520760793786640113779099219233665607521784524244604432396247693263) 30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476294288973734638520024025723849041945810477753436003616927382836946392946640857949253898501823403164885856802595158634931239225582481891603055412411436736233) (num-test (- 793528769616879938852241178439496352527042950647521648629732169156958768358523029837406526207126598190786120139491813624819360632811627576064199559812277 -7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323018004882611048769247228828875493680284766874334247375868318795940759082324831733175858991629741478124633015067484305547002438816473086042218906532116413) 7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323811533652227928708099470007314990032811809824981769024498050965097717850683354763013265517836868076315419135206976119171821799449284713618283106091928690) (num-test (- 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554199017672360091721648 9164115638960783470) 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554189853556721130938178) (num-test (- -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769237154904791412049964 16928681651977808800) -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769254083586443389858764) (num-test (- -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289916823063616573634058 -10755560408227106818) -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289906067503208346527240) (num-test (- 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427134042574317487793 -126159569916621842) 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427260202144234109635) (num-test (- -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617308447853505824391099 13449070890444925581) -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617321896924396269316680) (num-test (- -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414447893892341891463988 4431555062692055371) -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414452325447404583519359) (num-test (- 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637382775371488874447622330992324750207465 329466253508616383200261654231797136951) 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637053309117980258064422069338092953070514) (num-test (- 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708269410828528742743794495302359380494607 126536164564464424337714470705049463978) 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708142874663964278319456780831654331030629) (num-test (- 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199731850712255885395479903525322397561293553 -169494171680584797187706369710105239124) 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199732020206427565980277091231692107666532677) (num-test (- -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152307499446188262820058714564165108542508 -26845770031559702758807696432929071597) -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152280653676156703117299906867732179470911) (num-test (- -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789655406716271370732069643455590690035701 -321447426701397438572265325285879998363) -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789333959289569973293497378130304810037338) (num-test (- -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955696690287600957842671916189752415855520 132223863177855649509430852484092802671) -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955828914150778813492181347042236508658191) (num-test (- 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912743446197670724757690108283368934769626461285961947257397454619164856011847736479229692086038931510067165282571276049292116713101550911614590774659556899356 -6114512833799784097991148713266650451765474382378581896952003894922931741133332233338460555227243451198289670274036744955599177213449957470212981501678055) 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912749560710504524541788099432082201420078226760344325839294406623059778943588869811463030546594158753518363572241550086037072312278764361572060987641058577411) (num-test (- -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912449969621455596132708975438173455827361542712483153981422051943690720556013580161324856788091093465837542336129629269227369781823515673967591796132853515009 3321161637038961370471515250185392889390643163295535903347391615170504064647249127732639364682803744773593849851778894972403397573953564801884397178069327) -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912453290783092635094079446953423641220250933355646449517325399335305891060078227410452589427455776269582315929979481048122342185221089627532393680530031584336) (num-test (- 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741918196732794332451120218658490129307932187658010681746557120172585093207839141764683325214902696969028472942954863209641597556494684135445935915485525220911 204625459185084436546676461283890328511903949966691877662249903659689934813784661695047569885195881142676761876303280806728760511429260843727967794322777) 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741917992107335147366683671982028845417603675754060715054679457922681433517904327980021630167332811773147330266192986906360790827734172706185092187517730898134) (num-test (- 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321037694842089561504643350632756961329867761604760788760440497535611072991056505806805291706178639395690245460397975614715123591611301423752799666149495108752 994321141213369910357526037382331323092462599623554452705525887587326552002660849455542761618020243106424015447778226642816634338781654345001677083881111) 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321036700520948348134732993106719578998544669142161165205987792009723485664504503145955836163417021375447139036382527836488480774976962642098454664472411227641) (num-test (- -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316157215551931810740200836725504693738229444336470213883741520460842708733150362983831267583568258736572295448486287825894301201018490203520738439038977754991 -7402949251688548738762242219263594861535354011996392637087346760786292549376145193266590582054224293289596877537643409310483743293801574030358189880866069) -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316149812602680122191462074483285430143367908982458217491104433114081922440600986838638000992986204512279005851608750182484990717275196401946708080849096888922) (num-test (- -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264269215878469013316796620921077244799814690434355127994011220041638393750697699141479399553359747084811371804524490919966410379714725200415331414459870271869 -9247155945465656153397925559476432992975541781462281935278489123804934847762489500833913193183733932905776020790478662969835879365116238125565077744775032) -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264259968722523547660643222995517768366821714892573665712075941552514588815849936651978565640166563350878466028503700441303440543835360084177205849382125496837) (num-test (- -17010604274474750006607667808593883725990508452473783283717890546525148212376267233909567638545898628257361383837671935903199638230375408397752251127816717091041943873728526445398525706450929660366518707254053655364610471112296477865068960744948010561798109833411657930112293904378353445961131058136287425064317621271289456901138718557297733713446119244533144377470099270824020439428168481914824420861176457152299497728390918971852021025089592998997807574907789524112450146545688385954763667980124432645276563626082835790429598328230426471161191074551543308732791287559033843466623138171520961684959997180979203053477 -17319079025684619178510812811805110270463447771889107440996086020812918555191263705580533644731591929176480040622705607552852994906782176254877135818109655911838591767583157894999741648979817400330572419476101372927546509769818404491634583907246692993992514876697330603464497645633398167129555001859772111887143352351860130929715392173452396253437927361301990735683539169040916027268831202732178553152351117118606495416985612909248422655861312689027789401950549626643389790516560291620711705848717875304929186131258525831197192620523261738944873398924939726689336762464320190834794155527335576391767307110012289717973) 308474751209869171903145003211226544472939319415324157278195474287770342814996471670966006185693300919118656785033671649653356676406767857124884690292938820796647893854631449601215942528887739964053712222047717562936038657521926626565623162298682432194405043285672673352203741255044721168423943723484686822825731080570674028576673616154662539991808116768846358213439898216895587840662720817354132291174659966306997688594693937396401630771719690029981827042760102530939643970871905665948037868593442659652622505175690040767594292292835267783682324373396417956545474905286347368171017355814614706807309929033086664496) (num-test (- -28362352496476494327713713233021518136860402239251781438945998574753662942796270292818595738100959519541952077905620088422871490191217157269435052965329201030095268586136492980900212955645939325800541690754639292707053269767151001292253701853012092829784482071789669480438026889625605099744553642207773753943711175375843649210118677569597324789367425691177169929576236753018329085700397911235750600921874606148324025962628852167093806152864269874177214562322576097931390470469397118268354868919899638376323751276807304678316688836173746719723312665764603485606350244811113608471530958617108833879194264695174468397461 -4081062111675377984305281082755054920741203741273067094307824323728798665450292976016160959354997082250970415737745853292134965575242789548167162064123232363464302136338349828801951197252612093077640695564825095503535921549690447893467349156939791370286866987224201115453216606688305427702274940837032716124925028835914047967887674858015919302546781010326385758988488478290741665427521820112231266659657169118374988259423444686317389869729817643396097464874333968181509317307320406521221309011946212308190273531009796563611621389720223920155554879800901239072885025170342349379379336047732368458185953903872634982504) -24281290384801116343408432150266463216119198497978714344638174251024864277345977316802434778745962437290981662167874235130736524615974367721267890901205968666630966449798143152098261758393327232722900995189814197203517348217460553398786352696072301459497615084565468364984810282937299672042278701370741037818786146539929601242231002711581405486820644680850784170587748274727587420272876091123519334262217437029949037703205407480776416283134452230781117097448242129749881153162076711747133559907953426068133477745797508114705067446453522799567757785963702246533465219640771259092151622569376465421008310791301833414957) (num-test (- 10367142604728811799331249565431331488313655422005202933702176605382043644320209814639311439871418581341534233560256605231366966869093495784665834232350567124110194965198962966795893926025854156729633358240069116588609932539289897499402463770167927610848388138020589286461244557962368497723086593344721146859584146431437967506007518396464517349944129896971137720357645026281243138165214047233258394590454775153944241555543594427555914116439316287902470043292624597940465373006598913770411505099332700167695871387948271302951230983772351549087620538875967635100644404345317626621438913980275970160864401622986870735123 -13323117602411502623386235160326625769048477819798659261203460002048250420188223753407093545503703207645050883770850457071863684414849353264890601744588860687970804808452855795406182324143949747985869939791374195222513169904228914579995165180964917538177994190229733465224857616114628815752065632238207474599531507602861647623695058640735949593381112671690796335596142010430124683781417828023076027476816068202219709673411776556090962187853799456968290579708094595903778622705850818245685205707447012659247018940946510378371952655457988959551256869060428488498330109152756599450626641948447980234503249330875085656261) 23690260207140314422717484725757957257362133241803862194905636607430294064508433568046404985375121788986585117331107062303230651283942849049556435976939427812080999773651818762202076250169803904715503298031443311811123102443518812079397628951132845149026382328250322751686102174076997313475152225582928621459115654034299615129702577037200466943325242568661934055953787036711367821946631875256334422067270843356163951228955370983646876304293115744870760623000719193844243995712449732016096710806779712826942890328894781681323183639230340508638877407936396123598974513498074226072065555928723950395367650953861956391384) (num-test (- -25321281404861286799950777949097462701962113587443565138655462269365151737118518315058035825695270231347401755128007072923189452859397209062457461602335603630181865680063451525170253746137368267674863889514153713728814272332433431604233690200451816570240227260445028630591376891139306370205846627093813889699170594185178241812081296510140572331372738998993116117098817936927692238682202717231675283209016857095739468507690090676681400453024293870135659990528969837132054786661560150259115734877162158755858653364070279937027014730947342216816307219127474721622123875699701715404820384545693058511056735799834754890692 -15870257059811626693754498423136372480069134596343998984549199283973854570508228359295418026089909378687774627821225399931314225867711515277913855368473873536462450935842786002269065816311054834857109074848803122494252885020527074586145467185882674518032764708782999568002770206995683800833252068328835778749976046128872525287656002968632147457840467536682726059599593635219947081138082647985895437016641903078766878782632503812736486529143041369932038649270950453231711525943737962179463585338023463992816994328519710963267459007592689204838965317062070771191372220277256094361390952025057574056586665509010902583686) -9451024345049660106196279525961090221892978991099566154106262985391297166610289955762617799605360852659627127306781672991875226991685693784543606233861730093719414744220665522901187929826313432817754814665350591234561387311906357018088223014569142052207462551662029062588606684143622569372594558764978110949194548056305716524425293541508424873532271462310390057499224301707745157544120069245779846192374954016972589725057586863944913923881252500203621341258019383900343260717822188079652149539138694763041659035550568973759555723354653011977341902065403950430751655422445621043429432520635484454470070290823852307006) (num-test (- -10064759312484387184876313010284016458560725440641239737323234767636591183611201479885347260175161165340917225306019885202675573016295152797559983194160634880140345743489989007821872426587698574795394887035658449467358615185057180305109018898637903449135520486663185036663238956537895356325733583128141439025002140924158670346599492383552938312402521066705186885506193758499006001382444818328802338159713646715901977137011576113434170842422373328479181457354927400927267448788528116619711184792932525071391797130057189079431487557270366699175956757661488296856660145077706273571985222726397848614141194988258117115194 -3689074607001776735792882994440038588887963294487080609346609068733026224735369468180206799966728461935654851527895876039403151156669223687679382665269013769686991783531091821265184956524448064027733731862929686596729449196238312997460578818232100254940830907672953344544031914926653652310468671685310332327057444910423081752028857828828473637496272809899061573593874011995802487442092326045415689987885712749026491545159340468151000027397821404233369034594141219014219707193746581364791219277489927025992135462852894714639406751538919395016165215641239054420028872350709704191189169571752512626755385998505584006855) -6375684705482610449083430015843977869672762146154159127976625698903564958875832011705140460208432703405262373778124009163272421859625929109880600528891621110453353959958897186556687470063250510767661155172728762870629165988818867307648440080405803194194689578990231692119207041611241704015264911442831106697944696013735588594570634554724464674906248256806125311912319746503203513940352492283386648171827933966875485591852235645283170815024551924245812422760786181913047741594781535254919965515442598045399661667204294364792080805731447304159791542020249242436631272726996569380796053154645335987385808989752533108339) (num-test (- -4621513851362114851854472268081584822344822740665629177305004335694395719163541988311496405455186973857145245414214464449674464879082042971313025249648887349614046805778335573547862191522938924075560443632614665169520240664970180760364771373836023824195690134618554368845612471858027311791638881380352344527105480173917778084361560336490212845414303819150625355111300877737042696291233444311426721588476948565949641149735838580313236869041013210454558557732497012037162735013212361842433337324577522358968152852532145622765032318936569346015498130151789662274686368870963891262060214274101000058555635785833724062234 20283847238128227963042817384468009365120280641032764409860857066215336820785816567924217697745867082423864450685360959383940995237907453126362378908108545669654749698030305432673477271848544313029448526561606175059997663752601262173667861202924953502866611309434183496911206954880840674239880495147451496219568787221129244201657487090244435562896841733049066453539864301122516559479757096183362477594406691085946787803323712522074578611082872627361465163804239673539339633332349145205596371287028267780080937728455742966681547897652607170788637996317683436193829274172400558140357237480809582038468874094877651383053) -24905361089490342814897289652549594187465103381698393587165861401909732539949358556235714103201054056281009696099575423833615460116989496097675404157757433019268796503808641006221339463371483237105008970194220840229517904417571442934032632576760977327062301444052737865756819426738867986031519376527803840746674267395047022286019047426734648408311145552199691808651165178859559255770990540494789199182883639651896428953059551102387815480123885837816023721536736685576502368345561507048029708611605790139049090580987888589446580216589176516804136126469473098468515643043364449402417451754910582097024509880711375445287) (num-test (- 8229768172162771789/4094631553683915058 14916542302144281688/9648520391570031013) 18327341244785642013243791303754634353/39507136041685332578233153660317693754) (num-test (- 13554976081719376860/5850035209629724601 -6813034992928443315/16012083383654426278) 256899901877002811987490932642058619395/93671251573905451634945335611797465078) (num-test (- -221798849980968127/896588178875000428 -10118632981534633697/16809799818197706916) 333990778095757160537366868413422249/941966737890699707694484674257410003) (num-test (- -10398409463665680242/10672871071680021919 908300169382593227/1663860017749090135) -2076589873614048366639515256135965791/1366012573135328609279238070700513005) (num-test (- -2198518713248421187/494031967775171833 162489257999262168/3608560229859558061) -8013762081101965644053022173225152351/1782744111192743850497670941715295813) (num-test (- 4025149216228566945/640594137312937394 5467380276809034025/15813352732084653151) 60148732603712157399679443099667862845/10129941051434949990590527231467828494) (num-test (- 45649282670476595/278386580761220266717341154184065537 -8637266763647548631/320617180101036447149595031898805939080) 17040443444897688379155017841073877168061229451634462447/89255520501631886327999278515127058459530587144975987720686743155549485960) (num-test (- 5648415331928005377/86815630814151297970860026950116430492 -3858618729527320883/27855468652821710859204555976171379400) 123081918822962876101148539477322308270739795776139149559/604572520679633516300271119677141637780408278090307422820905500994965166200) (num-test (- 9781572955588417059/112881800445343004034168709823458687843 -5059688483724168531/4577416283528891230944530353546966748) 615921077060787960354561606126348783111829996215681822765/516706991472571912574910836774186280180852506048696459094758451180832844564) (num-test (- -4967914039344839478/238170260180199675500515253723794945205 1851848905279976507/5731170327270969184071911155742503278) -469527297115675955424190428047537920421409443442551107819/1364994327983166854234805393053180119374354994464588574791772715189542881990) (num-test (- -16853061581795824324/96404437352723357070647888504166371117 2887610208906060444/32980643277330946266739822018299212963) -834203249643667606680245846951263316484378801689149307960/3179480358681967952651970543397987660141008737601948320258541111852875189671) (num-test (- -10766003534404571638/1736320411127247334175538439020437437 -220564366893542891/24024005562370344889629855466198025799) -11228676451427374102904112111967705085778332338188090365/1813624835433832784217556253227924899981441517333394378436857197512671181) (num-test (- -4039872531792560303/2717817538621352660433068255065439787147153801016478776178010367557953211548 -17969900169229544519/10371230759745501411127733226376204123221866394120596070959771442399588297129) 6940459580028931824293913174633904994365279610168782399332846513086074139209123514834476635325/28187112855925579976299840753672542065528422968220885043792832460046226866036339425358907691441054924266606457279617295071355282523744922239122018045692) (num-test (- 11905720953886477738/26349991043344773150817457299711471013733618033386232710348739943906972457535 -1868508269239354100/7915113871665192715310471309271830385175189228544536787145345883401181858893) 15941145914794937177093386304443205602552827651536706608400845076162777444155363739893353329726/23173686625047977587990304423741788120258508897732978034793987736019678129860415537604628640859289817332994555163435451240013483415438259775849311623195) (num-test (- -2449440712560236858/3924161613720467738425590715321110829708355586356453490516463081317902575263 3313932993860824279/18392642760231276916239249302906853654153090246504347205856270072174622214792) -19352032211145724571420568734409847660231095572377236173431089875006133635431666731719362137971/24058567564857748536604240288023690440577404826273237225585673569644473540232022448230431237781096357243673961302816983638647478040822458289501843963432) (num-test (- 2375854596996813469/17171542567603713573317138241061150416263899780234956304631913156611236192733 -1690236091628058998/115698505401619203741389026136939663329574241316722960060260525901879106902321) 303906786920788985464713527121698374469813384178920405503303785899916213843318155692692663023083/1986721810512032345893371071989737461519340072368099757524397292434629497187713075053126253107235936414498803590298681018206068059043963268488989361033293) (num-test (- -9066703779833220052/53996509329904595759286231403247566365148374715934463324003880626270687736687 10104829441267883881/34350188217372122913844475743718288066233853695548819225257606841719829170673) -857068498550946301314281599902676812596945461499639532351672507051201056365247232693696093577243/1854790258563312749374056592838765632813507083399863975139987272744324437901043103651094837595789610803765303659351781344942305171362498886075754606580351) (num-test (- -712905705954993103/38361275706852471555340413672243335795384295466685977818182375699688812583403 -3487523845474404757/24004509207225606167828624323100421869226668573968691661898194620137716910067) 116672912187985693533424614379662678476187446315443107971581372764612623068602629062267386180170/920843595906060126846114857872490000269306626188013726759480780006531676144330596572087176480154495471428384288229491172449159350622326294294528887818001) (num-test (- -104068455909264700529593875361271227125/3443783531459345396 94266182755532992545775726171008609186/10986871169556601787) -1468019045636814162670978305715811638938423723806410280031/37836405995984502494576730289263822652) (num-test (- 6250188382163250356218308848100308290/74975517450841979 10057222263694104272437942231238950849/1377150882331486572) 7853407001895533030925726629648778749078643531548391709/103252600010686800286181264132405988) (num-test (- -325869560300902552275820653500571757882/6390430580148850471 94468553562411191993094256419298214695/11908765973274803007) -4484399064985071999330976874105690617426359030318059422519/76102142247451389303559481900024166297) (num-test (- -93570528036598407567281714804477572547/1681213810574384291 -244906502561054838674546679498356325029/6878656438675875801) -231899320744132980638168050942881155823492361410591515708/11564492202898292712047439710761442091) (num-test (- -81411835730261219386583131450337332863/716127167248934 305772198898084305417824619321954306670/5852119619187572757) -476650772889757879179369019399921041943854248979406203071/4190861845290706865359628655691038) (num-test (- 8378821874364768218652992773582270365/264620166167099506 -235085292482743132422942426826553295351/5218853722286899445) 105936154887632142427944491040385766054707164161382644031/1381013939193345109641609957531174170) (num-test (- -46932041053326337601984043288899377207/83004348019257810472659105973646518650 -172752976692389001100875729845538600392/64697064048458368935602368307247306331) 11302882932785858045495103305619355060523322049764297548269071809310077113283/5370137620102451116225827082734739449691101289924623877117727128768254573150) (num-test (- -5215113722152182902641295804790889582/37267147737183802417372262122851319461 -174324915479281952095382231256728338942/198797486533978895289571841018885549001) 1819946959828587625889363843813156766676787993042778284071188313098762447560/2469538433480866339929667414220581052912334718874062150193407525506073469487) (num-test (- -308468863588547635528373349890793262605/277175417813474671446046438490775760091 -88071245580784145343997181342216325733/109042592277517238289414020635536175644) -9225060231388102579469362745283215538990500777711808852192407359260779270917/30223926073985207174135233898799350451872811382182855106546181559011381423604) (num-test (- -139281160373255540085888405052544101003/21590054032847718908692432707921390245 -175128181843395150044469443628898278945/101874815793501611839718166887463701141) -10408215647857282226079103083273257459322595128147732742048301223816698452898/2199482777568107961766315941206227462112836158088743951492692685709912769545) (num-test (- -13653637423911886957204229566898836211/6724361745919744069899921221745423919 60537422461958273742622747790343370991/323722395245687564470126807800714703749) -4827063738484690108652046326448960810791170812913084889649499536314520788768/2176826490887613088066161490358401961235974091796973399049221882998503572331) (num-test (- 207284509647982883454717074874778610186/315575836476247924963087075944676754095 59454580888278446469281150437143941047/3799382139920332759258392540934029749) -17974876032324524053425850245755672169670471578477359535347261991433397414151/1198993196898275844180025803639723883733761367273976879884312817813487572155) (num-test (- -149255714031984711085009662216310611563/61209488724728410476016289765233999883959861482512968048939594260689484910535 -206353007879160639705730135450663155/12341134377195982958424940281067948493740598784362073339140017508008773524522) -1829354061323966095884091779117676852909282652562065419187935424186237303685407507859167669375269438805585201409961/755394525511335693198081866608161950899365908489933659716533239785460293292606918153507868614180865950008697266433342863460741791684603303270127798639270) (num-test (- 286228990947356503137685907205210886138/64525193112922470913382853022276019736227442678252533126077234112153953877503 -93778927468512815169462456699065596479/70019706577332037325570327903202382111804035215024271930215402736305222068556) 26092773364888269343302672267572690894453186378630697330693315371426642609003667116358459590920104883240139740188665/4518035088612517412858008269349176355736855744033363257986123715832709510554983209440815107866748014413528943649032845277041680450752670951433682692095668) (num-test (- 128067958966292694713545212085241612749/50804897676960765097908813878456128842417954009101908722816951877006748778869 -331437715897535092432788513322484606485/102911257177761006574263802557003927106564530572416215828322919550454967864323) 30018293903870953799879886574342637699455128356488843398998059810000258259055116602688738404467489640369684487419392/5228395890723542025866546462435908982096651119675992137235094920338650164475761939608730060759309002063498665792819192135030537577109853650729817121390687) (num-test (- 27065789167947870065829490227927612633/10795458608984562931374526676297845621730864739104955678079256994070639461197 53314096352440087811254806167289750292/44807028208492548064750449353871285104149154384082409595945081934090139448067) 637187458285170434834128234123875152637450428605039275620795715002449318075555518355578432548587274399560043210887/483712418416385035748598509413117409273155809870339120248356475239836262578288026980177669113025449532258001487616187498682131415946755647640047843156199) (num-test (- 275528434092876314751862670579225752027/23290954563951481764306221308726902093226107549717031306984541394996363441752 118398743375843543978994815511147957868/26050691402435592629863948804505350954161759382372519491414484055670238339031) 4420086456754111377514058698455330162869575963826459083894390154200727636413353382047981846196341965799691593361101/606745469813648893293125236863835131523556569847025597910312571817347251611730291043895952533706547565767925058454286630395458711598751591845070996622312) (num-test (- -263828172858355421790882308711676546531/27836884730007976814146538035133148053942251062564400015534567388490010158584 31580638196736633522674344981675107601/26210154715367115936541726366619494863883445533448748701891278370021519416412) -1948520953518189888695889830515156795224640917019574042614412953331052369986548949517168001067643449389746489215939/182402263891837359872743630675214135004512597266032306942151126033873543370078488920825920736994254287019873146147276876145783659805845233146169813070152) (num-test (- 43029409555492054023102681165249027816896930295612442385573977041111849786681/17478431621804970398 -63831159286570708329826084149841946467426290005331979697932225104261019322894/15909114936773208135) 1800228375210677909820927489860838061135888931548234366640994061734196466170531105718785437541747/278066377585826623354880511023167787730) (num-test (- -34677827126365037739221949705076349308552841821108642369491195428278121711851/12321935233094032355 2466652720703038662112375481129216761044838204088317060529010755963314905661/458077759838279587) -46279076433142446690218423399092373290016631287423134630356063713373023144989129659854095947192/5644404488448083755690706619714037385) (num-test (- 75657421640076548917316021979547903196453821552146142751737530624725671569062/5416811919979369403 -51031635143911513328361770575139950616395278082588474953679149885798666896870/16274277637120569843) 1507698654622877634185545368063085304919907004898369478770589865697455127479301592176158803465876/88154701093808389139357381843158713729) (num-test (- -86696779369804422745383183615836359604633179506005810847902134850836986706763/15354752711854066426 83875579121692496325618937810567731584819474189441279434601944065565889174333/1890321146489013312) -725886765676185953186290796464189476910148783977596698524963064505627422317719186476684911836457/14512706875163632554860591439823131456) (num-test (- -2824584270835350806110810310308644313069326027498380007733023821989145840779/3128200028313826545 -16485532380752962986834975164722153533427821569516340079793116204530103476885/4044901389917631001) 40144878017198534388242075435853869853984060096218401720566307902396394251666454424383286522546/12653260642466969643085415999628721545) (num-test (- -71140717297594692514165816539390347954764512441693085945645019026357644035048/15130773661553937219 106518314860779634188990156539381479314908411240039365434170935270962911954978/11202282371121185733) -267626990691150539404999353980899804835901788880218020004516046839225745741587662342920970677374/18833244338916713919008552672213388503) (num-test (- -31372444086039981530710911528326367048894875160807395940269724829549418985367/149682691887362386596593782520991059630 13980025800771566396092717430902170466939197897483207383178768135899198010674/143215924045734814208985239450703841431) -6585601463869631351127457963734548845246885851328680299125624347680443020577881573937479731612385878788264587830797/21436945032301618223045694723696447349670080755369221855700055538448185530530) (num-test (- 60002561005149795132492915799111287923312170708430066011808292212167201814322/16346766380600148228286881361520329811 104734497917913613491539581495799848702023341599268915776996571583385896191203/61937476024742321910315674059586179787) 19844918952732846654680216616282727016967753441473733514766184661191061075852141231786969917096326062063227788681/10024529215648371311559365663430434349900555024451481776473735938354274557) (num-test (- 78980655687309201443760271907411093305339297143458162112992101000746746121121/24094471248783344167514231679460830840 10562090177736342378322146805187203837437609238688017154037816697523731420573/74961473522415640988394298626742882726) 2833009175986364875175323375606672657538996734036576482627590142336455915129629838687125527863027857335645122892263/903078534276138789186206765245648729133926893901427360507431923032322034920) (num-test (- 96507496069338193466683209170737942070468924698476218759487496209308948365/19252547784216386872197161331387216893 12563973560096321588715986952435909079270363887929001032891628645353358046011/79879611474172059435223762585596250921) -234179520035021783886726161079163865833895106001667476480293126893061678147610754451356994012799045797572757769658/1537886036891137155393554113191390737924110193971845147480358562685078008453) (num-test (- -95307376781556674397571761484869767912211504027346871580288574968524683908606/128329921725822403056205582017133271311 36170894925879686192917617159219095595164782822289198001474013555499918728596/240886887357120796976726436320063138705) -27600105449672599524131749634403660999916186956076872373762346977331203119722064380924286397976905109959929163304586/30912995399316310109755266138690547023211992922143297688759057498082990192255) (num-test (- -22104893896795356297688360407985617971036912713007110938688208155601366216839/5790727918973991999188987227357894380 -2339372311396919406471876113751500811577555408710269902369834593304924842262/12937689744925498650506694361349920911) -90813196841584888136609582546105640167792279132393576014002859436259486025871518847027719826829986116492656710923/24972880404321196721702428178050372850585634300866259560981343234830460060) (num-test (- -3426218098660813853559652497557253942819662042768623922183022792185928242671/2077407536662385613357832628600529321326686191757127715026249042748302985178 102639297566540827510784861997871251414598617775200449087621943894148321803293/83089038429507982364103335021257902316010144851865721965726693103637274338545) -497904817589969304680335736144278473886197067420059149312627956679073246109792679236301202959163792633927112737045328517845259242265445360227131779644849/172609794647490471018785535271654901168315737813115654161745630290269473799997219289162551586864155467201760250711449118429648095083028041134558889086010) (num-test (- 1543899448831604569141696144740105016328586790221799945430718394112623114412/1094690716976737526626281319975432667416762320123576900412499904933271786567 -101835025746074730017715423582062511397387458863000475669454309217160145993/55116548932808468782187525862059393507883043749327746382569396580129398962) 196572266866178229534134252625134989714563665559807019513454337864363053729628560611312158082929567528955985669620113192156991984486011150099776316375/60335574468539540262844259780498204139853746803235564167348945699931512713417761400790104247218084745081610815218855896912895393599203789305655343454) (num-test (- -37581128364300495505521143552535972339959603365602244668159915869829949338997/42947503543372015019662104425995959382231280059683481488692141811517675950053 -64888994735350842409379226446854438865448614840503930577860382883594178287934/83188698741706753136718468601650233481619465918167616089202536622553688681087) -339504834548876267781536981106771553482515399809961247195394672491113984585270709765073243997043174508213253440272888923497173265137136111635177948889237/3572746933977957867604303713153220827104741303667912510494658617478381525690274918494624922428110123336345510454960178899375325287131764283538305257747611) (num-test (- -16230533405187239318665866908175768720879595131719076634847964191318368133798/22572606803697929681675696479626869642065470042484269772607381297011844085929 -3238806615045730440879378702226410558103197865253164974472379309242480970831/7167633180423354812410246140643720752789573307606828791458541239290047771821) -43226201536346598702395278529841763047400215735214225929426206339139243925579733185594282160061132691154727543083543034702325848468839969037250195569159/161792165494835249202675342837643048016103040739685489755239980324180308179745586573032524649518850731442178659412287492012066453331740508600962908806709) (num-test (- -58154703770626762920775801228739843350302933064569814497417973139312614069763/25655935043535628671780902110427599603857741303802203417196105196580175051005 2291927744682353823611191393035210406213286149316388597509251757479544491322/2075117977066796442381930295725401140983312287419314083032058820231519915051) -2848879691864593463404526996418656511058536739346277043463623510210968076493148319480555434626780964688210750895957968447300033820091387019574369485421/845064952814266442598400897276554701819815257830830535600041451476645443978805142044657833921127247033533628716506571358424324423237490438402971304385) (num-test (- 16233726784138742204308718138203086218138595789383817317246449554340898453104/16370584482945481446847872945862788646563748664837147378940234530469832625057 14431071141710676049963542765626402177344958369162454874051268130438178883381/21166786163219212747261378458659387864767326410261049063051557406799162784072) 107370754167217929909136144689909613387440429633745577224054233373886366171618903318258855919060113440621302505589923655976636732694637334616990468681771/346512661117421566971293748815177161526095870176610277140325665174756629068111228154091043637596506814557119477231243643171068111260010676990408227692104) (num-test (- 3872339191937382556.0 13437882608410293981.0) -9565543416472911425.0) (num-test (- 12702320881720530101.0 13823645380834800545.0) -1121324499114270444.0) (num-test (- 10222969257152373972.0 -3454292165863475982.0) 13677261423015849954.0) (num-test (- 591233951053628288.0 -17639978232337836611.0) 18231212183391464899.0) (num-test (- -7878405903223218778.0 9050739027069287469.0) -16929144930292506247.0) (num-test (- 11347120771894057376.0 8443917396834074370.0) 2903203375059983006.0) (num-test (- 7831959259127703467.0 -257470007821066702597399141202130667973.0) 257470007821066702605231100461258371440.0) (num-test (- 1092406341647857980.0 -325710450166845666190895573961860069495.0) 325710450166845666191987980303507927475.0) (num-test (- -4220606126689357919.0 73461013742902296577411907972196819778.0) -73461013742902296581632514098886177697.0) (num-test (- -5112059189225304080.0 334306213789148650102245018234146620793.0) -334306213789148650107357077423371924873.0) (num-test (- 3093346224554776175.0 -204967241927023874963787190016588249299.0) 204967241927023874966880536241143025474.0) (num-test (- -5735747638156472357.0 -3881750746805128137401544408305666047.0) 3881750746805128131665796770149193690.0) (num-test (- 17639095392510638323.0 13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131453861285495087665017.0) -13312205908441007415860933757605397223142073616822325142416364932887680287063250296996056787873086490231950036662943632990219865746131436222190102577026694.0) (num-test (- 16304056910692545233.0 1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417465834928609990708982.0) -1463591032326743052350022746892396184459320617971409440301562638996633667625451301419074212369365394140737678584830314878769698416417449530871699298163749.0) (num-test (- -10347586523508777315.0 12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173691528917744363375331.0) -12614325304787850623826535169596975975360455924114817820074336137897280818245940873677389644701038550150832199897314137414727161192173701876504267872152646.0) (num-test (- 16875252323587344863.0 -10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527788318592431794213674.0) 10230183557696638447600885112945653217398839137450096120772416948425622105048400944465287395231588821521217980407867153259741079758527805193844755381558537.0) (num-test (- 8574302739232756920.0 2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503759011790017443478716.0) -2945205250727759066959418729185252318153395797902208079569164623770839848878181416073351760975066439564334127158302281471631001294503750437487278210721796.0) (num-test (- -17657597319577965851.0 -470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715357800461845632614015.0) 470389901349206124503884936612357721199915776516939967013182926735009022045917047211666512521578494339222795740836335004070464944715340142864526054648164.0) (num-test (- 11472336850218354926.0 16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290339231792790773612376.0) -16764018932433717867649699977474298016589762238077229911249331402108995850754999065988360217500238643747316139204767820295123085026049273617874157749889925712672510963712964034497935503076689670786498045302562704435768723916334451317158760704743066709581593570757498670622547878516907127632802801541072452593999435195637193819500375063696114131057474475407791672955417184592088612921927282233762919112197264895445408873539746256555444555901857369535350160665235184955438709679669964546134487688796078142789125799020704969226557493354453298489954288702387159956161243151013189140749021799388406290327759455940555257450.0) (num-test (- 12682607562584942903.0 32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884157735553718792115929.0) -32133619583510009354538204193505267426986629771080807813988708187761849276650847958886764459302043799013813125903744946349479743277662066609741649009023451783267511140245797235200413941774959851628239089013586399425314412329003636059313583335807925401822165199322334470452126484173417518861322963430951772895619791799137157183662289329901964728384697377777905235894234370773419160283767144177627084271804319157013765325677633945370597318765372346484383325176768117059688792498687750479618961541872574768601477738410497806623403054372221338126223825515939164627992974469102910882915893925327931884145052946156207173026.0) (num-test (- 14621880654476679971.0 -10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579655168106377696154728.0) 10075923784619510279100488003620810539888599376089081798647754628017452762406215094511315867213396543200861274584884759429891242650999761503100661310915213260386281412125687376866399124849043409890009033179987278297335571911640353059036551139958369871790768643514550179661619387008678118363266091945225880595898524898713646458647465935791224159084684209727153050053537752111696883536364966526666445737103854446009305531519860527938394412863332757413309423156200192973778629503534709731073637828912608835085933003410694216843775182940057891552358942312728978810053715387504707194992816961400377579669789987032172834699.0) (num-test (- -3220156644655019630.0 -8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543667539444686619670713.0) 8347829670073174550775641165362740628312221836466572623516708794243074870361401136762432100726575330214254748615114820602945887237367461962207075265579588481261313345359877816874924645801358760718027997416917747796144940020489321523749233377708490614979453376328244189926517907474704635785063100359787580409065317918203485474119227673185211436285930586838616288721370975925191964611302275354365110550116042403226844820172448647475637867255305805337047967053177320593337377763657329816935516961201488840745892529800883680912275812320160312651894919502389242002380151562481051684439333368396132543664319288041964651083.0) (num-test (- 11628988978410243120.0 21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111014116286675587727714.0) -21091260149209133824278525560739673446778991946138130571540201996950100883736332286627324787663044982195445635023357027423513202277912840570399895946346028843517588470258087913846945044832851780108963206182331994065720076983528527849542421619745503796476103034657238118665288185878258232226731582201217795631247916614224227701409259346052937919425072595891571572960468193421257458185693656090215937518204243652916583730260295885562094977775951577484951577581277292356830523013216949489797535362720471761788697932265967910160407593278848113303674799017334692501935041730808945554336564957621028111002487297697177484594.0) (num-test (- -15960716439913426281.0 18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592227795474197104696127.0) -18799211173341989380260980155501104944815245973352765317821146163884181375747259542484535639646490774929026134833947975785613727050541297797675705933339289016115326958150660323801621778641184271728990164666383865587422591755046779736996211052149338115836473967202556153668963815595875844414662034458693455631979862997316049580586739835122770408911308146605671192538040301857163633538268589024651373766021087864982140201615461513687698136663128896835597598904095187715456109340116329587986878167776146023396961265667934659006280575496363066974484893764810659481361856335795455814679851690737943592243756190637018122408.0) (num-test (- -181065640455671431985325539445069267017.0 14120143334024043377.0) -181065640455671431999445682779093310394.0) (num-test (- -91295299684959299024846233061686623774.0 6891102275697080803.0) -91295299684959299031737335337383704577.0) (num-test (- -252582289949155881579950873916766853744.0 883304029266526072.0) -252582289949155881580834177946033379816.0) (num-test (- -10104159950635417603045689770006558103.0 17251490913777465304.0) -10104159950635417620297180683784023407.0) (num-test (- 288463495341489091297108607960869684860.0 -16376960611483226267.0) 288463495341489091313485568572352911127.0) (num-test (- 204661965092367792468062569536290631004.0 7774991291341524479.0) 204661965092367792460287578244949106525.0) (num-test (- 174559967167400201536723778015754014369.0 168183438971818617783400303174116396891.0) 6376528195581583753323474841637617478.0) (num-test (- -253300708624436983509156598368557395374.0 -77166863757693227553099778725240875400.0) -176133844866743755956056819643316519974.0) (num-test (- -38587765028356074196061530813295290944.0 5999161273284748726648331130480323187.0) -44586926301640822922709861943775614131.0) (num-test (- -236400856885875891058508662756360145662.0 222191413471626205952456600591947275777.0) -458592270357502097010965263348307421439.0) (num-test (- 212937903940173587742882129816769611096.0 336470165768472077447806282475185249734.0) -123532261828298489704924152658415638638.0) (num-test (- -264812595676159375893264580577855253845.0 -247068943830535581577267897204259299723.0) -17743651845623794315996683373595954122.0) (num-test (- -1725732715479127274526681751197327660.0 -2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500508887739763323997191435566266331339917.0) 2279805492899538651574406423954277869507456204136276822451602661149698386520868702017367409743272511010382761246500507162007047844869916908884515134012257.0) (num-test (- -220007189346579184019349894240059989979.0 9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517057595815179415042385175627374957565803.0) -9116030813176547770422918633286023943039811682891023288884273747820892639481842291616424036020927750322528731882517277603004525994226404525521615017555782.0) (num-test (- 139683266109784685815165642637380856544.0 5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108688202931002414214353708335212597807345.0) -5782493350903499652295971390391981928106911831248674750993968151944332845911526084530951283012280786005612601970108548519664892629528538542692575216950801.0) (num-test (- 239160165978290709841254489756277328273.0 5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464958986304380141364542178714472948085275.0) -5152132850125501873897264811465207492706871561577273155117982457627773151595716641409297120994045059130053034927464719826138401850654700924224716670757002.0) (num-test (- 315772704643232632782106484978382006176.0 -3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184616218582046814434719444842678248982224.0) 3689252327480456512393153800679864208480329729627292260734151097785848947569336194072922395859496552999163037466184931991286690047067501551327656630988400.0) (num-test (- 82735713197488344149642668226610301853.0 -12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097816492579684543651922277865558518876774.0) 12473025194535761005577066561696471986140205263843017221991729197337093872383371857001077050460827652296473928714097899228292882031996071920533785129178627.0) (num-test (- 63472235942371758467270296983419551089.0 -7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656218937984504828452980698439495961392749596.0) 7866520408163137968600317959735552406794938230345293650627055135268307695389903092041438746530663083967329111232451176014649873249349534808700483360707382397988918594143264031213181385790969271527978925616276399184489007642142996251807222768397530946779296600805549276528669432847672215219943599871223372831999133812100481632278022608906065923652981249057846548868473376683960144009223047416366697876553049362242497225174860431577034875737250719899362881567590934060155436179316063810148362442197071642183371654740845983314705249832168923202400873364289483910868432511677656219001456740770824739165709792944812300685.0) (num-test (- -284018520801241078671538235859630240269.0 -5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682401429552174530714298081464588450842581.0) 5529748211779294240854894683633173443789067073881249229985499707296461959655918837051490512357840133495603640185675483847478587849599477020706893805485599954539589062532211767295361120129440287144117406526027552427750375526095104163474774446716012360038076376952619723549765229763943818011605991300849052030142173100367582906381575666628005795818339029350398340616624791399526643991489247585213423174803853961438830286737553181353007081438503238779644371968004083452645077716952159339978836669723137339898471600546912430030276920763475622536295311290657163861398519747560279682117411031373289635626543228728820602312.0) (num-test (- -171812101820192353275910956459431262142.0 11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870235074909890698574792562001595287630131.0) -11401673303315394031728944442295528921842441448377692701102691446500671963119794838260543877466107345474902885032629120622020177051592733148817057943390167845763358795044702079370835841331467130719834250134674578757640577473495192331790176510774020541399177011446664359866582351045889299070080989390219063301859447807907203943168891690028442190793548699886572720360741686677780644932612683647303776634496172481504075784427704287335805355801794320914944330891519283383694196486986108936857630373759865062862204149003789919218681050221366182434949855054760827976853645027544605870406887011710890928068472958054718892273.0) (num-test (- -243638660221338112796448050030955119997.0 -32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408826226326879491415484319411662301650468948.0) 32214383478080953899491069562585164652288236626686985994647827422262342469970423345510055643470262764747630363450204055220886177681745412924556264758690138113272748656941509018308925555317383307928766093730384151056027828368474245304944063213926492719166086055718735381341569379006804236876950175122702350552198046290567043195716369691666842524594399597143281611765509174168738392889075290806378316647736667077047013214732267367344808724905727602402784621437141760604478301412768904784950365257469208085143467704875589485635570084387755189599791857576855454112556762755762408825982688219270077371522963612270695348951.0) (num-test (- -126332081511349770866908261827634312283.0 31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799809203410103682003414364238243553515261.0) -31497387372874133218238910173378055967910722258532087598053588964599898753455370244114881403020152175272452951858324158004662566613339529101292284073176382818309096142522412043073218657587031893636358434796164444941535757484360125937835242214199979245499374972029624710574236962978707708765065292759037309958875006017588240959790355958632745299212449602934380927677385974488564420550408281673927387615657765312151272852486266800510090872812376232597458154951925709496664568906509814364388823105469855516803225244972466742963619633076158367569109107733990828830121948130235858799935535491615031774281272500071187827544.0) (num-test (- 219979452670016849533060110266815720199.0 3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063325766995908926108582896362623757323811.0) -3900115048441644499033281842448985956665866771934663536385503692700586024397767816761943054115584011069129310718114010862034970648115172218305599786238607524420973404711138276011261135403209178420948996472570042497859127324157786975578751148348046315727383390370594954695454631662061021971027739429505825056455676233533511412589936865597034183410893428831818716136282201523804692574965779771140320669492229416601369453681528301333865290947482219850340728455965391492610516639151652595539203632139883064874286555941718154489936421274731413286355640404192677546692090304496817063105787543238909259049836252356941603612.0) (num-test (- 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493643522748210870974797.0 -1855792162818946202.0) 585873325961105129055557280004608765382109855007674169500308242261038324959928764512890600512016613154122762798104714052579267789493645378540373689920999.0) (num-test (- -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396746566100575461602162.0 18009081534399282710.0) -3026050092505200332789765255096964033685859497096213532090644235603419347590512426830117415222669642053441336442247132403948783838396764575182109860884872.0) (num-test (- -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580214088920441698992069.0 -4827559068742614723.0) -11124638695599888462310706699308855434715251048597328942409434888923094027849143412724699165971400546471660924330688750607774759764580209261361372956377346.0) (num-test (- 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693871318067007752043113.0 17597810481352184048.0) 4950293428090696283711882613183655723616682297360442241017758383241177602498881186549809051670562038601658285833496694108818253845693853720256526399859065.0) (num-test (- -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778775472609306735864748.0 -3892174127829225880.0) -5733769947958740467479139247420201065087494801172241127791526686385518674532830661413722661802560247463032020003355494614502034002778771580435178906638868.0) (num-test (- 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676743031117653237018365.0 -12861394200627120797.0) 8320894458193427045187598554188178307429755504967209344418448624882517461814957461249858674758807195827056824653471934409067429988676755892511853864139162.0) (num-test (- 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971731015312020770945603825344926844435936044.0 236396022362585261770052671762207864597.0) 13033402737450594044106258936169013897237368708138118260402180886096095497725071502601849887805439844083105685971730778915998408360342055292255082228071447.0) (num-test (- 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903680828294561265828775791256812588754280222.0 -276673555533799047589626400978981416789.0) 12170667278114656173974716189098171384426379753661081475485441559687661443127166543908925678856145097632475832903681104968116799627823380883213567735697011.0) (num-test (- -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565826229169313660087149542130819663319659.0 -157671440495648010763311068579191828684.0) -12755594876262399860618168642932232021734362385933348033134635580177924615701078617214764415318471507488803810365565668557728818012076386231062240471490975.0) (num-test (- 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053785280430612875488847226724390758938740.0 54361107931665215623681874454167019934.0) 8664063140780163008577373335591938905735059211566906376953760862047748343846207426667781783874718320339071949903053730919322681210273223544849936591918806.0) (num-test (- 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942391817131531474661895913650810587431606.0 -50508350367572393968128467319633674717.0) 3699576825118349347309026261327541749454660339251578894574483235547605815416603169143590292164644149607672871236942442325481899047055864042118130221106323.0) (num-test (- 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306794511840379704578900504784165956486985.0 170502882789371639987361620116696459267.0) 5626548453644136572409808769267055618695663227750732922630041368983808478347120771651822300668480671524976882745306624008957590332938913143164049260027718.0) (num-test (- -10859007735074693411217019392659638207496329895257318665547454149984863458541990037760564769787816800806064437172810158051442267508476778676439633382657890.0 -7558060977666720080449823996328496253877735754811271086853901493753796001778345391546991917892931500169890406340928835457635973812901681485438886367096185.0) -3300946757407973330767195396331141953618594140446047578693552656231067456763644646213572851894885300636174030831881322593806293695575097191000747015561705.0) (num-test (- 9842028993407961669727766131360795288615020071102475108883839785397865740828387076847892646234215787999498419839351470775471313077046438080666908734795616.0 8259939762466350877481193620364896193464602165170783019804380181692322874550956777598992104871440502758410340359413403619753571535498118388286469082729503.0) 1582089230941610792246572510995899095150417905931692089079459603705542866277430299248900541362775285241088079479938067155717741541548319692380439652066113.0) (num-test (- 3122315115429970622394662815735050825423438028108957393747131991771456957037829402044934484343765915727397519247940959221091465331254497476137639859816450.0 10737995515603450913722681305571315249864367824351372254572936648132763616823019940208526402092654554035074813865303483747097673960803093638463005072804384.0) -7615680400173480291328018489836264424440929796242414860825804656361306659785190538163591917748888638307677294617362524526006208629548596162325365212987934.0) (num-test (- 11618335890332522671268040181306950825004789685088262996478365976802329054158653675768163009290064139158450983598701977173152384425333441365287895694522192.0 -13130287008197231017935223399369698658354829835061356451363818961959486828237111511740029441613108087354987794332115218978284937263725126538295501305403242.0) 24748622898529753689203263580676649483359619520149619447842184938761815882395765187508192450903172226513438777930817196151437321689058567903583396999925434.0) (num-test (- -4829477140897377009195646150061276059814366801005389903693533021027427566117360765323647260121062827801190746646296803957067548167571028717513392985791293.0 10716557117391614298810040587314742187092120526669273567183969821384063434473189717686678450880765426943205955814024872764413373364846268902370055526485180.0) -15546034258288991308005686737376018246906487327674663470877502842411491000590550483010325711001828254744396702460321676721480921532417297619883448512276473.0) (num-test (- 1560421244904974852620371975782132605421448226892487453928759432083522187778803424020804578027100625536441377609275030418285893555753560195716001014786650.0 -11797558308994912054526619290334311429749533070145154703018977152548370444659962978040151671210413666186432921816690953994784423526183449271023503069393845.0) 13357979553899886907146991266116444035170981297037642156947736584631892632438766402060956249237514291722874299425965984413070317081937009466739504084180495.0) (num-test (- -7701347923966912534344428538744620884561375267012102797292378941649984539207353887059064943586048644516121387166836442084007442716291792933061162738380376.0 5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642478870844024835907350391770605391526921411004262446196112836319091260967898895009427182171643279100998182191816962677328417390867021108292139204864164048286.0) -5290969389374230541016502448421359606252744677802288901830045825873182202718418905866055323957065013553046698199939002159982374580735362593037515863844280108947533575824820196689891621498006303535207762625068798755031433921940066544809959896067184147997503827988613858484669349726945188167613248195147619673963531690938913245110754715059472477991342216448470339490385593605806518967792963339193162830698488489270925945408227996742278697477358272529028932771642486572191948802819884736199144136147805972379529458298910128698032910952438102363314241236586865149642698313204129513770501398309737400085072266026902428662.0) (num-test (- 9733743430220591762422540139212426729307515492818443460852332805653889275463385649305231919846970974905736816260992940027028218064265519723018527155353151.0 -29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453255593120138178690189726206775893096279000909079330468718593887702543025737308336025198677457129910473491269839827087491228569718246503140134413881896746751.0) 29407855293830047984154639411082591337348779678279017647951764366455421210163494489475996514661359700145916243499452007595041420522019751347743105082745321262372977262641488359297167392118038994384136863563032667040671405618315550876997904307423736276844997706938133936081058323434935833614475654922773162140266784233792639117145232791514703532554345086520312281500696798706889025860427142771458666376271994240028586899592254884476941388776984078337603148583453265326863568399281952148746915105523008308424572148912179446220508196915012771721674503909376976881448397006656088080431255597936310768659857432409052099902.0) (num-test (- -276731217243271862683214238489380950428392903790808046630969592255272629537001990355375434170910931115552132394269672247616298060929507021008951190291387.0 100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150102261744547461816282538319258966892339056695718919291240188920586288417893106046698069355647145603908383687239983874164793005765733782432717429040621674.0) -100289083769237476480554074865040988004216167545459907207847010762380733541100608695693297149249375537088329431700364201275915507683345148401600569951338052791424407090330310974243070931256108167365334162914085216447196038922091547331474328250886730614683299908003398886233860613008266913065047699535081030427106800418656336608005860846045905149012346378286475449307630537665901621055008855374148058291266835796203075976592585729940879567246284967856356337849150378992961790733678965752557748347842767449599509727337871158512841561047430108037053444789818056535023935819634253546412409303826663289453726380230913061.0) (num-test (- 8505070389896098095621766692413480203366379968950158493268895987250690600795955783113900096527432416791184386061684833478921638080978014176210898461637606.0 -16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728677459134022062202283647690649100602260948409511070624300011106517649666031530376191755817891213910847547809248990517666613043010292627100428536737652546738.0) 16410711613672171332126342754193842244915477287016327757357714698751777287458963458682349581881560880814595167244857846847668988374679430572782121021084683986742283012573569894084166107235597351093334125816075658348307113218478800035703971671113417712009419861470917307849916674203301497919242668373376352901312309673053175315189945730756118172940886476343290174961420986113367531057713782438374928471960914578818951372282574754612716278516397754222547513576728685964204411958300379269457341514082464314789480020782793280002504900356632326331974869717987741343264338993635052202500091964648373605114604747636114184344.0) (num-test (- -12618010259109779267590315037969998053964054382853891516547435925972388025118492931596200697357628900783311183940584302426381939302632641549019984810957030.0 -30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476306906983993748299291616038887011943864441807818857508443930272872365334665976442185494702520760793786640113779099219233665607521784524244604432396247693263.0) 30500906828861638007306362171210132987300359439962044769219457463653547834815716264412200930088623097530758080891972640000479943534665059199377729854850415258341537838023739964147532129877743393965857370995558748807382396090020006195649251292012405690725917389684473999400905751109361754679152179983739269026226054012963756892488872262522587481931950410504651253101938824790285623805566521723062029033001745636445860437154344665483641408727637784045030118212476294288973734638520024025723849041945810477753436003616927382836946392946640857949253898501823403164885856802595158634931239225582481891603055412411436736233.0) (num-test (- 793528769616879938852241178439496352527042950647521648629732169156958768358523029837406526207126598190786120139491813624819360632811627576064199559812277.0 -7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323018004882611048769247228828875493680284766874334247375868318795940759082324831733175858991629741478124633015067484305547002438816473086042218906532116413.0) 7357484069649002655190557040768215614708659708788999334802985986235721030962928900092675952032143512196279092521450986819067071570862007086586132687661085824939677603953832219860573980632016025218580608321648907608385784471745482257672314890331358256478273312255285010343369949412955387472116587504557483184506548209831317705115523967163525846685455369176657510129844566195941925821733027993620517287411895496215426174909366458092382652675628195464969405904518323811533652227928708099470007314990032811809824981769024498050965097717850683354763013265517836868076315419135206976119171821799449284713618283106091928690.0) (num-test (- 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554199017672360091721648.0 9164115638960783470.0) 30958566711373255787092081401292877738974978442987704470984765018293851031728996862405055424093249924047528792113585028592262445810946419909807061004531455817427671594281537965628880611732831524185850161910304038646992464838306728350704966234151134620041799373762432970330864023007632010865749239024802839173884778578927209741320635135275002489733299806669933393428518104197594560039136096527206600870299327752296492029012993590212340409989598323540081430189567580333356380487749078595746626408529223195894600223743978246922817054226858311823994547784553612982586322603593335538875728113115443554189853556721130938178.0) (num-test (- -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769237154904791412049964.0 16928681651977808800.0) -22540807692474380279530794404584230073523360203115293035869063366926380719566516089428840111682263403627532047214106171892715667227836310498366393991106231487046533598391969789120283294510723096483520917309134391072655861112766764278247568027435618337967113341863713181603534251049249873125130781073437913954718595729437608729446837417196899902194261111827656247095442897532040935029872731410799530408713850806239149348700486268275019296069828199088780767614008685960242354118969741283398882689239770114582524756296906388861630890288875920861344939520380841337675934551587994259348267613541166769254083586443389858764.0) (num-test (- -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289916823063616573634058.0 -10755560408227106818.0) -5403850875869356031749551669837202919756114555261706106905659104903792701565965475066159243529680606410723686422444947172225540145977333194008702465610630608545009270872541652430806931212184915840724378685979865349848151917650322286497417985248678815214889868576385900691591784772762893647315325310416150353725001943778473686980157692817497562783521120544549784746647104651038037129984152623720529803205580894126664077380391379306511348324442512538418658728022685805514196592544294177914956734669359073791151050869328577099869772182315103156047405800398706114122356939316464974680113324979723289906067503208346527240.0) (num-test (- 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427134042574317487793.0 -126159569916621842.0) 16201587974698660164372991183566748501003872177894450603471850345714117528335101264234127789041855420954511595895378320972957964222386731614839583078498685801156670229700092209313747849610762975747730086443186821337319452128253859293962343891549207804191088925361935683615063225197130192492652062735684739784075955094308092423304262201429421582566117390598395895220976999990205945523225411701169301910362640419341608407294018105959688929256136725564385243617240412649023368133778798063226772467915584333795357813292935080009919284755332034998122912861893282865727947810588086156919649131720183722427260202144234109635.0) (num-test (- -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617308447853505824391099.0 13449070890444925581.0) -9976758107386398142455037422077809088581080675608340830198269021688955930541332630075972471934165382030070969307731206728197760190279942894255740733209190331510591013089699837164445642396864912572863786290237335963836376543389815671640509582958465164874961381137096877288362944469137669502842448492172241151419831252572392809173900377271652074261706120638052379886108764460001026094198502028776365675088466580595870167840105746912975236851293882732079317535103041585285239081516202482201377111734010788198635874359396626004300532752450289119192633850562141516671742961938277967783337559307443617321896924396269316680.0) (num-test (- -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414447893892341891463988.0 4431555062692055371.0) -8570952518585194406209873586517687582701183275108243979199329595605282282125006489076327154374449108678257552384372919282846744626955206382078850958298637157198962032090439427286914716782317030245513658212430127586764421559372214829010306717557679285031617989735914399954286846456953917915955558448774972943731602144914068097214910567329340361564904028964471241318105967747431610163083002382821902859161510204381788262611298660559327478615315484763561786397041779926288206767156863141140852268323253657685018587945456372648431446464389004257999049529945532453598011773843788498650935959375182414452325447404583519359.0) (num-test (- 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637382775371488874447622330992324750207465.0 329466253508616383200261654231797136951.0) 4117976000917214601143188578494558474138167055110060832594841842655428229500889876131794484851166401425675703592388271925904534237338595998991043982676292549088043959446082382516734793718348862105938692342851330680670593768890094290655852108130945387988863730762717733881418314989528719379494082656897158942547008663543153236129762264443358316776532465284014215413819415615612452225913947961681691310132286840303081453109375175436902292224029179426794714036524361081174901146731799945483243427138748119832116750910126386838614645397770107366925613473924955965862778639046707637053309117980258064422069338092953070514.0) (num-test (- 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708269410828528742743794495302359380494607.0 126536164564464424337714470705049463978.0) 28857935543824608075326348244201981931023939250259142606733822094071772153858420201297951828741003977413353359215638528196235956061529059419904405354390715114239219947402126760298132539402386106279333968395498788354937020337343839325588433318100331044091923709732742795159387846354148919054314582749477292946200912006940503778924320301062789466388997936618573519744795661160190636101768486096961991215006236190655062992372061052426455063703038765465688361316141792840153608145888307784845264037109867657483109819380082597605481013612040648149090345778910883349230476481347645708142874663964278319456780831654331030629.0) (num-test (- 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199731850712255885395479903525322397561293553.0 -169494171680584797187706369710105239124.0) 3146199586408378667812619157270468624370984629500707476575291934586478540055436137993431548830607708293475788354970610669452058906009873485175438772484599603993015239438297747261356407887781450787482447252615210880612867127689283653562498484594955015919746443263740095372831444793239911996227663006098501180972347442107190398034048225264564325230296723559400768342331039755765597288518435463475921534765025262262798267314969774604439319964638461636007229819888743218820584570149249791727508891676067767073852694327748467914037392778283816153183422263956621516748627574334199732020206427565980277091231692107666532677.0) (num-test (- -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152307499446188262820058714564165108542508.0 -26845770031559702758807696432929071597.0) -17024716654716744558842421452239026542281806678754026383430912733874686056449261218428541803113383766132449624540209841726047308927951820311213785345168358108138304716549475322223600292513384537980742126687035576531330089447100646214364923043445903103768701639992829171572718403272488931980504461938688955457870904289239032709146514866818331202329982821151580491257491540240579366183525075936339515949345815704583685855315810611089822402567649542290589282153225725537026309623090382054078872576985425957096858376112688308214148412270019118710904983829984589093557307164347051152280653676156703117299906867732179470911.0) (num-test (- -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789655406716271370732069643455590690035701.0 -321447426701397438572265325285879998363.0) -20875354448001792153279041347864644172439177882677780548397567327274288309764204295853633150227327732322157811413794613378828291977852467550695289535036337326494269114787031260705326469002279939986228049380615128280814933748700667874022724707001736732724010699175779382411342385842744973636495738468838244099596215421975861650998954057316519632062827510021706536194961332185926551767127180751211669386674770139039516623606727799489291663572125587356845055646322930167536458093283930082765496058330805117442824718962237069840252138957395570892073194575112213410604881673785921789333959289569973293497378130304810037338.0) (num-test (- -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955696690287600957842671916189752415855520.0 132223863177855649509430852484092802671.0) -6750548706930727136186675393752693335334383613941059024795513640678178119089262068912855951615043660442324823673049951182143778744824110223137384940032268718291241014850714197673735719784663896993460156686600813524168487673234842233781654493200950459723884918456280719440022930492599128086690014332139955274261568563155723011697763382009890186816226119314994799655369791620499988988986590903148198659095740939986627235565633349906453726759224441608018598520571182643709143072528030332708598472074166415467718451869993686505339408706320298338691467040585228617379086727764240955828914150778813492181347042236508658191.0) (num-test (- 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912743446197670724757690108283368934769626461285961947257397454619164856011847736479229692086038931510067165282571276049292116713101550911614590774659556899356.0 -6114512833799784097991148713266650451765474382378581896952003894922931741133332233338460555227243451198289670274036744955599177213449957470212981501678055.0) 15737797902964168014939893286340956118635524170934156177365242966267432695262586636031957242055461736359478270642576860414422844075672388559647477705484719667060463718865742735598799928335211410004369240278699196301127699945374217439676378682879115442203681638050752745036508637214733712716867800216723838016099572951915042604603457902610639317648800296497583507890473114507231814851908526534709496988648572353272479026750068932474334642929727977996779536604912749560710504524541788099432082201420078226760344325839294406623059778943588869811463030546594158753518363572241550086037072312278764361572060987641058577411.0) (num-test (- -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912449969621455596132708975438173455827361542712483153981422051943690720556013580161324856788091093465837542336129629269227369781823515673967591796132853515009.0 3321161637038961370471515250185392889390643163295535903347391615170504064647249127732639364682803744773593849851778894972403397573953564801884397178069327.0) -26633154627863501044020127597209297142657179797586777727331879111280843451446814109347357601013807189824906954310855123313836812409388745541128842840054310853220032505914307470215180950497357091093642400638925719682307925365402618310180378684705799724964274776149984064608716300479893889145492885897234574442542501896696821902329473018442082678749291668341477914681413039643187020003425962922948452894682558162414623956491734656939841377698702802567258906642912453290783092635094079446953423641220250933355646449517325399335305891060078227410452589427455776269582315929979481048122342185221089627532393680530031584336.0) (num-test (- 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741918196732794332451120218658490129307932187658010681746557120172585093207839141764683325214902696969028472942954863209641597556494684135445935915485525220911.0 204625459185084436546676461283890328511903949966691877662249903659689934813784661695047569885195881142676761876303280806728760511429260843727967794322777.0) 27668394897866653012794531261739800318882766882548843941974485394983434533400277607364280566269718161470415771058329222680901477416257843578362127708934184467195154000133252468684612556324066063725677629160438683034201285122508880444372096430021219637788794365539396242345208611990491721052691567092029622640533057073151980959055665792776356282961971341363712186503783566960850166774438868528799819047163739437906559674823146932668464230936946321915236658512741917992107335147366683671982028845417603675754060715054679457922681433517904327980021630167332811773147330266192986906360790827734172706185092187517730898134.0) (num-test (- 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321037694842089561504643350632756961329867761604760788760440497535611072991056505806805291706178639395690245460397975614715123591611301423752799666149495108752.0 994321141213369910357526037382331323092462599623554452705525887587326552002660849455542761618020243106424015447778226642816634338781654345001677083881111.0) 18944451653774463090918576081661764936021793389045063662102219434278236461286997354190032851092512146937346521704215170240383659165117708716738711782597164244188741818096207452074083439983059414271417130274747048227795964884943105011205424198661201055104372863019759130697888820715782179466491256695453118035286889359217448004524564796840711987314064158194625731263591557915838970249677548534895064545467992194029425250039951132361639559343536937119283951538321036700520948348134732993106719578998544669142161165205987792009723485664504503145955836163417021375447139036382527836488480774976962642098454664472411227641.0) (num-test (- -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316157215551931810740200836725504693738229444336470213883741520460842708733150362983831267583568258736572295448486287825894301201018490203520738439038977754991.0 -7402949251688548738762242219263594861535354011996392637087346760786292549376145193266590582054224293289596877537643409310483743293801574030358189880866069.0) -25075128489482657321316021943980016828761861550379828525731288423212311433274066958090940464803020097932875912251380196071686918459370667428905844496548191635733867314315152547202859654044591981512687559437417616479425752991419002108503390319869665933757684966460526631533822984311725217788657567199485442486045019468844265484117570385156844404625735176559901986920712550964238722824122000259551821135404274194791706113272773768366572120227974096419295159271316149812602680122191462074483285430143367908982458217491104433114081922440600986838638000992986204512279005851608750182484990717275196401946708080849096888922.0) (num-test (- -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264269215878469013316796620921077244799814690434355127994011220041638393750697699141479399553359747084811371804524490919966410379714725200415331414459870271869.0 -9247155945465656153397925559476432992975541781462281935278489123804934847762489500833913193183733932905776020790478662969835879365116238125565077744775032.0) -26509487378481600038412836495388065888781507388737194948728047318975269277448073484403390476243134990463394380967295356958474984927721196047241216945988250219075749832868804186657201899994373052648345989716938779173325348547767647529160988985542438998030764420175306438858518207072038513664360905985908879070216069156102379349899544471658754952888660878997691670566078979940005195987259493512159628198906090101827331841914429358969184839073862821059400943312264259968722523547660643222995517768366821714892573665712075941552514588815849936651978565640166563350878466028503700441303440543835360084177205849382125496837.0) (num-test (- -17010604274474750006607667808593883725990508452473783283717890546525148212376267233909567638545898628257361383837671935903199638230375408397752251127816717091041943873728526445398525706450929660366518707254053655364610471112296477865068960744948010561798109833411657930112293904378353445961131058136287425064317621271289456901138718557297733713446119244533144377470099270824020439428168481914824420861176457152299497728390918971852021025089592998997807574907789524112450146545688385954763667980124432645276563626082835790429598328230426471161191074551543308732791287559033843466623138171520961684959997180979203053477.0 -17319079025684619178510812811805110270463447771889107440996086020812918555191263705580533644731591929176480040622705607552852994906782176254877135818109655911838591767583157894999741648979817400330572419476101372927546509769818404491634583907246692993992514876697330603464497645633398167129555001859772111887143352351860130929715392173452396253437927361301990735683539169040916027268831202732178553152351117118606495416985612909248422655861312689027789401950549626643389790516560291620711705848717875304929186131258525831197192620523261738944873398924939726689336762464320190834794155527335576391767307110012289717973.0) 308474751209869171903145003211226544472939319415324157278195474287770342814996471670966006185693300919118656785033671649653356676406767857124884690292938820796647893854631449601215942528887739964053712222047717562936038657521926626565623162298682432194405043285672673352203741255044721168423943723484686822825731080570674028576673616154662539991808116768846358213439898216895587840662720817354132291174659966306997688594693937396401630771719690029981827042760102530939643970871905665948037868593442659652622505175690040767594292292835267783682324373396417956545474905286347368171017355814614706807309929033086664496.0) (num-test (- -28362352496476494327713713233021518136860402239251781438945998574753662942796270292818595738100959519541952077905620088422871490191217157269435052965329201030095268586136492980900212955645939325800541690754639292707053269767151001292253701853012092829784482071789669480438026889625605099744553642207773753943711175375843649210118677569597324789367425691177169929576236753018329085700397911235750600921874606148324025962628852167093806152864269874177214562322576097931390470469397118268354868919899638376323751276807304678316688836173746719723312665764603485606350244811113608471530958617108833879194264695174468397461.0 -4081062111675377984305281082755054920741203741273067094307824323728798665450292976016160959354997082250970415737745853292134965575242789548167162064123232363464302136338349828801951197252612093077640695564825095503535921549690447893467349156939791370286866987224201115453216606688305427702274940837032716124925028835914047967887674858015919302546781010326385758988488478290741665427521820112231266659657169118374988259423444686317389869729817643396097464874333968181509317307320406521221309011946212308190273531009796563611621389720223920155554879800901239072885025170342349379379336047732368458185953903872634982504.0) -24281290384801116343408432150266463216119198497978714344638174251024864277345977316802434778745962437290981662167874235130736524615974367721267890901205968666630966449798143152098261758393327232722900995189814197203517348217460553398786352696072301459497615084565468364984810282937299672042278701370741037818786146539929601242231002711581405486820644680850784170587748274727587420272876091123519334262217437029949037703205407480776416283134452230781117097448242129749881153162076711747133559907953426068133477745797508114705067446453522799567757785963702246533465219640771259092151622569376465421008310791301833414957.0) (num-test (- 10367142604728811799331249565431331488313655422005202933702176605382043644320209814639311439871418581341534233560256605231366966869093495784665834232350567124110194965198962966795893926025854156729633358240069116588609932539289897499402463770167927610848388138020589286461244557962368497723086593344721146859584146431437967506007518396464517349944129896971137720357645026281243138165214047233258394590454775153944241555543594427555914116439316287902470043292624597940465373006598913770411505099332700167695871387948271302951230983772351549087620538875967635100644404345317626621438913980275970160864401622986870735123.0 -13323117602411502623386235160326625769048477819798659261203460002048250420188223753407093545503703207645050883770850457071863684414849353264890601744588860687970804808452855795406182324143949747985869939791374195222513169904228914579995165180964917538177994190229733465224857616114628815752065632238207474599531507602861647623695058640735949593381112671690796335596142010430124683781417828023076027476816068202219709673411776556090962187853799456968290579708094595903778622705850818245685205707447012659247018940946510378371952655457988959551256869060428488498330109152756599450626641948447980234503249330875085656261.0) 23690260207140314422717484725757957257362133241803862194905636607430294064508433568046404985375121788986585117331107062303230651283942849049556435976939427812080999773651818762202076250169803904715503298031443311811123102443518812079397628951132845149026382328250322751686102174076997313475152225582928621459115654034299615129702577037200466943325242568661934055953787036711367821946631875256334422067270843356163951228955370983646876304293115744870760623000719193844243995712449732016096710806779712826942890328894781681323183639230340508638877407936396123598974513498074226072065555928723950395367650953861956391384.0) (num-test (- -25321281404861286799950777949097462701962113587443565138655462269365151737118518315058035825695270231347401755128007072923189452859397209062457461602335603630181865680063451525170253746137368267674863889514153713728814272332433431604233690200451816570240227260445028630591376891139306370205846627093813889699170594185178241812081296510140572331372738998993116117098817936927692238682202717231675283209016857095739468507690090676681400453024293870135659990528969837132054786661560150259115734877162158755858653364070279937027014730947342216816307219127474721622123875699701715404820384545693058511056735799834754890692.0 -15870257059811626693754498423136372480069134596343998984549199283973854570508228359295418026089909378687774627821225399931314225867711515277913855368473873536462450935842786002269065816311054834857109074848803122494252885020527074586145467185882674518032764708782999568002770206995683800833252068328835778749976046128872525287656002968632147457840467536682726059599593635219947081138082647985895437016641903078766878782632503812736486529143041369932038649270950453231711525943737962179463585338023463992816994328519710963267459007592689204838965317062070771191372220277256094361390952025057574056586665509010902583686.0) -9451024345049660106196279525961090221892978991099566154106262985391297166610289955762617799605360852659627127306781672991875226991685693784543606233861730093719414744220665522901187929826313432817754814665350591234561387311906357018088223014569142052207462551662029062588606684143622569372594558764978110949194548056305716524425293541508424873532271462310390057499224301707745157544120069245779846192374954016972589725057586863944913923881252500203621341258019383900343260717822188079652149539138694763041659035550568973759555723354653011977341902065403950430751655422445621043429432520635484454470070290823852307006.0) (num-test (- -10064759312484387184876313010284016458560725440641239737323234767636591183611201479885347260175161165340917225306019885202675573016295152797559983194160634880140345743489989007821872426587698574795394887035658449467358615185057180305109018898637903449135520486663185036663238956537895356325733583128141439025002140924158670346599492383552938312402521066705186885506193758499006001382444818328802338159713646715901977137011576113434170842422373328479181457354927400927267448788528116619711184792932525071391797130057189079431487557270366699175956757661488296856660145077706273571985222726397848614141194988258117115194.0 -3689074607001776735792882994440038588887963294487080609346609068733026224735369468180206799966728461935654851527895876039403151156669223687679382665269013769686991783531091821265184956524448064027733731862929686596729449196238312997460578818232100254940830907672953344544031914926653652310468671685310332327057444910423081752028857828828473637496272809899061573593874011995802487442092326045415689987885712749026491545159340468151000027397821404233369034594141219014219707193746581364791219277489927025992135462852894714639406751538919395016165215641239054420028872350709704191189169571752512626755385998505584006855.0) -6375684705482610449083430015843977869672762146154159127976625698903564958875832011705140460208432703405262373778124009163272421859625929109880600528891621110453353959958897186556687470063250510767661155172728762870629165988818867307648440080405803194194689578990231692119207041611241704015264911442831106697944696013735588594570634554724464674906248256806125311912319746503203513940352492283386648171827933966875485591852235645283170815024551924245812422760786181913047741594781535254919965515442598045399661667204294364792080805731447304159791542020249242436631272726996569380796053154645335987385808989752533108339.0) (num-test (- -4621513851362114851854472268081584822344822740665629177305004335694395719163541988311496405455186973857145245414214464449674464879082042971313025249648887349614046805778335573547862191522938924075560443632614665169520240664970180760364771373836023824195690134618554368845612471858027311791638881380352344527105480173917778084361560336490212845414303819150625355111300877737042696291233444311426721588476948565949641149735838580313236869041013210454558557732497012037162735013212361842433337324577522358968152852532145622765032318936569346015498130151789662274686368870963891262060214274101000058555635785833724062234.0 20283847238128227963042817384468009365120280641032764409860857066215336820785816567924217697745867082423864450685360959383940995237907453126362378908108545669654749698030305432673477271848544313029448526561606175059997663752601262173667861202924953502866611309434183496911206954880840674239880495147451496219568787221129244201657487090244435562896841733049066453539864301122516559479757096183362477594406691085946787803323712522074578611082872627361465163804239673539339633332349145205596371287028267780080937728455742966681547897652607170788637996317683436193829274172400558140357237480809582038468874094877651383053.0) -24905361089490342814897289652549594187465103381698393587165861401909732539949358556235714103201054056281009696099575423833615460116989496097675404157757433019268796503808641006221339463371483237105008970194220840229517904417571442934032632576760977327062301444052737865756819426738867986031519376527803840746674267395047022286019047426734648408311145552199691808651165178859559255770990540494789199182883639651896428953059551102387815480123885837816023721536736685576502368345561507048029708611605790139049090580987888589446580216589176516804136126469473098468515643043364449402417451754910582097024509880711375445287.0)) (test (- - 1) 'error) (test (-) 'error) (test (- 1 #f) 'error) (test (- 1 #t) 'error) (test (- 1 + 2) 'error) (test (- 1 - 2) 'error) (test (- 1 2 . 3) 'error) (test (- 1 . 2) 'error) (unless with-bignums (test (- most-negative-fixnum) 'error) (test (- most-positive-fixnum) (+ most-negative-fixnum 1))) (catch #t (lambda () (- 1 #())) (lambda (type info) (test (apply format #f info) "- second argument, #(), is a vector but should be a number"))) (catch #t (lambda () (- #() 1)) (lambda (type info) (test (apply format #f info) "- first argument, #(), is a vector but should be a number"))) (catch #t (lambda () (- 1 2 #())) (lambda (type info) (test (apply format #f info) "- third argument, #(), is a vector but should be a number"))) (catch #t (lambda () (- 1 2 3 #())) (lambda (type info) (test (apply format #f info) "- fourth argument, #(), is a vector but should be a number"))) (for-each (lambda (arg) (test (- arg +nan.0) 'error) (test (- +nan.0 arg) 'error) (test (- arg +inf.0) 'error) (test (- +inf.0 arg) 'error) (test (- arg) 'error) (test (- 1 arg) 'error) (test (- 1/2 arg) 'error) (test (- 1.0 arg) 'error) (test (- 1+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) ;;; -------------------------------------------------------------------------------- ;;; / ;;; -------------------------------------------------------------------------------- (num-test (/ -0.0+0.00000001i) 0.0-100000000.0i) (num-test (/ -1.0) -1.0) (num-test (/ -1.0+1.0i -1.0+1.0i) 1.0) (num-test (/ -1.0+1.0i 0.0+1.0i) 1.0+1.0i) (num-test (/ -1.0+1.0i 1) -1.0+1.0i) (num-test (/ -1.0+1.0i 1.0) -1.0+1.0i) (num-test (/ -1.0+1.0i 1.0+1.0i) 0.0+1.0i) (num-test (/ -1.0+1.0i 1/1) -1.0+1.0i) (num-test (/ -1.0+1.0i 123.4) -0.00810372771475+0.00810372771475i) (num-test (/ -1.0+1.0i 1234) -0.00081037277147+0.00081037277147i) (num-test (/ -1.0+1.0i 1234/11) -0.00891410048622+0.00891410048622i) (num-test (/ -1.0+1.0i) -0.5-0.5i) (num-test (/ -10) -1/10) (num-test (/ -10/3) -3/10) (num-test (/ -10 3) -10/3) (num-test (/ -1234000000.0) -0.00000000081037) (num-test (/ -2) -1/2) (num-test (/ 0 -1.0+1.0i) 0.0) (num-test (/ 0 1 -1.0+1.0i) 0.0) (num-test (/ 0 1 1) 0) (num-test (/ 0 1 1.0+1.0i) 0.0) (num-test (/ 0 1 123.4) 0.0) (num-test (/ 0 1 1234/11) 0) (num-test (/ 0 1.0 -1.0+1.0i) 0.0) (num-test (/ 0 1.0 1) 0.0) (num-test (/ 0 1.0 1.0+1.0i) 0.0) (num-test (/ 0 1.0 123.4) 0.0) (num-test (/ 0 1.0 1234/11) 0.0) (num-test (/ 0 1.0+1.0i -1.0+1.0i) 0.0) (num-test (/ 0 1.0+1.0i 1) 0.0) (num-test (/ 0 1.0+1.0i 1.0+1.0i) 0.0) (num-test (/ 0 1.0+1.0i 123.4) 0.0) (num-test (/ 0 1.0+1.0i 1234/11) 0.0) (num-test (/ 0 1/1 -1.0+1.0i) 0.0) (num-test (/ 0 1234) 0) (num-test (/ 0.0 -1.0+1.0i -1.0+1.0i) 0.0) (num-test (/ 0.0 1 -1.0+1.0i) 0.0) (num-test (/ 0.0 1 1.0) 0.0) (num-test (/ 0.0 1 1/1) 0.0) (num-test (/ 0.0 1 1234) 0.0) (num-test (/ 0.0 1) 0.0) (num-test (/ 0.0 1.0 0.0+1.0i) 0.0) (num-test (/ 0.0 1.0 1.0) 0.0) (num-test (/ 0.0 1.0 1/1) 0.0) (num-test (/ 0.0 1.0 1234) 0.0) (num-test (/ 0.0 1.0) 0.0) (num-test (/ 0.0 1/1 -1.0+1.0i) 0.0) (num-test (/ 0.0 1234 -1.0+1.0i) 0.0) (num-test (/ 0.0+0.00000001i) 0.0-100000000.0i) (num-test (/ 0.0+1.0i 0.0+1.0i) 1.0) (num-test (/ 0.0+1.0i 1.0) 0.0+1.0i) (num-test (/ 0.0+1.0i 1/1) 0.0+1.0i) (num-test (/ 0.0+1.0i 1234) 0.0+0.00081037277147i) (num-test (/ 1 -1.0+1.0i) -0.5-0.5i) (num-test (/ 1 1 -1.0+1.0i) -0.5-0.5i) (num-test (/ 1 1 1) 1) (num-test (/ 1 1 1.0+1.0i) 0.5-0.5i) (num-test (/ 1 1 123.4) 0.00810372771475) (num-test (/ 1 1 1234/11) 11/1234) (num-test (/ 1 1.0 -1.0+1.0i) -0.5-0.5i) (num-test (/ 1 1.0 1) 1.0) (num-test (/ 1 1.0 1.0+1.0i) 0.5-0.5i) (num-test (/ 1 1.0 123.4) 0.00810372771475) (num-test (/ 1 1.0 1234/11) 0.00891410048622) (num-test (/ 1 1.0+1.0i -1.0+1.0i) -0.5) (num-test (/ 1 1.0+1.0i 1) 0.5-0.5i) (num-test (/ 1 1.0+1.0i 1.0+1.0i) 0.0-0.5i) (num-test (/ 1 1.0+1.0i 123.4) 0.00405186385737-0.00405186385737i) (num-test (/ 1 1.0+1.0i 1234/11) 0.00445705024311-0.00445705024311i) (num-test (/ 1 123.4) 0.00810372771475) (num-test (/ 1 1234/11) 11/1234) (num-test (/ 1.0 -1.0+1.0i 0.0+1.0i) -0.5+0.5i) (num-test (/ 1.0 -1.0+1.0i 1.0) -0.5-0.5i) (num-test (/ 1.0 -1.0+1.0i 1/1) -0.5-0.5i) (num-test (/ 1.0 -1.0+1.0i 1234) -0.00040518638574-0.00040518638574i) (num-test (/ 1.0 -1.0+1.0i) -0.5-0.5i) (num-test (/ 1.0 0.0+1.0i 0.0+1.0i) -1.0) (num-test (/ 1.0 0.0+1.0i 1.0) 0.0-1.0i) (num-test (/ 1.0 0.0+1.0i 1/1) 0.0-1.0i) (num-test (/ 1.0 0.0+1.0i 1234) 0.0-0.00081037277147i) (num-test (/ 1.0 0.0+1.0i) 0.0-1.0i) (num-test (/ 1.0 1 0.0+1.0i) 0.0-1.0i) (num-test (/ 1.0 1 1.0) 1.0) (num-test (/ 1.0 1 1/1) 1.0) (num-test (/ 1.0 1 1234) 0.00081037277147) (num-test (/ 1.0 1) 1.0) (num-test (/ 1.0 1.0 0.0+1.0i) 0.0-1.0i) (num-test (/ 1.0 1.0 1.0) 1.0) (num-test (/ 1.0 1.0 1/1) 1.0) (num-test (/ 1.0 1.0 1234) 0.00081037277147) (num-test (/ 1.0 1.0) 1.0) (num-test (/ 1.0 1.0+1.0i 0.0+1.0i) -0.5-0.5i) (num-test (/ 1.0 1.0+1.0i 1.0) 0.5-0.5i) (num-test (/ 1.0 1.0+1.0i 1/1) 0.5-0.5i) (num-test (/ 1.0 1.0+1.0i 1234) 0.00040518638574-0.00040518638574i) (num-test (/ 1.0 1.0+1.0i) 0.5-0.5i) (num-test (/ 1.0 1/1 0.0+1.0i) 0.0-1.0i) (num-test (/ 1.0 123.4 0.0+1.0i) 0.0-0.00810372771475i) (num-test (/ 1.0 123.4 1.0) 0.00810372771475) (num-test (/ 1.0 123.4 1/1) 0.00810372771475) (num-test (/ 1.0 123.4 1234) 0.00000656704029) (num-test (/ 1.0 123.4) 0.00810372771475) (num-test (/ 1.0 1234 0.0+1.0i) 0.0-0.00081037277147i) (num-test (/ 1.0 1234 1.0) 0.00081037277147) (num-test (/ 1.0 1234 1/1) 0.00081037277147) (num-test (/ 1.0 1234 1234) 0.00000065670403) (num-test (/ 1.0 1234) 0.00081037277147) (num-test (/ 1.0 1234/11 0.0+1.0i) 0.0-0.00891410048622i) (num-test (/ 1.0 1234/11 1.0) 0.00891410048622) (num-test (/ 1.0 1234/11 1/1) 0.00891410048622) (num-test (/ 1.0 1234/11 1234) 0.00000722374432) (num-test (/ 1.0 1234/11) 0.00891410048622) (num-test (/ 1.0+1.0i -1.0+1.0i -1.0+1.0i) -0.5+0.5i) (num-test (/ 1.0+1.0i -1.0+1.0i 1) -0.0-1.0i) (num-test (/ 1.0+1.0i -1.0+1.0i 1.0+1.0i) -0.5-0.5i) (num-test (/ 1.0+1.0i -1.0+1.0i 123.4) -0.0-0.00810372771475i) (num-test (/ 1.0+1.0i -1.0+1.0i 1234/11) -0.0-0.00891410048622i) (num-test (/ 1.0+1.0i 0.0+1.0i -1.0+1.0i) -1.0) (num-test (/ 1.0+1.0i 0.0+1.0i 1) 1.0-1.0i) (num-test (/ 1.0+1.0i 0.0+1.0i 1.0+1.0i) 0.0-1.0i) (num-test (/ 1.0+1.0i 0.0+1.0i 123.4) 0.00810372771475-0.00810372771475i) (num-test (/ 1.0+1.0i 0.0+1.0i 1234/11) 0.00891410048622-0.00891410048622i) (num-test (/ 1.0+1.0i 1 -1.0+1.0i) -0.0-1.0i) (num-test (/ 1.0+1.0i 1 1) 1.0+1.0i) (num-test (/ 1.0+1.0i 1 1.0+1.0i) 1.0) (num-test (/ 1.0+1.0i 1 123.4) 0.00810372771475+0.00810372771475i) (num-test (/ 1.0+1.0i 1 1234/11) 0.00891410048622+0.00891410048622i) (num-test (/ 1.0+1.0i 1.0 -1.0+1.0i) -0.0-1.0i) (num-test (/ 1.0+1.0i 1.0 1) 1.0+1.0i) (num-test (/ 1.0+1.0i 1.0 1.0+1.0i) 1.0) (num-test (/ 1.0+1.0i 1.0 123.4) 0.00810372771475+0.00810372771475i) (num-test (/ 1.0+1.0i 1.0 1234/11) 0.00891410048622+0.00891410048622i) (num-test (/ 1.0+1.0i 1.0+1.0i -1.0+1.0i) -0.5-0.5i) (num-test (/ 1.0+1.0i 1.0+1.0i 1) 1.0) (num-test (/ 1.0+1.0i 1.0+1.0i 1.0+1.0i) 0.5-0.5i) (num-test (/ 1.0+1.0i 1.0+1.0i 123.4) 0.00810372771475) (num-test (/ 1.0+1.0i 1.0+1.0i 1234/11) 0.00891410048622) (num-test (/ 1.0+1.0i 1/1 -1.0+1.0i) -0.0-1.0i) (num-test (/ 1.0+1.0i 123.4 -1.0+1.0i) -0.0-0.00810372771475i) (num-test (/ 1.0+1.0i 123.4 1) 0.00810372771475+0.00810372771475i) (num-test (/ 1.0+1.0i 123.4 1.0+1.0i) 0.00810372771475) (num-test (/ 1.0+1.0i 123.4 123.4) 0.00006567040287+0.00006567040287i) (num-test (/ 1.0+1.0i 123.4 1234/11) 0.00007223744316+0.00007223744316i) (num-test (/ 1.0+1.0i 1234 -1.0+1.0i) -0.0-0.00081037277147i) (num-test (/ 1.0+1.0i 1234 1) 0.00081037277147+0.00081037277147i) (num-test (/ 1.0+1.0i 1234 1.0+1.0i) 0.00081037277147) (num-test (/ 1.0+1.0i 1234 123.4) 0.00000656704029+0.00000656704029i) (num-test (/ 1.0+1.0i 1234 1234/11) 0.00000722374432+0.00000722374432i) (num-test (/ 1.0+1.0i 1234/11 -1.0+1.0i) -0.0-0.00891410048622i) (num-test (/ 1.0+1.0i 1234/11 1) 0.00891410048622+0.00891410048622i) (num-test (/ 1.0+1.0i 1234/11 1.0+1.0i) 0.00891410048622) (num-test (/ 1.0+1.0i 1234/11 123.4) 0.00007223744316+0.00007223744316i) (num-test (/ 1.0+1.0i 1234/11 1234/11) 0.00007946118748+0.00007946118748i) (num-test (/ 1.0+1.0i) 0.5-0.5i) (num-test (/ 10/3) 3/10) (num-test (/ 10 -3) -10/3) (num-test (/ 11) 1/11) (num-test (/ 123.4 -1.0+1.0i 0.0+1.0i) -61.7+61.7i) (num-test (/ 123.4 -1.0+1.0i 1.0) -61.7-61.7i) (num-test (/ 123.4 -1.0+1.0i 1/1) -61.7-61.7i) (num-test (/ 123.4 -1.0+1.0i 1234) -0.05000000000000-0.05000000000000i) (num-test (/ 123.4 -1.0+1.0i) -61.7-61.7i) (num-test (/ 123.4 0.0+1.0i 0.0+1.0i) -123.4) (num-test (/ 123.4 0.0+1.0i 1.0) 0.0-123.4i) (num-test (/ 123.4 0.0+1.0i 1/1) 0.0-123.4i) (num-test (/ 123.4 0.0+1.0i 1234) 0.0-0.1i) (num-test (/ 123.4 0.0+1.0i) 0.0-123.4i) (num-test (/ 123.4 1 0.0+1.0i) 0.0-123.4i) (num-test (/ 123.4 1 1.0) 123.4) (num-test (/ 123.4 1 1/1) 123.4) (num-test (/ 123.4 1 1234) 0.1) (num-test (/ 123.4 1) 123.4) (num-test (/ 123.4 1.0 0.0+1.0i) 0.0-123.4i) (num-test (/ 123.4 1.0 1.0) 123.4) (num-test (/ 123.4 1.0 1/1) 123.4) (num-test (/ 123.4 1.0 1234) 0.1) (num-test (/ 123.4 1.0) 123.4) (num-test (/ 123.4 1.0+1.0i 0.0+1.0i) -61.7-61.7i) (num-test (/ 123.4 1.0+1.0i 1.0) 61.7-61.7i) (num-test (/ 123.4 1.0+1.0i 1/1) 61.7-61.7i) (num-test (/ 123.4 1.0+1.0i 1234) 0.05000000000000-0.05000000000000i) (num-test (/ 123.4 1.0+1.0i) 61.7-61.7i) (num-test (/ 123.4 1/1 0.0+1.0i) 0.0-123.4i) (num-test (/ 123.4 123.4 0.0+1.0i) 0.0-1.0i) (num-test (/ 123.4 123.4 1.0) 1.0) (num-test (/ 123.4 123.4 1/1) 1.0) (num-test (/ 123.4 123.4 1234) 0.00081037277147) (num-test (/ 123.4 123.4) 1.0) (num-test (/ 123.4 1234 0.0+1.0i) 0.0-0.1i) (num-test (/ 123.4 1234 1.0) 0.1) (num-test (/ 123.4 1234 1/1) 0.1) (num-test (/ 123.4 1234 1234) 0.00008103727715) (num-test (/ 123.4 1234) 0.1) (num-test (/ 123.4 1234/11 0.0+1.0i) 0.0-1.10000000000000i) (num-test (/ 123.4 1234/11 1.0) 1.10000000000000) (num-test (/ 123.4 1234/11 1/1) 1.10000000000000) (num-test (/ 123.4 1234/11 1234) 0.00089141004862) (num-test (/ 123.4 1234/11) 1.10000000000000) (num-test (/ 1234 0.0+1.0i) 0.0-1234.0i) (num-test (/ 1234 1.0) 1234.0) (num-test (/ 1234 1/1) 1234) (num-test (/ 1234 1234) 1) (num-test (/ 1234/11 -1.0+1.0i) -56.09090909090909-56.09090909090909i) (num-test (/ 1234/11 1) 1234/11) (num-test (/ 1234/11 1.0+1.0i) 56.09090909090909-56.09090909090909i) (num-test (/ 1234/11 123.4) 0.90909090909091) (num-test (/ 1234/11 1234/11) 1) (num-test (/ 1234000000.0) 0.00000000081037) (num-test (/ 2) 1/2) (num-test (/ 2/2) 2/2) (num-test (/ 1/2 1+i 1-i) 0.25) (num-test (/ (bignum 1/3) 1/0+i) +nan.0+nan.0i) (num-test (let () (define (func) (/ (bignum 1/3) 1/0+i)) (define (hi) (func)) (hi)) +nan.0+nan.0i) (when (provided? 'overflow-checks) (num-test (/ 2/9223372036854775807 2) 1/9223372036854775807) (num-test (/ -63/288230376151711744 -63) 1/288230376151711744)) (unless (or with-bignums (not (provided? 'overflow-checks))) (num-test (/ 1/2305843009213693952 -1 4194304/2097151) -2.168403310995243176730312012479018335398E-19) (num-test (/ 1/2199023255552 -63 8388608/4194303) -3.609105098938467225452985162735872325445E-15) (num-test (/ 1/17179869184 -1 1073741824/536870911) -2.91038304025235949890060282996273599565E-11)) (test (nan? (/ 3 1/0+i 5/2)) #t) (test (nan? (/ 3 1/0+i (bignum 5/2))) #t) (test (nan? (/ (bignum 2.0) -1 1/0+i (bignum 1/3))) #t) (test (nan? (/ (bignum 2) (* -1 1/0+i (bignum 1/3)))) #t) (test (nan? (/ (bignum 2/3) (* -1 1/0+i (bignum 1/3)))) #t) (test (nan? (/ (bignum 2/3+i) (* -1 1/0+i (bignum 1/3)))) #t) (test (nan? (/ 2.0 (* -1/3 1/0+i))) #t) (test (nan? (/ 3/4 -inf.0+i)) #t) (for-each-permutation (lambda args (if (not (= (apply / args) (/ (car args) (apply * (cdr args))))) (format #t "~A: ~A != ~A?~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args)))))) '(1 1/2 0.5 1+i)) (num-test (/ -9223372036854775808 5.551115123125783999999999999999999999984E-17) -1.661534994731144452653560599947843044136E35) (num-test (/ 1.110223024625156799999999999999999999997E-16 -9223372036854775808) -1.203706215242022689593248685469006886702E-35) (num-test (/ 1.110223024625156799999999999999999999997E-16 5.551115123125783999999999999999999999984E-17 5.42101086242752217060000000000000000001E-20) 3.689348814741910322817021726897015792169E19) (num-test (/ 5.551115123125783999999999999999999999984E-17 1.110223024625156799999999999999999999997E-16) 5.000E-1) (num-test (/ 9223372036854775807 9223372036854775807) 1) (num-test (/ (* 2 3 4 5 6 7 8 9 10) (* 2 (expt (log 2) 11))) 102247563.00527) (num-test (/ 1 (/ 1 1234)) 1234) (num-test (/ 1.0 (/ 1.0 1.0+1.0i)) 1.0+1.0i) (num-test (/ 1.0 (/ 1.0 pi)) pi) (num-test (/ 1/123412341234) 123412341234) (num-test (/ 1/98947 2/97499 3/76847) 7492505653/593682) (num-test (/ 123412341234) 1/123412341234) (num-test (/ 500009/500029 500057/500041) 250025000369/250043001653) (num-test (/ -9223372036854775808 -9223372036854775808 4) 1/4) (num-test (/ -9223372036854775808 2) -4611686018427387904) (num-test (/ 0 -00-1i) 0.0) (num-test (/ 0+i) 0-1i) (num-test (/ 0-i) 0+i) (num-test (/ 1+i) 1/2-1/2i); (num-test (/ 1.0 1/524288 1/19073486328125) 1.000000000000000024754073164739868757037E19) (num-test (/ 1/10 010) 1/100) (num-test (/ 1/9223372036854775807 1/9223372036854775807) 1) (num-test (/ 1234567890/9223372036854775807 123456789/9223372036854775807) 10) (num-test (/ 2 -9223372036854775808) -1/4611686018427387904) (num-test (/ 2 most-negative-fixnum) -1/4611686018427387904) (num-test (/ 3 most-negative-fixnum) (/ 3.0 most-negative-fixnum)) (num-test (/ 1 most-negative-fixnum) (/ 1.0 most-negative-fixnum)) (num-test (/ 1 most-negative-fixnum) (/ most-negative-fixnum)) (num-test (/ 1 most-positive-fixnum) (/ most-positive-fixnum)) (num-test (/ (- most-positive-fixnum 1) most-negative-fixnum) -4611686018427387903/4611686018427387904) (num-test (/ most-positive-fixnum (+ most-negative-fixnum 1)) -1) (num-test (/ 1 1) (/ 1)) (num-test (/ 1 0+i) (/ 0+i)) (when (provided? 'overflow-checks) (num-test (/ 2/9223372036854775807 2/3) 3/9223372036854775807)) (num-test (/ 9223372036854775807/123456789 9223372036854775807/123456789) 1) (num-test (/ 9223372036854775807/1234567890 9223372036854775807/12345678900) 10) (num-test (/ most-negative-fixnum 2) -4611686018427387904) (num-test (/ most-negative-fixnum most-negative-fixnum 2) 1/2) (num-test (/ most-negative-fixnum most-negative-fixnum) 1) (num-test (/ (/ (- most-positive-fixnum))) -9223372036854775807) (num-test (/ most-negative-fixnum 864691128455135232) -32/3) (when with-bignums (test (/ 1 (*s7* 'most-negative-fixnum)) -1/9223372036854775808) ; most-negative-fixnum here is a bignum (test (/ (*s7* 'most-negative-fixnum)) -1/9223372036854775808) (test (/ -9223372036854775808) -1/9223372036854775808) (test (/ 1 -9223372036854775808) -1/9223372036854775808)) (num-test (/(*(/(*)))) 1) (num-test (/ 12341234/111 123456789 12341234/111) 1/123456789) (num-test (/ 1e63 1e-63) 1e126) (num-test (/ 1e154 1e-154) 1e308) ; else inf (num-test (/ 1e-200 1e200) 0.0) ;;; inaccuracies creep in (/ 1e-200 1e123) => 9.8813129168249e-324 ;;; or (/ 10e307 1e309) => 0.0 and (/ 10e308 1e308) => inf ;;; might be neat to handle these (if exps= just divide mant? (when with-bignums (test (nan? (/ 9223372036854775806 +inf.0 (bignum 1+i))) #f)) (when with-bignums (test (type-of (/ (bignum 1))) 'integer?) (test (type-of (/ (bignum 0))) 'error) ; division-by-zero (test (type-of (/ (bignum 0.0))) 'error) ; division-by-zero (test (type-of (/ (bignum -1))) 'integer?) (test (type-of (/ (bignum 2))) 'rational?) (test (type-of (/ (bignum 1/2))) 'integer?) (test (type-of (/ 1 (bignum 1))) 'integer?) (test (type-of (/ 1 (bignum 1/2))) 'integer?) (test (type-of (/ (bignum 1) 1)) 'integer?)) (test (type-of (/ 1)) 'integer?) (test (type-of (/ 0)) 'error) (test (type-of (/ -1)) 'integer?) (test (type-of (/ 1/2)) 'integer?) (num-test (/ -0.651381628953465E0 -0.9237050214744277E0) 7.051835962889135018948026610294923703508E-1) (num-test (/ 0.5067986732438687E0 0.6260017267692811E0) 8.095803119575965307784422745290898299591E-1) (num-test (/ -0.8399445051045212E0 0.1829250718359493E0) -4.591740742120902283769244624290448381427E0) (num-test (/ -0.5987041550692662E0 -0.4124053212463479E0) 1.451737221187875469260813375116670894624E0) (num-test (/ 0.5861382519823647E0 -0.7560374696447822E0) -7.752767230673855251634630463492900473644E-1) (num-test (/ -0.012882644582824954E0 -0.4671067448591679E0) 2.757965866390787237919533761751626109973E-2) (num-test (/ -0.7830198970435231E0 2.1690164135025935E9) -3.610022921767930828778117437420472499541E-10) (num-test (/ -0.2339206226652567E0 2.729373380002701E9) -8.570488170622710029144125942503181451939E-11) (num-test (/ -0.2285806315782951E0 -2.602073870582813E9) 8.784555817667757706754728345837912936962E-11) (num-test (/ -0.5298716781559242E0 1.3509547453340487E9) -3.922201539215168658138266422439019362809E-10) (num-test (/ 0.7287190523338418E0 -8.244205871151566E9) -8.839166121309546680006433484161854320415E-11) (num-test (/ 0.18973054487786212E0 6.557593452200545E9) 2.893295326415727180554709812740977209383E-11) (num-test (/ 0.5084032300982587E0 4.5431682148621014E-11) 1.119049980221104893780059617560389832312E10) (num-test (/ 0.6621212705475221E0 -1.838873437953206E-11) -3.6006897314505184969089186237646638616E10) (num-test (/ -0.4041791750277005E0 7.707875701307648E-11) -5.243716825365141031107302892929967408104E9) (num-test (/ -0.09569063343466655E0 4.789751448902253E-11) -1.9978204392338054187984205729651608099E9) (num-test (/ -0.6471008513340974E0 1.890250884404079E-11) -3.423359600956370337454713673029890117878E10) (num-test (/ -0.4301276572683971E0 9.134844738134672E-11) -4.708647706651977799170970961042517830565E9) (num-test (/ -0.5061027989171409E0 4.246468515299164E19) -1.191820443490291421327933820140392588455E-20) (num-test (/ -0.9601783702217944E0 7.495754288877955E19) -1.280962973461506313537075112900039769719E-20) (num-test (/ -0.6477754868655262E0 -8.507334914535449E19) 7.614317449272520944989386124046318248581E-21) (num-test (/ 0.1934462826116784E0 3.6173521417193476E19) 5.347731573618163299262146929108634114511E-21) (num-test (/ -0.7794308505212441E0 4.172217291786081E19) -1.868145391314406352823434511710862322776E-20) (num-test (/ -0.8462346361305484E0 7.378170819620111E19) -1.146943675904374803577079154661818066039E-20) (num-test (/ 0.9783005897625496E0 6.175045007596078E-21) 1.584280905740958108982369263614665552851E20) (num-test (/ -0.9700832605850568E0 -1.7695051741124812E-21) 5.4822290139480091183029856440319954731E20) (num-test (/ 0.07062591404368701E0 -8.855398515753737E-21) -7.975464223100026969579387130724758972895E18) (num-test (/ 0.4751383409805402E0 -8.1371029771106E-21) -5.839158510308749293926976970601471638106E19) (num-test (/ -0.5103510786836052E0 8.302178001281015E-21) -6.147195092719750272554937885528717433502E19) (num-test (/ 0.7148807879199733E0 4.338856119331781E-21) 1.647625015115898182854639201045676562387E20) (num-test (/ 4.180670608983218E9 -0.8621420131862095E0) -4.849167010818503318377538718886882159085E9) (num-test (/ 3.202209376555907E9 0.008113117870009012E0) 3.946952858152361317410218375892707092144E11) (num-test (/ 7.767843042272955E9 -0.04145956871894663E0) -1.87359475322354819500790198613468533242E11) (num-test (/ 1.1937839884817846E9 0.45557753834605563E0) 2.620374992181877679062077123717269598672E9) (num-test (/ -2.4205138097471213E9 -0.3737757916008485E0) 6.475844247109412171348144805246962117951E9) (num-test (/ -7.534066568550288E9 -0.3609372553147958E0) 2.087361849632108651836399241353567759856E10) (num-test (/ 6.098867840095913E9 3.0464612528039427E9) 2.001951554277132357084991750811780094278E0) (num-test (/ 4.956687716396978E9 7.035407926465974E9) 7.045345157244949942198957065331702603612E-1) (num-test (/ 6.969049109639194E9 -8.115758334653503E9) -8.587058438990264159516222429259889060394E-1) (num-test (/ -8.0699835500126705E9 -1.1896420666819375E9) 6.783539163608157717597859343396495021042E0) (num-test (/ -2.229793060172571E9 -2.658809828346301E9) 8.386433043838395143199282594014446842336E-1) (num-test (/ 3.0672739776038485E9 -7.988270854370873E9) -3.839722054398737311833139439634292109412E-1) (num-test (/ 2.477055391151669E9 -1.3522358047779648E-11) -1.831822070085178675709536653203693354871E20) (num-test (/ 1.1318646612469008E9 -8.457695758685169E-11) -1.338265992938554414702828284241585726631E19) (num-test (/ -7.978772126259147E9 6.210468872769038E-11) -1.284729428601367805018001112036580297153E20) (num-test (/ -9.057338243339752E9 7.364415429198257E-11) -1.22987877726580108212627205863468836645E20) (num-test (/ -5.341117220720213E9 4.7359651161519756E-11) -1.127777990277920421924982539741683693507E20) (num-test (/ 5.838003830912871E9 -5.0625478501901024E-11) -1.153175042225753978331600642680269130096E20) (num-test (/ 6.407156672927742E9 5.006339136594536E19) 1.279808758079079048751288572047629634958E-10) (num-test (/ 4.687485139826675E8 -3.5561755068968083E19) -1.318125365504547538826162177354689732851E-11) (num-test (/ -5.838044723576891E9 -6.843985743599882E19) 8.530182473036721969937888742798001972008E-11) (num-test (/ 3.9279221543350096E9 -5.882918042982924E19) -6.676826237652909876656284584084555589571E-11) (num-test (/ -9.686323716926361E9 -3.44800215666902E19) 2.809256861452760638746791455737599480861E-10) (num-test (/ 7.301304808910639E9 1.2845297359643038E19) 5.684029419085037872687787191413868358377E-10) (num-test (/ 4.380345662298534E9 -4.352751895415198E-21) -1.006339384266859136854551985691861659542E30) (num-test (/ 8.239490918139045E9 3.2397577733346748E-21) 2.543242888698483402490821850315555889368E30) (num-test (/ 3.8980499504872713E9 8.311650110069505E-21) 4.689862901910189296816144765858628505003E29) (num-test (/ -9.425472285331268E9 -3.294031046828316E-21) 2.861379310436876111669825630018089608938E30) (num-test (/ 2.517833161624173E9 3.6891560299469316E-21) 6.824957093669990747641669780362243770063E29) (num-test (/ -5.463519676339016E9 -7.298583081866205E-22) 7.485726496576409428699223883071063828111E30) (num-test (/ 1.39357009199772E-11 0.417842407627649E0) 3.335157146709649079791043787228216537723E-11) (num-test (/ 8.58494900746665E-11 -0.6481371063028898E0) -1.324557554872456302657963676252150750478E-10) (num-test (/ -9.310282234439046E-11 0.9146343299129254E0) -1.017923986663107128254299604028521252096E-10) (num-test (/ -8.800556770159418E-11 -0.9305573406536135E0) 9.457296596014170681132977631993414317205E-11) (num-test (/ -1.3361456473382827E-11 0.06420301636905124E0) -2.081125970247038707404762086321230923761E-10) (num-test (/ 6.1406425153971765E-12 -0.3082496074575478E0) -1.992100676476244033296635444865296145538E-11) (num-test (/ -3.6962256202372035E-11 3.089420488573177E9) -1.196413901541863127466123235969256148157E-20) (num-test (/ -6.145126590884831E-11 -6.225608984106817E9) 9.870723661849873241350389006374300024184E-21) (num-test (/ 9.052281678541901E-11 -6.9187138778508625E9) -1.308376359878287335554324548627653637652E-20) (num-test (/ -3.4950245360118636E-11 7.543342567738434E9) -4.633257080169574405642456881139071687897E-21) (num-test (/ -3.482822570743636E-11 -3.87599225187502E9) 8.985628309909063146939690605121402184145E-21) (num-test (/ -9.42226868788213E-11 7.501937454180854E9) -1.25597803839741017709728590003874245271E-20) (num-test (/ -4.8165035309367155E-11 9.484620130429997E-11) -5.078225026096383416618039442767276425835E-1) (num-test (/ 6.880022773725747E-11 -9.699156104509544E-11) -7.093424107822057000929770558471489984227E-1) (num-test (/ 1.5817962388036865E-11 -7.11651152335492E-11) -2.222712959309569253469449863287830842251E-1) (num-test (/ -7.0140750853949335E-12 -4.4677941652531186E-11) 1.569919030725435801904141818366904619636E-1) (num-test (/ -2.6947489262085355E-11 8.365454450205894E-11) -3.221282169723859093984652053864584015511E-1) (num-test (/ 8.703167674410303E-11 -4.88739813223768E-11) -1.780736383435491638475146912252252561499E0) (num-test (/ 1.165112061543483E-12 -5.899528740399518E19) -1.974923952086012268924127751659019857389E-32) (num-test (/ 7.126386981630328E-12 5.091741402945837E19) 1.399597194293359595983101664952569614126E-31) (num-test (/ -7.132349854872655E-13 7.70347159367981E19) -9.258617712985762871283798832641751905855E-33) (num-test (/ 4.507266517270466E-11 -1.6192737232544485E19) -2.78351118315665136913517665604742725923E-30) (num-test (/ -3.025128309814261E-11 -5.606736896306867E19) 5.395523930874836927233660478269495795871E-31) (num-test (/ -5.390258677516223E-11 6.628750121976767E18) -8.131636550373975963243412569165785520017E-30) (num-test (/ -8.484515181627938E-11 6.226893371743352E-21) -1.362559895457550846279271972989853630227E10) (num-test (/ 5.110456708789676E-11 -7.434814854731122E-21) -6.873683889434922905934754874417370413592E9) (num-test (/ -7.784815533665352E-11 -8.942884975553875E-21) 8.705038200698988300091363733020271337225E9) (num-test (/ 6.06871371776654E-11 -8.4720755768444E-21) -7.163195916657483482294943699821186479438E9) (num-test (/ 6.395725883763629E-11 3.2465500186809204E-21) 1.970006883295217146112013920243427167994E10) (num-test (/ 8.23766365482318E-11 3.5665958051648335E-21) 2.309671211661863324131996575306264215863E10) (num-test (/ -6.882125490660233E19 0.680553203393516E0) -1.011254587641810638505458546065261498221E20) (num-test (/ -8.955858402134752E19 0.11144092291315044E0) -8.036418012361891226885340978581557821805E20) (num-test (/ 4.517225460957592E19 -0.5804969398143229E0) -7.781652496570381006264991321295105224966E19) (num-test (/ -9.741926397385082E19 -0.9037000739789977E0) 1.078004381972805693752225428081454781542E20) (num-test (/ 9.654390326446178E19 -0.061963385089831124E0) -1.558079874501654704495847314268744072438E21) (num-test (/ 9.50855454738802E19 0.30375471599023185E0) 3.130339727036137864357134952530976170215E20) (num-test (/ 4.323538184184934E19 -2.6027608151521606E9) -1.661135421670382968923474255247239383096E10) (num-test (/ 4.0554081767557594E17 4.814123702784068E9) 8.423979995384136048633041200603888010585E7) (num-test (/ 5.12727309625028E19 1.761988796449604E9) 2.909935129316203535920673855950717437829E10) (num-test (/ -7.335661993746345E19 -4.961351435504E9) 1.478561252736806087045652086640747044774E10) (num-test (/ 3.7135994768593306E18 3.273427798269768E8) 1.134468118961482490398408895662653948827E10) (num-test (/ 1.3911083524706402E19 8.651242909451927E9) 1.607986698594236535694138981270724564992E9) (num-test (/ 6.473382688386894E19 -3.700509647679497E-11) -1.74932193257385527761113361595002688054E30) (num-test (/ 7.25328632809461E19 6.793518758100849E-11) 1.0676773828651782212117989476182162163E30) (num-test (/ 7.053090091571119E19 8.009021819073383E-11) 8.806431360661641824334823520600629499368E29) (num-test (/ -1.6322872380348074E19 1.234889420758779E-11) -1.32180842316378978004378947103470484747E30) (num-test (/ -7.716951191497702E19 -2.473367210466666E-11) 3.120018393888910452644610629695438606501E30) (num-test (/ -2.1174708383466066E19 -9.66632270128099E-11) 2.190565020207733610503619470750854251338E29) (num-test (/ 4.0902039392392786E18 -5.029423690873208E19) -8.132549951322828067822875337940065787516E-2) (num-test (/ 1.4562115759233494E17 4.2665150414889705E19) 3.413117173530803542079920263107168159861E-3) (num-test (/ -3.309692589578652E19 1.1329455009949342E19) -2.92131667999222745140457080629099499358E0) (num-test (/ 3.059130103268258E19 -7.719433592654628E19) -3.962894513632647141286488246687660445133E-1) (num-test (/ 5.622979366632147E19 -8.407251901594788E19) -6.688248945610292804540334084533940238665E-1) (num-test (/ -7.457587910839625E18 1.102755747735572E19) -6.762683328700153669243467171164281736437E-1) (num-test (/ 1.2026615920578564E19 -3.77964792582931E-21) -3.181940793583240608441984111790776956096E39) (num-test (/ -2.74643694419756E19 2.538907641816601E-22) -1.08173960287601117923133084738647095934E41) (num-test (/ 8.267361397156658E18 -4.986401395715489E-21) -1.657981526368955793956856573504468676464E39) (num-test (/ 9.876393891158812E19 -5.792612775193684E-22) -1.704998119925007613535922021885867984527E41) (num-test (/ 3.927461252713038E17 4.810589424292295E-21) 8.164199656866003466542429981600313024025E37) (num-test (/ 7.29943837795987E19 -4.8820727437034755E-21) -1.495151498382347474354240468822304376928E40) (num-test (/ -7.837850970911807E-21 0.41514160181315674E0) -1.887994587070894820872902637806483134671E-20) (num-test (/ 1.1499234744049124E-21 0.4643166529612681E0) 2.476593219457143961012942936990797968514E-21) (num-test (/ -1.094368243984769E-21 0.9008053219044149E0) -1.214877640455251662856715755193246361763E-21) (num-test (/ 2.4821206327531197E-21 0.22988631081892086E0) 1.079716588565493668307955174993650571244E-20) (num-test (/ -4.56226662576732E-22 0.6695285124602162E0) -6.814148375851898788485451948577541009839E-22) (num-test (/ 6.442796853653397E-21 -0.0419134640377401E0) -1.537166397855380228851954699451812058468E-19) (num-test (/ -5.584403218169678E-21 -8.092869169805251E9) 6.900399723506295845105466793248363429626E-31) (num-test (/ -9.796722996869492E-21 -3.2988270899833827E9) 2.969759471970033259328414098139420231204E-30) (num-test (/ 9.441829923771915E-22 5.464575083746736E9) 1.727825087783076315606418411938950517056E-31) (num-test (/ -6.419360319610147E-21 -7.333962810289677E9) 8.752921831841952013186922455457072581443E-31) (num-test (/ 7.973734412555454E-21 -9.367577614661436E9) -8.512055880994845185202464827966401354632E-31) (num-test (/ 8.105484193881594E-21 -8.664550975192905E9) -9.354765431108951260398341387461553707907E-31) (num-test (/ -5.3151708182942476E-21 -3.406928289732576E-11) 1.560106455516695805992469791379650741489E-10) (num-test (/ -7.026602845639829E-21 -9.92483846943868E-11) 7.079815824989676856562805642631867847741E-11) (num-test (/ -5.901970468193158E-21 2.074489043942647E-11) -2.845023686881582124910812196899705492945E-10) (num-test (/ -6.40466723844613E-21 -2.551008177490094E-11) 2.510641594550905909683475044031419810602E-10) (num-test (/ 8.056066940872177E-21 4.645883100460603E-11) 1.734022739417072488146823616965762354533E-10) (num-test (/ 7.453765056481805E-21 6.956136187014756E-11) 1.071538114851171096483487539186715128913E-10) (num-test (/ 7.357434693258832E-21 -7.093525088486332E19) -1.037204295675341715303117810431180096085E-40) (num-test (/ -3.3759558579798473E-21 9.991075630444324E19) -3.378971376908405498870850768959668870304E-41) (num-test (/ 6.908026973557955E-21 -4.20805893397862E19) -1.641618399822784611549409240045335916762E-40) (num-test (/ 5.181767322756247E-21 7.46986056263721E19) 6.936899664063931551045422017869651239957E-41) (num-test (/ -5.7217313601659264E-21 5.604979023134118E19) -1.020830111326005351069300302415295512527E-40) (num-test (/ -9.340193892824771E-21 9.147101848766205E19) -1.021109641857175884684740262364588092125E-40) (num-test (/ 8.331002176099931E-21 2.0276444314093977E-21) 4.108709617449606347005645831416724715479E0) (num-test (/ -3.747505523684784E-21 4.394623185543803E-21) -8.527478615259381231018127145394525879915E-1) (num-test (/ -3.310403953328861E-21 2.3420390876737627E-21) -1.413470838617356120752866783055539347411E0) (num-test (/ 6.23845405853013E-21 -8.933620117412232E-21) -6.983119918397872761237650028889120834928E-1) (num-test (/ -4.276770609150315E-21 6.853299965034864E-21) -6.240454424832049912604789277138688124888E-1) (num-test (/ -8.847946637724495E-21 6.33827952828724E-21) -1.395953996386055439061738621964402924048E0) (when with-bignums ; from futilitycloset I think (let-temporarily (((*s7* 'bignum-precision) 2048)) (test (object->string (/ 1.0 999999999999999999999998999999999999999999999999)) "1.00000000000000000000000100000000000000000000000200000000000000000000000300000000000000000000000500000000000000000000000800000000000000000000001300000000000000000000002100000000000000000000003400000000000000000000005500000000000000000000008900000000000000000000014400000000000000000000023300000000000000000000037700000000000000000000061000000000000000000000098700000000000000000000159700000000000000000000258400000000000000000000418100000000000000000000676500000000000000000001094600000000000000000001771100000000000000000002865700000000000000000004636800000000000000000007502500000000000000000012139300000000000000001E-48"))) (for-each (lambda (num-and-val) (let ((num (car num-and-val)) (val (cadr num-and-val))) (num-test-1 '/ num (/ num) val))) (vector (list 1 1) (list 2 1/2) (list 3 1/3) (list -1 -1) (list -2 -1/2) (list -3 -1/3) (list 9223372036854775807 1/9223372036854775807) (list 1/2 2) (list 1/3 3) (list -1/2 -2) (list -1/3 -3) (list 1/9223372036854775807 9223372036854775807) (list 1.0 1.0) (list 2.0 0.5) (list -2.0 -0.5) (list 1e+16 1e-16) (list +inf.0 0.0) (list -inf.0 0.0) (list 0+1i 0-1i) (list 0+2i 0-0.5i) (list 0-1i 0+1i) (list 1+1i 0.5-0.5i) (list 1-1i 0.5+0.5i) (list -1+1i -0.5-0.5i) (list -1-1i -0.5+0.5i) (list 0.1+0.1i 5-5i) (list 1e+16+1e+16i 5e-17-5e-17i) (list 1e-16+1e-16i 5e+15-5e+15i) )) (num-test (/ -8) -1/8) (num-test (/ 0 2/3) 0) (num-test (/ 1e-10 1e10) 1e-20) (num-test (/ 4 2) 2) (num-test (/ -9223372036854775808 -9223372036854775808) 1) (num-test (/ -9223372036854775808 9223372036854775807) -9223372036854775808/9223372036854775807) (num-test (/ most-positive-fixnum most-positive-fixnum) 1) (num-test (/ (/ 1 most-positive-fixnum)) most-positive-fixnum) (num-test (/ (/ -1 most-positive-fixnum)) (- most-positive-fixnum)) (num-test (/ (/ most-positive-fixnum) 1) 1/9223372036854775807) ; why isn't this a ratio in the non-bignum case? (let () ; check g_divide_by_2 opt (define (f1) (let ((x (/ 1 6917529027641081856))) (/ x 2))) (if with-bignums (test (f1) 1/13835058055282163712) (test (f1) 7.228014483236696e-20)) (define (f2) (let ((x (/ 2 6917529027641081856))) (/ x 2))) (test (f2) 1/6917529027641081856) (define (f3) (let* ((y (/ (*s7* 'most-positive-fixnum) 2)) (x (/ 1 y))) (/ x 2))) (test (f3) 1/9223372036854775807) (define (f-1) (let ((x (/ 1 -6917529027641081856))) (/ x 2))) (if with-bignums (test (f-1) -1/13835058055282163712) (test (f-1) -7.228014483236696e-20)) (define (f-2) (let ((x (/ 2 -6917529027641081856))) (/ x 2))) (test (f-2) -1/6917529027641081856) (define (f-3) (let* ((y (/ (+ (*s7* 'most-negative-fixnum) 1) 2)) (x (/ 1 y))) (/ x 2))) (test (f-3) -1/9223372036854775807)) (unless (or with-bignums (not (provided? 'overflow-checks))) (num-test (/ -1024 1/9765625 1/512 1/1953125) -1e19) (num-test (/ 1/19073486328125 -524288) -1e-19) (num-test (/ 1/19073486328125 524288) 1e-19) (num-test (/ 1/524288 -19073486328125) -1e-19) (num-test (/ 1/524288 19073486328125) 1e-19) (num-test (/ 1/9223372036854775807 1/3) 3.2526065174565e-19) (num-test (/ 1/9223372036854775807 1/9223372036854775806) 1.0) (num-test (/ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 2.6040239996689e+16) (num-test (/ 1/98947 2/97499 3/76847 4/61981 5/59981) 2345932343059.9) (num-test (/ 1/98947 2/97499 3/76847 4/61981) 464392992878593/2374728) ;195556288.07955 -- seems to fit (num-test (/ 1024 1/9765625 1/512 1/1953125) 1e19) (num-test (/ 500009/500029 500057/500041 500083/500069) 0.999900013909921) (num-test (/ 98947 2/97499 76847 4/61981 5/59981) 11667778186668.0) (num-test (/ 3037000500 1/3037000500) 9.22337203700025E18)) (when with-bignums (num-test (/ 1/9223372036854775807 1+1i 1-1i) 5.421010862427522170625011179760852311177E-20) (num-test (/ (/ 1 most-positive-fixnum) most-negative-fixnum) -1/85070591730234615856620279821087277056) (num-test (/ 1.0e308+1.0e308i 2.0e308+2.0e308i) (/ 1.0e307+1.0e307i 2.0e307+2.0e307i)) (num-test (/ (+ 1.2345e-15 1 -1)) 8.1004455245038e+14) (num-test (/ -1.797693134862315699999999999999999999998E308 -9223372036854775808) 1.949062802279999590850112500817203908808E289) (num-test (/ -1/19073486328125 524288) -1/10000000000000000000) (num-test (/ -1/524288 19073486328125) -1/10000000000000000000) (num-test (/ -1024 1/9765625 1/512 1/1953125) -10000000000000000000) (num-test (/ -21 -1/2432902008176640000) 51090942171709440000) (num-test (/ -21 1/2432902008176640000) -51090942171709440000) (num-test (/ -2432902008176640000 -1/21) 51090942171709440000) (num-test (/ -2432902008176640000 1/21) -51090942171709440000) (num-test (/ -9223372036854775808 -9223372036854775808 -9223372036854775808) -1/9223372036854775808) (num-test (/ -9223372036854775808 9223372036854775807 -9223372036854775808) 1/9223372036854775807) (num-test (/ 0+1e20i 0-1e20i) -1.0) (num-test (/ 1 1000000000 1000000000 1000000000) 1/1000000000000000000000000000) (num-test (/ 1.0e20+i 1.0e20+i) 1.0) (num-test (/ 1/1024 9765625 -512 1953125) -1/10000000000000000000) (num-test (/ 1/1024 9765625 512 1953125) 1/10000000000000000000) (num-test (/ 1/19073486328125 524288) 1/10000000000000000000) (num-test (/ 1/524288 19073486328125) 1/10000000000000000000) (num-test (/ 1/9223372036854775807 1/3) 3/9223372036854775807) (num-test (/ 1/9223372036854775807 1/9223372036854775806) 9223372036854775806/9223372036854775807) (num-test (/ 1/98947 2/97499 3/76847 4/61981 5/59981 6/66601) 1855154611405774907304533/71241840) (num-test (/ 1/98947 2/97499 3/76847 4/61981 5/59981) 27854756105850886733/11873640) (num-test (/ 1024 1/9765625 1/512 1/1953125) 10000000000000000000) (num-test (/ 132120577/12 33292289/6 260046847/4) 264241154/8657554783862783) (num-test (/ 1e20 0+i) 0-1e20i) (num-test (/ 21 -1/2432902008176640000) -51090942171709440000) (num-test (/ 21 1/2432902008176640000) 51090942171709440000) (num-test (/ 2432902008176640000 -1/21) -51090942171709440000) (num-test (/ 2432902008176640000 1/21) 51090942171709440000) (num-test (/ 500009/500029 500057/500041 500083/500069) 125029751909525461/125042254395637199) (num-test (/ 9223372036854775807 -9223372036854775808) -9223372036854775807/9223372036854775808) (num-test (/ 98947 2/97499 76847 4/61981 5/59981) 35865350012435458633/3073880) (num-test (/ most-negative-fixnum) -1/9223372036854775808) (num-test (/ 10105597264942543888 14352488138967388642) 5052798632471271944/7176244069483694321) (num-test (/ -17631701977702695093 3931860028646338313) -17631701977702695093/3931860028646338313) (num-test (/ -1606495881715082381 16324360910828438638) -1606495881715082381/16324360910828438638) (num-test (/ -7960193178071300653 -10280747961248435844) 7960193178071300653/10280747961248435844) (num-test (/ -11544909483975853384 -16041992360613233027) 11544909483975853384/16041992360613233027) (num-test (/ -5758820541298901548 -2596462557714095861) 5758820541298901548/2596462557714095861) (num-test (/ -13056342734667572546 46502284983183419157350605242474199851) -13056342734667572546/46502284983183419157350605242474199851) (num-test (/ 12668118634717482325 -338544675918656078399121171905238525746) -12668118634717482325/338544675918656078399121171905238525746) (num-test (/ -16738429327795346815 164053836541028518093058940786011794219) -16738429327795346815/164053836541028518093058940786011794219) (num-test (/ -9884600460121235549 -53914696297933680001835530599748561584) 9884600460121235549/53914696297933680001835530599748561584) (num-test (/ 6753521264659576004 71759828079371803409570464915096122874) 3376760632329788002/35879914039685901704785232457548061437) (num-test (/ -6072478784520825268 83641961138289700975241455431547940418) -3036239392260412634/41820980569144850487620727715773970209) (num-test (/ -6708950756971973620 -9847903810677323447803434015107261150885944735136350527205856921771320298384705376646797569973415403097847060539915279223391112430240736564839483430569706) 3354475378485986810/4923951905338661723901717007553630575442972367568175263602928460885660149192352688323398784986707701548923530269957639611695556215120368282419741715284853) (num-test (/ 11263779860755455072 2292311486393743282743453705144070351222990311578446825826935237655927864700827857707370158936582804478427014131790879562565658386819339761919809732496450) 1877296643459242512/382051914398957213790575617524011725203831718596407804304489206275987977450137976284561693156097134079737835688631813260427609731136556626986634955416075) (num-test (/ 9956488981426387585 -12351244248621474338537656633137999145154500022264356186225225426288301330225259889671144104952158102155582320296061124840400655528634050137479515338944145) -1991297796285277517/2470248849724294867707531326627599829030900004452871237245045085257660266045051977934228820990431620431116464059212224968080131105726810027495903067788829) (num-test (/ -14875992781716065391 4906952781757522095285156014969507916562921709689447567404076064849249737893410245743456952512717420040816186768213920574809530298070437840356629617118643) -2125141825959437913/700993254536788870755022287852786845223274529955635366772010866407035676841915749391922421787531060005830883824030560082115647185438633977193804231016949) (num-test (/ 16043178952268979636 -4962728781666935768923030490263743715131420507991284894489828489607808897271220927863958149140648859077934323268424257800724618076505149638049461104621679) -5347726317422993212/1654242927222311922974343496754581238377140169330428298163276163202602965757073642621319383046882953025978107756141419266908206025501716546016487034873893) (num-test (/ -14889985628902581941 3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361) -14889985628902581941/3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361) (num-test (/ -1719613957783789857 19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758) -1719613957783789857/19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758) (num-test (/ -10969623867482498359 1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595) -10969623867482498359/1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595) (num-test (/ -3716891004757979686 -19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987) 3716891004757979686/19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987) (num-test (/ -4863232114852441787 -22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720) 4863232114852441787/22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720) (num-test (/ -16248276650501285553 -3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159) 16248276650501285553/3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159) (num-test (/ 18296946401228630959 3302341071702763311560113831030141639804425031433511503765833897787925467295486187687396312611805794369889470239777040624530990622212474466940548049117664906468330871893337410618797113677420975837622378808494314918471282099855916016026079371666730617071364751834080179173620476977670099126230223862266413091012344741482772771219725893630556702028108027870656512750807359335108428687238687397060104669074315031780019301768744978815422943986587389425726602444937024004102212071953113581935989741954695450085391443134273670514145585869912689150728183940456773133212037846765421397201956541430155664614978559762638030787) 494512064898071107/89252461397371981393516590027841665940660135984689500101779294534808796413391518586145846286805562009997012709183163260122459206005742553160555352678855808282927861402522632719426949018308675022638442670499846349147872489185295027460164307342344070731658506806326491329016769648045137814222438482763957110567901209229264128951884483611636667622381298050558284128400198900948876451006451010731354180245251757615676197345101215643660079567205064579073691957971270919029789515458192258971242965998775552705010579544169558662544475293781424031100761728120453327924649671534200578302755582200815017962566988101692919751) (num-test (/ -60488682170925814337492051725122486652 14880088785789146426) -30244341085462907168746025862561243326/7440044392894573213) (num-test (/ 126617729996196635247771282957911941277 -7166506344996883172) -126617729996196635247771282957911941277/7166506344996883172) (num-test (/ -278675896803726074870988122161067771390 7744689831802931490) -27867589680372607487098812216106777139/774468983180293149) (num-test (/ -283351838662873779255871649630248958879 6912311315831153835) -14913254666467041013466928927907839941/363805858727955465) (num-test (/ -9715584046609700027352634666499181378 3368831995960494221) -9715584046609700027352634666499181378/3368831995960494221) (num-test (/ -137493547985106345282009151869389470397 -1916381539906956855) 137493547985106345282009151869389470397/1916381539906956855) (num-test (/ -328662747577960331872949773416436800743 -231069430804205460334599495337085157308) 328662747577960331872949773416436800743/231069430804205460334599495337085157308) (num-test (/ 213595640581249636406536485951630735277 -48492294677143227478357598229530842959) -213595640581249636406536485951630735277/48492294677143227478357598229530842959) (num-test (/ 85922846498729014445816145204889624189 193533957681757355413031965695625196813) 85922846498729014445816145204889624189/193533957681757355413031965695625196813) (num-test (/ 24053342958857142686054803491202486471 196417511107100936775397820630955772553) 24053342958857142686054803491202486471/196417511107100936775397820630955772553) (num-test (/ 102038936612518756467074084117019701214 -111946989731587760700903475996379168167) -102038936612518756467074084117019701214/111946989731587760700903475996379168167) (num-test (/ -3006867214208872584699983438179656913 -234257597822744479264249663225224173340) 3006867214208872584699983438179656913/234257597822744479264249663225224173340) (num-test (/ -279839802710533516603863620922251878907 -3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219) 279839802710533516603863620922251878907/3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219) (num-test (/ 123635964546481689465778244982425098404 7701433613491146708866098469269971554817017737111287276993583150548359764165526640986060909954451793171933304569726872785964805121981749276421956645830854) 61817982273240844732889122491212549202/3850716806745573354433049234634985777408508868555643638496791575274179882082763320493030454977225896585966652284863436392982402560990874638210978322915427) (num-test (/ 166158110049010486343321316578688184578 4093720847216792748840371965199135052196058344862447621818024731938681519017878880275303125899149558774718190527651555811733139227128378041055212888819294) 83079055024505243171660658289344092289/2046860423608396374420185982599567526098029172431223810909012365969340759508939440137651562949574779387359095263825777905866569613564189020527606444409647) (num-test (/ 147416259636838312272435267341375281181 -11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801) -147416259636838312272435267341375281181/11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801) (num-test (/ 102557200511608632541115941654031896919 3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511) 102557200511608632541115941654031896919/3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511) (num-test (/ 47794953079190110032282671989549362415 3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667) 47794953079190110032282671989549362415/3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667) (num-test (/ -169956065319483471022234920202991103615 -9934427489865644196610501807375648335352544234206717324511161205173460054921759084767897792996557220898467288533128078406604709773449948420404563411793533441010236017064154469575084055359823982786110746700747423674942932421964955746280671982635899487781780756099620799397239156211815110739544719746684712086075069101799537802834839550142629064374734870047412916259754010150500874430055034366305216104752636211802195447299210332237598443674867760860326529472901775427058078447963316168327741049511844237329137194533000697525539835371015163158135757326482343130221118201740819963770851200676279882978581431999960842565) 33991213063896694204446984040598220723/1986885497973128839322100361475129667070508846841343464902232241034692010984351816953579558599311444179693457706625615681320941954689989684080912682358706688202047203412830893915016811071964796557222149340149484734988586484392991149256134396527179897556356151219924159879447831242363022147908943949336942417215013820359907560566967910028525812874946974009482583251950802030100174886011006873261043220950527242360439089459842066447519688734973552172065305894580355085411615689592663233665548209902368847465827438906600139505107967074203032631627151465296468626044223640348163992754170240135255976595716286399992168513) (num-test (/ -83006311763073652927964071041666508273 13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690) -83006311763073652927964071041666508273/13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690) (num-test (/ -312626207169475064151212222217866488926 6989069923898656093413456232544365450599471748502878018530391549015151484336014906416216966193568842618920902504390187814247729346977677905224098932673981665869061845335443588666641982676550205160521286690015544764015602751932938178737949961754714143180917985455875095030469699198116593730005119922928175789172042067281849364217595912265452199938281052984802042194034638773435768458457616208103331213440768472281882976004050012769415198321241810008696147179275528426468408383757692656341606162350211696837361434874035354680073309142183699892959618671515841112321607728427286289324836870027735590091451421689980776552) -52104367861579177358535370369644414821/1164844987316442682235576038757394241766578624750479669755065258169191914056002484402702827698928140436486817084065031302374621557829612984204016488778996944311510307555907264777773663779425034193420214448335924127335933791988823029789658326959119023863486330909312515838411616533019432288334186653821362631528673677880308227369599318710908699989713508830800340365672439795572628076409602701350555202240128078713647162667341668794902533053540301668116024529879254737744734730626282109390267693725035282806226905812339225780012218190363949982159936445252640185386934621404547714887472811671289265015241903614996796092) (num-test (/ -151709660794612786408772973806200383563 -26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443) 151709660794612786408772973806200383563/26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443) (num-test (/ 138834496986391136939574372853300933725 -8052690543272184576133758511645801940246473546142520821850130421981395129853341888352999304040698251945886555605291324954368612109314080471658982022831338507499254609048475429862437003158379101603576571787302167207044118847876475134352180874260998595377014195145760071923429129767580115085764485254455919915567128572731355497418831212259648020550107573824886521471697331410754043280744066090848295906051303624846301488010249980896364883452154860562864255354208802313850527991005497484253401461375477060954782095047043919500670383372218536999834862885439984085848342867301834247551832677237328664699302165347765799113) -15426055220710126326619374761477881525/894743393696909397348195390182866882249608171793613424650014491331266125539260209816999922671188694660654061733921258328263179123257120052406553558092370945277694956560941714429159667017597677955952952420811351911893790983097386126039131208251222066153001577238417785769269903307508901676196053917161768879507458730303483944157647912473294224505567508202765169052410814601194893697860451787872032878450144847205144609778916664544040542605794984506984917261578755812650058665667277498250377940152830784550531343894115991055630042596913170777759429209493331565094260318589092694172425853026369851633255796149751755457) (num-test (/ 276499207940187081393841843387608369874 27347897028734618663428054896349668572244941195143856840032842195489553215406302254043947382368793914074147314353589439281000471813879502242851166670252197853998033813694814376228360691543987661407996785043637351295817024680721181205269262470473172181965930243852520386958529041036476807810647578694133804796395977642274699322030062940721165202488695975750512485574440928370802874677938542169620505668128224812441566912043326338714451629730522324228356364241376445033028898865300103247057378058702233150414643818049655628999871012383236520330575609745427181485617250755214922048672375947942288446974485524776744246517) 8919329288393131657865865915729302254/882190226733374795594453383753215115233707780488511510968801361144824297271171040453030560721573997228198300463019014170354853929479983943317779570008135414645097864957897237942850344888515731013161186614310882299865065312281328425976427821628166844579546136898468399579307388420531509929375728344972058219238579923944345139420324610991005329112538579862919757599175513818412995957352856199020016311875104026207792481033655688345627471926791042717043753685205691775258996737590325911195399292216201069368214316711279213838705516528491500655825019669207328435019911314684352324150721804772331885386273726605701427307) (num-test (/ -8979365591106781219797187096315899769868799444656824967426553299158070014074001230883484015880186603742048949313393413640240595706939311540002219411120389 -1698360947072008877) 1282766513015254459971026728045128538552685634950974995346650471308295716296285890126212002268598086248864135616199059091462942243848473077143174201588627/242622992438858411) (num-test (/ -12831814656788829919185319784994714617782749504716966706877579983082880759985031662545957372565411439648298939198657738497464024214657609856476819270030801 454910754379715) -273017333123166594025219569893504566335803180951424823550586808150699590637979397075445901543944924247836147642524632733988596259886332124605889771702783/9678952220845) (num-test (/ -7834266257250691217409788323211914445703052638619784568844628449769010091330019095736167988675873769434766592786720961949649685040028101508217441360672222 -428418418877192732) 3917133128625345608704894161605957222851526319309892284422314224884505045665009547868083994337936884717383296393360480974824842520014050754108720680336111/214209209438596366) (num-test (/ 5737805823029931079838944835405107564434908634489801628049345331760087020955028323378020396677249341204498685189403657652738071833877470777083253103936452 9588993061977446661) 5737805823029931079838944835405107564434908634489801628049345331760087020955028323378020396677249341204498685189403657652738071833877470777083253103936452/9588993061977446661) (num-test (/ -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045 15760991890495426717) -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045/15760991890495426717) (num-test (/ 2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499 -6788234478844960330) -2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499/6788234478844960330) (num-test (/ 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333 190237375887614033974333796608341639595) 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333/190237375887614033974333796608341639595) (num-test (/ -12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472 -41681385674896602840749705069663453185) 12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472/41681385674896602840749705069663453185) (num-test (/ 13185465843955116174925558412278612918939024395488172088108029202384613698982949554556435640011161663974075894844304583900497170806796813871943782330552768 -155202352609947911537719051033334010254) -6592732921977558087462779206139306459469512197744086044054014601192306849491474777278217820005580831987037947422152291950248585403398406935971891165276384/77601176304973955768859525516667005127) (num-test (/ 12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044 -249441012384365373362771955533424187237) -12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044/249441012384365373362771955533424187237) (num-test (/ 8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433 -23101645464137481399279134347982485126) -8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433/23101645464137481399279134347982485126) (num-test (/ -10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192 -25611473771508763579433379623726126173) 10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192/25611473771508763579433379623726126173) (num-test (/ -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974 5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627) -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974/5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627) (num-test (/ 7706102251141221799524762336156378964168657337573751909064577951085535246905735244239132983582998872001001594454632956803416956154262109939446710205558308 6334400709835247308796432875490978646658012545184955441452799118298109610816693049400832749087993843490999852355789914065232784070007399786089389453289854) 3853051125570610899762381168078189482084328668786875954532288975542767623452867622119566491791499436000500797227316478401708478077131054969723355102779154/3167200354917623654398216437745489323329006272592477720726399559149054805408346524700416374543996921745499926177894957032616392035003699893044694726644927) (num-test (/ 12609622044672092190084693450911157599596799695538449568681964257744962273690941575572590166273187189250007688411096790312605666562908125521094386992971478 -8237858212652788898158635047388584411011830102060269605835391741772914864422465141467281143809161251942948659243584296367296559912373856433388249393853968) -6304811022336046095042346725455578799798399847769224784340982128872481136845470787786295083136593594625003844205548395156302833281454062760547193496485739/4118929106326394449079317523694292205505915051030134802917695870886457432211232570733640571904580625971474329621792148183648279956186928216694124696926984) (num-test (/ -9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785 -1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086) 9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785/1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086) (num-test (/ -10729942326579120947061030583094707809945059776287551713953926998992375520903658867971835616518813070294302895655369081976222497359056962112544408591462495 -4917625712783289245414023733273041940212797202855299465496072729329693853584860839801663152618595377553772371725021213143455497822882736730281253858119747) 10729942326579120947061030583094707809945059776287551713953926998992375520903658867971835616518813070294302895655369081976222497359056962112544408591462495/4917625712783289245414023733273041940212797202855299465496072729329693853584860839801663152618595377553772371725021213143455497822882736730281253858119747) (num-test (/ 8114113595157517238445304590338354472776364877475201453112450680537221171989478096363668912966343706408770932684807802285529572133696646343108263717309148 5443953102973235688784499815692116502566847594605098596244123647428188581304528525010862185203718640610834003873728718183528722470626702382993497913086105) 8114113595157517238445304590338354472776364877475201453112450680537221171989478096363668912966343706408770932684807802285529572133696646343108263717309148/5443953102973235688784499815692116502566847594605098596244123647428188581304528525010862185203718640610834003873728718183528722470626702382993497913086105) (num-test (/ -7125100205152691887479515774712530950031072786448635736036405923401522078562323494262148946679985384635556474075282302608446439950458673260234175964199684 -23871420315894180764743988478670341498770583257649869670486332228804693253344466615199983955886679924409910043885402198203427975742868174334723967563526738510726448815413356678504144193747696164586135745786501041060322480940451156015256191962506052700295351077719851275026974629635679531161390660244641370183176979934485671396035404817388717005746812037357500295693454623478902942336087760288091719793968445716246099043828787040340339906538864570506773535078524092440112404847904632624419421052178754041718790915772437556681684830937503838434712179830722395832238257078212535157309743054115702650740005055678387806081) 7125100205152691887479515774712530950031072786448635736036405923401522078562323494262148946679985384635556474075282302608446439950458673260234175964199684/23871420315894180764743988478670341498770583257649869670486332228804693253344466615199983955886679924409910043885402198203427975742868174334723967563526738510726448815413356678504144193747696164586135745786501041060322480940451156015256191962506052700295351077719851275026974629635679531161390660244641370183176979934485671396035404817388717005746812037357500295693454623478902942336087760288091719793968445716246099043828787040340339906538864570506773535078524092440112404847904632624419421052178754041718790915772437556681684830937503838434712179830722395832238257078212535157309743054115702650740005055678387806081) (num-test (/ 4801495919363827077158204249631885157347198552733998896638174958434968555935827788499392382851493568264006507028024783408190862186734863708684652212703744 29234959990138609668202089052356468732793041824333219340488007351402997202222578434579705387840772390513345507274006495462445058795870182760749392281528881636623188890883479914921272700981309656920982410970774047916714087713562927554033500521877735827036675598267184309367127514966388636440710253467328441763131873309183205727440365838789320851968108312559316922678357314418486932673434031479515016224407618177089903730349114511598373251388750023508633761000320088841886505077453257141723747388913336375142897897501529451618927178835485127020789481918641637409265186365292847057986276062625965612268181771076051892980) 1200373979840956769289551062407971289336799638183499724159543739608742138983956947124848095712873392066001626757006195852047715546683715927171163053175936/7308739997534652417050522263089117183198260456083304835122001837850749300555644608644926346960193097628336376818501623865611264698967545690187348070382220409155797222720869978730318175245327414230245602742693511979178521928390731888508375130469433956759168899566796077341781878741597159110177563366832110440782968327295801431860091459697330212992027078139829230669589328604621733168358507869878754056101904544272475932587278627899593312847187505877158440250080022210471626269363314285430936847228334093785724474375382362904731794708871281755197370479660409352316296591323211764496569015656491403067045442769012973245) (num-test (/ 10769619761532897875307527770350128978615798426116103116325434914975512103385205123955114305107607195469345895102375220593168903042839441996791318999499708 -7224105715967976893083374742254251507019823877014718307738328810406361200631626366722837314776666720638271529652546975342143108973422364041422652163016078890272393678677152791565494865444430757858556891645947268886646732022748338160528677218733159766121781240328812893374941548395710123982510227501927393735585082736583984561348450061452997663109932611188779299623613963995350679177776686423432406091192517292522853783968685873925548901506191291253596763183277703635837071862492572256145656312023955675669362656148946145528559574994353884313568526553663370513565393821926602014407548325293145102073923450066319746913) -10769619761532897875307527770350128978615798426116103116325434914975512103385205123955114305107607195469345895102375220593168903042839441996791318999499708/7224105715967976893083374742254251507019823877014718307738328810406361200631626366722837314776666720638271529652546975342143108973422364041422652163016078890272393678677152791565494865444430757858556891645947268886646732022748338160528677218733159766121781240328812893374941548395710123982510227501927393735585082736583984561348450061452997663109932611188779299623613963995350679177776686423432406091192517292522853783968685873925548901506191291253596763183277703635837071862492572256145656312023955675669362656148946145528559574994353884313568526553663370513565393821926602014407548325293145102073923450066319746913) (num-test (/ 1505915608160301518246681692927442986955390537144107830770082927276722640395785957392652130911646706470337068266772174699405268120590454296080828168261019 31152879253507543898583880698200027990847289346701738353567402100527465991154555548630544962150902011282973749886327325250084401181379196961322399337408341296727915922288276602390334861175305055229766353672502691855637668618950047400571070157436221479289152631256433294884836727331457389922838951144187501751190662594278336543502171639899940796536926507796271202659224890656712231014450702948847764643603683153113663072089256293587951842007583210791100743318865647555912543508324790181772321217524164822106191538518498016236866957803105254555578252294418243701672226181762763332992886540089416888889135117147250495261) 1505915608160301518246681692927442986955390537144107830770082927276722640395785957392652130911646706470337068266772174699405268120590454296080828168261019/31152879253507543898583880698200027990847289346701738353567402100527465991154555548630544962150902011282973749886327325250084401181379196961322399337408341296727915922288276602390334861175305055229766353672502691855637668618950047400571070157436221479289152631256433294884836727331457389922838951144187501751190662594278336543502171639899940796536926507796271202659224890656712231014450702948847764643603683153113663072089256293587951842007583210791100743318865647555912543508324790181772321217524164822106191538518498016236866957803105254555578252294418243701672226181762763332992886540089416888889135117147250495261) (num-test (/ -4912349668310730778272626761660101328812783790262451913449395750351147048676353891314609774894027305081515542385381430403698808605768281804457186380542764 6582102431028556562269167182029950958541569095123705594954788174046339660437206159173417583841743892857066740116322758515837624700881569925244230209567223461401193316695082415261197843574563450002486582967745135870782254839990479649574452750850133306720341823136645982650022199634379361313745598455049448887744206616434903460504591098363901961758069797933831934878649993183747273660007900662110776570580293994733189753806312784239743585453090900671308673380802381312083077891736513388250097195232616017027333586286786139736783210630705878401429301217589001317082952461701571026008195534878902572422952568763551674434) -2456174834155365389136313380830050664406391895131225956724697875175573524338176945657304887447013652540757771192690715201849404302884140902228593190271382/3291051215514278281134583591014975479270784547561852797477394087023169830218603079586708791920871946428533370058161379257918812350440784962622115104783611730700596658347541207630598921787281725001243291483872567935391127419995239824787226375425066653360170911568322991325011099817189680656872799227524724443872103308217451730252295549181950980879034898966915967439324996591873636830003950331055388285290146997366594876903156392119871792726545450335654336690401190656041538945868256694125048597616308008513666793143393069868391605315352939200714650608794500658541476230850785513004097767439451286211476284381775837217) (num-test (/ -11503235648135220410087372678575470255397243144180272745183844970864347348074104828328211521698012119761674096067066173927209129755062269068090560678650614 -5548338218081690289723998288742945948643693817491921699797822887914665364835947234564530865119623677435878746610856459141463506776423054050179729345956931675338102809929977610828639446535095411122377961067651902947030310564736893080382424590568134091858634304377553326990788802662029347894499019277621467098333287442862683493159356014650672092060912274570436879076161496563079759704321556494898013269338428360856068237785049960484767969682269790642298701577934519452927652996671267126348627432295779183359417597868330923329974640383630473044712419371517153268338860560601603043892503067815822312755611206254762903436) 5751617824067610205043686339287735127698621572090136372591922485432173674037052414164105760849006059880837048033533086963604564877531134534045280339325307/2774169109040845144861999144371472974321846908745960849898911443957332682417973617282265432559811838717939373305428229570731753388211527025089864672978465837669051404964988805414319723267547705561188980533825951473515155282368446540191212295284067045929317152188776663495394401331014673947249509638810733549166643721431341746579678007325336046030456137285218439538080748281539879852160778247449006634669214180428034118892524980242383984841134895321149350788967259726463826498335633563174313716147889591679708798934165461664987320191815236522356209685758576634169430280300801521946251533907911156377805603127381451718) (num-test (/ -22964048032108117904633365483799091488990853392670636861794813863757795874434768543212887316456319246155824842161717179767513360050328383696194174741889496306018655333450647372293193335577883672679165775070112770359697627614883420620410888137853011387271594559450892054491963940112235887802995117234918878648066362268919389271696465517050425727202664230530633207566444357393843669758809938086228366322548799235049875711702216182219182908217345405023677260470015666831191434586902791186444958476491096759363292487221288620810273243009200212776634572092195691654105986099646006756823055390654876878195583529521482548988 10644501761877612307) -22964048032108117904633365483799091488990853392670636861794813863757795874434768543212887316456319246155824842161717179767513360050328383696194174741889496306018655333450647372293193335577883672679165775070112770359697627614883420620410888137853011387271594559450892054491963940112235887802995117234918878648066362268919389271696465517050425727202664230530633207566444357393843669758809938086228366322548799235049875711702216182219182908217345405023677260470015666831191434586902791186444958476491096759363292487221288620810273243009200212776634572092195691654105986099646006756823055390654876878195583529521482548988/10644501761877612307) (num-test (/ -19058897134776675884737764093896349427183484738023061956638485191239529906311503740032626797095131123523175909943402828257449376045336777553758951620699386266853663342003969442142858702229701661125904623724248177901462857013835790939020450746503125344631958534655024089231193396521561965297735217497608287565163852923704017958259400904834287026933197193592591423799328167149965328232560408884408251535373934831244856695227539243433290481951528897142697352526450162440279318507285454432916819060795455956931254810171588139618689138022062041222735056137988435900866680084665165131313435515187611756148824388549448126467 -8326067459929079652) 19058897134776675884737764093896349427183484738023061956638485191239529906311503740032626797095131123523175909943402828257449376045336777553758951620699386266853663342003969442142858702229701661125904623724248177901462857013835790939020450746503125344631958534655024089231193396521561965297735217497608287565163852923704017958259400904834287026933197193592591423799328167149965328232560408884408251535373934831244856695227539243433290481951528897142697352526450162440279318507285454432916819060795455956931254810171588139618689138022062041222735056137988435900866680084665165131313435515187611756148824388549448126467/8326067459929079652) (num-test (/ 25828007361450952719858846443651616751980622231808382804245407702688699228397920589229449608543284896555585501243582045708656531815385828908740757435341854996277769645696261182122648194952548457487178342682313459444433667556195761154944956714756269417591048771194019245925463541886773351873002480266654825771525233808830260734678788520487541379982691221386179066818743751876186761036101255542680066874888848011074569355779905086056095043888696435054884292698783753890317487209955316141370052511469715869816445031102161253514609763532756500340262263800747279044587806090353812452308490155782240390040070679663451429071 -16419739031141199968) -25828007361450952719858846443651616751980622231808382804245407702688699228397920589229449608543284896555585501243582045708656531815385828908740757435341854996277769645696261182122648194952548457487178342682313459444433667556195761154944956714756269417591048771194019245925463541886773351873002480266654825771525233808830260734678788520487541379982691221386179066818743751876186761036101255542680066874888848011074569355779905086056095043888696435054884292698783753890317487209955316141370052511469715869816445031102161253514609763532756500340262263800747279044587806090353812452308490155782240390040070679663451429071/16419739031141199968) (num-test (/ -1669696848499325185991294008037906453080648048592518700324899343297324898656645662186964240087582483813312797482298159224575128489696846451225871663856944749639170892311973606684486632224811435175199158920841554176114937196187087530038509898368755036744105403511353564606301040888877621412514452110348953863172547944175251415725815533087344857665837809749724257466399374547882097484009980477192931829030533366309859182367479867549644502538060694266048652224732348150866071381652452605392696555259221463464108413747443898588713629829490175098280805280460168541344102200890646453100478450456898359263676257882174308268 -3154577849943484396) 417424212124831296497823502009476613270162012148129675081224835824331224664161415546741060021895620953328199370574539806143782122424211612806467915964236187409792723077993401671121658056202858793799789730210388544028734299046771882509627474592188759186026350877838391151575260222219405353128613027587238465793136986043812853931453883271836214416459452437431064366599843636970524371002495119298232957257633341577464795591869966887411125634515173566512163056183087037716517845413113151348174138814805365866027103436860974647178407457372543774570201320115042135336025550222661613275119612614224589815919064470543577067/788644462485871099) (num-test (/ -2215504974719141921873290809898041836016933916943403987778356628123168736190963062169230280020568365292362281642280014010817115943641228422541948070912910166283758843455538187697141038676028739959626556519808411324617157646799936128314485433146912658200236754847332237438334421065771940922444296618134121662770699950019164632463150784605652351782139277998735272280336096528241168196650073301607171613955878761317417480490869592669781417658461696905996344800864447403426286476662235990122025654999230690604488053668524888833992415515434190712628587043474760836969696399229242018051635699746048823240033842587927229964 -11305319675542865070) 1107752487359570960936645404949020918008466958471701993889178314061584368095481531084615140010284182646181140821140007005408557971820614211270974035456455083141879421727769093848570519338014369979813278259904205662308578823399968064157242716573456329100118377423666118719167210532885970461222148309067060831385349975009582316231575392302826175891069638999367636140168048264120584098325036650803585806977939380658708740245434796334890708829230848452998172400432223701713143238331117995061012827499615345302244026834262444416996207757717095356314293521737380418484848199614621009025817849873024411620016921293963614982/5652659837771432535) (num-test (/ 24358677073350645219370308521851912760304925518671532565724702185818845784332554892130070740233218685874351979772556877899278790031132507391155876157108663291716896413773711734271947599485714147026138105714458778787734198938526335256418673319464023475137997251085298903419563039860433435847755093653670989129405749785476487449599232956305952768800154351414655365461746574761818724131185410194605648466196476174400166047788352670171627261342369793028465418799251589432585363577887467959594667618177199696618852093807640490831859585621198048572586882398004957371434677752931134884039120875470266936204172511104679441462 8754800987327220648) 12179338536675322609685154260925956380152462759335766282862351092909422892166277446065035370116609342937175989886278438949639395015566253695577938078554331645858448206886855867135973799742857073513069052857229389393867099469263167628209336659732011737568998625542649451709781519930216717923877546826835494564702874892738243724799616478152976384400077175707327682730873287380909362065592705097302824233098238087200083023894176335085813630671184896514232709399625794716292681788943733979797333809088599848309426046903820245415929792810599024286293441199002478685717338876465567442019560437735133468102086255552339720731/4377400493663610324) (num-test (/ -26302114071841994464108666310942614602208671348774320769941579409198660404735714925432808094014718434192516800374483192192707032773903982752997957629389083405320034044554226640590549491188742685901503166669355807243735533977994184111229208270447279559478659750835531593667003322059717930484363943660175452777363121025595100592911646539549735930625865256846706785601753749996181113742254145758187876411260965175520035400453360390392991183382425735199046574346992179663247011131958270717402007532256308394559029768974932620173103778338779940189812875680687510582798628982957687329572431433891809534332514765287899172737 196971971351558855568201373145365478995) -26302114071841994464108666310942614602208671348774320769941579409198660404735714925432808094014718434192516800374483192192707032773903982752997957629389083405320034044554226640590549491188742685901503166669355807243735533977994184111229208270447279559478659750835531593667003322059717930484363943660175452777363121025595100592911646539549735930625865256846706785601753749996181113742254145758187876411260965175520035400453360390392991183382425735199046574346992179663247011131958270717402007532256308394559029768974932620173103778338779940189812875680687510582798628982957687329572431433891809534332514765287899172737/196971971351558855568201373145365478995) (num-test (/ -25700334917103749626396366612061842558162882395534131493737229591609654899446089376271023701490708870843231350129849819430092002268875830384992877382393956173037794109904701961390126146975281052960293513473777226100954163054292968509501976296424278813632162404905591038465215586347229260479401862039805429711982871702185657527199220459658257385112793877259572278229045135617281858788415643567614198333459934599272409406206213115625226065750113120833933806486512117533453281522448845990642550827848765145774541658722594353290694745164913189694785762218575339370800538946514325662656804799046877175035545715523049884960 56325873113907570153638933263921340484) -6425083729275937406599091653015460639540720598883532873434307397902413724861522344067755925372677217710807837532462454857523000567218957596248219345598489043259448527476175490347531536743820263240073378368444306525238540763573242127375494074106069703408040601226397759616303896586807315119850465509951357427995717925546414381799805114914564346278198469314893069557261283904320464697103910891903549583364983649818102351551553278906306516437528280208483451621628029383363320380612211497660637706962191286443635414680648588322673686291228297423696440554643834842700134736628581415664201199761719293758886428880762471240/14081468278476892538409733315980335121) (num-test (/ -25716495567761925495340309269248196976121711927176026606462843116646034561721958499564011513233986043633061335866265799467020807570689498961190839877265773450484494789052182300993137822542881883769593344810286970036960228835955266304979090841345697560418139960733748874044680214388098802745248923989851173047158103142988835055585349795022662576576434371181693607267864646932929998659458265265400181839509356921460222604661909947838434113964465769102604033848276159366897885013231683417270877512514679528402888899725431524867260144325739317224922955028035417867933390409466302057857579158202739536568407090965929352402 -92089830031261826185903006947297196357) 25716495567761925495340309269248196976121711927176026606462843116646034561721958499564011513233986043633061335866265799467020807570689498961190839877265773450484494789052182300993137822542881883769593344810286970036960228835955266304979090841345697560418139960733748874044680214388098802745248923989851173047158103142988835055585349795022662576576434371181693607267864646932929998659458265265400181839509356921460222604661909947838434113964465769102604033848276159366897885013231683417270877512514679528402888899725431524867260144325739317224922955028035417867933390409466302057857579158202739536568407090965929352402/92089830031261826185903006947297196357) (num-test (/ 6427758281007308443295844679532867042370757542760390680622584758338041709910068192973790897624827722686313216884084305612889554116246627679267186323854642904894988936981064543865794245002470271142875081223308666588659587718561791667575945670118263124267218395749059879636505504607358472659126298770422135028955713148882314050530771750859372048576074912599265823577267962213046012777760882389021047579367276198483178024744924299929585515193595330026399302022065656106472153858484998010254767462854235008343139218888170221421046454280858208068658907389288543063912721882521711363713136166478126504226820360347652405439 80854661163518168674595213426641201760) 6427758281007308443295844679532867042370757542760390680622584758338041709910068192973790897624827722686313216884084305612889554116246627679267186323854642904894988936981064543865794245002470271142875081223308666588659587718561791667575945670118263124267218395749059879636505504607358472659126298770422135028955713148882314050530771750859372048576074912599265823577267962213046012777760882389021047579367276198483178024744924299929585515193595330026399302022065656106472153858484998010254767462854235008343139218888170221421046454280858208068658907389288543063912721882521711363713136166478126504226820360347652405439/80854661163518168674595213426641201760) (num-test (/ 1960728263483597985471065015024594804771170333646104429205729831998416939777820080209106943861368202560376682136488253096512360698625765514606930980274938979705620987031595592685578710084284618125325617453699875318678007463857705931376750632972266553809944621631324385690517092215690694024807784270742388108802858889381036105223858467345514041786882957807868961085072340965930749117411726729713477739990680381647988935514765113077094375924848051541167125595015542791382355149166582367766443782842193396221676952668624805183924877889696428989259842153378327156342464279071638070457876940165186524833987190050817072048 91266493124541431873557009470479491083) 1960728263483597985471065015024594804771170333646104429205729831998416939777820080209106943861368202560376682136488253096512360698625765514606930980274938979705620987031595592685578710084284618125325617453699875318678007463857705931376750632972266553809944621631324385690517092215690694024807784270742388108802858889381036105223858467345514041786882957807868961085072340965930749117411726729713477739990680381647988935514765113077094375924848051541167125595015542791382355149166582367766443782842193396221676952668624805183924877889696428989259842153378327156342464279071638070457876940165186524833987190050817072048/91266493124541431873557009470479491083) (num-test (/ 4941680418946960910262990974014623728051861920391294141439502190044830922127013115391726343950340163023958511659132792063033185693862678433421115681422259770928656196358763089894449447854011668445981430826871764812047994423858851467292757304285634515474652989618200442851239459073981986390515468331839802701176644729973346052528164203299481240263263697394061787580128379398464090163611942724580936445878570184925290925246112514015572149640886198984723311273144361235138411362294735799814160816806773736605477503201836095726740734281001021071803299510239436683913500734680524381145064985356627091311888606290704759943 291575320383555320391938911470370670502) 1647226806315653636754330324671541242683953973463764713813167396681610307375671038463908781316780054341319503886377597354344395231287559477807038560474086590309552065452921029964816482618003889481993810275623921604015998141286283822430919101428544838491550996539400147617079819691327328796838489443946600900392214909991115350842721401099827080087754565798020595860042793132821363387870647574860312148626190061641763641748704171338524049880295399661574437091048120411712803787431578599938053605602257912201825834400612031908913578093667007023934433170079812227971166911560174793715021661785542363770629535430234919981/97191773461185106797312970490123556834) (num-test (/ -17803449239532304707372697093467431202778585961066204978641168716990033159088600623106396534094218402005803618121159982050197012697237961155375180768349707725936023283589475384693590539312637333226292265409814019687105755522332846972859860649558844229320481883408457674560284773922666633054564243260924189551494368660033292970122831009582038986061326503238023206238467592238752824663935316307653075615249537594229930297642710570473007696494702367783692850946455203144153509057520651038068881755863521371187245025834292163874467913915588768778393773565536027848586260129438664753479013894698439967637389690509120223682 -10962227285754340409566802000064407225866105372406170304563353147415988225079632767886653994299800743521362563345682593189107807948342418743229049299449088) 8901724619766152353686348546733715601389292980533102489320584358495016579544300311553198267047109201002901809060579991025098506348618980577687590384174853862968011641794737692346795269656318666613146132704907009843552877761166423486429930324779422114660240941704228837280142386961333316527282121630462094775747184330016646485061415504791019493030663251619011603119233796119376412331967658153826537807624768797114965148821355285236503848247351183891846425473227601572076754528760325519034440877931760685593622512917146081937233956957794384389196886782768013924293130064719332376739506947349219983818694845254560111841/5481113642877170204783401000032203612933052686203085152281676573707994112539816383943326997149900371760681281672841296594553903974171209371614524649724544) (num-test (/ -11349783565099575757929584771389010505157850113880084607145768380886038854233583951229136273631022011781914171912628263930864052254964518914857757025547156428098062812984733912827827545722979442676567330004437902674729872754963478834939047061999292143602525229120558979819117729589695377623970606315287270030693151486803968345724658003068961239204812937084581894755863859944500186226990319892122692007317326534880413455575446314965159569830188583093978564829748603480193166063624130610256395632946002879039047154077629561745862713628266069928068634042545592328263646730943717246953000457159714049930890865576634096206 -5169948998417532948043886408019867395123131165917923418040862036041756675786217242743410895008311710518018466892169868028617239526646914529999134517417939) 11349783565099575757929584771389010505157850113880084607145768380886038854233583951229136273631022011781914171912628263930864052254964518914857757025547156428098062812984733912827827545722979442676567330004437902674729872754963478834939047061999292143602525229120558979819117729589695377623970606315287270030693151486803968345724658003068961239204812937084581894755863859944500186226990319892122692007317326534880413455575446314965159569830188583093978564829748603480193166063624130610256395632946002879039047154077629561745862713628266069928068634042545592328263646730943717246953000457159714049930890865576634096206/5169948998417532948043886408019867395123131165917923418040862036041756675786217242743410895008311710518018466892169868028617239526646914529999134517417939) (num-test (/ -4372008041495429462966226028389793326873997497126815043214338280101332483009650104005998792061125254101227371430911497751865710691604158789733634394053254604723940088324934622768312096370232736965692181452463495731681105253628558429524788376108667441329817524961077744083376843098018692898745743361309486938506049017980865957895278210133305721083115513131884239744064081819033733041876411992332060293539102545847193260167588667810376670587099064558298380310132769718526554738650709745767046942440481512965138461694790645096012018276362849398785863823724642554436182185786302301222529261914437437947741031113015699315 -13213007132248918651858333568248204618745148942720942572088217188768868803339938910599097839075045781852237705726227293430250507070717570662238736211897310) 874401608299085892593245205677958665374799499425363008642867656020266496601930020801199758412225050820245474286182299550373142138320831757946726878810650920944788017664986924553662419274046547393138436290492699146336221050725711685904957675221733488265963504992215548816675368619603738579749148672261897387701209803596173191579055642026661144216623102626376847948812816363806746608375282398466412058707820509169438652033517733562075334117419812911659676062026553943705310947730141949153409388488096302593027692338958129019202403655272569879757172764744928510887236437157260460244505852382887487589548206222603139863/2642601426449783730371666713649640923749029788544188514417643437753773760667987782119819567815009156370447541145245458686050101414143514132447747242379462) (num-test (/ -24003371850945507239307096734506644624830254935119140199726507920301383328662376914775504920527918338079792692943250446679097229950654636321252144129692109999375967030689211646504258922323499994340282315270808545865248969923421472430657741998787024263629527291510416193284540865950122841477102934165296344839654902079279846705581902668360663987722715177845485423354226653585575109653937253382583158263755381721094429734122004436184054214443676096492583897635497699417294183504529284810360226314491839533303380490277211336049582128602304906849999737224506976061216780230350942535246958957024226614847691329767208211525 10686139440491678930358521446524488461285005495304677740436234635584738003880529034339295291091217655777627375148264449580064000634364863951333061091724053) -1263335360576079328384584038658244453938434470269428431564553048436914912034861942882921311606732544109462773312802655088373538418455507174802744427878532105230314054246800612973908364332815789175804332382674133992907840522285340654245144315725632855980501436395285062804449519260532781130373838640278754991560784319962097195030626456229508630932774483044499232808117192293977637350207223862241218855987125353741812091269579180851792327075982952446978099875552510495647062289712067621597906648131149449121230552119853228213135901505384468781578933538131946108485093696334260133434050471422327716570931122619326747975/562428391604825206860974812974973076909737131331825144233486033451828315993712054438910278478485139777769861849908655241056000033387624418491213741669687) (num-test (/ 11114571678097117920369007866358540243142633567044843952020632081573546909920632543585596494530749645890342978505657174505155646987551523455565703297238406590291026899487431109110746657023874064284362499621762851387854720746040865741433394111425240861542892218169985953747711593827913014379823797703717216676877313898809377467394109623799717556800777662963842899812297087284510893865429864819927951428138755600792987191034272014681606301885821862650098620488569288170357746018556395309910262410994899971436293672676949544989196526035130226777567220128838888396668158456237490064462262193759918857287915854681904206680 4808076329737968688023887165061921594706561818755147855784713748545995818001333418509444774306288638038607173052166709335820929501845348060033808100812677) 11114571678097117920369007866358540243142633567044843952020632081573546909920632543585596494530749645890342978505657174505155646987551523455565703297238406590291026899487431109110746657023874064284362499621762851387854720746040865741433394111425240861542892218169985953747711593827913014379823797703717216676877313898809377467394109623799717556800777662963842899812297087284510893865429864819927951428138755600792987191034272014681606301885821862650098620488569288170357746018556395309910262410994899971436293672676949544989196526035130226777567220128838888396668158456237490064462262193759918857287915854681904206680/4808076329737968688023887165061921594706561818755147855784713748545995818001333418509444774306288638038607173052166709335820929501845348060033808100812677) (num-test (/ -27971792815424016824370019866875377333122266892537700816201893161065327053508379094007350664178576160161460501442627646041422270472469587140689725524176629653056006769618104516779694726446739085332330345789012312708713495757968594985567285237456431009983022526625885024663335598317191838389804118084831445251467492693688286258834282078888862754754572546522075833632779922232880101875914894393005204887265821991459415144492487189071888581048779385051174007698853920104709378859053075296413813207007405843448595681090932498329066591349910723578718333092115184652723310842559914379989208301125396793101430807658654849482 3169580893680227534064172567436590084742349042688765883461923377455374714865282199177755353861979892274552092801376364846717140845237173266602633583445110) -4661965469237336137395003311145896222187044482089616802700315526844221175584729849001225110696429360026910083573771274340237045078744931190114954254029438275509334461603017419463282454407789847555388390964835385451452249292994765830927880872909405168330503754437647504110555933052865306398300686347471907541911248782281381043139047013148143792459095424420345972272129987038813350312652482398834200814544303665243235857415414531511981430174796564175195667949808986684118229809842179216068968867834567640574765946848488749721511098558318453929786388848685864108787218473759985729998201383520899465516905134609775808247/528263482280037922344028761239431680790391507114794313910320562909229119144213699862959225643663315379092015466896060807786190140872862211100438930574185) (num-test (/ -138888658164471549506154385143989713534453638138516110941977029 48484067562152384719540184707188444570280914254129306788137384972303743285284814 56428088099244342456240635263153370817851703737803685168591843059886944388583310 6984617762898435035101945891920384937438416626357047934508608980105797822504000 90193136183227859939744547239819443586783276313678017953708293432043879247302040 70539472782976230144489157899475475029273447055080677052149474853222128626227832 2525164589393997980217929709704832829968554364529060039097810436136432713906553063644429644328565051224269893261942396763235990073001625976866246420775436 15614337547041181126817477188043219628044963126229393225781917631975649438502836750353253851523795212263078850399716875892512719059737913422781999218667136371648316387382440793865460028660248325297931269646982047533754121791358966254514009830876592200454797694143082163294323565673200905929297174223061890100210054105027025488322289599106119653451218493916291922340123640475500240519924011764050880374885136181582395113140580448936759383024305870622004464940344826337458060607492042593813585998516868215921180540240201095202617277388950504036371411600204964284568597705251929695275183521036281637399204541958859605054) -138888658164471549506154385143989713534453638138516110941977029/4793535847709521198063287553243915170068914691727215964454867625024011698922303669226389748584276840530192157568469968220857898703102351955898913589325705637953049380748829567692600765708909637920797057370082064005557328769108356548100875674196976079597658854339583183901899349355521527519781721778545444496852540362424465770767219571362842157786846795990148969989617793004579188905882473140017509154008696803103206996067638134383708975696867028865870695941933200225325283190379262695816923376790224594063264297952504481719779782130509306530621779762254864669078635401870023086312919956154224782043667754741333688780367667466505233610011253346902821033707597517691608103391952937194719540981992469020284583499872663129517095879706480339710037976698298522952071766717472040399518290905103777436461474880898550115925718887748413534479076504168236430697214654069473800915087572730747027455509241250627470590715812698745630545585772046458363388764449879417348554556621640336029897762172500880501074103433267444717053504878282494505367980026597725927414511391047010801407870379019921551218005714825277162504166028680939100225793768617321830389705750902850499916610355200000) (num-test (/ 2902267908619179684129536324641634394442732593027015198805855082 4748067699021154152763168285921806700655154833226062437593302484475663167752990 92172802787151156076284963978247829387076983213530315481815585776147505007251090 15808981285029107672090190966349736198141855760941720122983980047623201110025085 60559202289239963744584432021634662330089323842876293477363484160210450706125345 20641717016962556495214267565148984505293698026059157698737040675346468206231142 142380249473014630955299439077662853963947100833592874440361316474000948841420058017600161066408668117933232436922811486348705081331372574460204309908598 22418721268614574393232189860262616514600143215945007038687873335656746730488694050883006164427390756358558140145027011322151188565843290717535647848841274550496431839061217253488169143292339455650565906288959125935798633464526818546688779845699340483771625364583343140648892889571715648295855169294054985996834093294240640072029711789359793649773566295329912082241637482772608479106201840565936084243727069954911883243252762742415647868355726139789907900798435783365130277592703989608678774745914668128791639635886550753850811717805962562157686110637810320436812644047534536168343578232389700410352900247092236175044) 1451133954309589842064768162320817197221366296513507599402927541/13803211377640454778526029288269623376813125655593684775595099045285713415153039020789267800416616529908688645478733023490751981264976732618374046330204398361829051480928696426688037404239513603403603849882719851670264413777889524531938606364925013854252374108222701436535488401321603495905123597139234414735397259257280679663147039651553472142280954446675036289021783142392760217244908768132158498744301278889276778209560846418263599491357632762902447742083022806085077053406738681250354036208472026046315736408632370478801849290705001622808552373129971427533249307210975612625050706661691322027927380443494854794852235813844542319971019369687589916047377092369702778251658652143114091304960406840026816351348391618676357634544120732441610431417230403811846208113160343697557236265319994702483700922393762500190362776377442551539417224595247790865885105594005740401824824367904020732469833438717527758468635665777261969819260766044978137909489986407113029460354144391595512642835261443393260585888868936164331461486646676578398836326366036777321522851855085808626766493197635871100152761464712744017549919220291986785134521319127277292845352756807452050073157340000) (num-test (/ 7798204144688205291220879078360728451593323170355809361079096742 35808393784851478122520372074317359817820799318259895240196875729073154197251420 58532175726063855694248618287185551673975962776708803423334853085996022345828434 97834368697888769536063057370864051207348099191057106781292664602519775900739777 92489021460656714290092899983209031746574776013841975324837145038810562509209529 71083733375588666647468985607775761710974844539643116636307037921671845148256816 6123989271760127932230015643359630675168106436173654465119508990415235040641894537960236511442249258231302028977221206744158863083898145166446430168108 -27418900206398855942064397259705713102524342707255992250395147550519659429645343464288092288218160406382406024735131578979728501208163782063519839258876833755387025755815673514708453862847139552613587001235204464673999898312854941659541050445981594990466469147364579547089805525464252876345032296745312923488525701877655352034887018931755379078328147999631937419977103372927428613463482328465834563846802083044643719319690088670748858904291298575733560600669924511028715689681303059001186388754140003746463568171428267337107394361025465082282061651196456268663181772211292647101192148287507051053367729008997838464209) -3899102072344102645610439539180364225796661585177904680539548371/113184205287561573324139833190653102440730360395399197973956984769580868365256138025034414373155098575475566747215877030265786675432252675717351889433714136838615056208470421665419618669892136317438270826178251174708190860235979949204785938786562420189510825909814566675745650194525647207897976611434325225523578368855952217879373499055292850828774005130267218801086474623429504045290678320168493275019256514768273116059350700654655821674309331585233552793659038912697151359657915391954687630783641745610431060563252789714638916120291482852533638921356624929690158752601417722733222880768367060672103351737811624242610815140332559619520810810999145535251960674284283045907801934328911198563750515779896457101601178888594882087326241517566336011980952110586199881600553269825310575512911473547251704677890770772166895623118832621335417348044312911888377718725944255218219811801447500167145561774582342171995333086224230231746597452848775656030037837271428187450747141983599129861631612369300880722326218963779650411119279310045263996988089484063433088077868691314162108392639864773907107325220582413508233901954483499166402135445110435112499264825479433389003494762240) (num-test (/ 6291885367078853457481986049409245691302078375827782321496819120 20959289231548357352292073342856567687394126070322865796282035211176720583560298 24366038587110130209541647226271577368736240640393242419005751016119649778306566 40118119174220166901790237425673316895032570534639145502274313654443256239236466 73598137358602854818844747625643480865061277528564461120022408463105339470504117 36695182446520138181079917512512743290981469731336486456411609014364293489978544 8671667981598505073194269824535189054936442262459158402875147736469644925300845122881093216273840895555488593258562684601176239455526568314028830532770 15920064019095473156324398162334173238735268739049399738654357508344572552411935473846021991360836375685872129737682603096450566258725052013769725919038955505690389573813769125933987978360857342250911865713011888064725725934341157729878064563080803955584985269499994186472079783942404183377695242296289152788154908185130552013951432753148997632323578507137074131845177376689609114975253308906745794984371839952312988353950198030866538756253618535421214253194954603293145507537939731320546686208032528588232652963255550963088571344119439249328480867640436815434047309164687808223851012490130534705427647158409623238123) 1439421788255379275215959765325419043929720157723371200401/1747562187028503746686299553853635643553063923188506902759251937250022196751705340155682655202720363192751787186892107863159676381018035068965958466119538181810433273947829904580526582292369320932134048728374142501965682147541817431447933591106030690334465450755701191781243754499216697336293783127396687916725975251100500896467549458036395977769801208905203001097425041200299917628353220804629035768571072498715030261324138691471497255335498185741379289492513543474304524261634247519034231348033379344777678679950561777846684978640375273167561174451700942154388980887510088060818147834369595669846115248027925007288445161871535514130090907585140894883683709507099726386549038354860875469377442908932714711235823032704493155679240378374325069782368108779247450762222838197717507164088182062062215767468125843278459189085290703729281279344184417197883359351058003644499215541300350121854220342250451978930421772367851329849662028719768708399155817754711362398236471946313773603716759409265530444582884661320404389499624411965234669344882203618613097197387901166904575791500958722726774956950592290330175936039556139052663816485140080963740296685158607671768592) (num-test (/ 7377598052472799909620353419322603137723415431070641423056433630 50990728761110292768803869421408199244526424730838143228662194914314857136430737 89434155113971221138805303763480423496687322824531744020762041598590716339098287 91343386111124700155689622654961840380754244946720984970313893805578518003516073 5641075230099727784981579696383316732450130418277879081291954534985607255267932 91040802121912074401640073226003257602385910518707524375098380810792151468159323 59272268188012925764499414539835790113036863511169317924034366016920114706179376837448098952655862721652129333873020625135398431500899131874782270590048 26690053756452308398721390096804652429111408747235998849320348549870126230712525274708597346508961935323823048352116439255386668122483555236157562141222434006899926132549352821247340442387991613448730451171206857242290791156220288682675982609964518905569737166444127835826079348146626921864776959482079234994631361894786436656768739968380067890165160954836874044821979903056957225885565092422439358816023307475581832942250031121721325840673134241504501661692722633100336840768527354183989544434614842654682324213774503456414914613412547380720171088896588158750436205804689590730033393056191028424154915201435563063992) 3688799026236399954810176709661301568861707715535320711528216815/169215718032454146095901737002485678790901914179482864125777331106759302744215797822810809511498045518338288799757661725047129775976254373463314416017128993811694804386237923340900604770406784566473173755998386770282409830097844352035251738093305402541509197084964701114515390028814839744480965823142680384744649624767291550851759670297818996073873968006960956353033659153219390871979066743795530136868490210455800714335529013059123604101460242870160400211866883478263106349349114199154533363251799944090298252763172390952446660627602934622584400932001701907172000401485323481964448487312714644861543740014645407417493588261100128985848137181719614326345024112347151970444057551896842474702539258687521054961314443551837168457190568932765925484427579811571491887599619302241390226818415165012748654917331557679228501007751078584244340346651276906088856205294333241792044902850102153793417101337667969641035858108457362954650972654353600494166650067557014544136240962457086782865870886529792004619668808741311540795514394731398977642092124679638585188974746423756335151669217754388004341907440529525288302872368689364872785975840444000802518095138062596107983803117056) (num-test (/ -239344771695510351349291992975349015183687755312261264640655565 59880027487583466136533364102518649070390160795136023810470091681171428955831193 48344457085007359228086666145324485903333773379391455489556219681156342646858065 96824393663737121700189215323825147927318524415097221824671795011444303522438090 73240728471954064253765051525185557601431281145369716902120469411886093226662465 53476482728312567840603110355495270554470432250981685279567813448298175801364992 2468459436652089730331798017030410049989399340882712030505584719342958436741536069714790640546086933185494149096286590992747248311590137695839482679011866 -20583944357058654336975302336113341974001469085102805363209530168831840401111182124827636905521584509677325966689931599005216123375088335255672290604710305325984961984791919524676460851699284525672773368217606895110240237523696098521003978238685169880199868729577660354717875890521074505342309726366304528678619465048659607726264456481345739318939431629704180230985397408136331466856633265343276511285483458860216756106887559724757372775728879136089013590836231272961497930729470443491032308329051560641396901204040829291495325588896591482909336032903587307512310970849256645908744180630660878534263566681640143534823) 15956318113034023423286132865023267678912517020817417642710371/3718709813392127924163278362562751486187605430152002432053108623099406465632705761508167478249438322470295467114170871555665890539409511492475240415534629792791729596612426725326976353265532166735941330128195885206087665506220364347120981130748862937276841801804372097254983242962029582754709606117339082763083905960784323141929645331591164015455383939302728076410053178677168172481507115685831178503426055335630689722163467637005123748113214310366231893390818795405612007113310547901224920768646006621130651182788173442625298859454337696280614462941186626306295514630883052819172301830539345633711941340491653447613466053205836875456839023743314390098829184111583809697328393569588632000669468187410368485286035179259523632217543401146996259011916302393091677624838641658623073752023082344005134299104409908004250830639232078441523519412192782367689826532215394196055149255026188549091956300108740792221660678858924234682223183500313556198187095251404633698868186071148295957994257417049500872570631774233307260384902571112475241073598945295745287525486108978093728296107260155093397986671349139935376427469718767763295900745932105722655724205000829205748307261900800) (num-test (/ 7013212896988366906/12397903473277899947 818833870013215068/2125577647443895255) 7453564285301859120853045020886215515/5075911640537211768265804260348400698) (num-test (/ -15781329068048599432/14942574238341613337 4388772934226358350/2640112802717985697) -20832244458230302534551181278529162052/32789782692450857054331267544650656975) (num-test (/ -9015230453321124271/17425619133302730035 -10422000746814766599/14972344381173680534) 134979135022768387806775446187867640714/181609815620990738305316999098032100965) (num-test (/ -14741075237791868512/12448692140900938227 -1090381863721238817/1060836378253796023) 15637868866825840780217685066084527776/13573828137487503515304766902031557459) (num-test (/ -7371815071140740177/4722722556038701367 3872455829192658988/994203944294825175) -7329087620340161131469364260313555975/18288534491791723206480607737200436596) (num-test (/ -9856364379969390509/7988230468709836259 -7208901117187058135/7430860779232874136) 1093153305924514768551484985555671272/859497963436269188803272225817371895) (num-test (/ -16740689272507881147/56924866550406451570641164619431212169 -14712532880452686095/143481612520580129383584255576273223983) 2401981091525408257128502717450566513166280001357873948501/837508970838236191644285394369194561392491093277901090055) (num-test (/ 1874027699956565000/65960003455647360668413772300355814843 -172394881832672950/2006879686300828197846469567507151887) -75218962452157875130617756878839223573611935155763100/227423340028380523596387094039260091189651621559491937) (num-test (/ 851521912886492079/58839621451933520132430725102159653727 -5525838657334730480/268863138354222710211869290179088409033) -228942853876053297959532391872114722003932597144466549607/325138254802036127673497464266072288930584674567672498960) (num-test (/ 2130823024472312937/30463932363736038600114358208342163020 413938864244113775/131673792970459944919771618253738144891) 280573549781056638388629087822719475587456644826399754867/12610205563054396144647765193069861697742251186477600500) (num-test (/ 17234694073181371137/253506951459931119968572673772742357160 8407879684613951161/42697666588937447817581914537644794355) 147176244259806896721181660841298454615950364713859506327/426291189417673978158704851675227114861497071554451732552) (num-test (/ 14739301038477826821/4801125431810347467140397350459581435 -1752125940488995048/127905197451270157484305628763539243969) -1885233209620217720514367144506571751170505057476450692549/8412176412616337518572109406238500578932979745867733880) (num-test (/ 9194848570227974720/45448499872046683203864930109076126035374684748838016011669264943000310475483 -4572473918523931944/28941042619577200519536336906341131911598596429670188136734086846500956354149) -33263563043940787786171015409141766453199063320923723716765930467953050399983260590187417389160/25976510037621464639740779963549572814837984766154635046133743883024710122710674726552171566119) (num-test (/ -2662376868940711929/2674240208804755702377222409224408783678596883960539287029565653749020338064 -5046618244273151929/26826013625152995057141957222948811537350409769204161465077735924332004069058) 35710479080747854012875521001477955195584454274704368888444222736697434540936425667291700196441/6747934713661461716612153292457811722283965560031580498434684530869001786777260513409206862728) (num-test (/ 646980248518054663/28444849537262537816809349756569888989442483441699293309597267649158853799707 -10174938507557455325/16470612178414296088079890015341965945714023680627341561729034923083435428747) -10656160760434978971303471120231114671340660575734505071429575384684610862775940451177787597261/289424594898370460244167952344748286246980979584479610186308309369583658143095854438992150589775) (num-test (/ 1268676597518744714/6024937921458004492480888468749320142603908196076058575752452561172018490893 17823595902143962912/85935047374548136904062562443188289405155329832270007415035044821925251080203) 18170630585125644385503771892175817370913744757273904248648000044618805359154885235028182716157/17897676474595109057512045856227678061218241143085827332930191066967148125532813505892133626736) (num-test (/ -3035741006152688190/58890268425224581569217175195410848521985674465189565646495474378301884202047 -4870935665435665519/47998868922405332801456101880162843269583282603435159879276723163289928325531) 145712134636693761356266465698326002831562744975420904782663360472436650653549187025441059178890/286850708819506259357726384810790881448875152111132928069815447961129371272624891025817707117393) (num-test (/ -4420263280205408439/38682162086456801604593696710774835436326970692840048042132553053971380151628 -758651402628235427/1755534012040040367913026343944696058732638465867705260088080517539506722166) 3879961265286134914514096239640695384126081133972137242327715997675029567458817030555062379437/14673138261791601182714628661554161812345431143865809776872034934342213839184709418896670662578) (num-test (/ -312487180249669742743295380499853180353/9828632991038934281 -86131955660561774942466932680637336739/10268762916730341592) 3208856768501438660232746468300370677374054716853273141976/846559380988100144557815474234956961169507773676687849659) (num-test (/ 105376075880566042097567073713047434893/11411565636673693365 -220737802783327232867818580441304577024/5817406274606660773) -613015445021032499619145665530563205764250055719854552289/2518963924957071797477174332253152325843619212749200245760) (num-test (/ -311533429150518992652072799089375050497/4403073054828470603 -320230219907951760832723580313293021909/1370493254961533625) 426954463345823097468320537904981772054351338526938461625/1409997052618498081840381197699863669488222338862641441127) (num-test (/ 305676222727436457375950609916137360009/2001517485431820526 324338803123828318219640932070020543912/11123178903397935211) 3400091311912189654145957985944153094384781502787164376899/649169785656371151621897383467144093766684841422885937712) (num-test (/ 8845112929712368402815105446090151026/8124751572615311799 -107609110538267962880281203537194473336/8714443449141779053) -38540118213625599008519681983731393728094066419546629189/437148645036763776481446937412401903340367189496615845732) (num-test (/ 152921217721894690043853278309581658066/11705615305395353865 184187448038871874764725486848823516773/4171619104693691390) 127585814672335876029018138907883882524550368713261650348/431205482165106014329333719781838993214328411764819575529) (num-test (/ 16414254293541341780725162107696242521/155838132618727968561620486302365154071 323320173010032367023620851618405869489/49801924105617352177018959505967933104) 817461446577249670665800625691379410535771218196808189195363718417488315184/50385611999847495177988476252475899813264458225659097815552272081452203039719) (num-test (/ -188149667625860588508273820953820709614/21438745582767797684161462130971215025 128458309657689922121539794960212789849/134174286369366827879740776978166655691) -25244847384333405496229128525982900130397411994350175944375943735942831513274/2753985018743617742875555653653797261370358442640799457019039857068516281225) (num-test (/ 1218460641064115152742257147372113443/1773382194117714970762642066492794929 -105212349758139121832338365854603836112/35045896682356785176328011712384921341) -42702045738251194875426595475683618047253961691478453648029952948483687063/186581707662369193907913729212042024270164277319717456729276609131940676048) (num-test (/ 1467722271775252460214852151179762687/1747611358981474614363356529179985509 25495740211005247928144692929451604259/29615224810946461612486375021101910565) 14488975012885720730598332784736375353299643425098519766594278819666029385/14852215066131169889445443721709162270198753408805825268529301698140894277) (num-test (/ 6278399735526726207674375684072448068/13890681759576280617381650633747782321 -112063146811220963294237186476216238443/46495820670393894026441353693945662660) -291919348200099113895651901892723884699250237261456280525601785996696740880/1556633509331345870779770006255469001211806559199158615405344674499795966203) (num-test (/ 248406099260780863433196593538936526373/315762135750029127758352280023694126018 -24578051912523675039725210046249323571/3033769619337997374435389027823294736) -376803438597807975522050212312559316811899647514236724224019181136008036264/3880409082236781853269738100403484871805889674074731389226471480469265885139) (num-test (/ -305871752543087256004326578375555909668/80170799467978436032303243749692785696371676780847080230403479135749775915991 -208573266832391890136462745593008906685/96016271562601269514856687672805175650907293023094157826925793080307407361434) 29368665255505841438632782694581946057561031972462112644657516768267440383833513431444679871238206541553985530943912/16721485549600848123731461311227384049611071114404954309505697259277905994635125654414916826332204568970567318299835) (num-test (/ -171651126582338417143004525987733942986/48126955023093310081685702171788275811688444573315712039582092051531229683107 32570134112026732491936310765048378699/18584159151613423191553551933672204731023422884196280183931777685641069715348) -3189991854959918631828923606391779823799241149346421336570141741355492000935500642040047513113849334779592681149128/1567501379505627719887579027549074087653888429037997616626567546431482074522690424133509833932668944596793898937793) (num-test (/ -31304786393644787215292629624842492472/10539846271603297974613179098685212701091372728582260780054561526149580513583 43496364289252206338797704034889660065/966865502932307025364733802774045297740949567802356684866342045679773834966) -30267518040679809082934454680954168768135550720881039440573156734314284479043791824457029301083428211405425375952/458444992982373700837242411005687390212275114474481688646320865335043970683786989531994936463047685893258985162895) (num-test (/ 124366625369659591476708994326732418029/107684759001536292829359995221778346870065030877016948429894748600664800488759 -90949754058598173499067700725927605729/79727020098830307921496202496061295138733611655702270828135321391380898414003) -9915380440470549523296226431396644117384598256053664887332801972488440466568616812942647849957495261151611303260087/9793902347049141646079571573977765974008832433473016883117384010293158932212528563016145547341801740792289848500311) (num-test (/ 26792084925762094333829722201654015569/6815899891200140342329613369008754659665480100088941978786466272502677117648 179968988142253715757129058636648023126/97033837835570527321466682927970125702018459951415339098532052222053589117353) 866579607987744230609336186273867662887766686833260209925103055244528379635362816895584608387230956963010276689619/408883535566062149539621907018509777969515872715944952500700527207173412646715462423653890585029605025758308909216) (num-test (/ 320794852821756057819990044473359503428/42380074203350930293358543616207018031675687905746455222111844144668904183229 -11813439835454851567822019323728871339/51852159737956631156972450987013128151750117741949546305537111598356497409240) -5544635317209327550045071802859986261979158492907374734760649234578367469399038563605323839330681533705071632958240/166884818941132804535892580774781586387104334774784737031184369589400544303785250219152004898392301479219940857877) (num-test (/ 63160395612932962868082774785156358041658469338654564454114468396132462549944/5671929772244157797 19541045450680948617094710246839287171374470593288265457341382295544977156173/10827756125123268218) 227961786821047895774887365257727015864174017882302289602409601101722343657899277052494444293264/36945145824164509580938949252327087600266044162541122809277442696583642758457532273140841543627) (num-test (/ 31389399613343712511677734270541516183531975055644318154870016415582858008412/11320913214023484367 -95931706646769408081251897664360951854776052790951374912970042200868629796051/14301831604104230477) -149641969141325406602881756591195860220337618158488775091717625369334526143115090325362684257508/362011508473745439254610688691597507367516106821889963803421575701854031622412859179610532278239) (num-test (/ -50845041077039215658764589763556935122444212169574762080162289087527164772395/482986173890811026 -51342299909113507561385579724776151277474630060658338514843664853027455595538/3864573616937705869) 196494404298439669659681446421686066898686292162412914850963937042669022612531239234324840686255/24797620991857267698917294149872672843409173617406514673128342148521539559341861421304646801988) (num-test (/ 76283614020376921713154299810619585257752996149145061806263596894412414185408/337890011287912517039286436540240936661 70530558237421368381589233382700323659036925075366138096846582768833233488577/12121510300837787759729092713205686989) 924672613133132744522463879340347327755455994321131972145048214329608890428265966744607561005512244129921459256512/23831571118985077324412202325831974453532679575894228007993082738742295289254461850021038245882565939546151124021397) (num-test (/ 13518475961402756750057330871273933874583566313800024119371308450919239424622/71146816100737230880567880716110051085 -11914742388051168959634071864657967837347162591767656949770878950409478930980/166466796775669753065110807850377519909) -1125188695291804746273664719520877594103080002716204716437885631737502681157239448228517736957154781558316254899699/423847992785167635691798025732868758201476408654527740579259436528169254792708107390082891890404030666159494556650) (num-test (/ -53624051286117226406327700847140806598091981633622544805551583455315188018537/149060170957501829683988930330276188371 -49540630291338976658332195799658601133012561780540500265134312414843218811481/313014990314092319823049811442768272842) 16785131893926373429171158665038393627227592608630727377590747943991201054188961463248027101037470630205119769672154/7384534820569381535972144752572408048556227885764547207137140227958732266609348654686668662110083737942669493487451) (num-test (/ 2634758410586745842739353561704344884865889793873131750193619887157306355755/83106075320614705363810122092414199463231740446254118542567688658288107572919 10787649314660479714744029413883607304719873485501736976813666398631455642569/2439964488756696481271244145022481444549967702052558191280867337292105066432) 2142905652761565172685487282499186838096673751132490328620490049367034561455889328384026705096013173825469773464105722689198047146574263705663366838720/298839732158850477765824602476778580028064205733214070073086531571837859351705342746223206218407306637658483098569582239416197836311325170250187389329637) (num-test (/ -1907320079310938642409293211056905401889419041722087613680756850005726714712/10387378553621846874105702088597026076825105075730032753153301604042569998683 113647247724474559442709588703965365251731833799417671287796250968092484717057/58756890421232187224353930678527831208703723187770044891160428018937233424397) -37356065632762902117955690133395145368676268194116097031480521390942668514422835237280325034441435052929702455487858500299401976652159912902024146542888/393498994563785425899168694480259206994308562177080555315323154941891277193612821825931878224565302417504072329241812530787363937691786269618438039211977) (num-test (/ -54987418627898620923060954379316763081930842855917193391807940070173620336071/17370345837184638879794373707261631548922174314274224219546763452439685451597 107349939397731511365417710412808670916754334908520065561311453951414109180973/7800708635318451621630266369706695626474649690647985662113853436261704078874) -428940831324519456770429889832838610542119304716244392653623661175655561457214418178921042544524225772650432309479656622489393939407340321261255371264054/1864705572939408818246392762570376592749103793151936455808919833872532407312841098160841844995663367019074328670998871082130543124576872890789577304863881) (test (= -98781233389595723930250385525631360344437602649022271391716773162526352115087074898920261954897888235939429993829738630297052776667061779065100945771127020439712527398509771853491319737304616607041615012797134365574007368603232768089410097730646360760856052946465578073788924743642391638455649511108051053789425902013657106523269224045822294981391380222050223141347787674321888089837786284947870569165079491411110074602544203383038299901291952931113248943344436935596614205784436844912243069019367149526328612664067719765890897558075277707055756274228634652905751880612235340874976952880431555921814590049070979276358637989837532124647692152520447680373275200239544449293834424643702763974403094033892112967196087310232853165951285609426599617479356206218697586025251765476179158153123631158173662488102357611674821528467825910806391548770908013608889792001203039243914696463472490444573930050190716726220002151679336252008777326482398042427845860796285369622627679324605214987983884122808994422164327311297556122943400093231935477754959547620500784989043704825777186301417894825200797719289692636286337716705491307686644214213732116277102140558505945554566856673724837541141206267647285222293953181717113434757149921850120377706206012113994795124049471433490016083401216757825264766474891405185591236321448744678896448941259668731597494947127423662646933419809756274038044752395708014998820826196523041220918922611359697502638594907608648168849193813197790291360087857093790119162389573209640804111261616771827989939551840471235079945175327536638365874717775169210186608268924244639016270610098894971732892267642318266405837012482726627199088381027028630711279130575230815976484191675172279903609489448225149181063260231957171204855841611039996959582465138269247794842445177715476581512709861409446684911276158067098438009067149531119008707418601627426255891/2063950098473886055933596136103014753954685977787179797499441692283103642150668140884348149132839387663291870239435604463778573480782766958396423322880804442523056530013282118705429274303746421980903580754656364533869319744640130831962767797772323836293079599182477171562218297208495122660799328579852852969560730744211066545295945803939271680397511478811389399527913043145952054883289558914237172406636283114284363301999238526952309439259354223729114988806937903509692118585280437646676248013406270664905997291670857985754768850507766359973207600149782819306010561088246502918148146264806947375101624011387317921439210509902170092173796154464078297852707797984007992277904626058467143192149921546030028316990855470478894515952884526783686210401408859364838148201339959570732480920969000913791571631154267939054105878236201498477027265774680071188764947522112650857013491135901945605796776829525789886482760578142306057177990048751864852763036720112071475134369179525117161001517868525821398753039187062869247457336940152614866298628205010037695017885878296140891234142925514925051385440766473260338168038302226808098439763889250948602137806546736025439919604390464712793474019469457135856879584745805794574609707742445431851999335443724488636749987837445626810087003490329257105472274738811579817454656532496370562155449815456374456838912258383282154811001588175608617475540639254689723629881619252699580383612847920348111900440075645703960104081690968807839189109040568288972353424306876947127635585164905071821419089229871978994388197349499565628906992171901547121903117815637249359328193980583892566359962066242217169190169986105579733710057404319381685578470983838597020624234209884597110721892707818651210378187525863009879314177842634871978427592746452643603586344401223449546482306838947819060455178762434166799996220143825677025686435609179225302671777326568324855229172912876656233006785717920665743720753617646617017219230313226844735567400507490772935145894670445831971526014183234960075574401616682479457962912905141754252265169682318523572680657053374002911007741991220001444440319448034755483178790032581428679303588017268970 0) #f) (num-test (/ 10105597264942543888.0 14352488138967388642.0) 5052798632471271944/7176244069483694321) (num-test (/ -17631701977702695093.0 3931860028646338313.0) -17631701977702695093/3931860028646338313) (num-test (/ -1606495881715082381.0 16324360910828438638.0) -1606495881715082381/16324360910828438638) (num-test (/ -7960193178071300653.0 -10280747961248435844.0) 7960193178071300653/10280747961248435844) (num-test (/ -11544909483975853384.0 -16041992360613233027.0) 11544909483975853384/16041992360613233027) (num-test (/ -5758820541298901548.0 -2596462557714095861.0) 5758820541298901548/2596462557714095861) (num-test (/ -13056342734667572546.0 46502284983183419157350605242474199851.0) -13056342734667572546/46502284983183419157350605242474199851) (num-test (/ 12668118634717482325.0 -338544675918656078399121171905238525746.0) -12668118634717482325/338544675918656078399121171905238525746) (num-test (/ -16738429327795346815.0 164053836541028518093058940786011794219.0) -16738429327795346815/164053836541028518093058940786011794219) (num-test (/ -9884600460121235549.0 -53914696297933680001835530599748561584.0) 9884600460121235549/53914696297933680001835530599748561584) (num-test (/ 6753521264659576004.0 71759828079371803409570464915096122874.0) 3376760632329788002/35879914039685901704785232457548061437) (num-test (/ -6072478784520825268.0 83641961138289700975241455431547940418.0) -3036239392260412634/41820980569144850487620727715773970209) (num-test (/ -6708950756971973620.0 -9847903810677323447803434015107261150885944735136350527205856921771320298384705376646797569973415403097847060539915279223391112430240736564839483430569706.0) 3354475378485986810/4923951905338661723901717007553630575442972367568175263602928460885660149192352688323398784986707701548923530269957639611695556215120368282419741715284853) (num-test (/ 11263779860755455072.0 2292311486393743282743453705144070351222990311578446825826935237655927864700827857707370158936582804478427014131790879562565658386819339761919809732496450.0) 1877296643459242512/382051914398957213790575617524011725203831718596407804304489206275987977450137976284561693156097134079737835688631813260427609731136556626986634955416075) (num-test (/ 9956488981426387585.0 -12351244248621474338537656633137999145154500022264356186225225426288301330225259889671144104952158102155582320296061124840400655528634050137479515338944145.0) -1991297796285277517/2470248849724294867707531326627599829030900004452871237245045085257660266045051977934228820990431620431116464059212224968080131105726810027495903067788829) (num-test (/ -14875992781716065391.0 4906952781757522095285156014969507916562921709689447567404076064849249737893410245743456952512717420040816186768213920574809530298070437840356629617118643.0) -2125141825959437913/700993254536788870755022287852786845223274529955635366772010866407035676841915749391922421787531060005830883824030560082115647185438633977193804231016949) (num-test (/ 16043178952268979636.0 -4962728781666935768923030490263743715131420507991284894489828489607808897271220927863958149140648859077934323268424257800724618076505149638049461104621679.0) -5347726317422993212/1654242927222311922974343496754581238377140169330428298163276163202602965757073642621319383046882953025978107756141419266908206025501716546016487034873893) (num-test (/ -14889985628902581941.0 3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361.0) -14889985628902581941/3075736124701105220602924325296812116294816310089906623707854625135862902005059305428034753787024827094954645083406870532379125275086885405969947540175361) (num-test (/ -1719613957783789857.0 19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758.0) -1719613957783789857/19860562547348050982501313785551054055826630539673708970554435103060535649825139319625648954889488501680865494719253019921780044205805557658109807483499994523398090829033362953135186523580359552555144614353929273831853529446536288544481045105104526669277307473478898498061888931858821517694257595658138564305517447595298378933983614114298000880741350618424855028965861930329619462261269994651112266861896630584883581092431090390354633458596611690990999635499563944625720180529318327647519405136188243979680965052005899543797270970540925042201315580510136864931200059448645464256385079735225156720340173280541113382758) (num-test (/ -10969623867482498359.0 1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595.0) -10969623867482498359/1292477254230352575769754773488799598312602810841892384475535212194939033905139960602724737178675944133847094464739764817257836826367652752931492512753561670732296265459534230949226553571982695924178928914002527460943582374603078611662312521259541641138419845784008028215876048965254023368247445173694441960256131358058174374542730502334351759171930973722361567186133851896057677818979314942434199157003833234473048838906103902832115569853657335216793235394595479328932380393044485884605451918890395812628720641212850763944658735838941829604119213195707479940053016354291972875689927240247563236506479099606571912595) (num-test (/ -3716891004757979686.0 -19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987.0) 3716891004757979686/19452372993227550502015765258932159656814363741878583541173956168837566077148160901999018823586675966076058615847408138956450751813058209394199427182041779436168298455103717521843644244801542056954603631432685194627158423459586845252167819811850263444712218938833443253125954475476481099092216538126519474183531297423759923656571895377587989169731023397615799830371852298135015608612181670362528239430952907458704415974164085176066242388561893721949244663406941558257051263727439679525692652639731850971185056484335828001005009903973037524233097329857690857731943951449292814500362180170793919266389501882641682782987) (num-test (/ -4863232114852441787.0 -22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720.0) 4863232114852441787/22963038454503597269981750990033903654256693514059439027985256604978917966584414065892146187253799108250061573972673983350956191446047978392921074610323648301008272837432907303975548030552369880338022067315042332692023645592417869181836251486577977896077712912433381480614752789750181208326525834629219729662085632321271870762094800588296544243340047360684854239747242066367921596241226349790282723168222543448385227922748241223520686047460119733024390425165073367321644498280127168757335614077882325524816799960018589278475564547840614315473357481582710826551932681173443524724802157570101916268510464302946527662720) (num-test (/ -16248276650501285553.0 -3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159.0) 16248276650501285553/3381199474840825715485713565301777938368574604710714363907009216856320913536015299178065264912798511857598595067318796576494480424838898250138649774858742984769125731728430552285782315111538920026330816414650913188340281906359149109963139438960274321560117812365241840204034925444652058916966934904097509799291744775242863360284348334605170437300543978049053839829106628489146216325576991696936733592366926096500684308845306493636196092408597450926695579897293944488261001228478152650490677071497874746121221519036861983646423005753475340900508665494162949119110128646472783016552527735050067363030838015919512260159) (num-test (/ 18296946401228630959.0 3302341071702763311560113831030141639804425031433511503765833897787925467295486187687396312611805794369889470239777040624530990622212474466940548049117664906468330871893337410618797113677420975837622378808494314918471282099855916016026079371666730617071364751834080179173620476977670099126230223862266413091012344741482772771219725893630556702028108027870656512750807359335108428687238687397060104669074315031780019301768744978815422943986587389425726602444937024004102212071953113581935989741954695450085391443134273670514145585869912689150728183940456773133212037846765421397201956541430155664614978559762638030787.0) 494512064898071107/89252461397371981393516590027841665940660135984689500101779294534808796413391518586145846286805562009997012709183163260122459206005742553160555352678855808282927861402522632719426949018308675022638442670499846349147872489185295027460164307342344070731658506806326491329016769648045137814222438482763957110567901209229264128951884483611636667622381298050558284128400198900948876451006451010731354180245251757615676197345101215643660079567205064579073691957971270919029789515458192258971242965998775552705010579544169558662544475293781424031100761728120453327924649671534200578302755582200815017962566988101692919751) (num-test (/ -60488682170925814337492051725122486652.0 14880088785789146426.0) -30244341085462907168746025862561243326/7440044392894573213) (num-test (/ 126617729996196635247771282957911941277.0 -7166506344996883172.0) -126617729996196635247771282957911941277/7166506344996883172) (num-test (/ -278675896803726074870988122161067771390.0 7744689831802931490.0) -27867589680372607487098812216106777139/774468983180293149) (num-test (/ -283351838662873779255871649630248958879.0 6912311315831153835.0) -14913254666467041013466928927907839941/363805858727955465) (num-test (/ -9715584046609700027352634666499181378.0 3368831995960494221.0) -9715584046609700027352634666499181378/3368831995960494221) (num-test (/ -137493547985106345282009151869389470397.0 -1916381539906956855.0) 137493547985106345282009151869389470397/1916381539906956855) (num-test (/ -328662747577960331872949773416436800743.0 -231069430804205460334599495337085157308.0) 328662747577960331872949773416436800743/231069430804205460334599495337085157308) (num-test (/ 213595640581249636406536485951630735277.0 -48492294677143227478357598229530842959.0) -213595640581249636406536485951630735277/48492294677143227478357598229530842959) (num-test (/ 85922846498729014445816145204889624189.0 193533957681757355413031965695625196813.0) 85922846498729014445816145204889624189/193533957681757355413031965695625196813) (num-test (/ 24053342958857142686054803491202486471.0 196417511107100936775397820630955772553.0) 24053342958857142686054803491202486471/196417511107100936775397820630955772553) (num-test (/ 102038936612518756467074084117019701214.0 -111946989731587760700903475996379168167.0) -102038936612518756467074084117019701214/111946989731587760700903475996379168167) (num-test (/ -3006867214208872584699983438179656913.0 -234257597822744479264249663225224173340.0) 3006867214208872584699983438179656913/234257597822744479264249663225224173340) (num-test (/ -279839802710533516603863620922251878907.0 -3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219.0) 279839802710533516603863620922251878907/3244112647743502769852782626803305310331045534071805654982307107362388474314396636799597033636575215617240554815450017779373048313695795886893032630263219) (num-test (/ 123635964546481689465778244982425098404.0 7701433613491146708866098469269971554817017737111287276993583150548359764165526640986060909954451793171933304569726872785964805121981749276421956645830854.0) 61817982273240844732889122491212549202/3850716806745573354433049234634985777408508868555643638496791575274179882082763320493030454977225896585966652284863436392982402560990874638210978322915427) (num-test (/ 166158110049010486343321316578688184578.0 4093720847216792748840371965199135052196058344862447621818024731938681519017878880275303125899149558774718190527651555811733139227128378041055212888819294.0) 83079055024505243171660658289344092289/2046860423608396374420185982599567526098029172431223810909012365969340759508939440137651562949574779387359095263825777905866569613564189020527606444409647) (num-test (/ 147416259636838312272435267341375281181.0 -11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801.0) -147416259636838312272435267341375281181/11266711292262839805944890501811605204323255169233519804446548849178247889563130015168799346120099052214488209897402054530713234143622703174309015777885801) (num-test (/ 102557200511608632541115941654031896919.0 3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511.0) 102557200511608632541115941654031896919/3866177549962722728707550488877109233779215384377007088712280650225992470307822792085413087509167847767889824884877044539352696974351192629898363157976511) (num-test (/ 47794953079190110032282671989549362415.0 3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667.0) 47794953079190110032282671989549362415/3802290983508829335098916118339496411537222492645529399519373082799614656011270200284796148989094312601047370399228868583158444769807910513767845541589667) (num-test (/ -169956065319483471022234920202991103615.0 -9934427489865644196610501807375648335352544234206717324511161205173460054921759084767897792996557220898467288533128078406604709773449948420404563411793533441010236017064154469575084055359823982786110746700747423674942932421964955746280671982635899487781780756099620799397239156211815110739544719746684712086075069101799537802834839550142629064374734870047412916259754010150500874430055034366305216104752636211802195447299210332237598443674867760860326529472901775427058078447963316168327741049511844237329137194533000697525539835371015163158135757326482343130221118201740819963770851200676279882978581431999960842565.0) 33991213063896694204446984040598220723/1986885497973128839322100361475129667070508846841343464902232241034692010984351816953579558599311444179693457706625615681320941954689989684080912682358706688202047203412830893915016811071964796557222149340149484734988586484392991149256134396527179897556356151219924159879447831242363022147908943949336942417215013820359907560566967910028525812874946974009482583251950802030100174886011006873261043220950527242360439089459842066447519688734973552172065305894580355085411615689592663233665548209902368847465827438906600139505107967074203032631627151465296468626044223640348163992754170240135255976595716286399992168513) (num-test (/ -83006311763073652927964071041666508273.0 13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690.0) -83006311763073652927964071041666508273/13480787677843057038436344704360462056114592749322481662307876594244244638227291805757775026215166740035048814729231681821563443093991755779505400592913963236010573873554317250153995160235771659208137440518282824497744092608999871327127239673370293239927529076145825972430101380272357235582367639159280348164804218713823424182167974242317526959809443701996053548231667727254858428867000011055354779789221097183515832386890638024105232865079002765479933320220378271026425568216748186200736499581088153390350474814123049637951929317200314355414551809067125550551841102097159644340520444983020267926123546444838010089690) (num-test (/ -312626207169475064151212222217866488926.0 6989069923898656093413456232544365450599471748502878018530391549015151484336014906416216966193568842618920902504390187814247729346977677905224098932673981665869061845335443588666641982676550205160521286690015544764015602751932938178737949961754714143180917985455875095030469699198116593730005119922928175789172042067281849364217595912265452199938281052984802042194034638773435768458457616208103331213440768472281882976004050012769415198321241810008696147179275528426468408383757692656341606162350211696837361434874035354680073309142183699892959618671515841112321607728427286289324836870027735590091451421689980776552.0) -52104367861579177358535370369644414821/1164844987316442682235576038757394241766578624750479669755065258169191914056002484402702827698928140436486817084065031302374621557829612984204016488778996944311510307555907264777773663779425034193420214448335924127335933791988823029789658326959119023863486330909312515838411616533019432288334186653821362631528673677880308227369599318710908699989713508830800340365672439795572628076409602701350555202240128078713647162667341668794902533053540301668116024529879254737744734730626282109390267693725035282806226905812339225780012218190363949982159936445252640185386934621404547714887472811671289265015241903614996796092) (num-test (/ -151709660794612786408772973806200383563.0 -26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443.0) 151709660794612786408772973806200383563/26960472721919005254400858042130056790831511338891584787669209989714807518625849812230185079206081782191501696661436514815190623849929065098497737155759771863508038766934134444191240792356114381746781342181881402424707118515655119761011977116554236461222788625158348668147995099157685699761135150772589445239536582228655532345059046596356954495360132444243748421428095867292294626357084961338288369883088525401649234025290736504802104065029036642533076183281468647642956623788270236516849523210698622687255735945678505925047193818483603361307498423724202227256505312543145618362906047473400380196192622607541097732443) (num-test (/ 138834496986391136939574372853300933725.0 -8052690543272184576133758511645801940246473546142520821850130421981395129853341888352999304040698251945886555605291324954368612109314080471658982022831338507499254609048475429862437003158379101603576571787302167207044118847876475134352180874260998595377014195145760071923429129767580115085764485254455919915567128572731355497418831212259648020550107573824886521471697331410754043280744066090848295906051303624846301488010249980896364883452154860562864255354208802313850527991005497484253401461375477060954782095047043919500670383372218536999834862885439984085848342867301834247551832677237328664699302165347765799113.0) -15426055220710126326619374761477881525/894743393696909397348195390182866882249608171793613424650014491331266125539260209816999922671188694660654061733921258328263179123257120052406553558092370945277694956560941714429159667017597677955952952420811351911893790983097386126039131208251222066153001577238417785769269903307508901676196053917161768879507458730303483944157647912473294224505567508202765169052410814601194893697860451787872032878450144847205144609778916664544040542605794984506984917261578755812650058665667277498250377940152830784550531343894115991055630042596913170777759429209493331565094260318589092694172425853026369851633255796149751755457) (num-test (/ 276499207940187081393841843387608369874.0 27347897028734618663428054896349668572244941195143856840032842195489553215406302254043947382368793914074147314353589439281000471813879502242851166670252197853998033813694814376228360691543987661407996785043637351295817024680721181205269262470473172181965930243852520386958529041036476807810647578694133804796395977642274699322030062940721165202488695975750512485574440928370802874677938542169620505668128224812441566912043326338714451629730522324228356364241376445033028898865300103247057378058702233150414643818049655628999871012383236520330575609745427181485617250755214922048672375947942288446974485524776744246517.0) 8919329288393131657865865915729302254/882190226733374795594453383753215115233707780488511510968801361144824297271171040453030560721573997228198300463019014170354853929479983943317779570008135414645097864957897237942850344888515731013161186614310882299865065312281328425976427821628166844579546136898468399579307388420531509929375728344972058219238579923944345139420324610991005329112538579862919757599175513818412995957352856199020016311875104026207792481033655688345627471926791042717043753685205691775258996737590325911195399292216201069368214316711279213838705516528491500655825019669207328435019911314684352324150721804772331885386273726605701427307) (num-test (/ -8979365591106781219797187096315899769868799444656824967426553299158070014074001230883484015880186603742048949313393413640240595706939311540002219411120389.0 -1698360947072008877.0) 1282766513015254459971026728045128538552685634950974995346650471308295716296285890126212002268598086248864135616199059091462942243848473077143174201588627/242622992438858411) (num-test (/ -12831814656788829919185319784994714617782749504716966706877579983082880759985031662545957372565411439648298939198657738497464024214657609856476819270030801.0 454910754379715.0) -273017333123166594025219569893504566335803180951424823550586808150699590637979397075445901543944924247836147642524632733988596259886332124605889771702783/9678952220845) (num-test (/ -7834266257250691217409788323211914445703052638619784568844628449769010091330019095736167988675873769434766592786720961949649685040028101508217441360672222.0 -428418418877192732.0) 3917133128625345608704894161605957222851526319309892284422314224884505045665009547868083994337936884717383296393360480974824842520014050754108720680336111/214209209438596366) (num-test (/ -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045.0 15760991890495426717.0) -4001605821592542867351046644170905984672346731784670159062281252096012802838642896466582343641124674682428297533953704119505640938363392225910275838094045/15760991890495426717) (num-test (/ 2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499.0 -6788234478844960330.0) -2876630161532936743269451364955814480771395635620140205538288339793482694260173239474830738010159518887660000673207712630507802368373928478641773477534499/6788234478844960330) (num-test (/ 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333.0 190237375887614033974333796608341639595.0) 6230070442453337264527950102774203962152836811174649694700041895216739851602598854067104967963392074425258687296947909484969927078206601660837276754799333/190237375887614033974333796608341639595) (num-test (/ -12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472.0 -41681385674896602840749705069663453185.0) 12098771374444180013224380531550204930654718468097503123335711776524055419889032578894177605164827523969169377266342179411916625188550162928371789854647472/41681385674896602840749705069663453185) (num-test (/ 13185465843955116174925558412278612918939024395488172088108029202384613698982949554556435640011161663974075894844304583900497170806796813871943782330552768.0 -155202352609947911537719051033334010254.0) -6592732921977558087462779206139306459469512197744086044054014601192306849491474777278217820005580831987037947422152291950248585403398406935971891165276384/77601176304973955768859525516667005127) (num-test (/ 12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044.0 -249441012384365373362771955533424187237.0) -12784980722915659825738808684740823452025110516624579136271791852138148426775553817114893299569867520414470532361018804123866264934222335562072872489963044/249441012384365373362771955533424187237) (num-test (/ 8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433.0 -23101645464137481399279134347982485126.0) -8517839393030302736298983538193047531846908718502576675615969705563208303329257882565359266876007571790337440612227785062203468682754778416335180236967433/23101645464137481399279134347982485126) (num-test (/ -10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192.0 -25611473771508763579433379623726126173.0) 10157767522292361462005308817460390811646115952647174687477824271227382383351453540195549992670001314693794150879368708343715654899952822395459036505947192/25611473771508763579433379623726126173) (num-test (/ -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974.0 5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627.0) -8580252632668820290302987230726290672170301642399871646484841866604753910447257372311950907045477729554307803379310475132687855999835211879267570997069974/5347050029330174629945013741349819215851040371727058829687387719215168997632386672310746837193930669173408831178932364105722911104309540550576485594530627) (num-test (/ 7706102251141221799524762336156378964168657337573751909064577951085535246905735244239132983582998872001001594454632956803416956154262109939446710205558308.0 6334400709835247308796432875490978646658012545184955441452799118298109610816693049400832749087993843490999852355789914065232784070007399786089389453289854.0) 3853051125570610899762381168078189482084328668786875954532288975542767623452867622119566491791499436000500797227316478401708478077131054969723355102779154/3167200354917623654398216437745489323329006272592477720726399559149054805408346524700416374543996921745499926177894957032616392035003699893044694726644927) (num-test (/ 12609622044672092190084693450911157599596799695538449568681964257744962273690941575572590166273187189250007688411096790312605666562908125521094386992971478.0 -8237858212652788898158635047388584411011830102060269605835391741772914864422465141467281143809161251942948659243584296367296559912373856433388249393853968.0) -6304811022336046095042346725455578799798399847769224784340982128872481136845470787786295083136593594625003844205548395156302833281454062760547193496485739/4118929106326394449079317523694292205505915051030134802917695870886457432211232570733640571904580625971474329621792148183648279956186928216694124696926984) (num-test (/ -9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785.0 -1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086.0) 9988492519236282081446302885464711911055350309732728352574982611126604133339499170845224383282665522673248920309221355720665956477799939031063172954469785/1878204914631111607000020160429571305542722711529281855381736226230242796648854769713662269068364131804626863789957256573308715572826753755672493154125086)) (let ((val1 (catch #t (lambda () (/ 1.0 0.0)) (lambda args 'error))) (val2 (catch #t (lambda () (/ 1.0 -0.0)) (lambda args 'error)))) (test (equal? val1 val2) #t)) (test (/ "hi") 'error) (test (/ -0) 'error) (test (/ 0) 'error) (test (/ 0.0) 'error) (test (/ 1.0 0) 'error) (test (/) 'error) (test (/ 0/3) 'error) (test (/ 0 1 "hi") 'error) (test (/ 2/3 0) 'error) (test (/ 0 0) 'error) (test (/ 1 0) 'error) (test (/ 0 0.0) 'error) (test (/ 1 0.0) 'error) (test (/ 0.0 0.0) 'error) (test (/ 1.0 0.0) 'error) (test (/ 0 1 2 3 0 4) 'error) (test (/ 0.0 1 2.0 3 0.0 4) 'error) (let ((NaN 1/0)) (test (nan? (/ 0 1 NaN 2 3)) #t)) (let ((NaN 1/0)) (test (nan? (/ 0.0 1.0 NaN 1+i)) #t)) (test (/ 1/9223372036854775807 0) 'error) (test (/ 1/9223372036854775807 0.0) 'error) (when with-bignums (test (/ (bignum 1.0) (bignum 0)) 'error) (test (/ (bignum 1.0) (bignum -0.0)) 'error) (test (/ 9223372036854775807123123123 0) 'error)) (catch #t (lambda () (/ 1 #())) (lambda (type info) (test (apply format #f info) "/ second argument, #(), is a vector but should be a number"))) (catch #t (lambda () (/ #() 1)) (lambda (type info) (test (apply format #f info) "/ first argument, #(), is a vector but should be a number"))) (catch #t (lambda () (/ 1 2 #())) (lambda (type info) (test (apply format #f info) "/ third argument, #(), is a vector but should be a number"))) (catch #t (lambda () (/ 1 2 3 #())) (lambda (type info) (test (apply format #f info) "/ fourth argument, #(), is a vector but should be a number"))) (for-each (lambda (arg) (test (/ arg +nan.0) 'error) (test (/ +nan.0 arg) 'error) (test (/ arg +inf.0) 'error) (test (/ +inf.0 arg) 'error) (test (/ 0 arg +nan.0) 'error) (test (/ +nan.0 0 arg) 'error) (test (/ arg +inf.0 0) 'error) (test (/ 0 +inf.0 arg) 'error) (test (/ 0 arg) 'error) (test (/ 0.0 arg) 'error) (test (/ 1/2 arg) 'error) (test (/ 1+i arg) 'error)) (list "hi" () (integer->char 65) #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (zero? (/ 0 +inf.0)) #t) (test (zero? (/ 3 +inf.0)) #t) (test (negative? (/ +inf.0 2.0)) #f) (test (negative? (/ +inf.0 -2.0)) #t) (test (negative? (/ -inf.0 2)) #t) (test (negative? (/ -inf.0 -2)) #f) (test (negative? (/ +inf.0 -2)) #t) (num-test (/ -inf.0) 0.0) (for-each (lambda (arg) (test (/ arg) 'error)) (list "hi" () (integer->char 65) 0 0.0 0+0i -0.0 -0 0-0i #f #t '(1 2) _ht_ _undef_ _null_ _c_obj_ 'a-symbol (cons 1 2) (make-vector 3) abs # '(1 2 3) #\newline (lambda (a) (+ a 1)) # #)) (test (immutable? (/ 1.0 +nan.0)) #t) (test (let () (define (func) (immutable? (/ 1.0 +nan.0))) (define (hi) (func)) (hi)) #t) ;;; from guile irc (test (boolean? (let ((x (/ 1e-300 1e8))) x)) #f) (when with-bignums (let-temporarily (((*s7* 'bignum-precision) 512)) (let* ((rats (map bignum (list 2/3 5/8 12/19 53/84 253/401 665/1054 12941/20511 15601/24727 79335/125743 190537/301994 7161071/11350029 10400200/16483927 10781274/17087915 53715833/85137581 171928773/272500658 397573379/630138897 4201378396/6659027209 6189245291/9809721694 6586818670/10439860591 65470613321/103768467013 137528045312/217976794617 615582794569/975675645481 753110839881/1193652440098 5409303924479/8573543875303 11571718688839/18340740190704 52449289519716/83130157078217 326267455807135/517121682660006 483615324366283/766512153894657 3816473305410548/6048967074079039 6234549927241963/9881527843552324 111738283365989051/177100989030047175 130441933147714940/206745572560704147 397560349370386783/630118245525664765 3447601211185766107/5464318637170278738 4640282259296926456/7354673373747273033 22803850947114245497/36143248623210700400 50247984153525417450/79641170620168673833 205632218873398596256/325919355854421968365 5680010011095224105765/9002602871306688466954 7530699980955811472069/11935877073996486182239 23414628818361028801231/37111308645407146420177 31150961018190238869556/49373105075258054570781 1534133422091150914676569/2431543945117495582118873 1721039188200292347893905/2727782575569043909543559 3473229337418774934657366/5504938256213345873657899 154574280995644579711687565/244994438954031520405061896 171940427682738454384974395/272519130235098249773351391 522767741723052913024237917/828567267217721441067369971 2438425051595107335801557824/3864812267597295609689840565 8360810638231427833453149306/13251571337227329711204261637 25605199656417336413383685835/40583281278899710574680154882 62532402744384260909046316717/99111513429841767911321781937 201880404458020531058243690939/319972870696382667546684028520 378155609259623725703103696043/599362460113865624518687902158 2180796053156940756896192173706/3456479965974452268626125476129 30909300353456794322249794127927/48990081983756197385284444567964 72722580972698292428980549124384/115262563797384656113699516516573 253438635377865553122983825848491/401690733307859070263635245069941 579599851728429398674948200821366/918644030413102796640970006656455 2391121987886415887128773352409848/3789838685449795842677579543142393 8658726883466670304288180833845151/13723757414280836847692013404326603 13440970859239502078545727538664847/21303434785180428533047172490611389 42714034565604922122765955968404389/67700143040991081441819097014976560 114701132837575264289752140366548320/181796994337792815792410118554318291 845621964428631772151030938534242629/1340279103405540791988689926895204597 960323097266207036440783078900790949/1522076097743333607781100045449522888 6836962813701024519375233692672084963/10836329678541128070260110436700978507 14634248724668256075191250464244960875/23194735454825589748301320918851479902 51700032084971999781389768164307758537/81942612140761230922945173238704941101 229231662975523486756566339893048870935/363323589794154975118123224355821745701 724760772286874203975897537379209410467/1148718646068400566529013525387318698302 1360755729128472664464206788894048264735/2156746803310104260960438025216078994304 6167783688800764861832724692955402469407/9775705859308817610370765626251634675518 28435404464167678210479364512746335244699/45069049768544731377148664330740395536983 34603188152968443072312089205701737714106/54844755627853548987519429956992030212501 144580536300674537151081081515762353325831/229154728370723013560448485454219755525522 792109057809309571900029585990215242057367/1255463153109322165777281287185082838052612 1907982376372936661174533424217656928480502/3024080518587943907662978975235597217368769 27503862327030422828343497525037412240784395/43592590413340536873058986940483443881215378 31319827079776296150692564373472726097745399/49640751450516424688384944890954638315952916 221146771934807009716022484038526739612698295/350509340672202916726357593211918065429039181 252466599014583305866715048411999465710443694/400150092122719341414742538102872703744992097 2555985817225609354817843048493467383202182339/4051141672677709838835810325919681675765873886 2808452416240192660684558096905466848912626033/4451291764800429180250552864022554379510865983 50299676893308884586455330695886403814716824900/79723101674285005903095209014303106127450595597 72767296223230425871931795471130138606017833164/115333435792688439345099631926483541163537523461 148343044862701044404548149039165744060948292361/235118163350177307870449816716989636706585912905 590563727034563984957508038059757509394880543411/936021361635908802301548714003935992446832785637 1550580840017760484596044169668976645517675504708/2457612485764860659689096693368334799470374920545 26950438007336492223090258922432360483195364123447/42715433619638540017016192501265627583443206434902 ))) (fifth (/ (log (bignum "2.0")) (log (bignum "3.0")))) (c-fifth (complex fifth fifth)) (p-fifth (make-polar (* (sqrt 2.0) fifth) (/ pi 4))) (last-rat 26950438007336492223090258922432360483195364123447/42715433619638540017016192501265627583443206434902)) (for-each (lambda (a b) (if (not (< (abs (- b fifth)) (abs (- a fifth)))) (format #t ";fifth: ~A is not better than ~A??~%" b a)) (if (not (< (magnitude (- (complex b b) c-fifth)) (magnitude (- (complex a a) c-fifth)))) (format #t ";rectangular fifth: ~A is not better than ~A??~%" b a)) (let ((pa (make-polar (* (sqrt 2.0) a) (/ pi 4))) (pb (make-polar (* (sqrt 2.0) b) (/ pi 4)))) (if (not (< (magnitude (- pb p-fifth)) (magnitude (- pa p-fifth)))) (format #t ";polar fifth: ~A is not better than ~A??~%" b a))) (if (not (< (abs (- b last-rat)) (abs (- a last-rat)))) (format #t ";- last: ~A is not better than ~A??~%" b a)) (if (not (< (magnitude (sqrt (- b last-rat))) (magnitude (sqrt (- a last-rat))))) (format #t ";sqrt last: ~A is not better than ~A??~%" b a))) rats (cdr rats))))) (if with-bignums (num-test (- 2 (* 3796553736732654909229441/2684568892382786771291329 3796553736732654909229441/2684568892382786771291329)) 1/7206910137949342581102166717750576215502190586241)) (test (catch #t (lambda () (/ 1 0)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 1 0)") (test (catch #t (lambda () (quotient 1.5 0.0)) (lambda (type info) (apply format #f info))) "quotient: division by zero, (quotient 1.5 0.0)") (test (catch #t (lambda () (remainder 4.1 0)) (lambda (type info) (apply format #f info))) "remainder: division by zero, (remainder 4.1 0)") (test (catch #t (lambda () (/ 0)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 0)") (test (catch #t (lambda () (/ 1.0 0.0)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 1.0 0.0)") (test (catch #t (lambda () (/ 0.0)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 0.0)") (test (catch #t (lambda () (expt 0 -1)) (lambda (type info) (apply format #f info))) "expt: division by zero, (expt 0 -1)") (test (catch #t (lambda () (expt 0.0 -123)) (lambda (type info) (apply format #f info))) "expt: division by zero, (expt 0.0 -123)") (let () ; try to hit make_ratio_with_div_check (define (g) (do ((i 0 (+ i 1))) ((= i 1)) (display (/ 1 i)))) (test (catch #t (lambda () (g)) (lambda (type info) (apply format #f info))) "/: division by zero, (/ 1 0)")) ;;; -------------------------------------------------------------------------------- ;;; random ;;; -------------------------------------------------------------------------------- (let () (define (v n range chker) ; chi^2 or mus-random (let ((hits (make-vector 100 0))) (do ((i 0 (+ 1 i ))) ((= i n)) (let ((y (random range))) (if (not (chker y)) (format #t ";(random ~A) -> ~A?~%" range y)) (let ((iy (min 99 (floor (* 100 (/ y range)))))) (vector-set! hits iy (+ 1 (vector-ref hits iy)))))) (let ((sum 0.0) (p (/ n 100.0))) (do ((i 0 (+ 1 i))) ((= i 100) sum) (let ((num (- (vector-ref hits i) p))) (set! sum (+ sum (/ (* num num) p)))))))) (num-test (random 0) 0) (num-test (random 0.0) 0.0) (let () (define (rtest) (- (random 2.0) 1.0)) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (rtest))) (if (or (> val 1.0) (< val -1.0)) (format #t "(- (random 2.0) 1.0): ~A~%" i val))))) (let ((vr (v 1000 1.0 (lambda (val) (and (real? val) (not (negative? val)) (<= val 1.0)))))) (if (or (< vr 40) (> vr 400)) (format #t ";(random 1.0) not so random? ~A~%" vr))) (let ((vr (v 1000 100 (lambda (val) (and (integer? val) (not (negative? val)) (<= val 100)))))) (if (or (< vr 40) (> vr 400)) (format #t ";(random 100) not so random? ~A~%" vr))) (let ((vr (v 1000 1/2 (lambda (val) (and (rational? val) (not (negative? val)) (<= val 1/2)))))) (if (or (< vr 40) (> vr 400)) (format #t ";(random 1/2) not so random? ~A~%" vr))) (let ((vr (v 1000 -10.0 (lambda (val) (and (real? val) (not (positive? val)) (>= val -10.0)))))) (if (or (< vr 40) (> vr 400)) (format #t ";(random -10.0) not so random? ~A~%" vr))) (let ((imax 0.0) (rmax 0.0) (imin 100.0) (rmin 100.0)) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (random 1+i))) (set! imax (max imax (imag-part val))) (set! imin (min imin (imag-part val))) (set! rmax (max rmax (real-part val))) (set! rmin (min rmin (real-part val))))) (if (or (> imax 1.0) (< imin 0.0) (> rmax 1.0) (< rmin 0.0) (< rmax 0.001) (< imax 0.001)) (format #t ";(random 1+i): ~A ~A ~A ~A~%" rmin rmax imin imax))) (let ((imax 0.0) (rmax 0.0) (imin 100.0) (rmin 100.0)) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (random 0+i))) (set! imax (max imax (imag-part val))) (set! imin (min imin (imag-part val))) (set! rmax (max rmax (real-part val))) (set! rmin (min rmin (real-part val))))) (if (or (> imax 1.0) (< imin 0.0) (> rmax 0.0) (< rmin 0.0) (< imax 0.001)) (format #t ";(random 0+i): ~A ~A ~A ~A~%" rmin rmax imin imax))) (let ((imax 0.0) (rmax 0.0) (imin 100.0) (rmin 100.0)) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (random 10.0+100.0i))) (set! imax (max imax (imag-part val))) (set! imin (min imin (imag-part val))) (set! rmax (max rmax (real-part val))) (set! rmin (min rmin (real-part val))))) (if (or (> imax 100.0) (< imin 0.0) (> rmax 10.0) (< rmin 0.0) (< imax 0.1) (< rmax 0.01)) (format #t ";(random 100+10i): ~A ~A ~A ~A~%" rmin rmax imin imax))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (random 1.0+1.0i))) (if (or (not (complex? val)) (> (real-part val) 1.0) (> (imag-part val) 1.0) (< (real-part val) 0.0)) (format #t ";(random 1.0+1.0i) -> ~A?~%" val)))) (let ((rs (random-state 12345678))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (random 1.0 rs))) (if (or (not (real? val)) (negative? val) (> val 1.0)) (format #t ";(random 1.0 rs) -> ~A?~%" val))))) (when with-bignums (num-test (random (bignum "0")) 0) (num-test (random (bignum "0.0")) 0.0) (let ((vr (v 1000 (bignum "1.0") (lambda (val) (and (real? val) (not (negative? val)) (<= val 1.0)))))) (if (or (< vr 40) (> vr 400)) (format #t ";(big-random 1.0) not so random? ~A~%" vr))) (let ((vr (v 1000 (bignum "100") (lambda (val) (and (integer? val) (not (negative? val)) (<= val 100)))))) (if (or (< vr 40) (> vr 400)) (format #t ";(big-random 100) not so random? ~A~%" vr))) (let ((vr (v 1000 (bignum "1/2") (lambda (val) (and (rational? val) (not (negative? val)) (<= val 1/2)))))) (if (or (< vr 40) (> vr 400)) (format #t ";(big-random 1/2) not so random? ~A~%" vr))) (let ((vr (v 1000 (bignum "-10.0") (lambda (val) (and (real? val) (not (positive? val)) (>= val -10.0)))))) (if (or (< vr 40) (> vr 400)) (format #t ";(big-random -10.0) not so random? ~A~%" vr))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (random (bignum "1.0+1.0i")))) (if (or (not (complex? val)) (> (real-part val) 1.0) (> (imag-part val) 1.0) (< (real-part val) 0.0)) (format #t ";(big-random 1.0+1.0i) -> ~A?~%" val)))) (let ((rs (random-state (bignum "12345678")))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (random (bignum "1.0") rs))) (if (or (not (real? val)) (negative? val) (> val 1.0)) (format #t ";(big-random 1.0 rs) -> ~A?~%" val))) (let ((val (random 1.0 rs))) (if (or (not (real? val)) (negative? val) (> val 1.0)) (format #t ";(big-random small-1.0 rs) -> ~A?~%" val))))) (let ((rs (random-state 1234))) (do ((i 0 (+ i 1))) ((= i 100)) (let ((val (random (bignum "1.0") rs))) (if (or (not (real? val)) (negative? val) (> val 1.0)) (format #t ";(big-random 1.0 small-rs) -> ~A?~%" val))) (let ((val (random 1.0 rs))) (if (or (not (real? val)) (negative? val) (> val 1.0)) (format #t ";(random small-1.0 rs) -> ~A?~%" val))))) )) (test (random 0 #t) 'error) (test (random 0.0 #(1 2)) 'error) (test (nan? (random 1/0)) #t) (test (zero? (random 1e-30)) #f) (test (= (random 0) (random 1)) #t) (let ((size 20)) ; check add_i_random_i and subtract cases (define (cr) (let ((fv (make-float-vector size)) (iv (make-int-vector size)) (iv1 (make-int-vector size)) (ivmn 100) (ivmx -100) (iv1mn 100) (iv1mx -100) (fvmn 100.0) (fvmx -100.0)) (do ((i 0 (+ i 1))) ((= i size)) (int-vector-set! iv i (+ 3 (random 9))) (int-vector-set! iv1 i (- (random 9) 3)) (float-vector-set! fv i (- (random 9.0) 3.0))) (do ((i 0 (+ i 1))) ((= i size)) (set! ivmn (min ivmn (iv i))) (set! ivmx (max ivmx (iv i))) (set! iv1mn (min iv1mn (iv1 i))) (set! iv1mx (max iv1mx (iv1 i))) (set! fvmn (min fvmn (fv i))) (set! fvmx (max fvmx (fv i)))) (if (= ivmn ivmx) (format *stderr* "iv only value: ~S~%" ivmn)) (if (= iv1mn iv1mx) (format *stderr* "iv1 only value: ~S~%" iv1mn)) (if (= fvmn fvmx) (format *stderr* "fv only value: ~S~%" fvmn)) (do ((i 0 (+ i 1))) ((= i size)) (if (or (>= (int-vector-ref iv i) 12) (< (int-vector-ref iv i) 3)) (format *stderr* "iv[~D] is ~A?~%" i (int-vector-ref iv i))) (if (or (>= (int-vector-ref iv1 i) 6) (< (int-vector-ref iv1 i) -3)) (format *stderr* "iv1[~D] is ~A?~%" i (int-vector-ref iv1 i))) (if (or (>= (float-vector-ref fv i) 6.0) (< (float-vector-ref fv i) -3.0)) (format *stderr* "iv1[~D] is ~A?~%" i (float-vector-ref fv i)))))) (cr)) (unless with-bignums (test ((object->string (random-state 1234) :readable) 1) #\r) ; print-readably here (test ((object->string (random-state 1234)) 1) #\<)) ; write (#t as default) here (test (random-state 1.0) 'error) (test (random-state 1+i) 'error) (test (random-state 3/4) 'error) (test (random-state 1/0) 'error) (test (random-state (real-part (log 0))) 'error) (test (random-state? (random-state 100)) #t) (test (random-state?) 'error) (test (random-state? (random-state 100) 100) 'error) (test (equal? (random-state 1234) #f) #f) (unless with-bignums (test (random-state -1) 'error) (test (random-state -1 123) 'error) (test (random-state 1 -123) 'error) (test (random-state 1 most-negative-fixnum) 'error) (test (random-state -9223372036854775808) 'error) (let ((r1 (random-state 100)) (r2 (random-state 100)) (r3 (random-state 200))) (test (random-state? r3) #t) (test (equal? r1 r2) #t) (test (equal? r1 r3) #f) (random 1.0 r1) (test (equal? r1 r2) #f) (random 1.0 r2) (test (equal? r1 r2) #t) (test (equal? (copy r1) r1) #t) (test (random-state? r2) #t) (test (random-state? (copy r1)) #t))) (test (let () (define (func) (+ -1 (random 1))) (func)) -1) ; add_i_random test (test (complex? (random 1+i (random-state 1234))) #t) (when with-bignums (test (complex? (random (bignum "1+i") (random-state 1234))) #t) (test (real? (random (bignum "1.5") (random-state 1234))) #t) (test (rational? (random (bignum "1/2") (random-state 1234))) #t) (test (integer? (random (bignum "100") (random-state 1234))) #t) (test (complex? (random (bignum "1+i") (random-state (bignum "1234")))) #t) (test (real? (random (bignum "1.5") (random-state (bignum "1234")))) #t) (test (rational? (random (bignum "1/2") (random-state (bignum "1234")))) #t) (test (integer? (random (bignum "100") (random-state (bignum "1234")))) #t)) (for-each (lambda (arg) (test (random arg) 'error) (test (random 1.0 arg) 'error) (test (random-state arg) 'error) (test (random-state->list arg) 'error) (test (random-state? arg) #f) ) (list "hi" _ht_ _undef_ _null_ _c_obj_ () '(1 2) #f (integer->char 65) 'a-symbol (make-vector 3) abs #\f (lambda (a) (+ a 1)) (if #f #f) :hi # #)) (test (random-state->list #f 1234) 'error) (unless with-bignums (test (car (random-state->list (random-state 1234))) 1234) (test (pair? (random-state->list)) #t) (test (random-state? (random-state)) #t) (let ((r (random-state)) (iv (int-vector 0 0)) (p (random-state->list))) (copy r iv) (test (and (= (iv 0) (p 0)) (= (iv 1) (p 1))) #t) (let ((r1 (apply random-state (map values iv)))) (test (equal? r r1) #t)) (test (random-state? r) #t) (test (length r) 2) (let ((v (vector 1 2))) (copy r v) (let ((r1 (apply random-state (map values v)))) (test (equal? r r1) #t))) (for-each (lambda (arg) (test (copy r arg) 'error)) (list "12" (inlet 'a 1) (hash-table 'a 1) pi)))) (let ((r1 (random-state 1234)) (r2 (random-state 1234))) (test (eq? r1 r2) #f) (unless with-bignums (test (equal? r1 r2) #t)) (test (eq? r2 r2) #t) (test (equal? r1 r1) #t) (test ((object->string r1 #f) 1) #\<) ; display, not write (let ((val1 (random 10000000 r1)) (val2 (random 10000000 r2))) (test val1 val2))) (let ((r1 (random-state 1234)) (r2 (random-state 1234567))) (let ((val1 (random 10000000 r1)) (val2 (random 10000000 r2))) (let ((val3 (random 10000000 r1)) (val4 (random 10000000 r2))) (let ((val5 (random 10000000 r1)) (val6 (random 10000000 r2))) (test (or (not (= val1 val2)) ; might be equal by chance... (not (= val3 val4)) (not (= val5 val6))) #t))))) (unless with-bignums (let ((r1 (make-vector 10))) (let* ((rs1 (random-state 12345)) (rs2 (copy rs1)) (rs3 (apply random-state (random-state->list rs1))) (rs4 #f) (rs5 #f)) (do ((i 0 (+ i 1))) ((= i 10)) (set! (r1 i) (random 1.0 rs1)) (if (= i 3) (set! rs4 (copy rs1))) (if (= i 5) (set! rs5 (apply random-state (random-state->list rs1))))) (do ((i 0 (+ i 1))) ((= i 10)) (let ((v1 (random 1.0 rs2)) (v2 (random 1.0 rs3))) (if (not (= v1 v2 (r1 i))) (format #t ";random v1: ~A, v2: ~A, r1[~A]: ~A~%" v1 v2 i (r1 i)))) (if (> i 3) (let ((v3 (random 1.0 rs4))) (if (not (= v3 (r1 i))) (format #t ";random v3: ~A, r1[~A]: ~A~%" v3 i (r1 i))))) (if (> i 5) (let ((v4 (random 1.0 rs5))) (if (not (= v4 (r1 i))) (format #t ";random v4: ~A, r1[~A]: ~A~%" v4 i (r1 i))))))))) (do ((i 0 (+ i 1))) ((= i 20)) ; this was ((+ i 100)) !! -- surely a warning would be in order? (let ((val (random -1.0))) (test (and (real? val) (<= val 0.0) (>= val -1.0)) #t)) (let ((val (random -100))) (test (and (integer? val) (<= val 0) (>= val -100)) #t)) (let ((val (random most-negative-fixnum))) (test (and (integer? val) (<= val 0)) #t)) (let ((val (random most-positive-fixnum))) (test (and (integer? val) (>= val 0)) #t)) (let ((val (random pi))) (test (and (real? val) (>= val 0) (< val pi)) #t)) (let ((val (random 3/4))) (test (and (rational? val) (>= val 0) (< val 3/4)) #t)) (test (let ((x (random most-positive-fixnum))) (integer? x)) #t) (if with-bignums (begin (let ((val (random (expt 2 70)))) (test (and (integer? val) (>= val 0)) #t)) (let ((val (random 1180591620717411303424.0))) (test (and (real? val) (>= val 0.0)) #t))))) (when with-bignums (let ((r1 (random-state (expt 2 70)))) (test (random-state? r1) #t) (test ((object->string r1) 1) #\<) (test (eq? r1 r1) #t) (test (equal? r1 r1) #t) (let ((val1 (random 10000000 r1)) (val2 (random 10000000 r1))) (test (not (= val1 val2)) #t)))) (let () ; optimizer tests (define (f1) (- (random 100) 50)) (define (f2) (- (random 1.0) 0.5)) (define (f3) (random 100)) (define (f4) (random 1.0)) (do ((i 0 (+ i 1))) ((= i 20)) (let ((v1 (f1)) (v2 (f2)) (v3 (f3)) (v4 (f4))) (if (not (<= -50 v1 50)) (format *stderr* ";f1: sub_random_ic: ~A~%" v1)) (if (not (<= 0 v3 100)) (format *stderr* ";f3: random_ic: ~A~%" v3)) (if (not (<= -0.5 v2 0.5)) (format *stderr* ";f2: sub_random_rc: ~A~%" v2)) (if (not (<= 0.0 v4 1.0)) (format *stderr* ";f4: random_rc: ~A~%" v4))))) (test (real-part (random 0+i)) 0.0) ;;; -------------------------------------------------------------------------------- ;;; string->number ;;; number->string ;;; -------------------------------------------------------------------------------- (test (string->number "+#.#") #f) (test (string->number "-#.#") #f) (test (string->number "#.#") #f) (test (string->number "#") #f) (for-each (lambda (n) (if (not (eqv? n (string->number (number->string n)))) (format #t ";(string->number (number->string ~A)) = ~A?~%" n (string->number (number->string n))))) (list 1 2 3 10 1234 1234000000 500029 0/1 0/2 0/3 0/10 0/1234 0/1234000000 0/500029 1/1 1/2 1/3 1/10 1/1234 1/1234000000 1/500029 2/1 2/2 2/3 2/10 2/1234 2/1234000000 2/500029 3/1 3/2 3/3 3/10 3/1234 3/1234000000 3/500029 10/1 10/2 10/3 10/10 10/1234 10/1234000000 10/500029 1234/1 1234/2 1234/3 1234000000/10 1234000000/1234 1234000000/1234000000 1234000000/500029 500029/1 500029/2 500029/3 500029/10 500029/1234 500029/1234000000 500029/500029)) (let ((fequal? (lambda (a b) (< (magnitude (- a b)) 1e-14)))) (for-each (lambda (x) (if (not (fequal? x (string->number (number->string x)))) (format #t ";(string->number (number->string ~A)) -> ~A?~%" x (string->number (number->string x))))) (list 0.000000 1.000000 3.141593 2.718282 1234.000000 1234000000.000000 0.000000+0.000000i 0.000000+0.000000i 0.000000+1.000000i 0.000000+3.141593i 0.000000+2.718282i 0.000000+1234.000000i 0.000000+1234000000.000000i 0.000000+0.000000i 0.000000+0.000000i 0.000000+1.000000i 0.000000+3.141593i 0.000000+2.718282i 0.000000+1234.000000i 0.000000+1234000000.000000i 1.000000+0.000000i 1.000000+0.000000i 1.000000+1.000000i 1.000000+3.141593i 1.000000+2.718282i 1.000000+1234.000000i 1.000000+1234000000.000000i 3.141593+0.000000i 3.141593+0.000000i 3.141593+1.000000i 3.141593+3.141593i 3.141593+2.718282i 3.141593+1234.000000i 3.141593+1234000000.000000i 2.718282+0.000000i 2.718282+0.000000i 2.718282+1.000000i 2.718282+3.141593i 2.718282+2.718282i 2.718282+1234.000000i 2.718282+1234000000.000000i 1234.000000+0.000000i 1234.000000+0.000000i 1234.000000+1.000000i 1234.000000+3.141593i 1234.000000+2.718282i 1234.000000+1234.000000i 1234.000000+1234000000.000000i 1234000000.000000+0.000000i 1234000000.000000+0.000000i 1234000000.000000+1.000000i 1234000000.000000+3.141593i 1234000000.000000+2.718282i 1234000000.000000+1234.000000i 1234000000.000000+1234000000.000000i))) (test (string->number "1+1+i") #f) (test (string->number "1+i+i") #f) (test (string->number "1+.i") #f) (test (string->number ".") #f) (test (string->number "8.41470984807896506652502321630298999622563060798371065672751709991910404391239668948639743543052695.") #f) (test (string->number "8.41470184807816506652502321630218111622563060718371065672751701111110404311231668148631743543052695" 9) #f) (test (number->string -9223372036854775808) "-9223372036854775808") (test (number->string 9223372036854775807) "9223372036854775807") (test (number->string 123 8) "173") (test (number->string 123 16) "7b") (test (number->string 123 2) "1111011") (test (number->string -123 8) "-173") (test (number->string -123 16) "-7b") (test (number->string -123 2) "-1111011") (test (number->string 0 8) "0") (test (number->string 0 2) "0") (test (number->string 0 16) "0") (test (number->string 1 8) "1") (test (number->string 1 2) "1") (test (number->string 1 16) "1") (test (number->string -1 8) "-1") (test (number->string -1 2) "-1") (test (number->string -1 16) "-1") (test (string->number "- 1") #f) (num-test (string->number "1+0i") 1.0) (num-test (string->number "0-0i") 0.0) (num-test (string->number "0-0e10i") 0.0) (num-test (string->number "0-0e40i") 0.0) (num-test (string->number "0-0e100i") 0.0) (test (string->number "0e10e100") #f) (test (equal? (string->number (number->string -1e19)) -1e19) #t) (test (equal? (string->number (number->string 1e308)) 1e308) #t) (test (equal? (string->number (number->string 9.22e18)) 9.22e18) #t) ;;; @ exponent added 26-Mar-12 (when (provided? '@-exponent) (num-test 0.0 0@0) (num-test 0.0 0@-0) (num-test 0.0 0@+0) (num-test 1.0 1@0) (num-test 10.0 1@1) (num-test 10.0 1@+1) (num-test 0.1 1@-1) (num-test (string->number "1@0" 16) 1.0) (num-test (string->number "e@0" 16) 14.0) (num-test (string->number "a@1" 16) 160.0) (num-test (string->number "#xa@1") 160.0) (num-test (string->number ".a@0" 12) 0.83333333333333) (num-test (string->number "a.@0" 16) 10.0) (num-test (string->number "0a" 16) 10) (num-test (string->number "a@-1" 16) 0.625) (num-test 1@0+1@0i 1+1i) (num-test (string->number "1@1" 12) 12.0) (num-test (string->number "1@-1" 16) 0.0625) (num-test (string->number "1.0@1+0.1@2i" 16) 16+16i) (num-test (string->number "#b.0@2") 0.0) (num-test (string->number ".2@-22") 2e-23) (num-test (string->number "+02@02") 200.0) (num-test (string->number "2fe2@2" 16) 3138048.0) (num-test (string->number "1@-0-bc/di" 16) 1-14.461538461538i) (num-test (string->number ".f-a.c1@0i" 16) 0.9375-10.75390625i) (num-test (string->number "df2@2-ccfi" 16) 913920-3279i) (num-test (string->number "0/0de-0@2i" 16) 0.0) (num-test (string->number "-1a12cd.@1" 16) -27339984.0) (num-test (string->number "fb/2ea+2@+1i" 16) 0.33646112600536+32i) (num-test (string->number "af.e0@-0+0b/efefd11i" 16) 175.875+4.3721589140015e-08i) (num-test (string->number "bb10@1-i" 12) 247248-1i) (num-test (string->number "b.+0@01i" 12) 11.0) (num-test (string->number "-0@-0221" 12) 0.0) (num-test (string->number "-a-01@2i" 12) -10-144i) (num-test (string->number "-111@-1-1i" 10) -11.1-1i) (num-test (string->number "122@9-2@0i" 10) 122000000000-2i) (num-test (string->number "-0@+10-20i" 10) 0-20i) (num-test (string->number "+2@-909221" 10) 0.0)) (when (provided? 'dfls-exponents) (for-each (lambda (exponent) (num-test (string->number (string-append "2" exponent "2") 10) 200.0) ; 2 * e2=100 (num-test (string->number (string-append "2" exponent "-3") 10) 0.002) (num-test (string->number (string-append "1" exponent "1") 10) 10.0) (num-test (string->number (string-append "-111" exponent "-1-1i") 10) -11.1-1i) (num-test (string->number (string-append "122" exponent "9-2" exponent "0i") 10) 122000000000-2i) (num-test (string->number (string-append "-0" exponent "+10-20i") 10) 0-20i) (num-test (string->number (string-append "+2" exponent "-909221") 10) 0.0)) (list "e" "E" "d" "D" "f" "F" "s" "S" "l" "L"))) ;; s7.html claims this '=' is guaranteed... (test (= .6 (string->number ".6")) #t) (test (= 0.60 (string->number "0.60")) #t) (test (= 60e-2 (string->number "60e-2")) #t) (test (= 0.11 (string->number "0.11")) #t) (test (= 0.999 (string->number "0.999")) #t) (test (= 100.000 (string->number "100.000")) #t) (test (= 1e10 (string->number "1e10")) #t) (test (= 0.18 (string->number "0.18")) #t) (test (= 0.3 (string->number "0.3")) #t) (test (= 0.333 (string->number "0.333")) #t) (test (= -1/10 (string->number "-1/10")) #t) (test (= -110 (string->number "-110")) #t) (test (= 1+i (string->number "1+i")) #t) (test (= 0.6-.1i (string->number "0.6-.1i")) #t) ;; but is this case also guaranteed?? maybe use equivalent? here (unless with-bignums (test (= .6 (string->number (number->string .6))) #t) (test (= 0.6 (string->number (number->string 0.6))) #t) (test (= 0.60 (string->number (number->string 0.60))) #t) (test (= 60e-2 (string->number (number->string 60e-2))) #t) (test (= 0.6-.1i (string->number (number->string 0.6-.1i))) #t)) (test (= 0.11 (string->number (number->string 0.11))) #t) (test (= 0.999 (string->number (number->string 0.999))) #t) (test (= 100.000 (string->number (number->string 100.000))) #t) (test (= 1e10 (string->number (number->string 1e10))) #t) (test (= 0.18 (string->number (number->string 0.18))) #t) (test (equivalent? 0.3 (string->number (number->string 0.3))) #t) (test (= 0.333 (string->number (number->string 0.333))) #t) (test (= -1/10 (string->number (number->string -1/10))) #t) (test (= -110 (string->number (number->string -110))) #t) (test (= 1+i (string->number (number->string 1+i))) #t) (test (nan? (string->number "+nan.1")) #t) ; was error (test (string->number "+.nan.0") #f) (test (string->number "+nan.0+") #f) (test (string->number "+nan.0i") #f) (test (nan? (string->number "+nan.00")) #t) ; was an error, but now the 00 = "payload" = 0 (test (string->number "+nan.01i") #f) (test (string->number "+inf.1") #f) (test (string->number "+inf.i") #f) (test (string->number "+inf.0.") #f) (test (string->number "+inf.0#i") #f) (test (string->number "+nan.0+ii") #f) (test (string->number "+nan.0+3.3/2i") #f) (test (string->number "+nan.0+#x12i") #f) (test (string->number "1+in") #f) (test (string->number "1+infi") #f) (test (string->number "1+nani") #f) (test (string->number "+nan+nani") #f) (test (equivalent? (string->number "#x+nan.0+i") +nan.0+1.0i) #t) (test (equivalent? (string->number "#x+nan.0+12i") +nan.0+18.0i) #t) (test (equivalent? (string->number "#x+12/11+i") 1.0588235294117647+1.0i) #t) (test (string->number "#x1.2+i") 1.125+1.0i) (test (string->number "#x1e2+i") 482.0+1.0i) (test (string->number "#x12+i") 18.0+1.0i) (test (string->number "#x12+12i") 18.0+18.0i) (test (equivalent? (string->number "+nan.0+i") +nan.0+1.0i) #t) (test (equivalent? (string->number "-nan.0+i") +nan.0+1.0i) #t) (test (equivalent? (string->number "+nan.0+3i") +nan.0+3.0i) #t) (test (equivalent? (string->number "+nan.0-3i") +nan.0-3.0i) #t) (test (equivalent? (string->number "+nan.0+3.1i") +nan.0+3.1i) #t) (test (equivalent? (string->number "+nan.0-3.1i") +nan.0-3.1i) #t) (test (equivalent? (string->number "+nan.0+1/2i") +nan.0+0.5i) #t) (test (equivalent? (string->number "-nan.0+1/2i") +nan.0+0.5i) #t) (test (equivalent? (string->number "+nan.0-1e3i") +nan.0-1000.0i) #t) (test (equivalent? (string->number "+nan.0+nan.0i") +nan.0+nan.0i) #t) (test (equivalent? (string->number "+nan.0-nan.0i") +nan.0+nan.0i) #t) (test (equivalent? (string->number "+nan.0+inf.0i") +nan.0+inf.0i) #t) (test (equivalent? (string->number "+nan.0-inf.0i") +nan.0-inf.0i) #t) (test (string->number "+inf.0+i") +inf.0+1.0i) (test (string->number "-inf.0+i") -inf.0+1.0i) (test (string->number "+inf.0+3i") +inf.0+3.0i) (test (string->number "+inf.0-3i") +inf.0-3.0i) (test (string->number "+inf.0+3.1i") +inf.0+3.1i) (test (string->number "+inf.0-3.1i") +inf.0-3.1i) (test (string->number "+inf.0+1/2i") +inf.0+0.5i) (test (string->number "-inf.0+1/2i") -inf.0+0.5i) (test (string->number "+inf.0-1e3i") +inf.0-1000.0i) (test (equivalent? (string->number "+inf.0+nan.0i") +inf.0+nan.0i) #t) (test (equivalent? (string->number "+inf.0-nan.0i") +inf.0+nan.0i) #t) (test (string->number "+inf.0+inf.0i") +inf.0+inf.0i) (test (string->number "+inf.0-inf.0i") +inf.0-inf.0i) (test (string->number "0-inf.0i") 0.0-inf.0i) (test (string->number "0+inf.0i") 0.0+inf.0i) (test (equivalent? (string->number "0-nan.0i") 0.0+nan.0i) #t) (test (equivalent? (string->number "1/2-nan.0i") 0.5+nan.0i) #t) (test (equivalent? (string->number "1e3-nan.0i") 1000.0+nan.0i) #t) (test (equivalent? (string->number "1.2-nan.0i") 1.2+nan.0i) #t) (test (string->number "#xa.5+b.5i") 10.3125+11.3125i) (when with-bignums (test (let () (define (f) (number->string pi)) (define (g) (f)) (g)) "3.141592653589793238462643383279502884195E0")) (test (= 0.6 0.600) #t) (test (= 0.6 6e-1 60e-2 .06e1 6.e-1) #t) (test (= 0.6 6e-1 60e-2 .06e1 600e-3 6000e-4 .0006e3) #t) (test (= 0.3 0.3000) #t) (test (= 0.345 0.345000 345.0e-3) #t) (test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string -1.0)))))) (define (hi) (func) (func)) (hi) (hi)) "-1.0") (let-temporarily (((*s7* 'float-format-precision) 64)) (test (equivalent? (string->number (number->string 0.00001 2) 2) 0.00001) #t) ; 0 if default (string->number (number->string 0.0001 2) 2) 0.0001) (test (equivalent? (string->number (number->string 0.00001 2) 2) 0.00001) #f) (test (string->number #u(0 0 0 0 0) #\a) 'error) (test (string->number "" "") 'error) #| ;; scheme spec says (eqv? (number->string (string->number num radix) radix) num) is always #t ;; (also that radix is 10 if num is inexact) ;; currently in s7, if m below is 0, s7 is ok, but if there's a true integer part, we sometimes lose by 1e-15 or so (let () (do ((m 0 (+ m 1))) ((= m 10)) (do ((i 0 (+ i 1))) ((= i 10)) (do ((j 0 (+ j 1))) ((= j 10)) (do ((k 0 (+ k 1))) ((= k 10)) (let* ((str (string (integer->char (+ (char->integer #\0) i)) (integer->char (+ (char->integer #\0) j)) (integer->char (+ (char->integer #\0) k)))) (strd (string (integer->char (+ (char->integer #\0) m)))) (str1 (string-append strd "." str)) (str2 (string-append (if (= m 0) "" strd) "." str "000")) (str3 (string-append strd str "e-3")) (str4 (string-append strd str ".e-3")) (str5 (string-append "0.0" strd str "e2")) (str6 (string-append ".00000" strd str "e6")) (str7 (string-append strd str "00e-5")) (args (list (string->number str1) (string->number str2) (string->number str3) (string->number str4) (string->number str5) (string->number str6) (string->number str7)))) (if (not (apply = args)) (format #t "~A.~A: ~{~D~^~4T~}~%" strd str (map (lambda (val) (let ((ctr 0)) (for-each (lambda (arg) (if (not (equal? val arg)) (set! ctr (+ ctr 1)))) args) ctr)) args))))))))) (do ((i 0 (+ i 1))) ((= i 1000)) (let ((n (complex (if (> (random 10) 2) (case (random 3) ((0) (- (random 100.0) 50.0)) ((1) (- (random 100) 50)) (else (rationalize (- (random 10.0) 5.0)))) ((float-vector +nan.0 +inf.0 -inf.0) (random 3))) (if (> (random 10) 2) (case (random 3) ((0) (- (random 100.0) 50.0)) ((1) (- (random 100) 50)) (else (rationalize (- (random 10.0) 5.0)))) ((float-vector +nan.0 +inf.0 -inf.0) (random 3)))))) (let ((str (number->string n))) (let ((new-n (string->number str))) (unless (equivalent? n new-n) (format *stderr* "~A: ~S ~A~%" n str new-n)))))) |# (unless with-bignums (test (number->string 1/0) "+nan.0")) ; picks up __LINE__ payload in gmp (test (number->string 1/0 2) "+nan.0") (unless with-bignums (test (number->string 1/0 10) "+nan.0")) (test (number->string 1/0 16) "+nan.0") (unless with-bignums (test (number->string 1000000000000000000000000000000000/0) 'error)) (test (number->string 0/1000000000000000000000000000000000) "0") (unless with-bignums (test (object->string 1/0) "+nan.0")) (test (format #f "~F" 1/0) "+nan.0") (test (format #f "~E" 1/0) "+nan.0") (test (format #f "~G" 1/0) "+nan.0") (test (format #f "~D" 1/0) "+nan.0") (test (format #f "~X" 1/0) "+nan.0") (test (format #f "~B" 1/0) "+nan.0") (test (format #f "~O" 1/0) "+nan.0") (unless with-bignums (test (format #f "~A" 1/0) "+nan.0")) (unless with-bignums (test (format #f "~S" 1/0) "+nan.0")) (test (format #f "~P" 1/0) "s") (test (nan? (string->number "+nan.0")) #t) (test (nan? (string->number "+nan.0" 2)) #t) (test (equivalent? +nan.0 (string->number "+nan.0")) #t) (test (equivalent? (string->number "+inf.0") +inf.0) #t) (test (number->string (real-part (log 0.0))) "-inf.0") (test (number->string (real-part (log 0.0)) 2) "-inf.0") (test (number->string (real-part (log 0.0)) 16) "-inf.0") (test (number->string (- (real-part (log 0.0)))) "+inf.0") (test (number->string (- (real-part (log 0.0))) 2) "+inf.0") (test (format #f "~G" (real-part (log 0))) "-inf.0") (test (format #f "~E" (real-part (log 0))) "-inf.0") (test (format #f "~F" (real-part (log 0))) "-inf.0") (test (format #f "~D" (real-part (log 0))) "-inf.0") (test (format #f "~X" (real-part (log 0))) "-inf.0") (test (format #f "~B" (real-part (log 0))) "-inf.0") (test (format #f "~O" (real-part (log 0))) "-inf.0") (test (format #f "~A" (real-part (log 0))) "-inf.0") (test (format #f "~S" (real-part (log 0))) "-inf.0") (test (format #f "~P" (real-part (log 0))) "s") (test (infinite? (string->number "+inf.0")) #t) (test (infinite? (string->number "+inf.0" 16)) #t) (test (infinite? (string->number "-inf.0")) #t) (test (infinite? (string->number "-inf.0" 16)) #t) (test (negative? (string->number "-inf.0")) #t) (test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string +nan.0)))))) (func)) "+nan.0") (test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string (- +nan.0))))))) (func)) "-nan.0") (test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string +inf.0)))))) (func)) "+inf.0") (test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string -inf.0)))))) (func)) "-inf.0") (test (let () (define (func) (with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) (display (number->string (complex 4 0))))))) (func)) "4") (test (number->string 0+0/0i 2) "0.0+nan.0i") (test (number->string (complex 0 +inf.0) 2) "0.0+inf.0i") ;; (s7 NaNs are not signed) (test (number->string (complex 0 -nan.0)) "0.0+nan.0i") (test (number->string (complex 0 -inf.0)) "0.0-inf.0i") (test (number->string (complex +nan.0 +nan.0)) "+nan.0+nan.0i") (test (number->string (complex +nan.0 -nan.0)) "+nan.0+nan.0i") (test (number->string (complex +nan.0 +inf.0)) "+nan.0+inf.0i") (test (number->string (complex +nan.0 -inf.0)) "+nan.0-inf.0i") (test (number->string (complex -nan.0 +nan.0)) "+nan.0+nan.0i") (test (number->string (complex -nan.0 -nan.0)) "+nan.0+nan.0i") (test (number->string (complex -nan.0 +inf.0)) "+nan.0+inf.0i") (test (number->string (complex -nan.0 -inf.0)) "+nan.0-inf.0i") (test (number->string (complex +inf.0 +nan.0)) "+inf.0+nan.0i") (test (number->string (complex +inf.0 -nan.0)) "+inf.0+nan.0i") (test (number->string (complex +inf.0 +inf.0)) "+inf.0+inf.0i") (test (number->string (complex +inf.0 -inf.0)) "+inf.0-inf.0i") (test (number->string (complex -inf.0 +nan.0)) "-inf.0+nan.0i") (test (number->string (complex -inf.0 -nan.0)) "-inf.0+nan.0i") (test (number->string (complex -inf.0 +inf.0)) "-inf.0+inf.0i") (test (number->string (complex -inf.0 -inf.0)) "-inf.0-inf.0i") (test (number->string (complex 0 -nan.0) 8) "0.0+nan.0i") (test (number->string (complex 0 -inf.0) 8) "0.0-inf.0i") (test (number->string (complex +nan.0 +nan.0) 8) "+nan.0+nan.0i") (test (number->string (complex +nan.0 -nan.0) 8) "+nan.0+nan.0i") (test (number->string (complex +nan.0 +inf.0) 8) "+nan.0+inf.0i") (test (number->string (complex +nan.0 -inf.0) 8) "+nan.0-inf.0i") (test (number->string (complex -nan.0 +nan.0) 8) "+nan.0+nan.0i") (test (number->string (complex -nan.0 -nan.0) 8) "+nan.0+nan.0i") (test (number->string (complex -nan.0 +inf.0) 8) "+nan.0+inf.0i") (test (number->string (complex -nan.0 -inf.0) 8) "+nan.0-inf.0i") (test (number->string (complex +inf.0 +nan.0) 8) "+inf.0+nan.0i") (test (number->string (complex +inf.0 -nan.0) 8) "+inf.0+nan.0i") (test (number->string (complex +inf.0 +inf.0) 8) "+inf.0+inf.0i") (test (number->string (complex +inf.0 -inf.0) 8) "+inf.0-inf.0i") (test (number->string (complex -inf.0 +nan.0) 8) "-inf.0+nan.0i") (test (number->string (complex -inf.0 -nan.0) 8) "-inf.0+nan.0i") (test (number->string (complex -inf.0 +inf.0) 8) "-inf.0+inf.0i") (test (number->string (complex -inf.0 -inf.0) 8) "-inf.0-inf.0i") (test (equal? 0.0 0e0) #t) (test (equal? 0.0 -0.0) #t) (test (eqv? 0.0 -0.0) #t) (test (equal? 0.0 0e-0) #t) (test (equal? 0.0 .0e+0) #t) (test (equal? 0.0 00000000000000000000000000000000000000000000000000000e100) #t) (test (equal? 0.0 .0000000000000000000000000000000000000000000000000000e100) #t) (test (equal? 0.0 00000000000000000000000000000000000000000000000000000.0000000000000000000000000000000000000000000000000000000000e100) #t) (test (equal? 0.0 0e100000000000000000000000000000000000000000000000000000000000000000000000) #t) (num-test 0 0/1000000000) (num-test 0 0/100000000000000000000000000000000000000) (num-test 0 0/100000000000000000000000000000000000000000000000000000000000000) (num-test 0 0/100000000000000000000000000000000000000000000000000000000000000000000) (num-test 0 -0/100000000000000000000000000000000000000000000000000000000000000000000) (num-test 0 0/1000000000+0/1000000000i) (num-test 0 0/100000000000000000000000000000000000000-0/100000000000000000000000000000000000000i) (num-test 0 0/100000000000000000000000000000000000000000000000000000000000000+0/100000000000000000000000000000000000000000000000000000000000000i) (num-test 0 0/100000000000000000000000000000000000000000000000000000000000000000000-0/100000000000000000000000000000000000000000000000000000000000000000000i) (num-test 0 0+0/1000000000i) (num-test 0 0-0/100000000000000000000000000000000000000i) (num-test 0 0+0/100000000000000000000000000000000000000000000000000000000000000i) (num-test 0 0-0/100000000000000000000000000000000000000000000000000000000000000000000i) (num-test 0 0/1000000000+0i) (num-test 0 0/100000000000000000000000000000000000000-0i) (num-test 0 0/100000000000000000000000000000000000000000000000000000000000000+0i) (num-test 0 0/100000000000000000000000000000000000000000000000000000000000000000000-0i) (when with-bignums (test (< 0 1000000000000000000000000000000000) #t) (test (> 0 -1000000000000000000000000000000000) #t)) #| ;;; are these worth fixing? :(* 0 1000000000000000000000000000000000) +nan.0 :(* 0.0 1000000000000000000000000000000000) +nan.0 :(integer? 1000000000000000000000000000000000) #f :(positive? 1/1000000000000000000000000000000000) #f :(exact? 1/1000000000000000000000000000000000) #f :(floor 1/1000000000000000000000000000000000) ;floor argument 1, +nan.0, is out of range (argument is NaN) etc.... 10000000000000000000000000000/10000000000000000000000000000 |# (test (equal? 0.0 0.0e10) #t) (test (equal? 0.0 0e100) #t) (test (equal? 0.0 0.0e1000) #t) (test (equal? 0.0 0e+1000) #t) (test (equal? 0.0 0.0e-1) #t) (test (equal? 0.0 0e-10) #t) (test (equal? 0.0 0.0e-100) #t) (test (equal? 0.0 0e-1000) #t) (test (equal? 0.0 0.0e0123456789) #t) (test (equal? 0.0 0-0e10i) #t) (test (equal? 0.0 0-0.0e100i) #t) (test (equal? 0.0 0-0e1000i) #t) (test (equal? 0.0 0-0.0e+1000i) #t) (test (equal? 0.0 0-0e-1i) #t) (test (equal? 0.0 0-0.0e-10i) #t) (test (equal? 0.0 0-0e-100i) #t) (test (equal? 0.0 0-0.0e-1000i) #t) (test (equal? 0.0 0.0+0e0123456789i) #t) (num-test 0.0 1e-1000) (num-test 0e123412341231231231231231231231231231 0.0) (num-test 0e-123412341231231231231231231231231231 0.0) (num-test 0.00000e123412341231231231231231231231231231 0.0) (num-test .0e-123412341231231231231231231231231231 0.0) (num-test 2e-123412341231231231231 0.0) (num-test 2e-123412341231231231231231231231231231 0.0) (num-test 2.001234e-123412341231231231231 0.0) (num-test .00122e-123412341231231231231231231231231231 0.0) (num-test 2e00000000000000000000000000000000000000001 20.0) (num-test 2e+00000000000000000000000000000000000000001 20.0) (num-test 2e-00000000000000000000000000000000000000001 0.2) (num-test 2e-9223372036854775807 0.0) (num-test 2000.000e-9223372036854775807 0.0) (unless with-bignums (test (infinite? 2e123412341231231231231) #t) (test (infinite? 2e12341234123123123123123123) #t) (test (infinite? 2e12341234123123123123213123123123) #t) (test (infinite? 2e9223372036854775807) #t)) ;; (do ((i 0 (+ i 1)) (n 1 (* n 2))) ((= i 63)) (display n) (display " ") (display (number->string n 16)) (newline)) (test (number->string 3/4 2) "11/100") (test (number->string 3/4 8) "3/4") (test (number->string 3/4 16) "3/4") (test (number->string -3/4 2) "-11/100") (test (number->string -3/4 8) "-3/4") (test (number->string -3/4 16) "-3/4") (num-test (string->number "1/2") 1/2) (test (nan? (string->number "1/0")) #t) (test (nan? (string->number "0/0")) #t) (test (nan? 0/0) #t) (test (string->number "1.0/0.0") #f) (test (string->number "'1") #f) (test (string->number "`1") #f) (test (string->number ".@0") #f) (test (string->number "+.@0") #f) (test (string->number "+.-i") #f) (test (string->number "+.-0i") #f) (num-test (string->number "10111/100010" 2) 23/34) (num-test (string->number "27/42" 8) 23/34) (num-test (string->number "17/22" 16) 23/34) (num-test (string->number "-10111/100010" 2) -23/34) (num-test (string->number "-27/42" 8) -23/34) (num-test (string->number "-17/22" 16) -23/34) (num-test (string->number "11/100" 2) 3/4) (test (number->string 23/34 2) "10111/100010") (test (number->string 23/34 8) "27/42") (test (number->string 23/34 16) "17/22") (test (number->string -23/34 2) "-10111/100010") (test (number->string -23/34 8) "-27/42") (test (number->string -23/34 16) "-17/22") (test (number->string -1 16) "-1") ;(test (number->string #xffffffffffffffff 16) "-1") -- is this a bug? (unless with-bignums ;(test (= #xffffffffffffffff -1) #t) ; this is an overflow (test (= #x8000000000000000 -9223372036854775808) #t)) (test (= #x7fffffffffffffff 9223372036854775807) #t) (test (number->string 9223372036854775807 16) "7fffffffffffffff") (test (number->string -9223372036854775808 16) "-8000000000000000") (test (number->string #o777777777777777777777) "9223372036854775807") (unless with-bignums (test (number->string #o1000000000000000000000) "-9223372036854775808") (test (number->string #b1000000000000000000000000000000000000000000000000000000000000000) "-9223372036854775808")) (num-test (string->number "3/4+1/2i") 0.75+0.5i) (num-test (string->number "3/4+i") 0.75+i) (num-test (string->number "0+1/2i") 0+0.5i) (test (string->number "3+0i/4") #f) (num-test (string->number "3/4+0i") 0.75) (test (string->number " 1.0") #f) (test (string->number "1.0 ") #f) (test (string->number "1.0 1.0") #f) ;(test (string->number (string #\1 (integer->char 0) #\0)) 1) ; ?? Guile returns #f (test (string->number "1+1 i") #f) (test (string->number "1+ei") #f) (test (string->number "#b1") 1) (test (string->number " #b1") #f) (test (string->number "#b1 ") #f) (test (string->number "#b1 1") #f) (test (string->number "#b 1") #f) (test (string->number "# b1") #f) (test (string->number "#b12") #f) (test (string->number "000+1") #f) (test (string->number (string (integer->char 216))) #f) ; slashed 0 (test (string->number (string (integer->char 189))) #f) ; 1/2 as single char (test (string->number (string #\1 (integer->char 127) #\0)) #f) ; backspace (test (string->number (string #\1)) 1) (test (string->number "1\ 2") 12) (test (string->number "1E1") 10.0) (test (string->number "1e1") 10.0) (num-test (string->number "1234567890123456789012345678901234567890.123456789e-30") 1234567890.1235) (num-test (string->number "123456789012345678901234567890123456789012345678901234567890.123456789e-50") 1234567890.1235) (num-test (- 1234567890123456789012345678901234567890123456789012345678901234567890.123456789e-60 12345678901234567890123456789012345678901234567890.123456789e-40) 0.0) (num-test (string->number "#b000100111110110010011010100001.10111010011000100e1" 2) 167136579.45612) (num-test (string->number "000100111110110010011010100001.10111010011000100e1" 2) 167136579.45612) (num-test (string->number "#b1010100100110001111001001100101010011111010100110110.00011001001011101111101111111000110100100111011100100e-59") 5.163418497654431203689554326589836167902E-3) (num-test (string->number "#b01010011000101001010000101011001111110000010110010.1000000000111001011010110110011111101011100000100e-3") 4.567403573967031260951910866285885504112E13) (num-test 0000000000000000000000000001.0 1.0) (num-test 1.0000000000000000000000000000 1.0) (num-test 1000000000000000000000000000.0e-40 1.0e-12) (num-test 0.0000000000000000000000000001e40 1.0e12) (num-test 1.0e00000000000000000001 10.0) (num-test 12341234.56789e12 12341234567889999872.0) (num-test -1234567890123456789.0 -1234567890123456768.0) (num-test 12345678901234567890.0 12345678901234567168.0) (num-test 123.456e30 123456000000000012741097792995328.0) (num-test 12345678901234567890.0e12 12345678901234569054409354903552.0) (num-test 1.234567890123456789012e30 1234567890123456849145940148224.0) (num-test 1e20 100000000000000000000.0) (num-test 1234567890123456789.0 1234567890123456768.0) (num-test 123.456e16 1234560000000000000.0) (num-test 98765432101234567890987654321.0e-5 987654321012345728401408.0) (num-test 98765432101234567890987654321.0e-10 9876543210123456512.0) (num-test 0.00000000000000001234e20 1234.0) (num-test 0.000000000000000000000000001234e30 1234.0) (num-test 0.0000000000000000000000000000000000001234e40 1234.0) (num-test 0.000000000012345678909876543210e15 12345.678909877) (num-test 98765432101234567890987654321.0e-20 987654321.012346) (num-test 98765432101234567890987654321.0e-29 0.98765432101235) (num-test 98765432101234567890987654321.0e-30 0.098765432101235) (num-test 98765432101234567890987654321.0e-28 9.8765432101235) (num-test 1.0123456789876543210e1 10.12345678987654373771) (num-test 1.0123456789876543210e10 10123456789.87654304504394531250) (num-test 0.000000010000000000000000e10 100.0) (num-test 0.000000010000000000000000000000000000000000000e10 100.0) (num-test 0.000000012222222222222222222222222222222222222e10 122.22222222222222) (num-test 0.000000012222222222222222222222222222222222222e17 1222222222.222222) (num-test (- (string->number "769056139124082.") (string->number "769056139124080.")) 2.0) (num-test (string->number "0000000000000000000000000001.0") 1.0) (num-test (string->number "1.0000000000000000000000000000") 1.0) (num-test (string->number "1000000000000000000000000000.0e-40") 1.0e-12) (num-test (string->number "0.0000000000000000000000000001e40") 1.0e12) (num-test (string->number "1.0e00000000000000000001") 10.0) (num-test (string->number "12341234.56789e12") 12341234567889999872.0) (num-test (string->number "-1234567890123456789.0") -1234567890123456768.0) (num-test (string->number "12345678901234567890.0") 12345678901234567168.0) (num-test (string->number "123.456e30") 123456000000000012741097792995328.0) (num-test (string->number "12345678901234567890.0e12") 12345678901234569054409354903552.0) (num-test (string->number "1.234567890123456789012e30") 1234567890123456849145940148224.0) (num-test (string->number "1e20") 100000000000000000000.0) (num-test (string->number "1234567890123456789.0") 1234567890123456768.0) (num-test (string->number "123.456e16") 1234560000000000000.0) (num-test (string->number "98765432101234567890987654321.0e-5") 987654321012345728401408.0) (num-test (string->number "98765432101234567890987654321.0e-10") 9876543210123456512.0) (num-test (string->number "0.00000000000000001234e20") 1234.0) (num-test (string->number "0.000000000000000000000000001234e30") 1234.0) (num-test (string->number "0.0000000000000000000000000000000000001234e40") 1234.0) (num-test (string->number "0.000000000012345678909876543210e15") 12345.678909877) (num-test (string->number "98765432101234567890987654321.0e-20") 987654321.012346) (num-test (string->number "98765432101234567890987654321.0e-29") 0.98765432101235) (num-test (string->number "98765432101234567890987654321.0e-30") 0.098765432101235) (num-test (string->number "98765432101234567890987654321.0e-28") 9.8765432101235) (num-test (string->number "1.0123456789876543210e1") 10.12345678987654373771) (num-test (string->number "1.0123456789876543210e10") 10123456789.87654304504394531250) (num-test (string->number "0.000000010000000000000000e10") 100.0) (num-test (string->number "0.000000010000000000000000000000000000000000000e10") 100.0) (num-test (string->number "0.000000012222222222222222222222222222222222222e10") 122.22222222222222) (num-test (string->number "0.000000012222222222222222222222222222222222222e17") 1222222222.222222) (num-test (string->number "1.1001001000011111101101010100010001000010110100010011" 2) 1.5707963267949) (num-test #x0000000000000000000000000001.0 1.0) (num-test #x1.0000000000000000000000000000 1.0) ;(test (number->string 1222222222.222222 16) "48d9a18e.38e38c") (num-test (string->number (number->string 1222222222.222222222222222222 16) 16) 1222222222.222222222222222222) (if with-bignums (num-test (string->number "179769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368.0") 179769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368.0) (num-test (string->number "179769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368.0") 1.7976931348623e+308)) (when with-bignums (num-test (string->number (number->string (bignum "12345.67890987654321") 2) 2) 12345.67890987654321) (test (number->string 1234.5678909876543212345 16) "4.d291614dc3ab1f80e55a563311b8f308@2") (test (number->string -1234.5678909876543212345 16) "-4.d291614dc3ab1f80e55a563311b8f308@2") (test (number->string 1234.5678909876543212345e8 16) "1.cbe991a6ac3f35c11868cb7e3fb75536@9") (test (number->string 1234.5678909876543212345e-8 16) "c.f204983a27e1eff701c562a870641e5@-5") (test (number->string 123456789098765432.12345e-8 16) "4.99602d2fcd6e9e1748ba5adccc12c5a8@7") (test (number->string 123456789098765432.1e20 16) "9.49b0f70beeac8895e74b18b968@30")) (num-test (string->number "12345678900000000000.0") 1.23456789e+19) (num-test (string->number "1234567890000000000000000000000000000000000000000000000000000000000000.0") 1.23456789e+69) (num-test (string->number "1234567890000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.0") 1.23456789e+129) (num-test (string->number "1.1e4" 5) 750.0) (num-test (string->number "1.1e4" 4) 320.0) (num-test (string->number "1.1e4" 3) 108.0) (num-test (string->number "1.1e4" 2) 24.0) (num-test #b111111111111111111111111111111111111111111111111111111111111111 most-positive-fixnum) (num-test #o777777777777777777777 most-positive-fixnum) (num-test #o-1000000000000000000000 most-negative-fixnum) (num-test #x-8000000000000000 most-negative-fixnum) (num-test #b-1000000000000000000000000000000000000000000000000000000000000000 most-negative-fixnum) (test (number->string 1.0 most-negative-fixnum) 'error) (test (number->string 1.0 most-positive-fixnum) 'error) (test (string->number "1.0" most-negative-fixnum) 'error) (test (string->number "1.0" most-positive-fixnum) 'error) (test (number->string 16 17) 'error) (test (number->string -0. 11 -) 'error) (test (string->number "11" 2 -) 'error) (test (string->number "1.0F") #f) (test (string->number "1F") #f) (test (string->number "1d") #f) (test (string->number "1.0L") #f) (test (string->number "1.0+1.0Ei") #f) (test (string->number "0xff") #f) ;; duplicate various non-digit chars (for-each (lambda (str) (test (string->number str) #f)) (list "..1" "1.." "1..2" "++1" "+-1" "-+1" "--1" "-..1" "+..1" "1+i+" "1+i." "1++i" "1--i" "1.ee1" "1+1..i" "1+ii" "1+1ee1i" "1e1e1" "1+2i.i" "1//2" "1+.1/2i" "1+1//2i" "1+1/2" "1i" "1ii" "1+.i" "1+..i")) (test (number->string most-positive-fixnum 2) "111111111111111111111111111111111111111111111111111111111111111") (test (number->string most-positive-fixnum 8) "777777777777777777777") (test (number->string most-positive-fixnum 16) "7fffffffffffffff") (test (number->string most-positive-fixnum 10) "9223372036854775807") (test (number->string most-negative-fixnum 10) "-9223372036854775808") (test (number->string most-negative-fixnum 8) "-1000000000000000000000") (test (number->string most-negative-fixnum 16) "-8000000000000000") (test (number->string most-negative-fixnum 2) "-1000000000000000000000000000000000000000000000000000000000000000") (test (string->number "111111111111111111111111111111111111111111111111111111111111111" 2) most-positive-fixnum) (test (string->number "777777777777777777777" 8) most-positive-fixnum) (test (string->number "7fffffffffffffff" 16) most-positive-fixnum) (test (string->number "9223372036854775807" 10) most-positive-fixnum) (test (string->number "-9223372036854775808" 10) most-negative-fixnum) (test (string->number "-1000000000000000000000" 8) most-negative-fixnum) (test (string->number "-8000000000000000" 16) most-negative-fixnum) (test (string->number "-1000000000000000000000000000000000000000000000000000000000000000" 2) most-negative-fixnum) (test (string->number (string #\1 #\. #\0 (integer->char 128) #\1)) #f) (test (string->number (string #\1 #\. #\0 (integer->char 20) #\1)) #f) (test (string->number (string #\1 #\. #\0 (integer->char 200) #\1)) #f) (test (string->number (string #\1 #\. #\0 (integer->char 255) #\1)) #f) (test (string->number (string #\1 #\. #\0 (integer->char 2) #\1)) #f) (test (string->number (string #\1 #\. (integer->char 128) #\1)) #f) (test (string->number (string #\1 #\. (integer->char 20) #\1)) #f) (test (string->number (string #\1 #\. (integer->char 200) #\1)) #f) (test (string->number (string #\1 #\. (integer->char 255) #\1)) #f) (test (string->number (string #\1 #\. (integer->char 2) #\1)) #f) (test (string->number (string #\1 (integer->char 128) #\1)) #f) (test (string->number (string #\1 (integer->char 20) #\1)) #f) (test (string->number (string #\1 (integer->char 200) #\1)) #f) (test (string->number (string #\1 (integer->char 255) #\1)) #f) (test (string->number (string #\1 (integer->char 2) #\1)) #f) (test (string->number (string (integer->char 128) #\1)) #f) (test (string->number (string (integer->char 20) #\1)) #f) (test (string->number (string (integer->char 200) #\1)) #f) (test (string->number (string (integer->char 255) #\1)) #f) (test (string->number (string (integer->char 2) #\1)) #f) (test (string->number (string (integer->char 128) #\/ #\2)) #f) (test (string->number (string (integer->char 20) #\/ #\2)) #f) (test (string->number (string (integer->char 200) #\/ #\2)) #f) (test (string->number (string (integer->char 255) #\/ #\2)) #f) (test (string->number (string (integer->char 2) #\/ #\2)) #f) (do ((i 103 (+ i 1))) ((= i 256)) (test (string->number (string (integer->char i))) #f) (test (string->number (string (integer->char i) #\. #\0)) #f)) (test (string->number "1,000") #f) (test (string->number "1 000") #f) (test (string->number "1 / 2") #f) (test (string->number "1 .2") #f) (test (string->number "1:") #f) (test (string->number "2/") #f) (test (string->number "2@") #f) (num-test #b1.0e8 256.0) (num-test #o1.0e8 16777216.0) (num-test #x1.0e8 1.056640625) ; e is a digit (if with-bignums (num-test #b1.1111111111111111111111111111111111111111111111111110011101010100100100011001011011111011000011001110110101010011110011000100111E1023 1.7976931348623156E308)) (test (number->string 1/9 2) "1/1001") (test (number->string -11/4 2) "-1011/100") (test (number->string -11/4 8) "-13/4") (test (number->string -15/4 16) "-f/4") (test (string->number "f/4" 16) 15/4) (test (string->number "#b'0") #f) (test (equivalent? (string->number "#b0/0") +nan.0) #t) (test (equivalent? (string->number "#b-1/0") +nan.0) #t) (test (string->number "1e1/2") #f) (test (string->number "1e#b0") #f) (test (string->number "#B0") #f) (test (string->number "0+I") #f) (num-test (string->number "#x10+10i") 16+16i) (num-test 00-10e+001i 0-100i) (num-test (string->number "#x+e/00011ee0") 7/36720) (num-test (string->number "-1.-00.0e+10i") -1.0) (num-test (string->number "#x+1e1.+e10i") 481+3600i) (num-test (string->number "#xe/e+e/ei") 1+1i) (num-test (string->number "1e-0-.11e+1i") 1-1.1i) (num-test (string->number "00.-1.1e-00i") 0-1.1i) (num-test (string->number "+01.e+1+.00i") 10.0) (num-test (string->number "#x1e0/e+0/ei") 34.285714285714) (num-test (string->number "+01e0+00.i") 1.0) (num-test (string->number "+0/0100+0i") 0.0) (num-test (string->number "#x-e1e/eee") -139/147) (num-test (string->number "#x-0101.+00/11i") -257.0) (num-test (string->number "#x+ee.-e00e0110i") 238-3759014160i) (num-test (string->number "#x-e0/1ee") -112/247) (num-test (string->number "+01e01+0/1i") 10.0) (num-test (string->number "1.-0.0e+00i") 1.0) (num-test (string->number "#x1/7e2") 1/2018) (num-test (string->number "0.1e00" 2) 0.5) (num-test (string->number "10.101" 2) 2.625) (num-test (string->number "0e1010" 2) 0.0) (num-test (string->number ".1e010" 2) 512.0) (num-test (string->number "1/000100" 2) 1/4) (num-test (string->number "1000e+03" 2) 64.0) (num-test (string->number "-1e+1-1i" 2) -2-1i) (num-test (string->number ".1-110e03i" 2) 0.5-48i) (num-test (string->number "1e9" 2) 512.0) (num-test (string->number "52/7" 8) 6) (num-test (string->number "130." 8) 88.0) (num-test (string->number "121.-16i" 8) 81-14i) (num-test (string->number "12/15150" 8) 1/676) (num-test (string->number "612444175735" 8) 52958395357) (num-test (string->number "31005331+.4i" 8) 6556377+0.5i) (num-test (string->number "42220e-2" 8) 274.25) (num-test (string->number "1e9" 8) 134217728.0) (test (string->number "1e9" 12) #f) ; this may not be ideal... (num-test (string->number "1b9/64" 12) 15/4) (num-test (string->number "a880+i" 12) 18528+1i) (num-test (string->number "dc-i" 16) 220-1i) (num-test (string->number "dcd-fi" 16) 3533-15i) (num-test (string->number "d/ebee" 16) 1/4646) (num-test (string->number "a.d-ci" 16) 10.8125-12i) (num-test (string->number "fac/ed" 16) 4012/237) (num-test (string->number "-ccdebef.a" 16) -214821871.625) (num-test (string->number "+dfefc/c" 16) 76437) (num-test (string->number "acd/eabf" 16) 79/1717) (num-test (string->number "-1e-1-1e-1i") -0.1-0.1i) (num-test (string->number "+1e+1+1e+1i") 10+10i) (unless with-bignums (test (= 1e19 .1e20) #t)) (test (string->number "15+b7a9+8bbi-95+4e" 16) #f) (num-test (string->number "776.0a9b863471095a93" 12) 1098.0752175102) (num-test (string->number "a72972b301/398371448" 12) 54708015601/1637213240) (num-test (string->number "+ac946/b72ddf4847ce6" 16) 353443/1611261179739763) (num-test (string->number "b85.361c23cec099e742" 15) 2600.2272029731) (num-test (string->number "ade2411.a1422432dea8" 15) 1.24494541672338806082296187159063753079E8) (num-test (string->number "da99007963b182/8a66b" 15) 26681038227104972/440201) (num-test (string->number "74cc.d+b44.02a11ee5i" 15) 24717.866666667+2539.0118742348i) (num-test (string->number "d+7a5d40di" 14) 13+58313541i) (test (number->string 2000000000000000000.0 16) "1.bc16d674ec8@15") (test (string->number "1.bc16d674ec8@15" 16) 2e+18) (num-test (string->number "e.d6ed7c4c5387@14" 16) 1069303079659341600.0) (test (number->string 2e18+2e18i 16) "1.bc16d674ec8@15+1.bc16d674ec8@15i") (if with-bignums (test (number->string 1069303079659341600.0 16) "e.d6ed7c4c53872@14") (test (number->string 1069303079659341600.0 16) "e.d6ed7c4c5387@14")) ; @ exponent needed here (test (nan? (string->number "5639d72702b62527/0" 14)) #t) (test (nan? (string->number "-28133828f9421ef5/0" 16)) #t) (test (nan? (string->number "+4a11654f7e00d5f2/0" 16)) #t) (when (and with-bignums (not pure-s7)) (test (number->string (/ most-positive-fixnum most-negative-fixnum) 2) "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000") (test (string->number "-111111111111111111111111111111111111111111111111111111111111111/1000000000000000000000000000000000000000000000000000000000000000" 2) -9223372036854775807/9223372036854775808) (num-test (string->number "b2706b3d3e8e46ad5aae" 15) 247500582888444441302414) (num-test (string->number "ceec932122d7c22289da9144.4b7836de0a2f5ef" 16) 6.403991331575236168367699181229480307503E28) (num-test (string->number "c23177c20fb1296/fcf15a82c8544613721236e2" 16) 437284287268358475/39141000511500755277510679409) (num-test (string->number "775f81b8fee51b723f" 16) 2202044529881940455999) (num-test (string->number "5d9eb6d6496f5c9b6e" 16) 1726983762769631550318) (num-test (string->number "+775f81b8fee51b723f" 16) 2202044529881940455999) (num-test (string->number "+5d9eb6d6496f5c9b6e" 16) 1726983762769631550318) (num-test (string->number "-775f81b8fee51b723f" 16) -2202044529881940455999) (num-test (string->number "-5d9eb6d6496f5c9b6e" 16) -1726983762769631550318) (num-test (string->number "+d053d635e581a5c4/d7" 16) 15011577509928084932/215) (num-test (string->number "+a053a635a581a5a4/a7" 16) 11552760218475668900/167) (num-test (string->number "-d053d635e581a5c4/d7" 16) -15011577509928084932/215) (num-test (string->number "-a053a635a581a5a4/a7" 16) -11552760218475668900/167) (num-test (string->number "+6/a47367025481df6c8" 16) 1/31599808811326133196) (num-test (string->number "d053d635e581a5c4/d7" 16) 15011577509928084932/215) (num-test (string->number "+074563336d48564b774" 16) 2146033681147780970356) (num-test (string->number "e/4246061597ec79345a" 15) 7/204584420774687563055) (num-test (string->number "c57252467ff.cfd94d" 16) 1.3568424830975811909496784210205078125E13) (num-test (string->number "f309e9b9ba.7c52ff2" 16) 1.043843365306485641427338123321533203125E12) (num-test (string->number "+42e-0106653" 10) 4.199999999999999999999999999999999999999E-106652) (test (infinite? (string->number "8e7290491476" 10)) #t) (num-test (string->number "4ff7da4d/ab09e16255c06a55c5cb7193ebb2fbb" 16) 1341643341/14209330580250438592763227155654717371) (num-test (string->number "#x400000000000000000") (expt 2 70)) (for-each (lambda (op) (if (not (= (op (bignum 1e19)) (op (bignum .1e20)))) (format #t ";(~A 1e19) = ~A, but (~A .1e20) = ~A?~%" op (op 1e19) op (op .1e20)))) (list floor ceiling truncate round inexact->exact exact->inexact)) (for-each (lambda (op) (if (not (= (op (bignum -1e19)) (op (bignum -.1e20)))) (format #t ";(~A -1e19) = ~A, but (~A -.1e20) = ~A?~%" op (op -1e19) op (op -.1e20)))) (list floor ceiling truncate round inexact->exact exact->inexact))) (num-test #b+01 1) (num-test #b-01 -1) (num-test #b1.0e-8 0.00390625) (num-test #o1.0e-8 5.9604644775391e-08) (num-test #b-.1 -0.5) (num-test #o-.1 -0.125) (num-test #x-.1 -0.0625) (num-test #b+.1 +0.5) (num-test #o+.1 +0.125) (num-test #x+.1 +0.0625) (num-test #b+.1e+1 1.0) (num-test #o+.1e+1 1.0) (num-test #b000000001 1) (num-test #b1e1 2.0) (num-test #b1.e1 2.0) (num-test #x-AAF -2735) (num-test #x-aAf -2735) (num-test #b1+1.1i 1+1.5i) ; yow... (num-test #xf/c 5/4) (num-test #x+f/c 5/4) (num-test #x-f/c -5/4) (num-test #b0/1 0) ;(test #b0/0 'division-by-zero) ; read-error (num-test #o7/6 7/6) (num-test #o11/2 9/2) (num-test #x11/2 17/2) (num-test #b111/11 7/3) (num-test #b111111111111111111111111111111111111111111111111111111111111111/111 1317624576693539401) (num-test (* 1317624576693539401 7) most-positive-fixnum) (num-test #o777777777777777777777/7 1317624576693539401) (num-test #x7fffffffffffffff/7 1317624576693539401) (num-test (string->number "#x1234/12") (string->number "1234/12" 16)) (test (equal? 0.0 #b0e0) #t) (test (equal? 0.0 #b0e-0) #t) (test (equal? 0.0 #b.0e+0) #t) (test (equal? 0.0 #b00000000000000000000000000000000000000000000000000000e100) #t) (test (equal? 0.0 #b.0000000000000000000000000000000000000000000000000000e100) #t) (test (equal? 0.0 #b00000000000000000000000000000000000000000000000000000.0000000000000000000000000000000000000000000000000000000000e100) #t) (test (equal? 0.0 #b0e100000000000000000000000000000000000000000000000000000000000000000000000) #t) (num-test 0 #b0/1000000000) (num-test 0 #b0/100000000000000000000000000000000000000) (num-test 0 #b0/100000000000000000000000000000000000000000000000000000000000000) (num-test (string->number "#b0/100000000000000000000000000000000000000000000000000000000000000000000") 0) (num-test (string->number "#b-0/100000000000000000000000000000000000000000000000000000000000000000000") 0) (test (equal? 0.0 #b0.0e10) #t) (test (equal? 0.0 #b0e100) #t) (test (equal? 0.0 #b0.0e1000) #t) (test (equal? 0.0 #b0e+1000) #t) (test (equal? 0.0 #b0.0e-1) #t) (test (equal? 0.0 #b0e-10) #t) (test (equal? 0.0 #b0.0e-100) #t) (test (equal? 0.0 #b0e-1000) #t) (test (equal? 0.0 #b0.0e0123456789) #t) (test (equal? 0.0 #b0-0e10i) #t) (test (equal? 0.0 #b0-0.0e100i) #t) (test (equal? 0.0 #b0-0e1000i) #t) (test (equal? 0.0 #b0-0.0e+1000i) #t) (test (equal? 0.0 #b0-0e-1i) #t) (test (equal? 0.0 #b0-0.0e-10i) #t) (test (equal? 0.0 #b0-0e-100i) #t) (test (equal? 0.0 #b0-0.0e-1000i) #t) (test (equal? 0.0 #b0.0+0e0123456789i) #t) (num-test 0.0 #b1e-1000) (num-test #b+0+i 0+1i) (num-test #b0.-i 0-1i) (num-test #b0/01 0) (num-test #b-0/1 0) (num-test #b1.+.1i 1+0.5i) (num-test 1e-0 1.0) (num-test #b0100/10 2) (num-test #b0e+1-0.i 0.0) (num-test #b.1-0/01i 0.5) (num-test #b0e+1-0.i 0.0) (num-test #b1.+01.e+1i 1+2i) (num-test #b0+.0e10101i 0.0) (num-test #b00e+0-.00e11i 0.0) (num-test #b-000e+10110001 0.0) (test (number? ''1) #f) (test (symbol? ''1) #f) (test (string->number "''1") #f) (test 00 0) (test (string->number "00") 0) (test 000 0) (test (string->number "000") 0) (test 00.00 0.0) (test (string->number "00.00") 0.0) (test (number? '0-0) #f) (test (string->number "0-0") #f) (test (number? '00-) #f) (test (string->number "00-") #f) (num-test #o-11 -9) (num-test #o-0. 0.0) (num-test #o+.0 0.0) (num-test #xe/1 14) (num-test #xe/a 7/5) (num-test #xfad 4013) (num-test #xd/1 13) (num-test #x0/f 0) (num-test #x+00 0) (num-test #x.c0 0.75) (num-test #x-fc -252) (test (= 0e-1 0.0) #t) ;;; (/ (/ 0))?? (num-test #x.a+i 0.625+1i) (num-test #b1.+i 1+1i) (num-test 0.e-0 0.0) (num-test #o12+i 10+i) (num-test #o12+12i 10+10i) (num-test #o12/12 1) (let ((str (make-string 3))) (set! (str 0) #\#) (set! (str 1) #\b) (set! (str 2) #\null) (test (string->number str) #f)) (let ((str (make-string 4))) (set! (str 0) #\#) (set! (str 1) #\b) (set! (str 2) #\0) (set! (str 3) #\null) ; #\space here -> #f (test (string->number str) 0)) ; this is consistent with other (non-#) cases (do ((i 2 (+ i 1))) ((= i 17)) (num-test (string->number (number->string 12345.67890987654321 i) i) 12345.67890987654321)) (let () (define make-number (let () (define (digit->char digit) (if (< digit 10) (integer->char (+ (char->integer #\0) digit)) (integer->char (+ (char->integer #\a) (- digit 10))))) (define (exponent-marker) (string-ref "eE" (random 2))) (lambda (radix) (let* ((max-len (+ 1 (vector-ref (vector 0 0 62 39 31 26 23 22 20 19 18 17 17 16 16 15 15) radix))) (int-len (floor (* max-len (random 1.0) (random 1.0) (random 1.0)))) (frac-len (floor (* max-len (random 1.0) (random 1.0) (random 1.0)))) (exp-len 1) (has-frac (> (random 1.0) 0.2)) (has-exp (and (<= radix 10) (< int-len 9) (> (random 1.0) 0.5))) (signed (> (random 1.0) 0.5)) (exp-signed (> (random 1.0) 0.5))) (if (and (= int-len 0) (or (not has-frac) (= frac-len 0))) (set! int-len 1)) (let ((str (make-string (+ int-len (if signed 1 0) (if has-frac (+ frac-len 1) 0) ; extra 1 for "." (if has-exp (+ (+ exp-len 1) ; extra 1 for exponent char (if exp-signed 1 0)) 0)))) (loc 0)) (if signed (begin (set! (str 0) #\-) (set! loc (+ loc 1)))) (do ((i 0 (+ i 1))) ((= i int-len)) (set! (str loc) (digit->char (random radix))) (set! loc (+ loc 1))) (if has-frac (begin (set! (str loc) #\.) (set! loc (+ loc 1)) (do ((i 0 (+ i 1))) ((= i frac-len)) (set! (str loc) (digit->char (random radix))) (set! loc (+ loc 1))))) (if has-exp (begin (set! (str loc) (exponent-marker)) (set! loc (+ loc 1)) (if exp-signed (begin (set! (str loc) #\-) (set! loc (+ loc 1)))) (do ((i 0 (+ i 1))) ((= i exp-len)) (set! (str loc) (digit->char (random 10))) (set! loc (+ loc 1))))) str))))) (let ((tries 1000)) (do ((i 0 (+ i 1))) ((= i tries)) (let ((rad (+ 2 (random 15)))) (let ((str (make-number rad))) (if (not (number? (string->number str rad))) (format #t ";(1) trouble in string->number ~A ~S: ~A~%" rad str (string->number str rad)) (if (not (string? (number->string (string->number str rad) rad))) (format #t ";(2) trouble in number->string ~A ~S: ~A ~S~%" rad str (string->number str rad) (number->string (string->number str rad) rad)) (if (not (number? (string->number (number->string (string->number str rad) rad) rad))) (format #t ";(3) trouble in number->string ~A ~S: ~A ~S ~A~%" rad str (string->number str rad) (number->string (string->number str rad) rad) (string->number (number->string (string->number str rad) rad) rad)) (let ((diff (abs (- (string->number (number->string (string->number str rad) rad) rad) (string->number str rad))))) (if (> diff 2e-5) (format #t "(string->number ~S ~D): ~A, n->s: ~S, s->n: ~A, diff: ~A~%" str rad (string->number str rad) (number->string (string->number str rad) rad) (string->number (number->string (string->number str rad) rad) rad) diff))))))))))) (let () (define (no-char str radix) (let ((len (length str))) (do ((i 0 (+ i 1))) ((= i len)) (if (and (not (char=? (str i) #\.)) (>= (string->number (string (str i)) 16) radix)) (format #t ";~S in base ~D has ~C?" str radix (str i)))))) (no-char (number->string (* 1.0 2/3) 9) 9) (no-char (number->string (string->number "0.05" 9) 9) 9) ;; (number->string (string->number "-5L-4" 9) 9) -> "-0.00049" if rounding is stupid ;; (number->string (string->number "5.e-8" 6) 6) -> "0.000000046" (no-char (number->string (* 1.0 6/7) 7) 7) (do ((i 2 (+ i 1))) ((= i 17)) (no-char (number->string (* 1.0 (/ 1 i)) i) i) (no-char (number->string (* 1.0 (/ 1 (* i i))) i) i) (no-char (number->string (* 0.99999999999999 (/ 1 i)) i) i) (no-char (number->string (* 0.999999 (/ 1 i)) i) i))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (= i 17))) (if (not (eqv? 3/4 (string->number (number->string 3/4 i) i))) (begin (set! happy #f) (format #t ";(string<->number 3/4 ~A) -> ~A?~%" i (string->number (number->string 3/4 i) i)))) (if (not (eqv? 1234/11 (string->number (number->string 1234/11 i) i))) (begin (set! happy #f) (format #t ";(string<->number 1234/11 ~A) -> ~A?~%" i (string->number (number->string 1234/11 i) i)))) (if (not (eqv? -1234/11 (string->number (number->string -1234/11 i) i))) (begin (set! happy #f) (format #t ";(string<->number -1234/11 ~A) -> ~A?~%" i (string->number (number->string -1234/11 i) i)))))) (test (< (abs (- (string->number "3.1415926535897932384626433832795029") 3.1415926535897932384626433832795029)) 1e-7) #t) (num-test (string->number "111.01" 2) 7.25) (num-test (string->number "-111.01" 2) -7.25) (num-test (string->number "0.001" 2) 0.125) (num-test (string->number "1000000.001" 2) 64.125) (num-test (string->number "111.01" 8) 73.015625) (num-test (string->number "-111.01" 8) -73.015625) (num-test (string->number "0.001" 8) 0.001953125) (num-test (string->number "1000000.001" 8) 262144.001953125) (num-test (string->number "111.01" 16) 273.00390625) (num-test (string->number "-111.01" 16) -273.00390625) (num-test (string->number "0.001" 16) 0.000244140625) (num-test (string->number "1000000.001" 16) 16777216.000244) (num-test (string->number "11.+i" 2) 3+1i) (num-test (string->number "0+.1i" 2) 0+0.5i) (num-test (string->number "1.+0.i" 2) 1.0) (num-test (string->number ".01+.1i" 2) 0.25+0.5i) (num-test (string->number "1+0.i" 2) 1.0) (num-test (string->number "1+0i" 2) 1.0) (test (number->string 0.75 2) "0.11") (test (number->string 0.125 8) "0.1") (test (number->string 12.5 8) "14.4") (test (number->string 12.5 16) "c.8") (test (number->string 12.5 2) "1100.1") (test (number->string -12.5 8) "-14.4") (test (number->string -12.5 16) "-c.8") (test (number->string -12.5 2) "-1100.1") (test (number->string 12.0+0.75i 2) "1100.0+0.11i") (test (number->string -12.5-3.75i 2) "-1100.1-11.11i") (test (number->string 12.0+0.75i 8) "14.0+0.6i") (test (number->string -12.5-3.75i 8) "-14.4-3.6i") (test (number->string 12.0+0.75i 16) "c.0+0.ci") (test (number->string -12.5-3.75i 16) "-c.8-3.ci") (test (string->number "2/#b1" 10) #f) (test (string->number "2.i" 10) #f) (num-test (string->number "6+3.i" 10) 6+3i) (num-test (string->number "-61" 7) -43) (num-test (string->number "10100.000e11+011110111.1010110e00i" 2) 40960+247.671875i) (num-test (string->number "+4a00/b" 16) 18944/11) (num-test (string->number "9-9.e+9i" 10) 9-9000000000i) (num-test (string->number "-9+9e-9i" 10) -9+9e-09i) ; why the 09? (num-test +2-0.e-1i 2.0) (num-test +2.-0e-1i 2.0) ;; weird cases: (test (string->number "#b1000" 8) 8) (test (string->number "#b1000" 2) 8) (test (string->number "#b1000" 16) 8) (test (string->number "11" 2) 3) (test (string->number "#x11" 2) 17) (test (string->number "#b11" 16) 3) (test (string->number "#xffff" 2) 65535) (test (string->number "#xffff" 10) 65535) (test (string->number "#xffff" 6) 65535) (test (string->number "#xffff" 16) 65535) (test (string->number "#x35/3de" 10) 53/990) (test (string->number "#x#|1|#1") #f) (test (string->number "#||#1") #f) (test (string->number "#<") #f) (test (string->number "+.e1") #f) (test (string->number ".e1") #f) (num-test (string->number "4\x32;\x37;") 427) (num-test (string->number "\x32;.\x39;") 2.9) (num-test (string->number "4\x31;+3\x36;i") 41+36i) (when with-bignums (num-test (string->number "101461074055444526136" 8) 1181671265888545886) (num-test (string->number "-67330507011755171566102306711560321" 8) -35128577239298592313751007322321) (num-test (string->number "35215052773447206642040260+177402503313573563274751i" 8) 1.38249897923920622272688E23+1.176027342049207220713E21i) ;; there is some randomness here: 1.0e309 -> inf, but 1.0e310 -> -nan and others equally scattered ) (test (string=? (substring (number->string pi 16) 0 14) "3.243f6a8885a3") #t) (for-each (lambda (expchar) (let ((exponent (string expchar))) (do ((base 2 (+ base 1))) ((= base 11)) (let ((val (string->number (string-append "1" exponent "1") base))) (if (and (number? val) (> (abs (- val base)) 1e-9)) (format #t ";(string->number ~S ~A) returned ~A?~%" (string-append "1" exponent "1") base (string->number (string-append "1" exponent "1") base))))) (do ((base 2 (+ base 1))) ((= base 11)) (let ((val (string->number (string-append "1.1" exponent "1") base))) (if (and (number? val) (> (abs (- val (+ base 1))) 1e-9)) (format #t ";(string->number ~S ~A) returned ~A?~%" (string-append "1.1" exponent "1") base (string->number (string-append "1.1" exponent "1") base))))) (do ((base 2 (+ base 1))) ((= base 11)) (let ((val (string->number (string-append "1" exponent "+1") base))) (if (and (number? val) (> (abs (- val base)) 1e-9)) (format #t ";(string->number ~S ~A) returned ~A?~%" (string-append "1" exponent "+1") base (string->number (string-append "1" exponent "+1") base))))) ; in base 16 this is still not a number because of the + (or -) ; but "1e+1i" is a number -- gad! (do ((base 2 (+ base 1))) ((= base 11)) (let ((val (string->number (string-append "1" exponent "-1+1i") base))) (if (and (number? val) (> (magnitude (- val (complex (/ base) 1))) 1e-6)) (format #t ";(string->number ~S ~A) returned ~A?~%" (string-append "1" exponent "-1+1i") base (string->number (string-append "1" exponent "-1+1i") base))))))) (list #\e #\d #\f #\s #\l)) (test (< (abs (- (string->number "3.1415926535897932384626433832795029" 10) 3.1415926535897932384626433832795029)) 1e-7) #t) (num-test (string->number "2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427" 16) 2.4433976119657) (num-test (string->number "2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427" 11) 2.6508258818757) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (= i 17))) (let ((val (+ 1.0 i))) (do ((k 1 (+ k 1)) (incr (/ 1.0 i) (/ incr i))) ((< incr 1e-14)) (set! val (+ val incr))) (if (> (abs (- val (string->number "11.111111111111111111111111111111111111111111111111111111111111111111111111111111111111" i))) 1e-7) (begin (set! happy #f) (display "(string->number 11.111... ") (display i) (display ") -> ") (display (string->number "11.111111111111111111111111111111111111111111111111111111111111111111111111111111111111" i)) (display " but expected ") (display val) (newline)))) (let* ((digits "00123456789abcdef") (str (make-string 80 (string-ref digits i)))) (string-set! str 2 #\.) (let ((val (exact->inexact (* i i)))) (if (> (abs (- val (string->number str i))) 1e-7) (begin (set! happy #f) (format #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val))))) (let* ((radlim (list 0 0 62 39 31 26 23 22 20 19 18 17 17 16 16 15 15)) (digits "00123456789abcdef")) (do ((k (- (list-ref radlim i) 3) (+ k 1))) ((= k (+ (list-ref radlim i) 4))) (let ((str (make-string (+ k 3) (string-ref digits i)))) (string-set! str 2 #\.) (let ((val (exact->inexact (* i i)))) (if (> (abs (- val (string->number str i))) 1e-7) (begin (set! happy #f) (format #t ";(string->number ~S ~A) -> ~A (expected ~A)?~%" str i (string->number str i) val))))))))) (let ((happy #t)) (do ((i 2 (+ i 1))) ((or (not happy) (= i 17))) (if (> (abs (- 0.75 (string->number (number->string 0.75 i) i))) 1e-6) (begin (set! happy #f) (format #t ";(string->number (number->string 0.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 0.75 i) i)))) (if (> (abs (- 1234.75 (string->number (number->string 1234.75 i) i))) 1e-6) (begin (set! happy #f) (format #t ";(string->number (number->string 1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string 1234.75 i) i)))) (if (> (abs (- -1234.25 (string->number (number->string -1234.25 i) i))) 1e-6) (begin (set! happy #f) (format #t ";(string->number (number->string -1234.75 ~A) ~A) -> ~A?~%" i i (string->number (number->string -1234.75 i) i)))) (let ((val (string->number (number->string 12.5+3.75i i) i))) (if (or (not (number? val)) (> (abs (- (real-part val) 12.5)) 1e-6) (> (abs (- (imag-part val) 3.75)) 1e-6)) (begin (set! happy #f) (format #t ";(string->number (number->string 12.5+3.75i ~A) ~A) -> ~A?~%" i i (string->number (number->string 12.5+3.75i i) i))))) (let ((happy #t)) (do ((base 2 (+ base 1))) ((or (not happy) (= base 11))) ;;; see s7.c for an explanation of this limit (do ((i 0 (+ i 1))) ((= i 10)) (let* ((rl (- (random 200.0) 100.0)) (im (- (random 200.0) 100.0)) (rlstr (number->string rl base)) (imstr (number->string im base)) (val (complex rl im)) (str (string-append rlstr (if (or (negative? im) (char=? (string-ref imstr 0) #\-)) ; sigh -- -0.0 is not negative! "" "+") imstr "i"))) (let* ((sn (string->number str base)) (nsn (and (number? sn) (number->string sn base))) (nval (and (string? nsn) (string->number nsn base)))) (if (or (not nval) (> (abs (- (real-part nval) (real-part val))) 1e-3) (> (abs (- (imag-part nval) (imag-part val))) 1e-3)) (begin (set! happy #f) (format #t ";(number<->string ~S ~A) -> ~A? [~A ~S]~%" str base nval sn nsn) ))))))))) (let ((val (number->string 1.0-1.0i))) (if (and (not (string=? val "1-1i")) (not (string=? val "1.0-1.0i")) (not (string=? val "1-i")) (not (string=? val "1.0-i"))) (begin (display "(number->string 1.0-1.0i) returned ") (display val) (display "?") (newline)))) (let () (define (make-integer str j digits radix zero-ok) (do ((k 0 (+ k 1))) ((= k digits)) (if zero-ok (set! (str j) (#(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f) (random radix))) (set! (str j) (#(#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f) (random (- radix 1))))) (set! j (+ j 1))) j) (define (make-ratio str j ndigits ddigits radix) (set! j (make-integer str j (+ 1 ndigits) radix #t)) (set! (str j) #\/) (make-integer str (+ j 1) (+ 1 ddigits) radix #f)) (define (make-real str j digits edigits radix) (let ((nj (make-integer str j (random digits) radix #t))) (set! (str nj) #\.) (set! j (make-integer str (+ nj 1) (+ (if (= j nj) 1 0) (random digits)) radix #t)) (if (and (> edigits 0) (<= radix 10)) (begin (set! (str j) #\e) (set! j (make-integer str (+ j 1) (+ 1 (random edigits)) radix #t)))) j)) (define (make-complex str j digits edigits radix) (set! j (make-real str j digits edigits radix)) (set! (str j) (#(#\+ #\-) (random 2))) (set! j (make-real str (+ j 1) digits edigits radix)) (set! (str j) #\i) (+ j 1)) (let ((str (make-string 512)) (max-digits 10) (edigits 2)) (do ((i 0 (+ i 1))) ((= i 100)) (let ((j 0) (radix (+ 2 (random 15))) (choice (case (random 10) ((0 1) 'integer) ((2 3) 'ratio) ((4 5 6) 'real) (else 'complex)))) ;; possible #x etc (if (> (random 10) 7) (begin (set! (str j) #\#) (set! j (+ j 1)) (let ((rchoice (random 3))) (set! (str j) (#(#\b #\o #\x) rchoice)) (set! radix (#(2 8 16) rchoice))) (set! j (+ j 1)))) ;; possible sign (if (> (random 10) 5) (begin (set! (str j) (#(#\+ #\-) (random 2))) (set! j (+ j 1)))) (set! j (case choice ((integer) (make-integer str j (+ 1 (random max-digits)) radix #t)) ((ratio) (make-ratio str j (random max-digits) (random max-digits) radix)) ((real) (make-real str j max-digits edigits radix)) ((complex) (make-complex str j max-digits edigits radix)))) (let ((num (catch #t (lambda () (string->number (substring str 0 j) radix)) (lambda args 'error)))) (if (not (number? num)) (format *stderr* "(string->number ~S ~D) ~60T~A~%" (substring str 0 j) radix num))))))) (let ((string->number-2 (lambda (str radix) (let ((old-str (if (string? str) (string-copy str) str))) (let ((val (string->number str radix))) (if (not (string=? str old-str)) (error 'string->number-messed-up) val))))) (string->number-1 (lambda (str) (let ((old-str (if (string? str) (string-copy str) str))) (let ((val (string->number str))) (if (not (string=? str old-str)) (error 'string->number-messed-up) val)))))) (test (string->number-1 "100") 100) (test (string->number-2 "100" 16) 256) (test (string->number-2 "100" 2) 4) (test (string->number-2 "100" 8) 64) (test (string->number-2 "100" 10) 100) (test (string->number-2 "11" 16) 17) (test (string->number-2 "-11" 16) -17) (test (string->number-2 "+aa" 16) 170) (test (string->number-2 "-aa" 16) -170) (for-each (lambda (str rval fval) (let ((happy #t)) (do ((radix 3 (+ radix 1))) ((or (not happy) (= radix 16))) (let ((val (string->number-2 str radix))) (if (and (number? val) (not (fval val (rval radix) radix))) (begin (display "(string->number \"") (display str) (display "\" ") (display radix) (display ") = ") (display val) (display "?") (newline) (set! happy #f))))))) (list "101" "201.02" "1/21" "2e1" "10.1e-1" ) (list (lambda (radix) (+ 1 (* radix radix))) (lambda (radix) (+ 1.0 (* 2 radix radix) (/ 2.0 (* radix radix)))) (lambda (radix) (/ 1 (+ 1 (* 2 radix)))) (lambda (radix) (if (< radix 15) (* 2 radix) (+ 1 (* 14 radix) (* 2 radix radix)))) (lambda (radix) (+ 1 (/ 1.0 (* radix radix)))) ) (list (lambda (a b radix) (= a b)) (lambda (a b radix) (< (abs (- a b)) (/ 1.0 (* radix radix)))) (lambda (a b radix) (= a b)) (lambda (a b radix) (= a b)) (lambda (a b radix) (< (abs (- a b)) (/ 1.0 (* radix radix radix)))) )) (test (string->number-2 "34" 2) #f) (test (string->number-2 "19" 8) #f) (test (string->number-2 "1c" 10) #f) (num-test (string->number-2 "1c" 16) 28) (test (string->number-1 "") #f) (test (string->number-1 ".") #f) (test (string->number-1 "d") #f) (test (string->number-1 "D") #f) (test (string->number-1 "i") #f) (test (string->number-1 "I") #f) (test (string->number-1 "3i") #f) (test (string->number-1 "3I") #f) (test (string->number-1 "33i") #f) (test (string->number-1 "33I") #f) (test (string->number-1 "3.3i") #f) (test (string->number-1 "3.3I") #f) (test (string->number-1 "-") #f) (test (string->number-1 "+") #f) (test (string->number "1e0+i") 1+i) (test (string->number "1+ie0") #f) (test (string->number "1+e0") #f) (test (string->number "1+1e0i") 1+i) (test (string->number "1+1e0e0i") #f) (test (string->number "1+1e00i") 1+i) (test (string->number "1L") #f) (test (string->number "1.L") #f) (num-test (string->number-1 "3.4e3") 3400.0) (num-test (string->number-1 "0") 0)) (test (let* ((str "1+0i") (x (string->number str))) (and (number? x) (string=? str "1+0i"))) #t) (for-each (lambda (n) (let ((nb (catch #t (lambda () (number? n)) (lambda args 'error)))) (if (not nb) (begin (display "(number? ") (display n) (display ") returned #f?") (newline))))) (list 1 -1 +1 +.1 -.1 .1 .0 0. 0.0 -0 +0 -0. +0. +1.1 -1.1 1.1 '1.0e2 '-1.0e2 '+1.0e2 '1.1e-2 '-1.1e-2 '+1.1e-2 '1.1e+2 '-1.1e+2 '+1.1e+2 '1/2 '-1/2 '+1/2 '1.0+1.0i '1.0-1.0i '-1.0-1.0i '-1.0+1.0i '1+i '1-i '-1-i '-1+i '2/3+i '2/3-i '-2/3+i '1+2/3i '1-2/3i '2/3+2/3i '2.3-2/3i '2/3-2.3i '2e2+1e3i '2e2-2e2i '2.0e2+i '1+2.0e2i '2.0e+2-2.0e-1i '2/3-2.0e3i '2e-3-2/3i '-2.0e-2-2.0e-2i '+2.0e+2+2.0e+2i '+2/3-2/3i '2e2-2/3i '1e1-i '1.-i '.0+i '-.0-1e-1i '1.+.1i '0.-.1i '.1+.0i '1.+.0i '.1+.1i '1.-.1i '.0+.00i '.10+.0i '-1.+.0i '.1-.01i '1.0+.1i '1e1+.1i '-1.-.10i '1e01+.0i '0e11+.0i '1.e1+.0i '1.00-.0i '-1e1-.0i '1.-.1e0i '1.+.001i '1e10-.1i '1e+0-.1i '-0e0-.1i '-1.0e-1-1.0e-1i '-111e1-.1i '1.1-.1e11i '-1e-1-.11i '-1.1-.1e1i '-.1+.1i)) (for-each (lambda (n rl im) (if (not (number? n)) (begin (display "(number? ") (display n) (display ") returned #f?") (newline)) (begin (if (> (abs (- (real-part n) rl)) .000001) (begin (display "real-part: ") (display n) (display " ") (display (real-part n)) (display " ") (display rl) (newline))) (if (> (abs (- (imag-part n) im)) .000001) (begin (display "imag-part: ") (display n) (display " ") (display (imag-part n)) (display " ") (display im) (newline))) ))) (list 1 -1 +1 +.1 -.1 .1 .0 0. 0.0 -0 +0 -0. +0. +1.1 -1.1 1.1 '1.0e2 '-1.0e2 '+1.0e2 '1.1e-2 '-1.1e-2 '+1.1e-2 '1.1e+2 '-1.1e+2 '+1.1e+2 '1/2 '-1/2 '+1/2 '1.0+1.0i '1.0-1.0i '-1.0-1.0i '-1.0+1.0i '1+i '1-i '-1-i '-1+i '2/3+i '2/3-i '-2/3+i '1+2/3i '1-2/3i '2/3+2/3i '2.3-2/3i '2/3-2.3i '2e2+1e3i '2e2-2e2i '2.0e2+i '1+2.0e2i '2.0e+2-2.0e-1i '2/3-2.0e3i '2e-3-2/3i '-2.0e-2-2.0e-2i '+2.0e+2+2.0e+2i '+2/3-2/3i '2e2-2/3i '1e1-i '1.-i '.0+i '-.0-1e-1i '1.+.1i '0.-.1i '.1+.0i '1.+.0i '.1+.1i '1.-.1i '.0+.00i '.10+.0i '-1.+.0i '.1-.01i '1.0+.1i '1e1+.1i '-1.-.10i '1e01+.0i '0e11+.0i '1.e1+.0i '1.00-.0i '-1e1-.0i '1.-.1e0i '1.+.001i '1e10-.1i '1e+0-.1i '-0e0-.1i '-1.0e-1-1.0e-1i '-111e1-.1i '1.1-.1e11i '-1e-1-.11i '-1.1-.1e1i) (list 1.0 -1.0 1.0 0.1 -0.1 0.1 0.0 0.0 0.0 0.0 0.0 -0.0 0.0 1.1 -1.1 1.1 100.0 -100.0 100.0 0.011 -0.011 0.011 110.0 -110.0 110.0 0.5 -0.5 0.5 1.0 1.0 -1.0 -1.0 1.0 1.0 -1.0 -1.0 0.66666666666667 0.66666666666667 -0.66666666666667 1.0 1.0 0.66666666666667 2.3 0.66666666666667 200.0 200.0 200.0 1.0 200.0 0.66666666666667 0.002 -0.02 200.0 0.66666666666667 200.0 10.0 1.0 0.0 -0.0 1.0 0.0 0.1 1.0 0.1 1.0 0.0 0.1 -1.0 0.1 1.0 10.0 -1.0 10.0 0.0 10.0 1.0 -10.0 1.0 1.0 10000000000.0 1.0 -0.0 -0.1 -1110.0 1.1 -0.1 -1.1) (list 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 1.0 -1.0 -1.0 1.0 1.0 -1.0 -1.0 1.0 1.0 -1.0 1.0 0.66666666666667 -0.66666666666667 0.66666666666667 -0.66666666666667 -2.3 1000.0 -200.0 1.0 200.0 -0.2 -2000.0 -0.66666666666667 -0.02 200.0 -0.66666666666667 -0.66666666666667 -1.0 -1.0 1.0 -0.1 0.1 -0.1 0.0 0.0 0.1 -0.1 0.0 0.0 0.0 -0.01 0.1 0.1 -0.1 0.0 0.0 0.0 0.0 0.0 -0.1 0.001 -0.1 -0.1 -0.1 -0.1 -0.1 -10000000000.0 -0.11 -1.0)) (for-each (lambda (n name) (if (number? n) (begin (display "(number? ") (display name) (display ") returned #t?") (newline))) (if (or (not (symbol? n)) (boolean? n)) (begin (display "(symbol? ") (display name) (display ") returned #f?") (newline))) (if (number? (string->number name)) (begin (display "(string->number ") (display name) (display ") returned ") (display (string->number name)) (display "?") (newline)))) (list '1e '--1 '++1 '+. '+.+ '.. '.- '1e- '+ '- '-e1 '1/2/3 '1/2+/2 '/2 '2/ '1+2 '1/+i '1/2e1 '1/2. '1..0 '1.+0 '1--1 '1+- '1.0++i '1.0-ie++2 '1+1 '1.0. '1.0e '1ee2 '1.0e2e2 '1es2 '1e1.0 '1.0.0 '1/2.0 '1+i2 '1+1.0i0 '+.i 'i 'e 'e1 '1e.1 '1+.i '1.0e.1 '-.1ei '-1.0+1.0 '1.0+1.0i+1.0 '1.1/2 '1/2.0 '1/e '1/i 'e/i '1e2/3 '2/1e2 '1e2+1e2ii '1i-1.0 '1.0-i/2 '1/2i '2i/3 '2+/i '2+2/i '2+2/-i '2/- '2/+ '2/+3 '1e1.0 '1e1e2 '1+ie2 '1ei1 '1e/2 '0-- '1+ '1- '.1. '.1+ '1//2 '1/-/2 '1/2/ '1// '+/1 '.0. '+0ei '0e++i '+0e+i '0e+-i '+0e-i '+00ei '+.0ei '0+0ei '-01ei '+.1ei '1-1ei '-1.ei '0+.i '0-.i '1+e0i '1+/0i '1-/0i '1+e1i '1+/1i '10+.i '.0+.i '-0+.i '.1+.i '0.+.i '00-.i '.1-.i '1.-.i '1e++0i '1e--1i '.1e++i '+10e+i '1+0e+i '+01e+i '+0e+-i '.1e+-i '1-10ei '0e++00i '1e--.1i '1.e-+1i '1-0.e+i '1.+1e+i '-1.e--i '1.e+-.0i '1-e+01i '1-/101i '1+/10i '1-e10i '-1+e+1i '.1-e-1i '1-/0e1i '1e10+.i '1/1.1+i '1/11.+i '1/2e1-i '-1.0e-1-1-1.0e-1i '-1.0e-1-1.0e-1-1i '1.0e2/3 '-1e--1.e1i '-11e--1e1i '1e--1.1e1i '1.e-1-1.ei '-1.e--1.ei '-1.1e1-e1i '-1.e1-e-1i '.1e1-e-11i '3.-3. '1'2 '+-2 '1? '1a '1.a '-a '+a '1.. '..1 '-..1 '1ee1 '1ef2 '1+ief2 '1.+ '1.0- '1/2+/3 '1'2 '1-i. '1-ie '1... '1/1/1/1 '1//1 '-.e1 ) (list "1e" "--1" "++1" "+." "+.+" ".." ".-" "1e-" "+" "-" "-e1" "1/2/3" "1/2+/2" "/2" "2/" "1+2" "1/+i" "1/2e1" "1/2." "1..0" "1.+0" "1--1" "1+-" "1.0++i" "1.0-ie++2" "1+1" "1.0." "1.0e" "1ee2" "1.0e2e2" "1es2" "1e1.0" "1.0.0" "1/2.0" "1+i2" "1+1.0i0" "+.i" "i" "e" "e1" "1e.1" "1+.i" "1.0e.1" "-.1ei" "-1.0+1.0" "1.0+1.0i+1.0" "1.1/2" "1/2.0" "1/e" "1/i" "e/i" "1e2/3" "2/1e2" "1e2+1e2ii" "1i-1.0" "1.0-i/2" "1/2i" "2i/3" "2+/i" "2+2/i" "2+2/-i" "2/-" "2/+" "2/+3" "1e1.0" "1e1e2" "1+ie2" "1ei1" "1e/2" "0--" "1+" "1-" ".1." ".1+" "1//2" "1/-/2" "1/2/" "1//" "+/1" ".0." "+0ei" "0e++i" "+0e+i" "0e+-i" "+0e-i" "+00ei" "+.0ei" "0+0ei" "-01ei" "+.1ei" "1-1ei" "-1.ei" "0+.i" "0-.i" "1+e0i" "1+/0i" "1-/0i" "1+e1i" "1+/1i" "10+.i" ".0+.i" "-0+.i" ".1+.i" "0.+.i" "00-.i" ".1-.i" "1.-.i" "1e++0i" "1e--1i" ".1e++i" "+10e+i" "1+0e+i" "+01e+i" "+0e+-i" ".1e+-i" "1-10ei" "0e++00i" "1e--.1i" "1.e-+1i" "1-0.e+i" "1.+1e+i" "-1.e--i" "1.e+-.0i" "1-e+01i" "1-/101i" "1+/10i" "1-e10i" "-1+e+1i" ".1-e-1i" "1-/0e1i" "1e10+.i" "1/1.1+i" "1/11.+i" "1/2e1-i" "-1.0e-1-1-1.0e-1i" "-1.0e-1-1.0e-1-1i" "1.0e2/3" "-1e--1.e1i" "-11e--1e1i" "1e--1.1e1i" "1.e-1-1.ei" "-1.e--1.ei" "-1.1e1-e1i" "-1.e1-e-1i" ".1e1-e-11i" "3.-3." "'1'2" "'+-2" "'1?" "1a" "1.a" "-a" "+a" "1.." "..1" "-..1" "1ee1" "1ef2" "1+ief2" "1.+" "1.0-" "1/2+/3" "'1'2" "1-i." "1-ie" "1..." "1/1/1/1" "1//1" "-.e1" )) (let ((val (catch #t (lambda () (= 1 01 +1 1. 001 +01 1/1 1.0 1e0 01. +1. #b1 #o1 #x1 2/2 3/3 4/4 5/5 6/6 7/7 8/8 9/9 1E0 1e0 0001 +001 1/01 .1e1 01/1 +1/1 1.00 1e00 01.0 +1.0 1e+0 1e-0 01e0 +1e0 1.e0 001. +01. 1+0i 1-0i #b+1 #b01 #b1. #o+1 #o01 #o1. #x+1 #x01 #x1. +1E0 +1e0 +2/2 +3/3 +4/4 +5/5 +6/6 +7/7 +8/8 +9/9 .1E1 0001 001. 01.0 01/1 01E0 02/2 03/3 04/4 05/5 06/6 07/7 08/8 09/9 1.E0 1/01 1E+0 1E-0 1E00 2/02 3/03 4/04 5/05 6/06 7/07 8/08 9/09 11/11 00001 +0001 1/001 .1e01 01/01 +1/01 .1e+1 10e-1 0.1e1 +.1e1 .10e1 001/1 +01/1 10/10 1.000 1e000 01.00 +1.00 1e+00 1e-00 01e00 +1e00 1.e00 001.0 +01.0 01e+0 +1e+0 1.e+0 01e-0 +1e-0 1.e-0 001e0 +01e0 1.0e0 01.e0 +1.e0 0001. +001. 1+00i 1-00i 1+.0i 1-.0i 01+0i +1+0i 1.+0i 01-0i +1-0i 1.-0i 1+0.i 1-0.i 11/011 011/11 +11/11 000001 +00001 1/0001 .1e001 01/001 +1/001 .1e+01 10e-01 0.1e01 +.1e01 .10e01 001/01 +01/01 0.1e+1 +.1e+1 .10e+1 010e-1 +10e-1 10.e-1 00.1e1 +0.1e1 0.10e1 +.10e1 .100e1 0001/1 +001/1 10/010 010/10 +10/10 1.0000 1e0000 01.000 +1.000 1e+000 1e-000 01e000 +1e000 1.e000 001.00 +01.00 01e+00 +1e+00 1.e+00 01e-00 +1e-00 1.e-00 001e00 +01e00 1.0e00 01.e00 +1.e00 0001.0 +001.0 001e+0 +01e+0 1.0e+0 01.e+0 +1.e+0 001e-0 +01e-0 1.0e-0 01.e-0 +1.e-0 0001e0 +001e0 1.00e0 01.0e0 +1.0e0 001.e0 +01.e0 00001. +0001. 1+0e1i 1-0e1i 1+0/1i 1-0/1i 1+000i 1-000i 1+.00i 1-.00i 01+00i +1+00i 1.+00i 01-00i +1-00i 1.-00i 1+0.0i 1-0.0i 01+.0i +1+.0i 1.+.0i 01-.0i +1-.0i 1.-.0i 001+0i +01+0i 1/1+0i 1.0+0i 1e0+0i 01.+0i +1.+0i 001-0i +01-0i 1/1-0i 1.0-0i 1e0-0i 01.-0i +1.-0i 1+0e0i 1-0e0i 1+00.i 1-00.i 01+0.i +1+0.i 1.+0.i 01-0.i +1-0.i 1.-0.i 111/111 11/0011 011/011 +11/011 0011/11 +011/11 101/101 0000001 +000001 1/00001 .1e0001 01/0001 +1/0001 .1e+001 10e-001 0.1e001 +.1e001 .10e001 001/001 +01/001 0.1e+01 +.1e+01 .10e+01 010e-01 +10e-01 10.e-01 00.1e01 +0.1e01 0.10e01 +.10e01 .100e01 0001/01 +001/01 00.1e+1 +0.1e+1 0.10e+1 +.10e+1 .100e+1 0010e-1 +010e-1 10.0e-1 010.e-1 +10.e-1 000.1e1 +00.1e1 00.10e1 +0.10e1 0.100e1 +.100e1 .1000e1 00001/1 +0001/1 110/110 10/0010 010/010 +10/010 0010/10 +010/10 100/100 1.00000 1e00000 01.0000 +1.0000 1e+0000 1e-0000 01e0000 +1e0000 1.e0000 001.000 +01.000 01e+000 +1e+000 1.e+000 01e-000 +1e-000 1.e-000 001e000 +01e000 1.0e000 01.e000 +1.e000 0001.00 +001.00 001e+00 +01e+00 1.0e+00 01.e+00 +1.e+00 001e-00 +01e-00 1.0e-00 01.e-00 +1.e-00 0001e00 +001e00 1.00e00 01.0e00 +1.0e00 001.e00 +01.e00 00001.0 +0001.0 0001e+0 +001e+0 1.00e+0 01.0e+0 +1.0e+0 001.e+0 +01.e+0 0001e-0 +001e-0 1.00e-0 01.0e-0 +1.0e-0 001.e-0 +01.e-0 00001e0 +0001e0 1.000e0 01.00e0 +1.00e0 001.0e0 +01.0e0 0001.e0 +001.e0 000001. +00001. 1+0e11i 1-0e11i 1+0/11i 1-0/11i 1+0e01i 1-0e01i 1+0/01i 1-0/01i 1+0e+1i 1-0e+1i 1+0e-1i 1-0e-1i 1+00e1i 1-00e1i 1+.0e1i 1-.0e1i 01+0e1i +1+0e1i 1.+0e1i 01-0e1i +1-0e1i 1.-0e1i 1+0.e1i 1-0.e1i 1+00/1i 1-00/1i 01+0/1i +1+0/1i 1.+0/1i 01-0/1i +1-0/1i 1.-0/1i 1+0e10i 1-0e10i 1+0/10i 1-0/10i 1+0000i 1-0000i 1+.000i 1-.000i 01+000i +1+000i 1.+000i 01-000i +1-000i 1.-000i 1+0.00i 1-0.00i 01+.00i +1+.00i 1.+.00i 01-.00i +1-.00i 1.-.00i 001+00i +01+00i 1/1+00i 1.0+00i 1e0+00i 01.+00i +1.+00i 001-00i +01-00i 1/1-00i 1.0-00i 1e0-00i 01.-00i +1.-00i 1+0e00i 1-0e00i 1+00.0i 1-00.0i 01+0.0i +1+0.0i 1.+0.0i 01-0.0i +1-0.0i 1.-0.0i 001+.0i +01+.0i 1/1+.0i 1.0+.0i 1e0+.0i 01.+.0i +1.+.0i 001-.0i +01-.0i 1/1-.0i 1.0-.0i 1e0-.0i 01.-.0i +1.-.0i 0001+0i +001+0i 1/01+0i .1e1+0i 01/1+0i +1/1+0i 1.00+0i 1e00+0i 01.0+0i +1.0+0i 1e+0+0i 1e-0+0i 01e0+0i +1e0+0i 1.e0+0i 001.+0i +01.+0i 1+0e+0i 1-0e+0i 0001-0i +001-0i 1/01-0i .1e1-0i 01/1-0i +1/1-0i 1.00-0i 1e00-0i 01.0-0i +1.0-0i 1e+0-0i 1e-0-0i 01e0-0i +1e0-0i 1.e0-0i 001.-0i +01.-0i 1+0e-0i 1-0e-0i 1+00e0i 1-00e0i 1+.0e0i 1-.0e0i 01+0e0i +1+0e0i 1.+0e0i 01-0e0i +1-0e0i 1.-0e0i 1+0.e0i 1-0.e0i 1+000.i 1-000.i 01+00.i +1+00.i 1.+00.i 01-00.i +1-00.i 1.-00.i 001+0.i +01+0.i 1/1+0.i 1.0+0.i 1e0+0.i 01.+0.i +1.+0.i 001-0.i +01-0.i 1/1-0.i 1.0-0.i 1e0-0.i 01.-0.i +1.-0.i 111/0111 0111/111 +111/111 11/00011 011/0011 +11/0011 0011/011 +011/011 00011/11 +0011/11 101/0101 0101/101 +101/101 00000001 +0000001 1/000001 .1e00001 01/00001 +1/00001 .1e+0001 10e-0001 0.1e0001 +.1e0001 .10e0001 001/0001 +01/0001 0.1e+001 +.1e+001 .10e+001 010e-001 +10e-001 10.e-001 00.1e001 +0.1e001 0.10e001 +.10e001 .100e001 0001/001 +001/001 00.1e+01 +0.1e+01 0.10e+01 +.10e+01 .100e+01 0010e-01 +010e-01 10.0e-01 010.e-01 +10.e-01 000.1e01 +00.1e01 00.10e01 +0.10e01 0.100e01 +.100e01 .1000e01 00001/01 +0001/01 000.1e+1 +00.1e+1 00.10e+1 +0.10e+1 0.100e+1 +.100e+1 .1000e+1 00010e-1 +0010e-1 10.00e-1 010.0e-1 +10.0e-1 0010.e-1 +010.e-1 0000.1e1 +000.1e1 000.10e1 +00.10e1 00.100e1 +0.100e1 0.1000e1 +.1000e1 .10000e1 000001/1 +00001/1 110/0110 0110/110 +110/110 10/00010 010/0010 +10/0010 0010/010 +010/010 00010/10 +0010/10 100/0100 0100/100 +100/100 1.000000 1e000000 01.00000 +1.00000 1e+00000 1e-00000 01e00000 +1e00000 1.e00000 001.0000 +01.0000 01e+0000 +1e+0000 1.e+0000 01e-0000 +1e-0000 1.e-0000 001e0000 +01e0000 1.0e0000 01.e0000 +1.e0000 0001.000 +001.000 001e+000 +01e+000 1.0e+000 01.e+000 +1.e+000 001e-000 +01e-000 1.0e-000 01.e-000 +1.e-000 0001e000 +001e000 1.00e000 01.0e000 +1.0e000 001.e000 +01.e000 00001.00 +0001.00 0001e+00 +001e+00 1.00e+00 01.0e+00 +1.0e+00 001.e+00 +01.e+00 0001e-00 +001e-00 1.00e-00 01.0e-00 +1.0e-00 001.e-00 +01.e-00 00001e00 +0001e00 1.000e00 01.00e00 +1.00e00 001.0e00 +01.0e00 0001.e00 +001.e00 000001.0 +00001.0 00001e+0 +0001e+0 1.000e+0 01.00e+0 +1.00e+0 001.0e+0 +01.0e+0 0001.e+0 +001.e+0 00001e-0 +0001e-0 1.000e-0 01.00e-0 +1.00e-0 001.0e-0 +01.0e-0 0001.e-0 +001.e-0 000001e0 +00001e0 1.0000e0 01.000e0 +1.000e0 001.00e0 +01.00e0 0001.0e0 +001.0e0 00001.e0 +0001.e0 0000001. +000001.)) (lambda args 'error)))) (if (not (eq? val #t)) (format #t ";funny 1's are not all equal to 1? ~A~%" val))) (num-test (string->number "2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427") 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427) ;; from testbase-report.ps Vern Paxson (with some changes) ;; resultant strings are thanks to clisp (let ((cases (list (list '(* 49517601571415211 (expt 2 -94)) "2.5e-12") (list '(* 49517601571415211 (expt 2 -95)) "1.25e-12") (list '(* 54390733528642804 (expt 2 -133)) "4.995e-24") (list '(* 71805402319113924 (expt 2 -157)) "3.9305e-31") (list '(* 40435277969631694 (expt 2 -179)) "5.27705e-38") (list '(* 57241991568619049 (expt 2 -165)) "1.223955e-33") (list '(* 65224162876242886 (expt 2.0 58)) "1.8799585e+34") (list '(* 70173376848895368 (expt 2 -138)) "2.01387715e-25") (list '(* 37072848117383207 (expt 2 -99)) "5.849064105e-14") (list '(* 56845051585389697 (expt 2 -176)) "5.9349003055e-37") (list '(* 54791673366936431 (expt 2 -145)) "1.22847180395e-27") (list '(* 66800318669106231 (expt 2 -169)) "8.927076718085e-35") (list '(* 66800318669106231 (expt 2 -170)) "4.4635383590425e-35") (list '(* 66574323440112438 (expt 2 -119)) "1.00169908625495e-19") (list '(* 65645179969330963 (expt 2 -173)) "5.482941262802465e-36") (list '(* 61847254334681076 (expt 2 -109)) "9.529078328103644e-17") (list '(* 39990712921393606 (expt 2 -145)) "8.966227936640557e-28") (list '(* 59292318184400283 (expt 2 -149)) "8.308623441805854e-29") (list '(* 69116558615326153 (expt 2 -143)) "6.1985873566126555e-27") (list '(* 69116558615326153 (expt 2 -144)) "3.0992936783063277e-27") (list '(* 39462549494468513 (expt 2 -152)) "6.912351250617602e-30") (list '(* 39462549494468513 (expt 2 -153)) "3.456175625308801e-30") (list '(* 50883641005312716 (expt 2 -172)) "8.5e-36") (list '(* 38162730753984537 (expt 2 -170)) "2.55e-35") (list '(* 50832789069151999 (expt 2 -101)) "2.005e-14") (list '(* 51822367833714164 (expt 2 -109)) "7.984499999999999e-17") (list '(* 66840152193508133 (expt 2 -172)) "1.11655e-35") (list '(* 55111239245584393 (expt 2 -138)) "1.581615e-25") (list '(* 71704866733321482 (expt 2 -112)) "1.3809855e-17") (list '(* 67160949328233173 (expt 2 -142)) "1.20464045e-26") (list '(* 53237141308040189 (expt 2 -152)) "9.325140545e-30") (list '(* 62785329394975786 (expt 2 -112)) "1.2092014595e-17") (list '(* 48367680154689523 (expt 2 -77)) "3.20070458385e-07") (list '(* 42552223180606797 (expt 2 -102)) "8.391946324355e-15") (list '(* 63626356173011241 (expt 2 -112)) "1.2253990460585e-17") (list '(* 43566388595783643 (expt 2 -99)) "6.87356414897605e-14") (list '(* 54512669636675272 (expt 2 -159)) "7.459816430480385e-32") (list '(* 52306490527514614 (expt 2 -167)) "2.7960588398142556e-34") (list '(* 52306490527514614 (expt 2 -168)) "1.3980294199071278e-34") (list '(* 41024721590449423 (expt 2 -89)) "6.627901237305737e-11") (list '(* 37664020415894738 (expt 2 -132)) "6.917788004396807e-24") (list '(* 37549883692866294 (expt 2 -93)) "3.791569310834971e-12") (list '(* 69124110374399839 (expt 2 -104)) "3.408081767659137e-15") (list '(* 69124110374399839 (expt 2 -105)) "1.7040408838295685e-15") (list '(* 9 (expt 10 26)) "9e+26") (list '(* 79 (expt 10 -8)) "7.9e-07") (list '(* 393 (expt 10.0 26)) "3.93e+28") (list '(* 9171 (expt 10 -40)) "9.171e-37") (list '(* 56257 (expt 10 -16)) "5.6257e-12") (list '(* 281285 (expt 10 -17)) "2.81285e-12") (list '(* 4691113 (expt 10 -43)) "4.691113e-37") (list '(* 29994057 (expt 10 -15)) "2.9994057e-08") (list '(* 834548641 (expt 10 -46)) "8.34548641e-38") (list '(* 1058695771 (expt 10 -47)) "1.058695771e-38") (list '(* 87365670181 (expt 10 -18)) "8.7365670181e-08") (list '(* 872580695561 (expt 10 -36)) "8.72580695561e-25") (list '(* 6638060417081 (expt 10 -51)) "6.638060417081e-39") (list '(* 88473759402752 (expt 10 -52)) "8.8473759402752e-39") (list '(* 412413848938563 (expt 10 -27)) "4.12413848938563e-13") (list '(* 5592117679628511 (expt 10 -48)) "5.592117679628511e-33") (list '(* 83881765194427665 (expt 10 -50)) "8.388176519442766e-34") ;(list '(* 638632866154697279 (expt 10 -35)) "6.3863286615469725e-18") ;(list '(* 3624461315401357483 (expt 10 -53)) "3.6244613154013574e-35") ;(list '(* 75831386216699428651 (expt 10 -30)) "7.583138621669942e-11") ;(list '(* 356645068918103229683 (expt 10 -42)) "3.566450689181032e-22") ;(list '(* 7022835002724438581513 (expt 10 -33)) "7.022835002724439e-12") (list '(* 7 (expt 10 -27)) "7e-27") (list '(* 37 (expt 10 -29)) "3.7e-28") (list '(* 743 (expt 10 -18)) "7.43e-16") (list '(* 7861 (expt 10 -33)) "7.861e-30") (list '(* 46073 (expt 10 -30)) "4.6073e-26") (list '(* 774497 (expt 10 -34)) "7.74497e-29") (list '(* 8184513 (expt 10 -33)) "8.184513e-27") (list '(* 89842219 (expt 10 -28)) "8.9842219e-21") (list '(* 449211095 (expt 10 -29)) "4.49211095e-21") (list '(* 8128913627 (expt 10 -40)) "8.128913627e-31") (list '(* 87365670181 (expt 10 -18)) "8.7365670181e-08") (list '(* 436828350905 (expt 10 -19)) "4.36828350905e-08") (list '(* 5569902441849 (expt 10 -49)) "5.569902441849e-37") (list '(* 60101945175297 (expt 10 -32)) "6.0101945175297e-19") (list '(* 754205928904091 (expt 10 -51)) "7.54205928904091e-37") (list '(* 5930988018823113 (expt 10 -37)) "5.930988018823113e-22") (list '(* 51417459976130695 (expt 10 -27)) "5.14174599761307e-11") (list '(* 826224659167966417 (expt 10 -41)) "8.262246591679665e-24") ;(list '(* 9612793100620708287 (expt 10 -57)) "9.612793100620708e-39") ;(list '(* 93219542812847969081 (expt 10 -39)) "9.321954281284797e-20") ;(list '(* 544579064588249633923 (expt 10 -48)) "5.445790645882496e-28") ;(list '(* 4985301935905831716201 (expt 10 -48)) "4.9853019359058315e-27") (list '(* 12676506 (expt 2 -102)) "2.499999999549897e-24") (list '(* 12676506 (expt 2 -103)) "1.2499999997749484e-24") (list '(* 15445013 (expt 2.0 86)) "1.1949999999989506e+33") (list '(* 13734123 (expt 2 -138)) "3.941499999999621e-35") (list '(* 12428269 (expt 2 -130)) "9.13084999999985e-33") (list '(* 15334037 (expt 2 -146)) "1.719004999999994e-37") (list '(* 11518287 (expt 2 -41)) "5.237910499999998e-06") (list '(* 12584953 (expt 2 -145)) "2.82164405e-37") (list '(* 15961084 (expt 2 -125)) "3.752432815e-31") (list '(* 14915817 (expt 2 -146)) "1.6721209165e-37") (list '(* 10845484 (expt 2 -102)) "2.13889458145e-24") (list '(* 16431059 (expt 2 -61)) "7.125835945615e-12") (list '(* 16093626 (expt 2.0 69)) "9.500000001279935e+27") (list '(* 9983778 (expt 2.0 25)) "335000000004096.0") (list '(* 12745034 (expt 2.0 104)) "2.5850000000046706e+38") (list '(* 12706553 (expt 2.0 72)) "6.000500000000674e+28") (list '(* 11005028 (expt 2.0 45)) "3.8720500000001465e+20") (list '(* 15059547 (expt 2.0 71)) "3.555835000000006e+28") (list '(* 16015691 (expt 2 -99)) "2.5268305000000024e-23") (list '(* 8667859 (expt 2.0 56)) "6.24585065e+23") (list '(* 14855922 (expt 2 -82)) "3.072132665e-18") (list '(* 14855922 (expt 2 -83)) "1.5360663325e-18") (list '(* 10144164 (expt 2 -110)) "7.81477968335e-27") (list '(* 13248074 (expt 2.0 95)) "5.248102799365e+35") (list '(* 5 (expt 10 -20)) "5e-20") (list '(* 67 (expt 10.0 14)) "6.7e+15") (list '(* 985 (expt 10.0 15)) "9.85e+17") (list '(* 7693 (expt 10 -42)) "7.693e-39") (list '(* 55895 (expt 10 -16)) "5.5895e-12") (list '(* 996622 (expt 10 -44)) "9.96622e-39") (list '(* 7038531 (expt 10 -32)) "7.038531e-26") (list '(* 60419369 (expt 10 -46)) "6.0419369e-39") (list '(* 702990899 (expt 10 -20)) "7.02990899e-12") (list '(* 6930161142 (expt 10 -48)) "6.930161142e-39") (list '(* 25933168707 (expt 10.0 13)) "2.5933168707e+23") (list '(* 596428896559 (expt 10.0 20)) "5.96428896559e+31") (list '(* 3 (expt 10 -23)) "3e-23") (list '(* 57 (expt 10.0 18)) "5.7e+19") (list '(* 789 (expt 10 -35)) "7.89e-33") (list '(* 2539 (expt 10 -18)) "2.539e-15") (list '(* 76173 (expt 10.0 28)) "7.6173e+32") (list '(* 887745 (expt 10 -11)) "8.87745e-06") (list '(* 5382571 (expt 10 -37)) "5.382571e-31") (list '(* 82381273 (expt 10 -35)) "8.2381273e-28") (list '(* 750486563 (expt 10 -38)) "7.50486563e-30") (list '(* 3752432815 (expt 10 -39)) "3.752432815e-30") (list '(* 75224575729 (expt 10 -45)) "7.5224575729e-35") (list '(* 459926601011 (expt 10.0 15)) "4.59926601011e+26") ; 10.0 (and 2.0 above) because we aren't interested here in numeric overflows ))) (let ((maxdiff 0.0) (maxdiff-case ())) (do ((lst cases (cdr lst))) ((null? lst)) (let* ((form (caar lst)) (str (cadar lst)) (num (eval form)) (fnum (* 1.0 num)) (n2s (number->string fnum)) (s2n (string->number n2s)) (mnum (string->number str)) (diff (let () (if (not (string? n2s)) (format #t "(number->string ~A) #f?~%" fnum)) (if (not (number? s2n)) (format #t "(string->number ~S) #f?~%" n2s)) (/ (abs (- mnum s2n)) (max (expt 2 -31.0) (abs fnum)))))) (if (> diff maxdiff) (begin (set! maxdiff diff) (set! maxdiff-case (car lst)))))) (if (> maxdiff 1e-15) ; we're only interested in real problems (format #t ";number->string rounding checks worst case relative error ~A ~A ~S~%" maxdiff (car maxdiff-case) (cadr maxdiff-case))) )) #| ;;; here's code to generate all (im)possible numbers (using just a few digits) of a given length (define file (open-output-file "ntest.scm")) (define chars (list #\1 #\0 #\9 #\# #\. #\+ #\- #\/ #\b #\x #\o #\e)) (define (all-syms len with-file) (let ((sym (make-string len)) (num-chars (length chars)) (ctrs (make-vector len 0))) (do ((i 0 (+ i 1))) ((= i (expt num-chars len))) (let ((carry #t)) (do ((k 0 (+ k 1))) ((or (= k len) (not carry))) (vector-set! ctrs k (+ 1 (vector-ref ctrs k))) (if (= (vector-ref ctrs k) num-chars) (vector-set! ctrs k 0) (set! carry #f))) (do ((k 0 (+ k 1))) ((= k len)) (string-set! sym k (list-ref chars (vector-ref ctrs k))))) (let ((tag (catch #t (lambda () (string->number sym)) (lambda args (car args))))) (if (not with-file) (if (and (number? tag) (= tag 1)) (format #t "~S " sym)) (begin (if (number? tag) (format file "(if (not (number? (string->number ~S))) (begin (display ~S) (display #\\space)))" sym sym) (format file "(if (number? (string->number ~S)) (begin (display ~S) (display #\\space)))" sym sym)) (newline file))))))) (do ((len 1 (+ len 1))) ((= len 12)) (all-syms len #f)) (close-output-port file) |# (let () (define (~ !) (* 2 !)) (test (~ 3) 6) (define (~~ !) (* 2 !)) (test (~~ 3) 6) (define (\x00 !) (* 2 !)) (test (\x00 3) 6)) (for-each (lambda (n name) (if (number? n) (format #t ";(number? ~A) returned #t?~%" name))) (list 'a9 'aa 'aA 'a! 'a$ 'a% 'a& 'a* 'a+ 'a- 'a. 'a/ 'a: 'a< 'a= 'a> 'a? 'a@ 'a^ 'a_ 'a~ 'A9 'Aa 'AA 'A! 'A$ 'A% 'A& 'A* 'A+ 'A- 'A. 'A/ 'A: 'A< 'A= 'A> 'A? 'A@ 'A^ 'A_ 'A~ '!9 '!a '!A '!! '!$ '!% '!& '!* '!+ '!- '!. '!/ '!: '!< '!= '!> '!? '!@ '!^ '!_ '!~ '$9 '$a '$A '$! '$$ '$% '$& '$* '$+ '$- '$. '$/ '$: '$< '$= '$> '$? '$@ '$^ '$_ '$~ '%9 '%a '%A '%! '%$ '%% '%& '%* '%+ '%- '%. '%/ '%: '%< '%= '%> '%? '%@ '%^ '%_ '%~ '&9 '&a '&A '&! '&$ '&% '&& '&* '&+ '&- '&. '&/ '&: '&< '&= '&> '&? '&@ '&^ '&_ '&~ '*9 '*a '*A '*! '*$ '*% '*& '** '*+ '*- '*. '*/ '*: '*< '*= '*> '*? '*@ '*^ '*_ '*~ '/9 '/a '/A '/! '/$ '/% '/& '/* '/+ '/- '/. '// '/: '/< '/= '/> '/? '/@ '/^ '/_ '/~ ':9 ':a ':A ':! ':$ ':% ':& ':* ':+ ':- ':. ':/ ':: ':< ':= ':> ':? ':@ ':^ ':_ ':~ '<9 ' '=? '=@ '=^ '=_ '=~ '>9 '>a '>A '>! '>$ '>% '>& '>* '>+ '>- '>. '>/ '>: '>< '>= '>> '>? '>@ '>^ '>_ '>~ '?9 '?a '?A '?! '?$ '?% '?& '?* '?+ '?- '?. '?/ '?: '?< '?= '?> '?? '?@ '?^ '?_ '?~ '^9 '^a '^A '^! '^$ '^% '^& '^* '^+ '^- '^. '^/ '^: '^< '^= '^> '^? '^@ '^^ '^_ '^~ '_9 '_a '_A '_! '_$ '_% '_& '_* '_+ '_- '_. '_/ '_: '_< '_= '_> '_? '_@ '_^ '__ '_~ '~9 '~a '~A '~! '~$ '~% '~& '~* '~+ '~- '~. '~/ '~: '~< '~= '~> '~? '~@ '~^ '~_ '~~) (list "'a9" "'aa" "'aA" "'a!" "'a$" "'a%" "'a&" "'a*" "'a+" "'a-" "'a." "'a/" "'a:" "'a<" "'a=" "'a>" "'a?" "'a@" "'a^" "'a_" "'a~" "'A9" "'Aa" "'AA" "'A!" "'A$" "'A%" "'A&" "'A*" "'A+" "'A-" "'A." "'A/" "'A:" "'A<" "'A=" "'A>" "'A?" "'A@" "'A^" "'A_" "'A~" "'!9" "'!a" "'!A" "'!!" "'!$" "'!%" "'!&" "'!*" "'!+" "'!-" "'!." "'!/" "'!:" "'!<" "'!=" "'!>" "'!?" "'!@" "'!^" "'!_" "'!~" "'$9" "'$a" "'$A" "'$!" "'$$" "'$%" "'$&" "'$*" "'$+" "'$-" "'$." "'$/" "'$:" "'$<" "'$=" "'$>" "'$?" "'$@" "'$^" "'$_" "'$~" "'%9" "'%a" "'%A" "'%!" "'%$" "'%%" "'%&" "'%*" "'%+" "'%-" "'%." "'%/" "'%:" "'%<" "'%=" "'%>" "'%?" "'%@" "'%^" "'%_" "'%~" "'&9" "'&a" "'&A" "'&!" "'&$" "'&%" "'&&" "'&*" "'&+" "'&-" "'&." "'&/" "'&:" "'&<" "'&=" "'&>" "'&?" "'&@" "'&^" "'&_" "'&~" "'*9" "'*a" "'*A" "'*!" "'*$" "'*%" "'*&" "'**" "'*+" "'*-" "'*." "'*/" "'*:" "'*<" "'*=" "'*>" "'*?" "'*@" "'*^" "'*_" "'*~" "'/9" "'/a" "'/A" "'/!" "'/$" "'/%" "'/&" "'/*" "'/+" "'/-" "'/." "'//" "'/:" "'/<" "'/=" "'/>" "'/?" "'/@" "'/^" "'/_" "'/~" "':9" "':a" "':A" "':!" "':$" "':%" "':&" "':*" "':+" "':-" "':." "':/" "'::" "':<" "':=" "':>" "':?" "':@" "':^" "':_" "':~" "'<9" "'" "'" "'=?" "'=@" "'=^" "'=_" "'=~" "'>9" "'>a" "'>A" "'>!" "'>$" "'>%" "'>&" "'>*" "'>+" "'>-" "'>." "'>/" "'>:" "'><" "'>=" "'>>" "'>?" "'>@" "'>^" "'>_" "'>~" "'?9" "'?a" "'?A" "'?!" "'?$" "'?%" "'?&" "'?*" "'?+" "'?-" "'?." "'?/" "'?:" "'?<" "'?=" "'?>" "'??" "'?@" "'?^" "'?_" "'?~" "'^9" "'^a" "'^A" "'^!" "'^$" "'^%" "'^&" "'^*" "'^+" "'^-" "'^." "'^/" "'^:" "'^<" "'^=" "'^>" "'^?" "'^@" "'^^" "'^_" "'^~" "'_9" "'_a" "'_A" "'_!" "'_$" "'_%" "'_&" "'_*" "'_+" "'_-" "'_." "'_/" "'_:" "'_<" "'_=" "'_>" "'_?" "'_@" "'_^" "'__" "'_~" "'~9" "'~a" "'~A" "'~!" "'~$" "'~%" "'~&" "'~*" "'~+" "'~-" "'~." "'~/" "'~:" "'~<" "'~=" "'~>" "'~?" "'~@" "'~^" "'~_" "'~~")) ;(let ((initial-chars "aA!$%&*/:<=>?^_~") ; (subsequent-chars "9aA!$%&*+-./:<=>?@^_~")) ; (do ((i 0 (+ i 1))) ; ((= i (string-length initial-chars))) ; (do ((k 0 (+ k 1))) ; ((= k (string-length subsequent-chars))) ; (format #t "'~A " (string (string-ref initial-chars i) (string-ref subsequent-chars k)))))) (for-each (lambda (z) (if (not (zero? z)) (format #t "~A is not zero?~%" z)) (if (and (real? z) (positive? z)) (format #t "~A is positive?~%" z)) (if (and (real? z) (negative? z)) (format #t "~A is negative?~%" z))) '(0 -0 +0 0.0 -0.0 +0.0 0/1 -0/1 +0/24 0+0i 0-0i -0-0i +0-0i 0.0-0.0i -0.0+0i #b0 #o-0 #x000 000/111)) (for-each (lambda (x) (if (string->number x) (format #t ";(string->number ~A) returned ~A~%" x (string->number x)))) '("" "q" "1q" "6+7iq" "8+9q" "10+11" "13+" "18@19q" "20@q" "23@" "+25iq" "26i" "-q" "-iq" "i" "5#.0" "8/" "10#11" ".#" "." "3.4q" "15.16e17q" "18.19e+q" ".q" ".17#18" "10q" "#b2" "#b12" "#b-12" "#b3" "#b4" "#b5" "#b6" "#b7" "#b8" "#b9" "#ba" "#bb" "#bc" "#bd" "#be" "#bf" "#q" "#xag" "#x1x" "#o8" "#o9" "#o#" "-#b1" "+#b1" "#b1/#b2" "#b1+#b1i" "1+#bi" "1+#b1i" "1#be1" "#b" "#o" "#" "1+ie1" "1+i1" "1e+1i" "#b#b" "1e3e4" "1.0e-3e+4" "1e3s" "1e3s3" "1e-i" "#be1" "1/i" "1/e1" "1+e1" "1e+" "1e1+" "1e1e1" "1e-+1" "1e0x1" "1e-" "1/#o2" "-#xae" "-#o-7" "12@12i")) (for-each (lambda (couple) (apply (lambda (x y) (let ((xx (string->number x))) (if (or (not xx) (not y) (and (rational? y) (not (eqv? xx y))) (> (abs (- xx y)) 1e-12)) (format #t ";(string->number ~A) returned ~A but expected ~A (~A ~A ~A ~A)~%" x (string->number x) y xx (eq? xx #f) (if (and xx y) (and (rational? y) (not (eqv? xx y))) #f) (if (and xx y) (abs (- xx y)) #f))))) couple)) '( ("#b0" 0) ("#b1" 1) ("#o0" 0) ("#b-1" -1) ("#b+1" 1) ("#o1" 1) ("#o2" 2) ("#o3" 3) ("#o-1" -1) ("#o4" 4) ("#o5" 5) ("#o6" 6) ("#o7" 7) ("#xa" 10) ("#xb" 11) ("#x-1" -1) ("#x-a" -10) ("#xc" 12) ("#xd" 13) ("#xe" 14) ("#xf" 15) ("#x-abc" -2748) ("#b1010" 10) ("#o12345670" 2739128) ("#x1234567890abcdef" 1311768467294899695) ("1" 1) ("23" 23) ("-1" -1) ("-45" -45) ;("2#" 20.0) ("2##" 200.0) ("12##" 1200.0) ; this # = 0 is about the stupidest thing I've ever seen ("#xA" 10) ("#xB" 11) ("#x-1" -1) ("#x-A" -10) ("#xC" 12) ("#xD" 13) ("#xE" 14) ("#xF" 15) ("#x-ABC" -2748) ("#xaBC" 2748) ("#xAbC" 2748) ("#xabC" 2748) ("#xABc" 2748) ("1/1" 1) ("1/2" 1/2) ("-1/2" -1/2) ("1e2" 100.0) ("1e+2" 100.0) ("1e-2" 0.01) (".1" .1) (".0123456789" 123456789e-10) (".0123456789e10" 123456789.0) ("3." 3.0) ("3.e0" 3.0) ("1+i" 1+1i) ("1-i" 1-1i) )) ;;; some schemes are case insensitive throughout -- they accept 0+I, #X11 etc (for-each (lambda (arg) (test (string->number arg) 'error)) (list -1 #f #\a 1 _ht_ _undef_ _null_ _c_obj_ #(1 2 3) 3.14 3/4 1.0+1.0i () 'hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1))) (for-each (lambda (arg) (test (string->number "123" arg) 'error) (test (string->number "1" arg) 'error)) (list -1 0 1 17 #f _ht_ _undef_ _null_ _c_obj_ #\a #(1 2 3) 3.14 3/4 1.5+0.3i 1+i () "" "12" #() :hi most-positive-fixnum most-negative-fixnum 'hi abs #(()) (list 1 2 3) '(1 . 2) (lambda () 1))) ;; (string->number "0" 1) ?? why not? (for-each (lambda (arg) (test (number->string arg) 'error)) (list #\a #(1 2 3) () _ht_ _undef_ _null_ _c_obj_ 'hi abs "hi" #(()) #f (list 1 2 3) '(1 . 2) (lambda () 1))) (for-each (lambda (arg) (test (number->string 123 arg) 'error)) (list -1 17 most-positive-fixnum most-negative-fixnum 0 1 512 _ht_ _undef_ _null_ _c_obj_ #\a #f #(1 2 3) 3.14 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1))) (test (string->number "34.1" (+ 5 (expt 2 32))) 'error) (test (number->string 34.1 (+ 5 (expt 2 32))) 'error) (test (string->number) 'error) (test (string->number 'symbol) 'error) (test (string->number "1.0" "1.0") 'error) (test (number->string) 'error) (test (number->string "hi") 'error) (test (number->string 1.0+23.0i 1.0+23.0i 1.0+23.0i) 'error) (test (string->number "") #f) (test (string->number "" 8) #f) (test (string->number (make-string 0)) #f) (test (string->number (string #\null)) #f) (test (string->number (string)) #f) (test (string->number (substring "hi" 0 0)) #f) (test (string->number (string (integer->char 30))) #f) (test (string->number "123" 10+0i) 'error) ; a real in s7 (when with-bignums (test (number->string -46116860184273879035/27670116110564327424) "-46116860184273879035/27670116110564327424") (test (number->string 123 (bignum "10")) "123") (test (number->string 123 (bignum "2")) "1111011") (test (string->number "123" (bignum "10")) 123) (test (string->number "1111011" (bignum "2")) 123) (test (number->string 123 (bignum "17")) 'error) (test (number->string 123 (bignum "-1")) 'error) (test (number->string 123 (bignum "1")) 'error) (test (number->string 123 (bignum "1/2")) 'error) (test (string->number "101" (bignum "17")) 'error) (test (string->number "101" (bignum "1")) 'error) (test (string->number "101" (bignum "-1")) 'error) (test (string->number "101" (bignum "1/2")) 'error)) (num-test (- (string->number "11880772664.84631001" 10) (string->number "1.188077266484631001E10" 10)) 0.0) (num-test (- (string->number "11880772.66484631001" 10) (string->number "1.188077266484631001E7" 10)) 0.0) (if with-bignums (num-test (- (string->number "118807726648463.1001" 10) (string->number "1.188077266484631001E14" 10)) 0.0) (test (> (abs (- (string->number "118807726648463.1001" 10) (string->number "1.188077266484631001E14" 10))) 1e-1) #f)) (if with-bignums (num-test (- (string->number "118807726648463.1001" 9) (string->number "1.188077266484631001E14" 9)) 0.0) (test (> (abs (- (string->number "118807726648463.1001" 9) (string->number "1.188077266484631001E14" 9))) 1e-1) #f)) (num-test (- (string->number "11880772664.84631001" 9) (string->number "1.188077266484631001E10" 9)) 0.0) (num-test (- (string->number "11880772.66484631001" 9) (string->number "1.188077266484631001E7" 9)) 0.0) #| (num-test (- (string->number "1188077266484631001.") (string->number "1.188077266484631001E18")) 0.0) (num-test (- (string->number "1188077266484631001." 10) (string->number "1.188077266484631001E18" 10)) 0.0) (num-test (- (string->number "118807726648463100.1" 10) (string->number "1.188077266484631001E17" 10)) 0.0) (num-test (- (string->number "118807726648463100100." 9) (string->number "1.188077266484631001E20" 9)) 0.0) (num-test (- (string->number "1188077266484631001." 9) (string->number "1.188077266484631001E18" 9)) 0.0) (num-test (- (string->number "118807726648463100.1" 9) (string->number "1.188077266484631001E17" 9)) 0.0) ;; (num-test (- (string->number "1177077266474631001000." 8) (string->number "1.177077266474631001E21" 8)) 0.0) ;; a fake unfortunately -- actually all of these are not what they appear to be |# (num-test 111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111e-300 1.111111111111111111111111111111111111113E-1) (num-test 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0) (num-test 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e309 1.0) (num-test 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123e309 1.23) (num-test -.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123456e312 -1234.56) (num-test (string->number "111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111e-300") 1.111111111111111111111111111111111111113E-1) (num-test (string->number "0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300") 1.0) (num-test (string->number "0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e309") 1.0) (num-test (string->number "0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123e309") 1.23) (num-test (string->number "-.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000123456e312") -1234.56) (num-test #b0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0) (num-test #o0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0) (num-test #x0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e300 1.0) (num-test 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001e600 10.0) (num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1.0) (num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1.0) (num-test -1234000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 -1.234) (num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300") 1.0) (num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") 1.0) (num-test (string->number "-1234000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") -1.234) (num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300 1.0) (num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-300") 1.0) (num-test 1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309 1.0) (num-test (string->number "1000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e-309") 1.0) (num-test (string->number "7218817.36503571385593731949749063134519967478471341285646368059547752954588980538968510599079437e7") 7.218817365035713855937319497490631345183E13) (num-test (string->number "-8209943b.31283867353472bb21b" 12) -2.928292312585025742274395996260284298851E8) (test (string->number "-8209943b.31283867353472bc21b" 12) #f) (num-test (string->number "-25708892.1b6583269007366320788640bb79398b32a42" 12) -8.835044616346879740283599816201349374646E7) (test (string->number "-25708892.1b6583269007366320788640bb79398b32ac2" 12) #f) (num-test (string->number "9418.b89a40b0211a01147b75b23a529b0382775b32b+45936610b.a936586185a57b00ba4a90a139343235054b2i" 12) 1.614897792919114090019672485580641433273E4+1.926841115897881740778679262842131716289E9i) (num-test (string->number "1.0e0000000000000000000000000000000000001") 10.0) (num-test 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 10.0) (num-test (string->number "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001") 10.0) (num-test (string->number "\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 1.00000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 00e0000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0000000000000000000000000000000000000000\ 0001") 10.0) ;;; this whitespace handling only works in string constants in s7, not in arbitrary code. (num-test 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 1) (num-test (string->number "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001/00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001") 1) #| ;;; if not gmp: :(string->number "0.999999999999999") 1.0 :(number->string 0.999999999999999) "1.0" also :(string->number ".0999999999999995") 0.099999999999999 :(string->number ".0999999999999996") 0.1 :(string->number ".0fffffffffff" 16) 0.062499999999996 :(string->number ".0ffffffffffff" 16) 0.0625 but :(number->string 0.062499999999996 16) "0.0ffffffffffee" :(number->string (string->number ".0fffffffffff" 16) 16) "0.0fffffffffff" the 0.624... version is actually an approximation (off by 4.4408920985006e-16) :(number->string 0.062499999999996 16) "0.0ffffffffffedfc506118a9ea64de0c590" more non-gmp: :9999999999999999999 -8446744073709551617 :9999999999999999991 -8446744073709551625 :-9999999999999999991 8446744073709551625 :9223372036854775810 -9223372036854775806 etc |# (when with-bignums (test (char=? ((number->string 9.999999999999999) 0) #\9) #t) (test (char=? ((number->string 0.999999999999999999) 3) #\9) #t) (num-test -0.1e309 -1e308) (num-test .01e310 1e308) (num-test .1e310 1e309) (num-test 0.0e310 0.0)) ;;; -------------------------------------------------------------------------------- ;;; bignum ;;; bignum? ;;; -------------------------------------------------------------------------------- (when with-bignums (test (bignum? (bignum "2")) #t) (test (bignum (bignum 1)) 1) (num-test (bignum "6/3") 2) (num-test (bignum "+3/6") 1/2) (num-test (bignum "7447415382/3") 2482471794) (for-each (lambda (n) (test (bignum? n) #f)) (list 0 1 -1 1/3 1.0 1+i 1073741824 1.0e8 1+1.0e8i "hi" () (integer->char 65) #f #t '(1 2) 'a-symbol _ht_ _undef_ _null_ _c_obj_ (cons 1 2) (make-vector 3) abs)) (for-each (lambda (n) (test (bignum? n) #t)) (list 1.0e30 -1.0e20+i 1.0+1.0e80i 1e100 1267650600228229401496703205376 -1267650600228229401496703205376 1180591620717411303424/3 3/1180591620717411303424 1180591620717411303424/1180591620717411303423 1267650600228229401496703205376.99 -1267650600228229401496703205376.88 0.1231231231231231231231231231)) (for-each (lambda (n) (test (bignum n) 'error) (test (bignum "1.0" n) 'error)) (list "hi" (integer->char 65) #f #t '(1 2) 'a-symbol (cons 1 2) () _ht_ _undef_ _null_ _c_obj_ (make-vector 3) abs)) (test (bignum?) 'error) (test (bignum? 1 2) 'error) (test (bignum? 1) #f) (test (bignum? (bignum 1)) #t) (test (bignum? (bignum 1/2)) #t) (test (bignum? (bignum 1.5)) #t) (test (bignum? (bignum 1+i)) #t) (test (bignum) 'error) (test (bignum "hi" "ho") 'error) (test (bignum "") 'error) (test (bignum " ") 'error) (test (bignum " 1 ") 'error) (test (bignum "abc") 'error) (test (bignum "1/2/3") 'error) (test (bignum "1.0") (bignum 1.0))) ;;; coverage tests for relops ;;; from: #| (define ops '(= < > <= >=)) (define args '(1 -1 1/2 -1/2 1.5 -1.5 1+i 1-i m1)) (define real-args '(1 -1 1/2 -1/2 1.5 -1.5 m1)) (require mockery.scm) (define m1 ((*mock-number* 'mock-number) 3)) (call-with-output-file "tdata.scm" (lambda (p) (format p "(require mockery.scm)~%") (format p "(define m1 ((*mock-number* 'mock-number) 3))~%") (format p "(define with-bignums (provided? 'gmp))~%") (format p "(define-macro (test expr res)~%") (format p " `(let ((val (catch #t (lambda () ,expr) (lambda (type info) 'error))))~%") (format p " (unless (eq? val ,res)~%") (format p " (format *stderr* \"~~S -> ~~S?~~%\" ',expr val))))~%") (for-each (lambda (op) (for-each (lambda (arg1) (for-each (lambda (arg2) (let ((result (catch #t (lambda () (apply (symbol->value op) (list (if (symbol? arg1) (symbol->value arg1) arg1) (if (symbol? arg2) (symbol->value arg2) arg2)))) (lambda (type info) ;(apply format #t info) ''error)))) (format p "(test (~S ~S ~S) ~S)~%" op arg1 arg2 result) (when (and (number? arg1) (number? arg2)) (format p "(when with-bignums~%") (format p " (test (~S (bignum ~S) ~S) ~S)~%" op arg1 arg2 result) (format p " (test (~S ~S (bignum ~S)) ~S)~%" op arg1 arg2 result) (format p " (test (~S (bignum ~S) (bignum ~S)) ~S))~%" op arg1 arg2 result)))) (if (eq? op '=) args real-args))) (if (eq? op '=) args real-args))) ops))) |# (set! (*s7* 'autoloading?) #t) ; t101 turns this off in one test! (let () (require mockery.scm) (define m1 ((*mock-number* 'mock-number) 3)) (define with-bignums (provided? 'gmp)) (define-macro (test1 expr res) `(let ((val (catch #t (lambda () ,expr) (lambda (type info) 'error)))) (unless (equal? val ,res) (format *stderr* "~S -> ~S?~%" ',expr val)))) (test1 (= 1 1) #t) (when with-bignums (test1 (= (bignum 1) 1) #t) (test1 (= 1 (bignum 1)) #t) (test1 (= (bignum 1) (bignum 1)) #t)) (test1 (= 1 -1) #f) (when with-bignums (test1 (= (bignum 1) -1) #f) (test1 (= 1 (bignum -1)) #f) (test1 (= (bignum 1) (bignum -1)) #f)) (test1 (= 1 1/2) #f) (when with-bignums (test1 (= (bignum 1) 1/2) #f) (test1 (= 1 (bignum 1/2)) #f) (test1 (= (bignum 1) (bignum 1/2)) #f)) (test1 (= 1 -1/2) #f) (when with-bignums (test1 (= (bignum 1) -1/2) #f) (test1 (= 1 (bignum -1/2)) #f) (test1 (= (bignum 1) (bignum -1/2)) #f)) (test1 (= 1 1.5) #f) (when with-bignums (test1 (= (bignum 1) 1.5) #f) (test1 (= 1 (bignum 1.5)) #f) (test1 (= (bignum 1) (bignum 1.5)) #f)) (test1 (= 1 -1.5) #f) (when with-bignums (test1 (= (bignum 1) -1.5) #f) (test1 (= 1 (bignum -1.5)) #f) (test1 (= (bignum 1) (bignum -1.5)) #f)) (test1 (= 1 1.0+1.0i) #f) (when with-bignums (test1 (= (bignum 1) 1.0+1.0i) #f) (test1 (= 1 (bignum 1.0+1.0i)) #f) (test1 (= (bignum 1) (bignum 1.0+1.0i)) #f)) (test1 (= 1 1.0-1.0i) #f) (when with-bignums (test1 (= (bignum 1) 1.0-1.0i) #f) (test1 (= 1 (bignum 1.0-1.0i)) #f) (test1 (= (bignum 1) (bignum 1.0-1.0i)) #f)) (test1 (= 1 m1) #f) (test1 (= -1 1) #f) (when with-bignums (test1 (= (bignum -1) 1) #f) (test1 (= -1 (bignum 1)) #f) (test1 (= (bignum -1) (bignum 1)) #f)) (test1 (= -1 -1) #t) (when with-bignums (test1 (= (bignum -1) -1) #t) (test1 (= -1 (bignum -1)) #t) (test1 (= (bignum -1) (bignum -1)) #t)) (test1 (= -1 1/2) #f) (when with-bignums (test1 (= (bignum -1) 1/2) #f) (test1 (= -1 (bignum 1/2)) #f) (test1 (= (bignum -1) (bignum 1/2)) #f)) (test1 (= -1 -1/2) #f) (when with-bignums (test1 (= (bignum -1) -1/2) #f) (test1 (= -1 (bignum -1/2)) #f) (test1 (= (bignum -1) (bignum -1/2)) #f)) (test1 (= -1 1.5) #f) (when with-bignums (test1 (= (bignum -1) 1.5) #f) (test1 (= -1 (bignum 1.5)) #f) (test1 (= (bignum -1) (bignum 1.5)) #f)) (test1 (= -1 -1.5) #f) (when with-bignums (test1 (= (bignum -1) -1.5) #f) (test1 (= -1 (bignum -1.5)) #f) (test1 (= (bignum -1) (bignum -1.5)) #f)) (test1 (= -1 1.0+1.0i) #f) (when with-bignums (test1 (= (bignum -1) 1.0+1.0i) #f) (test1 (= -1 (bignum 1.0+1.0i)) #f) (test1 (= (bignum -1) (bignum 1.0+1.0i)) #f)) (test1 (= -1 1.0-1.0i) #f) (when with-bignums (test1 (= (bignum -1) 1.0-1.0i) #f) (test1 (= -1 (bignum 1.0-1.0i)) #f) (test1 (= (bignum -1) (bignum 1.0-1.0i)) #f)) (test1 (= -1 m1) #f) (test1 (= 1/2 1) #f) (when with-bignums (test1 (= (bignum 1/2) 1) #f) (test1 (= 1/2 (bignum 1)) #f) (test1 (= (bignum 1/2) (bignum 1)) #f)) (test1 (= 1/2 -1) #f) (when with-bignums (test1 (= (bignum 1/2) -1) #f) (test1 (= 1/2 (bignum -1)) #f) (test1 (= (bignum 1/2) (bignum -1)) #f)) (test1 (= 1/2 1/2) #t) (when with-bignums (test1 (= (bignum 1/2) 1/2) #t) (test1 (= 1/2 (bignum 1/2)) #t) (test1 (= (bignum 1/2) (bignum 1/2)) #t)) (test1 (= 1/2 -1/2) #f) (when with-bignums (test1 (= (bignum 1/2) -1/2) #f) (test1 (= 1/2 (bignum -1/2)) #f) (test1 (= (bignum 1/2) (bignum -1/2)) #f)) (test1 (= 1/2 1.5) #f) (when with-bignums (test1 (= (bignum 1/2) 1.5) #f) (test1 (= 1/2 (bignum 1.5)) #f) (test1 (= (bignum 1/2) (bignum 1.5)) #f)) (test1 (= 1/2 -1.5) #f) (when with-bignums (test1 (= (bignum 1/2) -1.5) #f) (test1 (= 1/2 (bignum -1.5)) #f) (test1 (= (bignum 1/2) (bignum -1.5)) #f)) (test1 (= 1/2 1.0+1.0i) #f) (when with-bignums (test1 (= (bignum 1/2) 1.0+1.0i) #f) (test1 (= 1/2 (bignum 1.0+1.0i)) #f) (test1 (= (bignum 1/2) (bignum 1.0+1.0i)) #f)) (test1 (= 1/2 1.0-1.0i) #f) (when with-bignums (test1 (= (bignum 1/2) 1.0-1.0i) #f) (test1 (= 1/2 (bignum 1.0-1.0i)) #f) (test1 (= (bignum 1/2) (bignum 1.0-1.0i)) #f)) (test1 (= 1/2 m1) #f) (test1 (= -1/2 1) #f) (when with-bignums (test1 (= (bignum -1/2) 1) #f) (test1 (= -1/2 (bignum 1)) #f) (test1 (= (bignum -1/2) (bignum 1)) #f)) (test1 (= -1/2 -1) #f) (when with-bignums (test1 (= (bignum -1/2) -1) #f) (test1 (= -1/2 (bignum -1)) #f) (test1 (= (bignum -1/2) (bignum -1)) #f)) (test1 (= -1/2 1/2) #f) (when with-bignums (test1 (= (bignum -1/2) 1/2) #f) (test1 (= -1/2 (bignum 1/2)) #f) (test1 (= (bignum -1/2) (bignum 1/2)) #f)) (test1 (= -1/2 -1/2) #t) (when with-bignums (test1 (= (bignum -1/2) -1/2) #t) (test1 (= -1/2 (bignum -1/2)) #t) (test1 (= (bignum -1/2) (bignum -1/2)) #t)) (test1 (= -1/2 1.5) #f) (when with-bignums (test1 (= (bignum -1/2) 1.5) #f) (test1 (= -1/2 (bignum 1.5)) #f) (test1 (= (bignum -1/2) (bignum 1.5)) #f)) (test1 (= -1/2 -1.5) #f) (when with-bignums (test1 (= (bignum -1/2) -1.5) #f) (test1 (= -1/2 (bignum -1.5)) #f) (test1 (= (bignum -1/2) (bignum -1.5)) #f)) (test1 (= -1/2 1.0+1.0i) #f) (when with-bignums (test1 (= (bignum -1/2) 1.0+1.0i) #f) (test1 (= -1/2 (bignum 1.0+1.0i)) #f) (test1 (= (bignum -1/2) (bignum 1.0+1.0i)) #f)) (test1 (= -1/2 1.0-1.0i) #f) (when with-bignums (test1 (= (bignum -1/2) 1.0-1.0i) #f) (test1 (= -1/2 (bignum 1.0-1.0i)) #f) (test1 (= (bignum -1/2) (bignum 1.0-1.0i)) #f)) (test1 (= -1/2 m1) #f) (test1 (= 1.5 1) #f) (when with-bignums (test1 (= (bignum 1.5) 1) #f) (test1 (= 1.5 (bignum 1)) #f) (test1 (= (bignum 1.5) (bignum 1)) #f)) (test1 (= 1.5 -1) #f) (when with-bignums (test1 (= (bignum 1.5) -1) #f) (test1 (= 1.5 (bignum -1)) #f) (test1 (= (bignum 1.5) (bignum -1)) #f)) (test1 (= 1.5 1/2) #f) (when with-bignums (test1 (= (bignum 1.5) 1/2) #f) (test1 (= 1.5 (bignum 1/2)) #f) (test1 (= (bignum 1.5) (bignum 1/2)) #f)) (test1 (= 1.5 -1/2) #f) (when with-bignums (test1 (= (bignum 1.5) -1/2) #f) (test1 (= 1.5 (bignum -1/2)) #f) (test1 (= (bignum 1.5) (bignum -1/2)) #f)) (test1 (= 1.5 1.5) #t) (when with-bignums (test1 (= (bignum 1.5) 1.5) #t) (test1 (= 1.5 (bignum 1.5)) #t) (test1 (= (bignum 1.5) (bignum 1.5)) #t)) (test1 (= 1.5 -1.5) #f) (when with-bignums (test1 (= (bignum 1.5) -1.5) #f) (test1 (= 1.5 (bignum -1.5)) #f) (test1 (= (bignum 1.5) (bignum -1.5)) #f)) (test1 (= 1.5 1.0+1.0i) #f) (when with-bignums (test1 (= (bignum 1.5) 1.0+1.0i) #f) (test1 (= 1.5 (bignum 1.0+1.0i)) #f) (test1 (= (bignum 1.5) (bignum 1.0+1.0i)) #f)) (test1 (= 1.5 1.0-1.0i) #f) (when with-bignums (test1 (= (bignum 1.5) 1.0-1.0i) #f) (test1 (= 1.5 (bignum 1.0-1.0i)) #f) (test1 (= (bignum 1.5) (bignum 1.0-1.0i)) #f)) (test1 (= 1.5 m1) #f) (test1 (= -1.5 1) #f) (when with-bignums (test1 (= (bignum -1.5) 1) #f) (test1 (= -1.5 (bignum 1)) #f) (test1 (= (bignum -1.5) (bignum 1)) #f)) (test1 (= -1.5 -1) #f) (when with-bignums (test1 (= (bignum -1.5) -1) #f) (test1 (= -1.5 (bignum -1)) #f) (test1 (= (bignum -1.5) (bignum -1)) #f)) (test1 (= -1.5 1/2) #f) (when with-bignums (test1 (= (bignum -1.5) 1/2) #f) (test1 (= -1.5 (bignum 1/2)) #f) (test1 (= (bignum -1.5) (bignum 1/2)) #f)) (test1 (= -1.5 -1/2) #f) (when with-bignums (test1 (= (bignum -1.5) -1/2) #f) (test1 (= -1.5 (bignum -1/2)) #f) (test1 (= (bignum -1.5) (bignum -1/2)) #f)) (test1 (= -1.5 1.5) #f) (when with-bignums (test1 (= (bignum -1.5) 1.5) #f) (test1 (= -1.5 (bignum 1.5)) #f) (test1 (= (bignum -1.5) (bignum 1.5)) #f)) (test1 (= -1.5 -1.5) #t) (when with-bignums (test1 (= (bignum -1.5) -1.5) #t) (test1 (= -1.5 (bignum -1.5)) #t) (test1 (= (bignum -1.5) (bignum -1.5)) #t)) (test1 (= -1.5 1.0+1.0i) #f) (when with-bignums (test1 (= (bignum -1.5) 1.0+1.0i) #f) (test1 (= -1.5 (bignum 1.0+1.0i)) #f) (test1 (= (bignum -1.5) (bignum 1.0+1.0i)) #f)) (test1 (= -1.5 1.0-1.0i) #f) (when with-bignums (test1 (= (bignum -1.5) 1.0-1.0i) #f) (test1 (= -1.5 (bignum 1.0-1.0i)) #f) (test1 (= (bignum -1.5) (bignum 1.0-1.0i)) #f)) (test1 (= -1.5 m1) #f) (test1 (= 1.0+1.0i 1) #f) (when with-bignums (test1 (= (bignum 1.0+1.0i) 1) #f) (test1 (= 1.0+1.0i (bignum 1)) #f) (test1 (= (bignum 1.0+1.0i) (bignum 1)) #f)) (test1 (= 1.0+1.0i -1) #f) (when with-bignums (test1 (= (bignum 1.0+1.0i) -1) #f) (test1 (= 1.0+1.0i (bignum -1)) #f) (test1 (= (bignum 1.0+1.0i) (bignum -1)) #f)) (test1 (= 1.0+1.0i 1/2) #f) (when with-bignums (test1 (= (bignum 1.0+1.0i) 1/2) #f) (test1 (= 1.0+1.0i (bignum 1/2)) #f) (test1 (= (bignum 1.0+1.0i) (bignum 1/2)) #f)) (test1 (= 1.0+1.0i -1/2) #f) (when with-bignums (test1 (= (bignum 1.0+1.0i) -1/2) #f) (test1 (= 1.0+1.0i (bignum -1/2)) #f) (test1 (= (bignum 1.0+1.0i) (bignum -1/2)) #f)) (test1 (= 1.0+1.0i 1.5) #f) (when with-bignums (test1 (= (bignum 1.0+1.0i) 1.5) #f) (test1 (= 1.0+1.0i (bignum 1.5)) #f) (test1 (= (bignum 1.0+1.0i) (bignum 1.5)) #f)) (test1 (= 1.0+1.0i -1.5) #f) (when with-bignums (test1 (= (bignum 1.0+1.0i) -1.5) #f) (test1 (= 1.0+1.0i (bignum -1.5)) #f) (test1 (= (bignum 1.0+1.0i) (bignum -1.5)) #f)) (test1 (= 1.0+1.0i 1.0+1.0i) #t) (when with-bignums (test1 (= (bignum 1.0+1.0i) 1.0+1.0i) #t) (test1 (= 1.0+1.0i (bignum 1.0+1.0i)) #t) (test1 (= (bignum 1.0+1.0i) (bignum 1.0+1.0i)) #t)) (test1 (= 1.0+1.0i 1.0-1.0i) #f) (when with-bignums (test1 (= (bignum 1.0+1.0i) 1.0-1.0i) #f) (test1 (= 1.0+1.0i (bignum 1.0-1.0i)) #f) (test1 (= (bignum 1.0+1.0i) (bignum 1.0-1.0i)) #f)) (test1 (= 1.0+1.0i m1) #f) (test1 (= 1.0-1.0i 1) #f) (when with-bignums (test1 (= (bignum 1.0-1.0i) 1) #f) (test1 (= 1.0-1.0i (bignum 1)) #f) (test1 (= (bignum 1.0-1.0i) (bignum 1)) #f)) (test1 (= 1.0-1.0i -1) #f) (when with-bignums (test1 (= (bignum 1.0-1.0i) -1) #f) (test1 (= 1.0-1.0i (bignum -1)) #f) (test1 (= (bignum 1.0-1.0i) (bignum -1)) #f)) (test1 (= 1.0-1.0i 1/2) #f) (when with-bignums (test1 (= (bignum 1.0-1.0i) 1/2) #f) (test1 (= 1.0-1.0i (bignum 1/2)) #f) (test1 (= (bignum 1.0-1.0i) (bignum 1/2)) #f)) (test1 (= 1.0-1.0i -1/2) #f) (when with-bignums (test1 (= (bignum 1.0-1.0i) -1/2) #f) (test1 (= 1.0-1.0i (bignum -1/2)) #f) (test1 (= (bignum 1.0-1.0i) (bignum -1/2)) #f)) (test1 (= 1.0-1.0i 1.5) #f) (when with-bignums (test1 (= (bignum 1.0-1.0i) 1.5) #f) (test1 (= 1.0-1.0i (bignum 1.5)) #f) (test1 (= (bignum 1.0-1.0i) (bignum 1.5)) #f)) (test1 (= 1.0-1.0i -1.5) #f) (when with-bignums (test1 (= (bignum 1.0-1.0i) -1.5) #f) (test1 (= 1.0-1.0i (bignum -1.5)) #f) (test1 (= (bignum 1.0-1.0i) (bignum -1.5)) #f)) (test1 (= 1.0-1.0i 1.0+1.0i) #f) (when with-bignums (test1 (= (bignum 1.0-1.0i) 1.0+1.0i) #f) (test1 (= 1.0-1.0i (bignum 1.0+1.0i)) #f) (test1 (= (bignum 1.0-1.0i) (bignum 1.0+1.0i)) #f)) (test1 (= 1.0-1.0i 1.0-1.0i) #t) (when with-bignums (test1 (= (bignum 1.0-1.0i) 1.0-1.0i) #t) (test1 (= 1.0-1.0i (bignum 1.0-1.0i)) #t) (test1 (= (bignum 1.0-1.0i) (bignum 1.0-1.0i)) #t)) (test1 (= 1.0-1.0i m1) #f) (test1 (= m1 1) #f) (test1 (= m1 -1) #f) (test1 (= m1 1/2) #f) (test1 (= m1 -1/2) #f) (test1 (= m1 1.5) #f) (test1 (= m1 -1.5) #f) (test1 (= m1 1.0+1.0i) #f) (test1 (= m1 1.0-1.0i) #f) (test1 (= m1 m1) #t) (test1 (< 1 1) #f) (when with-bignums (test1 (< (bignum 1) 1) #f) (test1 (< 1 (bignum 1)) #f) (test1 (< (bignum 1) (bignum 1)) #f)) (test1 (< 1 -1) #f) (when with-bignums (test1 (< (bignum 1) -1) #f) (test1 (< 1 (bignum -1)) #f) (test1 (< (bignum 1) (bignum -1)) #f)) (test1 (< 1 1/2) #f) (when with-bignums (test1 (< (bignum 1) 1/2) #f) (test1 (< 1 (bignum 1/2)) #f) (test1 (< (bignum 1) (bignum 1/2)) #f)) (test1 (< 1 -1/2) #f) (when with-bignums (test1 (< (bignum 1) -1/2) #f) (test1 (< 1 (bignum -1/2)) #f) (test1 (< (bignum 1) (bignum -1/2)) #f)) (test1 (< 1 1.5) #t) (when with-bignums (test1 (< (bignum 1) 1.5) #t) (test1 (< 1 (bignum 1.5)) #t) (test1 (< (bignum 1) (bignum 1.5)) #t)) (test1 (< 1 -1.5) #f) (when with-bignums (test1 (< (bignum 1) -1.5) #f) (test1 (< 1 (bignum -1.5)) #f) (test1 (< (bignum 1) (bignum -1.5)) #f)) (test1 (< 1 m1) #t) (test1 (< -1 1) #t) (when with-bignums (test1 (< (bignum -1) 1) #t) (test1 (< -1 (bignum 1)) #t) (test1 (< (bignum -1) (bignum 1)) #t)) (test1 (< -1 -1) #f) (when with-bignums (test1 (< (bignum -1) -1) #f) (test1 (< -1 (bignum -1)) #f) (test1 (< (bignum -1) (bignum -1)) #f)) (test1 (< -1 1/2) #t) (when with-bignums (test1 (< (bignum -1) 1/2) #t) (test1 (< -1 (bignum 1/2)) #t) (test1 (< (bignum -1) (bignum 1/2)) #t)) (test1 (< -1 -1/2) #t) (when with-bignums (test1 (< (bignum -1) -1/2) #t) (test1 (< -1 (bignum -1/2)) #t) (test1 (< (bignum -1) (bignum -1/2)) #t)) (test1 (< -1 1.5) #t) (when with-bignums (test1 (< (bignum -1) 1.5) #t) (test1 (< -1 (bignum 1.5)) #t) (test1 (< (bignum -1) (bignum 1.5)) #t)) (test1 (< -1 -1.5) #f) (when with-bignums (test1 (< (bignum -1) -1.5) #f) (test1 (< -1 (bignum -1.5)) #f) (test1 (< (bignum -1) (bignum -1.5)) #f)) (test1 (< -1 m1) #t) (test1 (< 1/2 1) #t) (when with-bignums (test1 (< (bignum 1/2) 1) #t) (test1 (< 1/2 (bignum 1)) #t) (test1 (< (bignum 1/2) (bignum 1)) #t)) (test1 (< 1/2 -1) #f) (when with-bignums (test1 (< (bignum 1/2) -1) #f) (test1 (< 1/2 (bignum -1)) #f) (test1 (< (bignum 1/2) (bignum -1)) #f)) (test1 (< 1/2 1/2) #f) (when with-bignums (test1 (< (bignum 1/2) 1/2) #f) (test1 (< 1/2 (bignum 1/2)) #f) (test1 (< (bignum 1/2) (bignum 1/2)) #f)) (test1 (< 1/2 -1/2) #f) (when with-bignums (test1 (< (bignum 1/2) -1/2) #f) (test1 (< 1/2 (bignum -1/2)) #f) (test1 (< (bignum 1/2) (bignum -1/2)) #f)) (test1 (< 1/2 1.5) #t) (when with-bignums (test1 (< (bignum 1/2) 1.5) #t) (test1 (< 1/2 (bignum 1.5)) #t) (test1 (< (bignum 1/2) (bignum 1.5)) #t)) (test1 (< 1/2 -1.5) #f) (when with-bignums (test1 (< (bignum 1/2) -1.5) #f) (test1 (< 1/2 (bignum -1.5)) #f) (test1 (< (bignum 1/2) (bignum -1.5)) #f)) (test1 (< 1/2 m1) #t) (test1 (< -1/2 1) #t) (when with-bignums (test1 (< (bignum -1/2) 1) #t) (test1 (< -1/2 (bignum 1)) #t) (test1 (< (bignum -1/2) (bignum 1)) #t)) (test1 (< -1/2 -1) #f) (when with-bignums (test1 (< (bignum -1/2) -1) #f) (test1 (< -1/2 (bignum -1)) #f) (test1 (< (bignum -1/2) (bignum -1)) #f)) (test1 (< -1/2 1/2) #t) (when with-bignums (test1 (< (bignum -1/2) 1/2) #t) (test1 (< -1/2 (bignum 1/2)) #t) (test1 (< (bignum -1/2) (bignum 1/2)) #t)) (test1 (< -1/2 -1/2) #f) (when with-bignums (test1 (< (bignum -1/2) -1/2) #f) (test1 (< -1/2 (bignum -1/2)) #f) (test1 (< (bignum -1/2) (bignum -1/2)) #f)) (test1 (< -1/2 1.5) #t) (when with-bignums (test1 (< (bignum -1/2) 1.5) #t) (test1 (< -1/2 (bignum 1.5)) #t) (test1 (< (bignum -1/2) (bignum 1.5)) #t)) (test1 (< -1/2 -1.5) #f) (when with-bignums (test1 (< (bignum -1/2) -1.5) #f) (test1 (< -1/2 (bignum -1.5)) #f) (test1 (< (bignum -1/2) (bignum -1.5)) #f)) (test1 (< -1/2 m1) #t) (test1 (< 1.5 1) #f) (when with-bignums (test1 (< (bignum 1.5) 1) #f) (test1 (< 1.5 (bignum 1)) #f) (test1 (< (bignum 1.5) (bignum 1)) #f)) (test1 (< 1.5 -1) #f) (when with-bignums (test1 (< (bignum 1.5) -1) #f) (test1 (< 1.5 (bignum -1)) #f) (test1 (< (bignum 1.5) (bignum -1)) #f)) (test1 (< 1.5 1/2) #f) (when with-bignums (test1 (< (bignum 1.5) 1/2) #f) (test1 (< 1.5 (bignum 1/2)) #f) (test1 (< (bignum 1.5) (bignum 1/2)) #f)) (test1 (< 1.5 -1/2) #f) (when with-bignums (test1 (< (bignum 1.5) -1/2) #f) (test1 (< 1.5 (bignum -1/2)) #f) (test1 (< (bignum 1.5) (bignum -1/2)) #f)) (test1 (< 1.5 1.5) #f) (when with-bignums (test1 (< (bignum 1.5) 1.5) #f) (test1 (< 1.5 (bignum 1.5)) #f) (test1 (< (bignum 1.5) (bignum 1.5)) #f)) (test1 (< 1.5 -1.5) #f) (when with-bignums (test1 (< (bignum 1.5) -1.5) #f) (test1 (< 1.5 (bignum -1.5)) #f) (test1 (< (bignum 1.5) (bignum -1.5)) #f)) (test1 (< 1.5 m1) #t) (test1 (< -1.5 1) #t) (when with-bignums (test1 (< (bignum -1.5) 1) #t) (test1 (< -1.5 (bignum 1)) #t) (test1 (< (bignum -1.5) (bignum 1)) #t)) (test1 (< -1.5 -1) #t) (when with-bignums (test1 (< (bignum -1.5) -1) #t) (test1 (< -1.5 (bignum -1)) #t) (test1 (< (bignum -1.5) (bignum -1)) #t)) (test1 (< -1.5 1/2) #t) (when with-bignums (test1 (< (bignum -1.5) 1/2) #t) (test1 (< -1.5 (bignum 1/2)) #t) (test1 (< (bignum -1.5) (bignum 1/2)) #t)) (test1 (< -1.5 -1/2) #t) (when with-bignums (test1 (< (bignum -1.5) -1/2) #t) (test1 (< -1.5 (bignum -1/2)) #t) (test1 (< (bignum -1.5) (bignum -1/2)) #t)) (test1 (< -1.5 1.5) #t) (when with-bignums (test1 (< (bignum -1.5) 1.5) #t) (test1 (< -1.5 (bignum 1.5)) #t) (test1 (< (bignum -1.5) (bignum 1.5)) #t)) (test1 (< -1.5 -1.5) #f) (when with-bignums (test1 (< (bignum -1.5) -1.5) #f) (test1 (< -1.5 (bignum -1.5)) #f) (test1 (< (bignum -1.5) (bignum -1.5)) #f)) (test1 (< -1.5 m1) #t) (test1 (< m1 1) #f) (test1 (< m1 -1) #f) (test1 (< m1 1/2) #f) (test1 (< m1 -1/2) #f) (test1 (< m1 1.5) #f) (test1 (< m1 -1.5) #f) (test1 (< m1 m1) #f) (test1 (> 1 1) #f) (when with-bignums (test1 (> (bignum 1) 1) #f) (test1 (> 1 (bignum 1)) #f) (test1 (> (bignum 1) (bignum 1)) #f)) (test1 (> 1 -1) #t) (when with-bignums (test1 (> (bignum 1) -1) #t) (test1 (> 1 (bignum -1)) #t) (test1 (> (bignum 1) (bignum -1)) #t)) (test1 (> 1 1/2) #t) (when with-bignums (test1 (> (bignum 1) 1/2) #t) (test1 (> 1 (bignum 1/2)) #t) (test1 (> (bignum 1) (bignum 1/2)) #t)) (test1 (> 1 -1/2) #t) (when with-bignums (test1 (> (bignum 1) -1/2) #t) (test1 (> 1 (bignum -1/2)) #t) (test1 (> (bignum 1) (bignum -1/2)) #t)) (test1 (> 1 1.5) #f) (when with-bignums (test1 (> (bignum 1) 1.5) #f) (test1 (> 1 (bignum 1.5)) #f) (test1 (> (bignum 1) (bignum 1.5)) #f)) (test1 (> 1 -1.5) #t) (when with-bignums (test1 (> (bignum 1) -1.5) #t) (test1 (> 1 (bignum -1.5)) #t) (test1 (> (bignum 1) (bignum -1.5)) #t)) (test1 (> 1 m1) #f) (test1 (> -1 1) #f) (when with-bignums (test1 (> (bignum -1) 1) #f) (test1 (> -1 (bignum 1)) #f) (test1 (> (bignum -1) (bignum 1)) #f)) (test1 (> -1 -1) #f) (when with-bignums (test1 (> (bignum -1) -1) #f) (test1 (> -1 (bignum -1)) #f) (test1 (> (bignum -1) (bignum -1)) #f)) (test1 (> -1 1/2) #f) (when with-bignums (test1 (> (bignum -1) 1/2) #f) (test1 (> -1 (bignum 1/2)) #f) (test1 (> (bignum -1) (bignum 1/2)) #f)) (test1 (> -1 -1/2) #f) (when with-bignums (test1 (> (bignum -1) -1/2) #f) (test1 (> -1 (bignum -1/2)) #f) (test1 (> (bignum -1) (bignum -1/2)) #f)) (test1 (> -1 1.5) #f) (when with-bignums (test1 (> (bignum -1) 1.5) #f) (test1 (> -1 (bignum 1.5)) #f) (test1 (> (bignum -1) (bignum 1.5)) #f)) (test1 (> -1 -1.5) #t) (when with-bignums (test1 (> (bignum -1) -1.5) #t) (test1 (> -1 (bignum -1.5)) #t) (test1 (> (bignum -1) (bignum -1.5)) #t)) (test1 (> -1 m1) #f) (test1 (> 1/2 1) #f) (when with-bignums (test1 (> (bignum 1/2) 1) #f) (test1 (> 1/2 (bignum 1)) #f) (test1 (> (bignum 1/2) (bignum 1)) #f)) (test1 (> 1/2 -1) #t) (when with-bignums (test1 (> (bignum 1/2) -1) #t) (test1 (> 1/2 (bignum -1)) #t) (test1 (> (bignum 1/2) (bignum -1)) #t)) (test1 (> 1/2 1/2) #f) (when with-bignums (test1 (> (bignum 1/2) 1/2) #f) (test1 (> 1/2 (bignum 1/2)) #f) (test1 (> (bignum 1/2) (bignum 1/2)) #f)) (test1 (> 1/2 -1/2) #t) (when with-bignums (test1 (> (bignum 1/2) -1/2) #t) (test1 (> 1/2 (bignum -1/2)) #t) (test1 (> (bignum 1/2) (bignum -1/2)) #t)) (test1 (> 1/2 1.5) #f) (when with-bignums (test1 (> (bignum 1/2) 1.5) #f) (test1 (> 1/2 (bignum 1.5)) #f) (test1 (> (bignum 1/2) (bignum 1.5)) #f)) (test1 (> 1/2 -1.5) #t) (when with-bignums (test1 (> (bignum 1/2) -1.5) #t) (test1 (> 1/2 (bignum -1.5)) #t) (test1 (> (bignum 1/2) (bignum -1.5)) #t)) (test1 (> 1/2 m1) #f) (test1 (> -1/2 1) #f) (when with-bignums (test1 (> (bignum -1/2) 1) #f) (test1 (> -1/2 (bignum 1)) #f) (test1 (> (bignum -1/2) (bignum 1)) #f)) (test1 (> -1/2 -1) #t) (when with-bignums (test1 (> (bignum -1/2) -1) #t) (test1 (> -1/2 (bignum -1)) #t) (test1 (> (bignum -1/2) (bignum -1)) #t)) (test1 (> -1/2 1/2) #f) (when with-bignums (test1 (> (bignum -1/2) 1/2) #f) (test1 (> -1/2 (bignum 1/2)) #f) (test1 (> (bignum -1/2) (bignum 1/2)) #f)) (test1 (> -1/2 -1/2) #f) (when with-bignums (test1 (> (bignum -1/2) -1/2) #f) (test1 (> -1/2 (bignum -1/2)) #f) (test1 (> (bignum -1/2) (bignum -1/2)) #f)) (test1 (> -1/2 1.5) #f) (when with-bignums (test1 (> (bignum -1/2) 1.5) #f) (test1 (> -1/2 (bignum 1.5)) #f) (test1 (> (bignum -1/2) (bignum 1.5)) #f)) (test1 (> -1/2 -1.5) #t) (when with-bignums (test1 (> (bignum -1/2) -1.5) #t) (test1 (> -1/2 (bignum -1.5)) #t) (test1 (> (bignum -1/2) (bignum -1.5)) #t)) (test1 (> -1/2 m1) #f) (test1 (> 1.5 1) #t) (when with-bignums (test1 (> (bignum 1.5) 1) #t) (test1 (> 1.5 (bignum 1)) #t) (test1 (> (bignum 1.5) (bignum 1)) #t)) (test1 (> 1.5 -1) #t) (when with-bignums (test1 (> (bignum 1.5) -1) #t) (test1 (> 1.5 (bignum -1)) #t) (test1 (> (bignum 1.5) (bignum -1)) #t)) (test1 (> 1.5 1/2) #t) (when with-bignums (test1 (> (bignum 1.5) 1/2) #t) (test1 (> 1.5 (bignum 1/2)) #t) (test1 (> (bignum 1.5) (bignum 1/2)) #t)) (test1 (> 1.5 -1/2) #t) (when with-bignums (test1 (> (bignum 1.5) -1/2) #t) (test1 (> 1.5 (bignum -1/2)) #t) (test1 (> (bignum 1.5) (bignum -1/2)) #t)) (test1 (> 1.5 1.5) #f) (when with-bignums (test1 (> (bignum 1.5) 1.5) #f) (test1 (> 1.5 (bignum 1.5)) #f) (test1 (> (bignum 1.5) (bignum 1.5)) #f)) (test1 (> 1.5 -1.5) #t) (when with-bignums (test1 (> (bignum 1.5) -1.5) #t) (test1 (> 1.5 (bignum -1.5)) #t) (test1 (> (bignum 1.5) (bignum -1.5)) #t)) (test1 (> 1.5 m1) #f) (test1 (> -1.5 1) #f) (when with-bignums (test1 (> (bignum -1.5) 1) #f) (test1 (> -1.5 (bignum 1)) #f) (test1 (> (bignum -1.5) (bignum 1)) #f)) (test1 (> -1.5 -1) #f) (when with-bignums (test1 (> (bignum -1.5) -1) #f) (test1 (> -1.5 (bignum -1)) #f) (test1 (> (bignum -1.5) (bignum -1)) #f)) (test1 (> -1.5 1/2) #f) (when with-bignums (test1 (> (bignum -1.5) 1/2) #f) (test1 (> -1.5 (bignum 1/2)) #f) (test1 (> (bignum -1.5) (bignum 1/2)) #f)) (test1 (> -1.5 -1/2) #f) (when with-bignums (test1 (> (bignum -1.5) -1/2) #f) (test1 (> -1.5 (bignum -1/2)) #f) (test1 (> (bignum -1.5) (bignum -1/2)) #f)) (test1 (> -1.5 1.5) #f) (when with-bignums (test1 (> (bignum -1.5) 1.5) #f) (test1 (> -1.5 (bignum 1.5)) #f) (test1 (> (bignum -1.5) (bignum 1.5)) #f)) (test1 (> -1.5 -1.5) #f) (when with-bignums (test1 (> (bignum -1.5) -1.5) #f) (test1 (> -1.5 (bignum -1.5)) #f) (test1 (> (bignum -1.5) (bignum -1.5)) #f)) (test1 (> -1.5 m1) #f) (test1 (> m1 1) #t) (test1 (> m1 -1) #t) (test1 (> m1 1/2) #t) (test1 (> m1 -1/2) #t) (test1 (> m1 1.5) #t) (test1 (> m1 -1.5) #t) (test1 (> m1 m1) #f) (test1 (<= 1 1) #t) (when with-bignums (test1 (<= (bignum 1) 1) #t) (test1 (<= 1 (bignum 1)) #t) (test1 (<= (bignum 1) (bignum 1)) #t)) (test1 (<= 1 -1) #f) (when with-bignums (test1 (<= (bignum 1) -1) #f) (test1 (<= 1 (bignum -1)) #f) (test1 (<= (bignum 1) (bignum -1)) #f)) (test1 (<= 1 1/2) #f) (when with-bignums (test1 (<= (bignum 1) 1/2) #f) (test1 (<= 1 (bignum 1/2)) #f) (test1 (<= (bignum 1) (bignum 1/2)) #f)) (test1 (<= 1 -1/2) #f) (when with-bignums (test1 (<= (bignum 1) -1/2) #f) (test1 (<= 1 (bignum -1/2)) #f) (test1 (<= (bignum 1) (bignum -1/2)) #f)) (test1 (<= 1 1.5) #t) (when with-bignums (test1 (<= (bignum 1) 1.5) #t) (test1 (<= 1 (bignum 1.5)) #t) (test1 (<= (bignum 1) (bignum 1.5)) #t)) (test1 (<= 1 -1.5) #f) (when with-bignums (test1 (<= (bignum 1) -1.5) #f) (test1 (<= 1 (bignum -1.5)) #f) (test1 (<= (bignum 1) (bignum -1.5)) #f)) (test1 (<= 1 m1) #t) (test1 (<= -1 1) #t) (when with-bignums (test1 (<= (bignum -1) 1) #t) (test1 (<= -1 (bignum 1)) #t) (test1 (<= (bignum -1) (bignum 1)) #t)) (test1 (<= -1 -1) #t) (when with-bignums (test1 (<= (bignum -1) -1) #t) (test1 (<= -1 (bignum -1)) #t) (test1 (<= (bignum -1) (bignum -1)) #t)) (test1 (<= -1 1/2) #t) (when with-bignums (test1 (<= (bignum -1) 1/2) #t) (test1 (<= -1 (bignum 1/2)) #t) (test1 (<= (bignum -1) (bignum 1/2)) #t)) (test1 (<= -1 -1/2) #t) (when with-bignums (test1 (<= (bignum -1) -1/2) #t) (test1 (<= -1 (bignum -1/2)) #t) (test1 (<= (bignum -1) (bignum -1/2)) #t)) (test1 (<= -1 1.5) #t) (when with-bignums (test1 (<= (bignum -1) 1.5) #t) (test1 (<= -1 (bignum 1.5)) #t) (test1 (<= (bignum -1) (bignum 1.5)) #t)) (test1 (<= -1 -1.5) #f) (when with-bignums (test1 (<= (bignum -1) -1.5) #f) (test1 (<= -1 (bignum -1.5)) #f) (test1 (<= (bignum -1) (bignum -1.5)) #f)) (test1 (<= -1 m1) #t) (test1 (<= 1/2 1) #t) (when with-bignums (test1 (<= (bignum 1/2) 1) #t) (test1 (<= 1/2 (bignum 1)) #t) (test1 (<= (bignum 1/2) (bignum 1)) #t)) (test1 (<= 1/2 -1) #f) (when with-bignums (test1 (<= (bignum 1/2) -1) #f) (test1 (<= 1/2 (bignum -1)) #f) (test1 (<= (bignum 1/2) (bignum -1)) #f)) (test1 (<= 1/2 1/2) #t) (when with-bignums (test1 (<= (bignum 1/2) 1/2) #t) (test1 (<= 1/2 (bignum 1/2)) #t) (test1 (<= (bignum 1/2) (bignum 1/2)) #t)) (test1 (<= 1/2 -1/2) #f) (when with-bignums (test1 (<= (bignum 1/2) -1/2) #f) (test1 (<= 1/2 (bignum -1/2)) #f) (test1 (<= (bignum 1/2) (bignum -1/2)) #f)) (test1 (<= 1/2 1.5) #t) (when with-bignums (test1 (<= (bignum 1/2) 1.5) #t) (test1 (<= 1/2 (bignum 1.5)) #t) (test1 (<= (bignum 1/2) (bignum 1.5)) #t)) (test1 (<= 1/2 -1.5) #f) (when with-bignums (test1 (<= (bignum 1/2) -1.5) #f) (test1 (<= 1/2 (bignum -1.5)) #f) (test1 (<= (bignum 1/2) (bignum -1.5)) #f)) (test1 (<= 1/2 m1) #t) (test1 (<= -1/2 1) #t) (when with-bignums (test1 (<= (bignum -1/2) 1) #t) (test1 (<= -1/2 (bignum 1)) #t) (test1 (<= (bignum -1/2) (bignum 1)) #t)) (test1 (<= -1/2 -1) #f) (when with-bignums (test1 (<= (bignum -1/2) -1) #f) (test1 (<= -1/2 (bignum -1)) #f) (test1 (<= (bignum -1/2) (bignum -1)) #f)) (test1 (<= -1/2 1/2) #t) (when with-bignums (test1 (<= (bignum -1/2) 1/2) #t) (test1 (<= -1/2 (bignum 1/2)) #t) (test1 (<= (bignum -1/2) (bignum 1/2)) #t)) (test1 (<= -1/2 -1/2) #t) (when with-bignums (test1 (<= (bignum -1/2) -1/2) #t) (test1 (<= -1/2 (bignum -1/2)) #t) (test1 (<= (bignum -1/2) (bignum -1/2)) #t)) (test1 (<= -1/2 1.5) #t) (when with-bignums (test1 (<= (bignum -1/2) 1.5) #t) (test1 (<= -1/2 (bignum 1.5)) #t) (test1 (<= (bignum -1/2) (bignum 1.5)) #t)) (test1 (<= -1/2 -1.5) #f) (when with-bignums (test1 (<= (bignum -1/2) -1.5) #f) (test1 (<= -1/2 (bignum -1.5)) #f) (test1 (<= (bignum -1/2) (bignum -1.5)) #f)) (test1 (<= -1/2 m1) #t) (test1 (<= 1.5 1) #f) (when with-bignums (test1 (<= (bignum 1.5) 1) #f) (test1 (<= 1.5 (bignum 1)) #f) (test1 (<= (bignum 1.5) (bignum 1)) #f)) (test1 (<= 1.5 -1) #f) (when with-bignums (test1 (<= (bignum 1.5) -1) #f) (test1 (<= 1.5 (bignum -1)) #f) (test1 (<= (bignum 1.5) (bignum -1)) #f)) (test1 (<= 1.5 1/2) #f) (when with-bignums (test1 (<= (bignum 1.5) 1/2) #f) (test1 (<= 1.5 (bignum 1/2)) #f) (test1 (<= (bignum 1.5) (bignum 1/2)) #f)) (test1 (<= 1.5 -1/2) #f) (when with-bignums (test1 (<= (bignum 1.5) -1/2) #f) (test1 (<= 1.5 (bignum -1/2)) #f) (test1 (<= (bignum 1.5) (bignum -1/2)) #f)) (test1 (<= 1.5 1.5) #t) (when with-bignums (test1 (<= (bignum 1.5) 1.5) #t) (test1 (<= 1.5 (bignum 1.5)) #t) (test1 (<= (bignum 1.5) (bignum 1.5)) #t)) (test1 (<= 1.5 -1.5) #f) (when with-bignums (test1 (<= (bignum 1.5) -1.5) #f) (test1 (<= 1.5 (bignum -1.5)) #f) (test1 (<= (bignum 1.5) (bignum -1.5)) #f)) (test1 (<= 1.5 m1) #t) (test1 (<= -1.5 1) #t) (when with-bignums (test1 (<= (bignum -1.5) 1) #t) (test1 (<= -1.5 (bignum 1)) #t) (test1 (<= (bignum -1.5) (bignum 1)) #t)) (test1 (<= -1.5 -1) #t) (when with-bignums (test1 (<= (bignum -1.5) -1) #t) (test1 (<= -1.5 (bignum -1)) #t) (test1 (<= (bignum -1.5) (bignum -1)) #t)) (test1 (<= -1.5 1/2) #t) (when with-bignums (test1 (<= (bignum -1.5) 1/2) #t) (test1 (<= -1.5 (bignum 1/2)) #t) (test1 (<= (bignum -1.5) (bignum 1/2)) #t)) (test1 (<= -1.5 -1/2) #t) (when with-bignums (test1 (<= (bignum -1.5) -1/2) #t) (test1 (<= -1.5 (bignum -1/2)) #t) (test1 (<= (bignum -1.5) (bignum -1/2)) #t)) (test1 (<= -1.5 1.5) #t) (when with-bignums (test1 (<= (bignum -1.5) 1.5) #t) (test1 (<= -1.5 (bignum 1.5)) #t) (test1 (<= (bignum -1.5) (bignum 1.5)) #t)) (test1 (<= -1.5 -1.5) #t) (when with-bignums (test1 (<= (bignum -1.5) -1.5) #t) (test1 (<= -1.5 (bignum -1.5)) #t) (test1 (<= (bignum -1.5) (bignum -1.5)) #t)) (test1 (<= -1.5 m1) #t) (test1 (<= m1 1) #f) (test1 (<= m1 -1) #f) (test1 (<= m1 1/2) #f) (test1 (<= m1 -1/2) #f) (test1 (<= m1 1.5) #f) (test1 (<= m1 -1.5) #f) (test1 (<= m1 m1) #t) (test1 (>= 1 1) #t) (when with-bignums (test1 (>= (bignum 1) 1) #t) (test1 (>= 1 (bignum 1)) #t) (test1 (>= (bignum 1) (bignum 1)) #t)) (test1 (>= 1 -1) #t) (when with-bignums (test1 (>= (bignum 1) -1) #t) (test1 (>= 1 (bignum -1)) #t) (test1 (>= (bignum 1) (bignum -1)) #t)) (test1 (>= 1 1/2) #t) (when with-bignums (test1 (>= (bignum 1) 1/2) #t) (test1 (>= 1 (bignum 1/2)) #t) (test1 (>= (bignum 1) (bignum 1/2)) #t)) (test1 (>= 1 -1/2) #t) (when with-bignums (test1 (>= (bignum 1) -1/2) #t) (test1 (>= 1 (bignum -1/2)) #t) (test1 (>= (bignum 1) (bignum -1/2)) #t)) (test1 (>= 1 1.5) #f) (when with-bignums (test1 (>= (bignum 1) 1.5) #f) (test1 (>= 1 (bignum 1.5)) #f) (test1 (>= (bignum 1) (bignum 1.5)) #f)) (test1 (>= 1 -1.5) #t) (when with-bignums (test1 (>= (bignum 1) -1.5) #t) (test1 (>= 1 (bignum -1.5)) #t) (test1 (>= (bignum 1) (bignum -1.5)) #t)) (test1 (>= 1 m1) #f) (test1 (>= -1 1) #f) (when with-bignums (test1 (>= (bignum -1) 1) #f) (test1 (>= -1 (bignum 1)) #f) (test1 (>= (bignum -1) (bignum 1)) #f)) (test1 (>= -1 -1) #t) (when with-bignums (test1 (>= (bignum -1) -1) #t) (test1 (>= -1 (bignum -1)) #t) (test1 (>= (bignum -1) (bignum -1)) #t)) (test1 (>= -1 1/2) #f) (when with-bignums (test1 (>= (bignum -1) 1/2) #f) (test1 (>= -1 (bignum 1/2)) #f) (test1 (>= (bignum -1) (bignum 1/2)) #f)) (test1 (>= -1 -1/2) #f) (when with-bignums (test1 (>= (bignum -1) -1/2) #f) (test1 (>= -1 (bignum -1/2)) #f) (test1 (>= (bignum -1) (bignum -1/2)) #f)) (test1 (>= -1 1.5) #f) (when with-bignums (test1 (>= (bignum -1) 1.5) #f) (test1 (>= -1 (bignum 1.5)) #f) (test1 (>= (bignum -1) (bignum 1.5)) #f)) (test1 (>= -1 -1.5) #t) (when with-bignums (test1 (>= (bignum -1) -1.5) #t) (test1 (>= -1 (bignum -1.5)) #t) (test1 (>= (bignum -1) (bignum -1.5)) #t)) (test1 (>= -1 m1) #f) (test1 (>= 1/2 1) #f) (when with-bignums (test1 (>= (bignum 1/2) 1) #f) (test1 (>= 1/2 (bignum 1)) #f) (test1 (>= (bignum 1/2) (bignum 1)) #f)) (test1 (>= 1/2 -1) #t) (when with-bignums (test1 (>= (bignum 1/2) -1) #t) (test1 (>= 1/2 (bignum -1)) #t) (test1 (>= (bignum 1/2) (bignum -1)) #t)) (test1 (>= 1/2 1/2) #t) (when with-bignums (test1 (>= (bignum 1/2) 1/2) #t) (test1 (>= 1/2 (bignum 1/2)) #t) (test1 (>= (bignum 1/2) (bignum 1/2)) #t)) (test1 (>= 1/2 -1/2) #t) (when with-bignums (test1 (>= (bignum 1/2) -1/2) #t) (test1 (>= 1/2 (bignum -1/2)) #t) (test1 (>= (bignum 1/2) (bignum -1/2)) #t)) (test1 (>= 1/2 1.5) #f) (when with-bignums (test1 (>= (bignum 1/2) 1.5) #f) (test1 (>= 1/2 (bignum 1.5)) #f) (test1 (>= (bignum 1/2) (bignum 1.5)) #f)) (test1 (>= 1/2 -1.5) #t) (when with-bignums (test1 (>= (bignum 1/2) -1.5) #t) (test1 (>= 1/2 (bignum -1.5)) #t) (test1 (>= (bignum 1/2) (bignum -1.5)) #t)) (test1 (>= 1/2 m1) #f) (test1 (>= -1/2 1) #f) (when with-bignums (test1 (>= (bignum -1/2) 1) #f) (test1 (>= -1/2 (bignum 1)) #f) (test1 (>= (bignum -1/2) (bignum 1)) #f)) (test1 (>= -1/2 -1) #t) (when with-bignums (test1 (>= (bignum -1/2) -1) #t) (test1 (>= -1/2 (bignum -1)) #t) (test1 (>= (bignum -1/2) (bignum -1)) #t)) (test1 (>= -1/2 1/2) #f) (when with-bignums (test1 (>= (bignum -1/2) 1/2) #f) (test1 (>= -1/2 (bignum 1/2)) #f) (test1 (>= (bignum -1/2) (bignum 1/2)) #f)) (test1 (>= -1/2 -1/2) #t) (when with-bignums (test1 (>= (bignum -1/2) -1/2) #t) (test1 (>= -1/2 (bignum -1/2)) #t) (test1 (>= (bignum -1/2) (bignum -1/2)) #t)) (test1 (>= -1/2 1.5) #f) (when with-bignums (test1 (>= (bignum -1/2) 1.5) #f) (test1 (>= -1/2 (bignum 1.5)) #f) (test1 (>= (bignum -1/2) (bignum 1.5)) #f)) (test1 (>= -1/2 -1.5) #t) (when with-bignums (test1 (>= (bignum -1/2) -1.5) #t) (test1 (>= -1/2 (bignum -1.5)) #t) (test1 (>= (bignum -1/2) (bignum -1.5)) #t)) (test1 (>= -1/2 m1) #f) (test1 (>= 1.5 1) #t) (when with-bignums (test1 (>= (bignum 1.5) 1) #t) (test1 (>= 1.5 (bignum 1)) #t) (test1 (>= (bignum 1.5) (bignum 1)) #t)) (test1 (>= 1.5 -1) #t) (when with-bignums (test1 (>= (bignum 1.5) -1) #t) (test1 (>= 1.5 (bignum -1)) #t) (test1 (>= (bignum 1.5) (bignum -1)) #t)) (test1 (>= 1.5 1/2) #t) (when with-bignums (test1 (>= (bignum 1.5) 1/2) #t) (test1 (>= 1.5 (bignum 1/2)) #t) (test1 (>= (bignum 1.5) (bignum 1/2)) #t)) (test1 (>= 1.5 -1/2) #t) (when with-bignums (test1 (>= (bignum 1.5) -1/2) #t) (test1 (>= 1.5 (bignum -1/2)) #t) (test1 (>= (bignum 1.5) (bignum -1/2)) #t)) (test1 (>= 1.5 1.5) #t) (when with-bignums (test1 (>= (bignum 1.5) 1.5) #t) (test1 (>= 1.5 (bignum 1.5)) #t) (test1 (>= (bignum 1.5) (bignum 1.5)) #t)) (test1 (>= 1.5 -1.5) #t) (when with-bignums (test1 (>= (bignum 1.5) -1.5) #t) (test1 (>= 1.5 (bignum -1.5)) #t) (test1 (>= (bignum 1.5) (bignum -1.5)) #t)) (test1 (>= 1.5 m1) #f) (test1 (>= -1.5 1) #f) (when with-bignums (test1 (>= (bignum -1.5) 1) #f) (test1 (>= -1.5 (bignum 1)) #f) (test1 (>= (bignum -1.5) (bignum 1)) #f)) (test1 (>= -1.5 -1) #f) (when with-bignums (test1 (>= (bignum -1.5) -1) #f) (test1 (>= -1.5 (bignum -1)) #f) (test1 (>= (bignum -1.5) (bignum -1)) #f)) (test1 (>= -1.5 1/2) #f) (when with-bignums (test1 (>= (bignum -1.5) 1/2) #f) (test1 (>= -1.5 (bignum 1/2)) #f) (test1 (>= (bignum -1.5) (bignum 1/2)) #f)) (test1 (>= -1.5 -1/2) #f) (when with-bignums (test1 (>= (bignum -1.5) -1/2) #f) (test1 (>= -1.5 (bignum -1/2)) #f) (test1 (>= (bignum -1.5) (bignum -1/2)) #f)) (test1 (>= -1.5 1.5) #f) (when with-bignums (test1 (>= (bignum -1.5) 1.5) #f) (test1 (>= -1.5 (bignum 1.5)) #f) (test1 (>= (bignum -1.5) (bignum 1.5)) #f)) (test1 (>= -1.5 -1.5) #t) (when with-bignums (test1 (>= (bignum -1.5) -1.5) #t) (test1 (>= -1.5 (bignum -1.5)) #t) (test1 (>= (bignum -1.5) (bignum -1.5)) #t)) (test1 (>= -1.5 m1) #f) (test1 (>= m1 1) #t) (test1 (>= m1 -1) #t) (test1 (>= m1 1/2) #t) (test1 (>= m1 -1/2) #t) (test1 (>= m1 1.5) #t) (test1 (>= m1 -1.5) #t) (test1 (>= m1 m1) #t) (test1 (min 1 1) 1) (when with-bignums (test1 (min (bignum 1) 1) 1) (test1 (min 1 (bignum 1)) 1) (test1 (min (bignum 1) (bignum 1)) 1)) (test1 (min 1 -1) -1) (when with-bignums (test1 (min (bignum 1) -1) -1) (test1 (min 1 (bignum -1)) -1) (test1 (min (bignum 1) (bignum -1)) -1)) (test1 (min 1 1/2) 1/2) (when with-bignums (test1 (min (bignum 1) 1/2) 1/2) (test1 (min 1 (bignum 1/2)) 1/2) (test1 (min (bignum 1) (bignum 1/2)) 1/2)) (test1 (min 1 -1/2) -1/2) (when with-bignums (test1 (min (bignum 1) -1/2) -1/2) (test1 (min 1 (bignum -1/2)) -1/2) (test1 (min (bignum 1) (bignum -1/2)) -1/2)) (test1 (min 1 1.5) 1) (when with-bignums (test1 (min (bignum 1) 1.5) 1) (test1 (min 1 (bignum 1.5)) 1) (test1 (min (bignum 1) (bignum 1.5)) 1)) (test1 (min 1 -1.5) -1.5) (when with-bignums (test1 (min (bignum 1) -1.5) -1.5) (test1 (min 1 (bignum -1.5)) -1.5) (test1 (min (bignum 1) (bignum -1.5)) -1.5)) (test1 (min 1 m1) 1) (test1 (min -1 1) -1) (when with-bignums (test1 (min (bignum -1) 1) -1) (test1 (min -1 (bignum 1)) -1) (test1 (min (bignum -1) (bignum 1)) -1)) (test1 (min -1 -1) -1) (when with-bignums (test1 (min (bignum -1) -1) -1) (test1 (min -1 (bignum -1)) -1) (test1 (min (bignum -1) (bignum -1)) -1)) (test1 (min -1 1/2) -1) (when with-bignums (test1 (min (bignum -1) 1/2) -1) (test1 (min -1 (bignum 1/2)) -1) (test1 (min (bignum -1) (bignum 1/2)) -1)) (test1 (min -1 -1/2) -1) (when with-bignums (test1 (min (bignum -1) -1/2) -1) (test1 (min -1 (bignum -1/2)) -1) (test1 (min (bignum -1) (bignum -1/2)) -1)) (test1 (min -1 1.5) -1) (when with-bignums (test1 (min (bignum -1) 1.5) -1) (test1 (min -1 (bignum 1.5)) -1) (test1 (min (bignum -1) (bignum 1.5)) -1)) (test1 (min -1 -1.5) -1.5) (when with-bignums (test1 (min (bignum -1) -1.5) -1.5) (test1 (min -1 (bignum -1.5)) -1.5) (test1 (min (bignum -1) (bignum -1.5)) -1.5)) (test1 (min -1 m1) -1) (test1 (min 1/2 1) 1/2) (when with-bignums (test1 (min (bignum 1/2) 1) 1/2) (test1 (min 1/2 (bignum 1)) 1/2) (test1 (min (bignum 1/2) (bignum 1)) 1/2)) (test1 (min 1/2 -1) -1) (when with-bignums (test1 (min (bignum 1/2) -1) -1) (test1 (min 1/2 (bignum -1)) -1) (test1 (min (bignum 1/2) (bignum -1)) -1)) (test1 (min 1/2 1/2) 1/2) (when with-bignums (test1 (min (bignum 1/2) 1/2) 1/2) (test1 (min 1/2 (bignum 1/2)) 1/2) (test1 (min (bignum 1/2) (bignum 1/2)) 1/2)) (test1 (min 1/2 -1/2) -1/2) (when with-bignums (test1 (min (bignum 1/2) -1/2) -1/2) (test1 (min 1/2 (bignum -1/2)) -1/2) (test1 (min (bignum 1/2) (bignum -1/2)) -1/2)) (test1 (min 1/2 1.5) 1/2) (when with-bignums (test1 (min (bignum 1/2) 1.5) 1/2) (test1 (min 1/2 (bignum 1.5)) 1/2) (test1 (min (bignum 1/2) (bignum 1.5)) 1/2)) (test1 (min 1/2 -1.5) -1.5) (when with-bignums (test1 (min (bignum 1/2) -1.5) -1.5) (test1 (min 1/2 (bignum -1.5)) -1.5) (test1 (min (bignum 1/2) (bignum -1.5)) -1.5)) (test1 (min 1/2 m1) 1/2) (test1 (min -1/2 1) -1/2) (when with-bignums (test1 (min (bignum -1/2) 1) -1/2) (test1 (min -1/2 (bignum 1)) -1/2) (test1 (min (bignum -1/2) (bignum 1)) -1/2)) (test1 (min -1/2 -1) -1) (when with-bignums (test1 (min (bignum -1/2) -1) -1) (test1 (min -1/2 (bignum -1)) -1) (test1 (min (bignum -1/2) (bignum -1)) -1)) (test1 (min -1/2 1/2) -1/2) (when with-bignums (test1 (min (bignum -1/2) 1/2) -1/2) (test1 (min -1/2 (bignum 1/2)) -1/2) (test1 (min (bignum -1/2) (bignum 1/2)) -1/2)) (test1 (min -1/2 -1/2) -1/2) (when with-bignums (test1 (min (bignum -1/2) -1/2) -1/2) (test1 (min -1/2 (bignum -1/2)) -1/2) (test1 (min (bignum -1/2) (bignum -1/2)) -1/2)) (test1 (min -1/2 1.5) -1/2) (when with-bignums (test1 (min (bignum -1/2) 1.5) -1/2) (test1 (min -1/2 (bignum 1.5)) -1/2) (test1 (min (bignum -1/2) (bignum 1.5)) -1/2)) (test1 (min -1/2 -1.5) -1.5) (when with-bignums (test1 (min (bignum -1/2) -1.5) -1.5) (test1 (min -1/2 (bignum -1.5)) -1.5) (test1 (min (bignum -1/2) (bignum -1.5)) -1.5)) (test1 (min -1/2 m1) -1/2) (test1 (min 1.5 1) 1) (when with-bignums (test1 (min (bignum 1.5) 1) 1) (test1 (min 1.5 (bignum 1)) 1) (test1 (min (bignum 1.5) (bignum 1)) 1)) (test1 (min 1.5 -1) -1) (when with-bignums (test1 (min (bignum 1.5) -1) -1) (test1 (min 1.5 (bignum -1)) -1) (test1 (min (bignum 1.5) (bignum -1)) -1)) (test1 (min 1.5 1/2) 1/2) (when with-bignums (test1 (min (bignum 1.5) 1/2) 1/2) (test1 (min 1.5 (bignum 1/2)) 1/2) (test1 (min (bignum 1.5) (bignum 1/2)) 1/2)) (test1 (min 1.5 -1/2) -1/2) (when with-bignums (test1 (min (bignum 1.5) -1/2) -1/2) (test1 (min 1.5 (bignum -1/2)) -1/2) (test1 (min (bignum 1.5) (bignum -1/2)) -1/2)) (test1 (min 1.5 1.5) 1.5) (when with-bignums (test1 (min (bignum 1.5) 1.5) 1.5) (test1 (min 1.5 (bignum 1.5)) 1.5) (test1 (min (bignum 1.5) (bignum 1.5)) 1.5)) (test1 (min 1.5 -1.5) -1.5) (when with-bignums (test1 (min (bignum 1.5) -1.5) -1.5) (test1 (min 1.5 (bignum -1.5)) -1.5) (test1 (min (bignum 1.5) (bignum -1.5)) -1.5)) (test1 (min 1.5 m1) 1.5) (test1 (min -1.5 1) -1.5) (when with-bignums (test1 (min (bignum -1.5) 1) -1.5) (test1 (min -1.5 (bignum 1)) -1.5) (test1 (min (bignum -1.5) (bignum 1)) -1.5)) (test1 (min -1.5 -1) -1.5) (when with-bignums (test1 (min (bignum -1.5) -1) -1.5) (test1 (min -1.5 (bignum -1)) -1.5) (test1 (min (bignum -1.5) (bignum -1)) -1.5)) (test1 (min -1.5 1/2) -1.5) (when with-bignums (test1 (min (bignum -1.5) 1/2) -1.5) (test1 (min -1.5 (bignum 1/2)) -1.5) (test1 (min (bignum -1.5) (bignum 1/2)) -1.5)) (test1 (min -1.5 -1/2) -1.5) (when with-bignums (test1 (min (bignum -1.5) -1/2) -1.5) (test1 (min -1.5 (bignum -1/2)) -1.5) (test1 (min (bignum -1.5) (bignum -1/2)) -1.5)) (test1 (min -1.5 1.5) -1.5) (when with-bignums (test1 (min (bignum -1.5) 1.5) -1.5) (test1 (min -1.5 (bignum 1.5)) -1.5) (test1 (min (bignum -1.5) (bignum 1.5)) -1.5)) (test1 (min -1.5 -1.5) -1.5) (when with-bignums (test1 (min (bignum -1.5) -1.5) -1.5) (test1 (min -1.5 (bignum -1.5)) -1.5) (test1 (min (bignum -1.5) (bignum -1.5)) -1.5)) (test1 (min -1.5 m1) -1.5) (test1 (min m1 1) 1) (test1 (min m1 -1) -1) (test1 (min m1 1/2) 1/2) (test1 (min m1 -1/2) -1/2) (test1 (min m1 1.5) 1.5) (test1 (min m1 -1.5) -1.5) (test1 (min m1 m1) 3) (test1 (max 1 1) 1) (when with-bignums (test1 (max (bignum 1) 1) 1) (test1 (max 1 (bignum 1)) 1) (test1 (max (bignum 1) (bignum 1)) 1)) (test1 (max 1 -1) 1) (when with-bignums (test1 (max (bignum 1) -1) 1) (test1 (max 1 (bignum -1)) 1) (test1 (max (bignum 1) (bignum -1)) 1)) (test1 (max 1 1/2) 1) (when with-bignums (test1 (max (bignum 1) 1/2) 1) (test1 (max 1 (bignum 1/2)) 1) (test1 (max (bignum 1) (bignum 1/2)) 1)) (test1 (max 1 -1/2) 1) (when with-bignums (test1 (max (bignum 1) -1/2) 1) (test1 (max 1 (bignum -1/2)) 1) (test1 (max (bignum 1) (bignum -1/2)) 1)) (test1 (max 1 1.5) 1.5) (when with-bignums (test1 (max (bignum 1) 1.5) 1.5) (test1 (max 1 (bignum 1.5)) 1.5) (test1 (max (bignum 1) (bignum 1.5)) 1.5)) (test1 (max 1 -1.5) 1) (when with-bignums (test1 (max (bignum 1) -1.5) 1) (test1 (max 1 (bignum -1.5)) 1) (test1 (max (bignum 1) (bignum -1.5)) 1)) (test1 (max 1 m1) 3) (test1 (max -1 1) 1) (when with-bignums (test1 (max (bignum -1) 1) 1) (test1 (max -1 (bignum 1)) 1) (test1 (max (bignum -1) (bignum 1)) 1)) (test1 (max -1 -1) -1) (when with-bignums (test1 (max (bignum -1) -1) -1) (test1 (max -1 (bignum -1)) -1) (test1 (max (bignum -1) (bignum -1)) -1)) (test1 (max -1 1/2) 1/2) (when with-bignums (test1 (max (bignum -1) 1/2) 1/2) (test1 (max -1 (bignum 1/2)) 1/2) (test1 (max (bignum -1) (bignum 1/2)) 1/2)) (test1 (max -1 -1/2) -1/2) (when with-bignums (test1 (max (bignum -1) -1/2) -1/2) (test1 (max -1 (bignum -1/2)) -1/2) (test1 (max (bignum -1) (bignum -1/2)) -1/2)) (test1 (max -1 1.5) 1.5) (when with-bignums (test1 (max (bignum -1) 1.5) 1.5) (test1 (max -1 (bignum 1.5)) 1.5) (test1 (max (bignum -1) (bignum 1.5)) 1.5)) (test1 (max -1 -1.5) -1) (when with-bignums (test1 (max (bignum -1) -1.5) -1) (test1 (max -1 (bignum -1.5)) -1) (test1 (max (bignum -1) (bignum -1.5)) -1)) (test1 (max -1 m1) 3) (test1 (max 1/2 1) 1) (when with-bignums (test1 (max (bignum 1/2) 1) 1) (test1 (max 1/2 (bignum 1)) 1) (test1 (max (bignum 1/2) (bignum 1)) 1)) (test1 (max 1/2 -1) 1/2) (when with-bignums (test1 (max (bignum 1/2) -1) 1/2) (test1 (max 1/2 (bignum -1)) 1/2) (test1 (max (bignum 1/2) (bignum -1)) 1/2)) (test1 (max 1/2 1/2) 1/2) (when with-bignums (test1 (max (bignum 1/2) 1/2) 1/2) (test1 (max 1/2 (bignum 1/2)) 1/2) (test1 (max (bignum 1/2) (bignum 1/2)) 1/2)) (test1 (max 1/2 -1/2) 1/2) (when with-bignums (test1 (max (bignum 1/2) -1/2) 1/2) (test1 (max 1/2 (bignum -1/2)) 1/2) (test1 (max (bignum 1/2) (bignum -1/2)) 1/2)) (test1 (max 1/2 1.5) 1.5) (when with-bignums (test1 (max (bignum 1/2) 1.5) 1.5) (test1 (max 1/2 (bignum 1.5)) 1.5) (test1 (max (bignum 1/2) (bignum 1.5)) 1.5)) (test1 (max 1/2 -1.5) 1/2) (when with-bignums (test1 (max (bignum 1/2) -1.5) 1/2) (test1 (max 1/2 (bignum -1.5)) 1/2) (test1 (max (bignum 1/2) (bignum -1.5)) 1/2)) (test1 (max 1/2 m1) 3) (test1 (max -1/2 1) 1) (when with-bignums (test1 (max (bignum -1/2) 1) 1) (test1 (max -1/2 (bignum 1)) 1) (test1 (max (bignum -1/2) (bignum 1)) 1)) (test1 (max -1/2 -1) -1/2) (when with-bignums (test1 (max (bignum -1/2) -1) -1/2) (test1 (max -1/2 (bignum -1)) -1/2) (test1 (max (bignum -1/2) (bignum -1)) -1/2)) (test1 (max -1/2 1/2) 1/2) (when with-bignums (test1 (max (bignum -1/2) 1/2) 1/2) (test1 (max -1/2 (bignum 1/2)) 1/2) (test1 (max (bignum -1/2) (bignum 1/2)) 1/2)) (test1 (max -1/2 -1/2) -1/2) (when with-bignums (test1 (max (bignum -1/2) -1/2) -1/2) (test1 (max -1/2 (bignum -1/2)) -1/2) (test1 (max (bignum -1/2) (bignum -1/2)) -1/2)) (test1 (max -1/2 1.5) 1.5) (when with-bignums (test1 (max (bignum -1/2) 1.5) 1.5) (test1 (max -1/2 (bignum 1.5)) 1.5) (test1 (max (bignum -1/2) (bignum 1.5)) 1.5)) (test1 (max -1/2 -1.5) -1/2) (when with-bignums (test1 (max (bignum -1/2) -1.5) -1/2) (test1 (max -1/2 (bignum -1.5)) -1/2) (test1 (max (bignum -1/2) (bignum -1.5)) -1/2)) (test1 (max -1/2 m1) 3) (test1 (max 1.5 1) 1.5) (when with-bignums (test1 (max (bignum 1.5) 1) 1.5) (test1 (max 1.5 (bignum 1)) 1.5) (test1 (max (bignum 1.5) (bignum 1)) 1.5)) (test1 (max 1.5 -1) 1.5) (when with-bignums (test1 (max (bignum 1.5) -1) 1.5) (test1 (max 1.5 (bignum -1)) 1.5) (test1 (max (bignum 1.5) (bignum -1)) 1.5)) (test1 (max 1.5 1/2) 1.5) (when with-bignums (test1 (max (bignum 1.5) 1/2) 1.5) (test1 (max 1.5 (bignum 1/2)) 1.5) (test1 (max (bignum 1.5) (bignum 1/2)) 1.5)) (test1 (max 1.5 -1/2) 1.5) (when with-bignums (test1 (max (bignum 1.5) -1/2) 1.5) (test1 (max 1.5 (bignum -1/2)) 1.5) (test1 (max (bignum 1.5) (bignum -1/2)) 1.5)) (test1 (max 1.5 1.5) 1.5) (when with-bignums (test1 (max (bignum 1.5) 1.5) 1.5) (test1 (max 1.5 (bignum 1.5)) 1.5) (test1 (max (bignum 1.5) (bignum 1.5)) 1.5)) (test1 (max 1.5 -1.5) 1.5) (when with-bignums (test1 (max (bignum 1.5) -1.5) 1.5) (test1 (max 1.5 (bignum -1.5)) 1.5) (test1 (max (bignum 1.5) (bignum -1.5)) 1.5)) (test1 (max 1.5 m1) 3) (test1 (max -1.5 1) 1) (when with-bignums (test1 (max (bignum -1.5) 1) 1) (test1 (max -1.5 (bignum 1)) 1) (test1 (max (bignum -1.5) (bignum 1)) 1)) (test1 (max -1.5 -1) -1) (when with-bignums (test1 (max (bignum -1.5) -1) -1) (test1 (max -1.5 (bignum -1)) -1) (test1 (max (bignum -1.5) (bignum -1)) -1)) (test1 (max -1.5 1/2) 1/2) (when with-bignums (test1 (max (bignum -1.5) 1/2) 1/2) (test1 (max -1.5 (bignum 1/2)) 1/2) (test1 (max (bignum -1.5) (bignum 1/2)) 1/2)) (test1 (max -1.5 -1/2) -1/2) (when with-bignums (test1 (max (bignum -1.5) -1/2) -1/2) (test1 (max -1.5 (bignum -1/2)) -1/2) (test1 (max (bignum -1.5) (bignum -1/2)) -1/2)) (test1 (max -1.5 1.5) 1.5) (when with-bignums (test1 (max (bignum -1.5) 1.5) 1.5) (test1 (max -1.5 (bignum 1.5)) 1.5) (test1 (max (bignum -1.5) (bignum 1.5)) 1.5)) (test1 (max -1.5 -1.5) -1.5) (when with-bignums (test1 (max (bignum -1.5) -1.5) -1.5) (test1 (max -1.5 (bignum -1.5)) -1.5) (test1 (max (bignum -1.5) (bignum -1.5)) -1.5)) (test1 (max -1.5 m1) 3) (test1 (max m1 1) 3) (test1 (max m1 -1) 3) (test1 (max m1 1/2) 3) (test1 (max m1 -1/2) 3) (test1 (max m1 1.5) 3) (test1 (max m1 -1.5) 3) (test1 (max m1 m1) 3) ;; coverage tests for / (define-macro (test2 expr res) `(let ((val (catch #t (lambda () ,expr) (lambda (type info) 'error)))) (unless (equivalent? val ,res) (format *stderr* "~S -> ~S (~S)?~%" ',expr val (magnitude (- val ,res)))))) (define old-eps (*s7* 'equivalent-float-epsilon)) (set! (*s7* 'equivalent-float-epsilon) 1e-12) (test (/ 1 1) 1) (when with-bignums (test (/ (bignum 1) 1) 1) (test (/ 1 (bignum 1)) 1) (test (/ (bignum 1) (bignum 1)) 1)) (test (/ 1 -1) -1) (when with-bignums (test (/ (bignum 1) -1) -1) (test (/ 1 (bignum -1)) -1) (test (/ (bignum 1) (bignum -1)) -1)) (test (/ 1 1/2) 2) (when with-bignums (test (/ (bignum 1) 1/2) 2) (test (/ 1 (bignum 1/2)) 2) (test (/ (bignum 1) (bignum 1/2)) 2)) (test (/ 1 -1/2) -2) (when with-bignums (test (/ (bignum 1) -1/2) -2) (test (/ 1 (bignum -1/2)) -2) (test (/ (bignum 1) (bignum -1/2)) -2)) (test2 (/ 1 1.5) 0.6666666666666666) (when with-bignums (test2 (/ (bignum 1) 1.5) 0.6666666666666666) (test2 (/ 1 (bignum 1.5)) 0.6666666666666666) (test2 (/ (bignum 1) (bignum 1.5)) 0.6666666666666666)) (test2 (/ 1 -1.5) -0.6666666666666666) (when with-bignums (test2 (/ (bignum 1) -1.5) -0.6666666666666666) (test2 (/ 1 (bignum -1.5)) -0.6666666666666666) (test2 (/ (bignum 1) (bignum -1.5)) -0.6666666666666666)) (test (/ 1 1.0+1.0i) 0.5-0.5i) (when with-bignums (test (/ (bignum 1) 1.0+1.0i) 0.5-0.5i) (test (/ 1 (bignum 1.0+1.0i)) 0.5-0.5i) (test (/ (bignum 1) (bignum 1.0+1.0i)) 0.5-0.5i)) (test (/ 1 1.0-1.0i) 0.5+0.5i) (when with-bignums (test (/ (bignum 1) 1.0-1.0i) 0.5+0.5i) (test (/ 1 (bignum 1.0-1.0i)) 0.5+0.5i) (test (/ (bignum 1) (bignum 1.0-1.0i)) 0.5+0.5i)) (test (/ 1 m1) 1/3) (test (/ -1 1) -1) (when with-bignums (test (/ (bignum -1) 1) -1) (test (/ -1 (bignum 1)) -1) (test (/ (bignum -1) (bignum 1)) -1)) (test (/ -1 -1) 1) (when with-bignums (test (/ (bignum -1) -1) 1) (test (/ -1 (bignum -1)) 1) (test (/ (bignum -1) (bignum -1)) 1)) (test (/ -1 1/2) -2) (when with-bignums (test (/ (bignum -1) 1/2) -2) (test (/ -1 (bignum 1/2)) -2) (test (/ (bignum -1) (bignum 1/2)) -2)) (test (/ -1 -1/2) 2) (when with-bignums (test (/ (bignum -1) -1/2) 2) (test (/ -1 (bignum -1/2)) 2) (test (/ (bignum -1) (bignum -1/2)) 2)) (test2 (/ -1 1.5) -0.6666666666666666) (when with-bignums (test2 (/ (bignum -1) 1.5) -0.6666666666666666) (test2 (/ -1 (bignum 1.5)) -0.6666666666666666) (test2 (/ (bignum -1) (bignum 1.5)) -0.6666666666666666)) (test2 (/ -1 -1.5) 0.6666666666666666) (when with-bignums (test2 (/ (bignum -1) -1.5) 0.6666666666666666) (test2 (/ -1 (bignum -1.5)) 0.6666666666666666) (test2 (/ (bignum -1) (bignum -1.5)) 0.6666666666666666)) (test (/ -1 1.0+1.0i) -0.5+0.5i) (when with-bignums (test (/ (bignum -1) 1.0+1.0i) -0.5+0.5i) (test (/ -1 (bignum 1.0+1.0i)) -0.5+0.5i) (test (/ (bignum -1) (bignum 1.0+1.0i)) -0.5+0.5i)) (test (/ -1 1.0-1.0i) -0.5-0.5i) (when with-bignums (test (/ (bignum -1) 1.0-1.0i) -0.5-0.5i) (test (/ -1 (bignum 1.0-1.0i)) -0.5-0.5i) (test (/ (bignum -1) (bignum 1.0-1.0i)) -0.5-0.5i)) (test (/ -1 m1) -1/3) (test (/ 1/2 1) 1/2) (when with-bignums (test (/ (bignum 1/2) 1) 1/2) (test (/ 1/2 (bignum 1)) 1/2) (test (/ (bignum 1/2) (bignum 1)) 1/2)) (test (/ 1/2 -1) -1/2) (when with-bignums (test (/ (bignum 1/2) -1) -1/2) (test (/ 1/2 (bignum -1)) -1/2) (test (/ (bignum 1/2) (bignum -1)) -1/2)) (test (/ 1/2 1/2) 1) (when with-bignums (test (/ (bignum 1/2) 1/2) 1) (test (/ 1/2 (bignum 1/2)) 1) (test (/ (bignum 1/2) (bignum 1/2)) 1)) (test (/ 1/2 -1/2) -1) (when with-bignums (test (/ (bignum 1/2) -1/2) -1) (test (/ 1/2 (bignum -1/2)) -1) (test (/ (bignum 1/2) (bignum -1/2)) -1)) (test2 (/ 1/2 1.5) 0.3333333333333333) (when with-bignums (test2 (/ (bignum 1/2) 1.5) 0.3333333333333333) (test2 (/ 1/2 (bignum 1.5)) 0.3333333333333333) (test2 (/ (bignum 1/2) (bignum 1.5)) 0.3333333333333333)) (test2 (/ 1/2 -1.5) -0.3333333333333333) (when with-bignums (test2 (/ (bignum 1/2) -1.5) -0.3333333333333333) (test2 (/ 1/2 (bignum -1.5)) -0.3333333333333333) (test2 (/ (bignum 1/2) (bignum -1.5)) -0.3333333333333333)) (test (/ 1/2 1.0+1.0i) 0.25-0.25i) (when with-bignums (test (/ (bignum 1/2) 1.0+1.0i) 0.25-0.25i) (test (/ 1/2 (bignum 1.0+1.0i)) 0.25-0.25i) (test (/ (bignum 1/2) (bignum 1.0+1.0i)) 0.25-0.25i)) (test (/ 1/2 1.0-1.0i) 0.25+0.25i) (when with-bignums (test (/ (bignum 1/2) 1.0-1.0i) 0.25+0.25i) (test (/ 1/2 (bignum 1.0-1.0i)) 0.25+0.25i) (test (/ (bignum 1/2) (bignum 1.0-1.0i)) 0.25+0.25i)) (test (/ 1/2 m1) 1/6) (test (/ -1/2 1) -1/2) (when with-bignums (test (/ (bignum -1/2) 1) -1/2) (test (/ -1/2 (bignum 1)) -1/2) (test (/ (bignum -1/2) (bignum 1)) -1/2)) (test (/ -1/2 -1) 1/2) (when with-bignums (test (/ (bignum -1/2) -1) 1/2) (test (/ -1/2 (bignum -1)) 1/2) (test (/ (bignum -1/2) (bignum -1)) 1/2)) (test (/ -1/2 1/2) -1) (when with-bignums (test (/ (bignum -1/2) 1/2) -1) (test (/ -1/2 (bignum 1/2)) -1) (test (/ (bignum -1/2) (bignum 1/2)) -1)) (test (/ -1/2 -1/2) 1) (when with-bignums (test (/ (bignum -1/2) -1/2) 1) (test (/ -1/2 (bignum -1/2)) 1) (test (/ (bignum -1/2) (bignum -1/2)) 1)) (test2 (/ -1/2 1.5) -0.3333333333333333) (when with-bignums (test2 (/ (bignum -1/2) 1.5) -0.3333333333333333) (test2 (/ -1/2 (bignum 1.5)) -0.3333333333333333) (test2 (/ (bignum -1/2) (bignum 1.5)) -0.3333333333333333)) (test2 (/ -1/2 -1.5) 0.3333333333333333) (when with-bignums (test2 (/ (bignum -1/2) -1.5) 0.3333333333333333) (test2 (/ -1/2 (bignum -1.5)) 0.3333333333333333) (test2 (/ (bignum -1/2) (bignum -1.5)) 0.3333333333333333)) (test (/ -1/2 1.0+1.0i) -0.25+0.25i) (when with-bignums (test (/ (bignum -1/2) 1.0+1.0i) -0.25+0.25i) (test (/ -1/2 (bignum 1.0+1.0i)) -0.25+0.25i) (test (/ (bignum -1/2) (bignum 1.0+1.0i)) -0.25+0.25i)) (test (/ -1/2 1.0-1.0i) -0.25-0.25i) (when with-bignums (test (/ (bignum -1/2) 1.0-1.0i) -0.25-0.25i) (test (/ -1/2 (bignum 1.0-1.0i)) -0.25-0.25i) (test (/ (bignum -1/2) (bignum 1.0-1.0i)) -0.25-0.25i)) (test (/ -1/2 m1) -1/6) (test (/ 1.5 1) 1.5) (when with-bignums (test (/ (bignum 1.5) 1) 1.5) (test (/ 1.5 (bignum 1)) 1.5) (test (/ (bignum 1.5) (bignum 1)) 1.5)) (test (/ 1.5 -1) -1.5) (when with-bignums (test (/ (bignum 1.5) -1) -1.5) (test (/ 1.5 (bignum -1)) -1.5) (test (/ (bignum 1.5) (bignum -1)) -1.5)) (test (/ 1.5 1/2) 3.0) (when with-bignums (test (/ (bignum 1.5) 1/2) 3.0) (test (/ 1.5 (bignum 1/2)) 3.0) (test (/ (bignum 1.5) (bignum 1/2)) 3.0)) (test (/ 1.5 -1/2) -3.0) (when with-bignums (test (/ (bignum 1.5) -1/2) -3.0) (test (/ 1.5 (bignum -1/2)) -3.0) (test (/ (bignum 1.5) (bignum -1/2)) -3.0)) (test (/ 1.5 1.5) 1.0) (when with-bignums (test (/ (bignum 1.5) 1.5) 1.0) (test (/ 1.5 (bignum 1.5)) 1.0) (test (/ (bignum 1.5) (bignum 1.5)) 1.0)) (test (/ 1.5 -1.5) -1.0) (when with-bignums (test (/ (bignum 1.5) -1.5) -1.0) (test (/ 1.5 (bignum -1.5)) -1.0) (test (/ (bignum 1.5) (bignum -1.5)) -1.0)) (test (/ 1.5 1.0+1.0i) 0.75-0.75i) (when with-bignums (test (/ (bignum 1.5) 1.0+1.0i) 0.75-0.75i) (test (/ 1.5 (bignum 1.0+1.0i)) 0.75-0.75i) (test (/ (bignum 1.5) (bignum 1.0+1.0i)) 0.75-0.75i)) (test (/ 1.5 1.0-1.0i) 0.75+0.75i) (when with-bignums (test (/ (bignum 1.5) 1.0-1.0i) 0.75+0.75i) (test (/ 1.5 (bignum 1.0-1.0i)) 0.75+0.75i) (test (/ (bignum 1.5) (bignum 1.0-1.0i)) 0.75+0.75i)) (test (/ 1.5 m1) 0.5) (test (/ -1.5 1) -1.5) (when with-bignums (test (/ (bignum -1.5) 1) -1.5) (test (/ -1.5 (bignum 1)) -1.5) (test (/ (bignum -1.5) (bignum 1)) -1.5)) (test (/ -1.5 -1) 1.5) (when with-bignums (test (/ (bignum -1.5) -1) 1.5) (test (/ -1.5 (bignum -1)) 1.5) (test (/ (bignum -1.5) (bignum -1)) 1.5)) (test (/ -1.5 1/2) -3.0) (when with-bignums (test (/ (bignum -1.5) 1/2) -3.0) (test (/ -1.5 (bignum 1/2)) -3.0) (test (/ (bignum -1.5) (bignum 1/2)) -3.0)) (test (/ -1.5 -1/2) 3.0) (when with-bignums (test (/ (bignum -1.5) -1/2) 3.0) (test (/ -1.5 (bignum -1/2)) 3.0) (test (/ (bignum -1.5) (bignum -1/2)) 3.0)) (test (/ -1.5 1.5) -1.0) (when with-bignums (test (/ (bignum -1.5) 1.5) -1.0) (test (/ -1.5 (bignum 1.5)) -1.0) (test (/ (bignum -1.5) (bignum 1.5)) -1.0)) (test (/ -1.5 -1.5) 1.0) (when with-bignums (test (/ (bignum -1.5) -1.5) 1.0) (test (/ -1.5 (bignum -1.5)) 1.0) (test (/ (bignum -1.5) (bignum -1.5)) 1.0)) (test (/ -1.5 1.0+1.0i) -0.75+0.75i) (when with-bignums (test (/ (bignum -1.5) 1.0+1.0i) -0.75+0.75i) (test (/ -1.5 (bignum 1.0+1.0i)) -0.75+0.75i) (test (/ (bignum -1.5) (bignum 1.0+1.0i)) -0.75+0.75i)) (test (/ -1.5 1.0-1.0i) -0.75-0.75i) (when with-bignums (test (/ (bignum -1.5) 1.0-1.0i) -0.75-0.75i) (test (/ -1.5 (bignum 1.0-1.0i)) -0.75-0.75i) (test (/ (bignum -1.5) (bignum 1.0-1.0i)) -0.75-0.75i)) (test (/ -1.5 m1) -0.5) (test (/ 1.0+1.0i 1) 1.0+1.0i) (when with-bignums (test (/ (bignum 1.0+1.0i) 1) 1.0+1.0i) (test (/ 1.0+1.0i (bignum 1)) 1.0+1.0i) (test (/ (bignum 1.0+1.0i) (bignum 1)) 1.0+1.0i)) (test (/ 1.0+1.0i -1) -1.0-1.0i) (when with-bignums (test (/ (bignum 1.0+1.0i) -1) -1.0-1.0i) (test (/ 1.0+1.0i (bignum -1)) -1.0-1.0i) (test (/ (bignum 1.0+1.0i) (bignum -1)) -1.0-1.0i)) (test (/ 1.0+1.0i 1/2) 2.0+2.0i) (when with-bignums (test (/ (bignum 1.0+1.0i) 1/2) 2.0+2.0i) (test (/ 1.0+1.0i (bignum 1/2)) 2.0+2.0i) (test (/ (bignum 1.0+1.0i) (bignum 1/2)) 2.0+2.0i)) (test (/ 1.0+1.0i -1/2) -2.0-2.0i) (when with-bignums (test (/ (bignum 1.0+1.0i) -1/2) -2.0-2.0i) (test (/ 1.0+1.0i (bignum -1/2)) -2.0-2.0i) (test (/ (bignum 1.0+1.0i) (bignum -1/2)) -2.0-2.0i)) (test2 (/ 1.0+1.0i 1.5) 0.6666666666666666+0.6666666666666666i) (when with-bignums (test2 (/ (bignum 1.0+1.0i) 1.5) 0.6666666666666666+0.6666666666666666i) (test2 (/ 1.0+1.0i (bignum 1.5)) 0.6666666666666666+0.6666666666666666i) (test2 (/ (bignum 1.0+1.0i) (bignum 1.5)) 0.6666666666666666+0.6666666666666666i)) (test2 (/ 1.0+1.0i -1.5) -0.6666666666666666-0.6666666666666666i) (when with-bignums (test2 (/ (bignum 1.0+1.0i) -1.5) -0.6666666666666666-0.6666666666666666i) (test2 (/ 1.0+1.0i (bignum -1.5)) -0.6666666666666666-0.6666666666666666i) (test2 (/ (bignum 1.0+1.0i) (bignum -1.5)) -0.6666666666666666-0.6666666666666666i)) (test (/ 1.0+1.0i 1.0+1.0i) 1.0) (when with-bignums (test (/ (bignum 1.0+1.0i) 1.0+1.0i) 1.0) (test (/ 1.0+1.0i (bignum 1.0+1.0i)) 1.0) (test (/ (bignum 1.0+1.0i) (bignum 1.0+1.0i)) 1.0)) (test (/ 1.0+1.0i 1.0-1.0i) 0.0+1.0i) (when with-bignums (test (/ (bignum 1.0+1.0i) 1.0-1.0i) 0.0+1.0i) (test (/ 1.0+1.0i (bignum 1.0-1.0i)) 0.0+1.0i) (test (/ (bignum 1.0+1.0i) (bignum 1.0-1.0i)) 0.0+1.0i)) (test2 (/ 1.0+1.0i m1) 0.3333333333333333+0.3333333333333333i) (test (/ 1.0-1.0i 1) 1.0-1.0i) (when with-bignums (test (/ (bignum 1.0-1.0i) 1) 1.0-1.0i) (test (/ 1.0-1.0i (bignum 1)) 1.0-1.0i) (test (/ (bignum 1.0-1.0i) (bignum 1)) 1.0-1.0i)) (test (/ 1.0-1.0i -1) -1.0+1.0i) (when with-bignums (test (/ (bignum 1.0-1.0i) -1) -1.0+1.0i) (test (/ 1.0-1.0i (bignum -1)) -1.0+1.0i) (test (/ (bignum 1.0-1.0i) (bignum -1)) -1.0+1.0i)) (test (/ 1.0-1.0i 1/2) 2.0-2.0i) (when with-bignums (test (/ (bignum 1.0-1.0i) 1/2) 2.0-2.0i) (test (/ 1.0-1.0i (bignum 1/2)) 2.0-2.0i) (test (/ (bignum 1.0-1.0i) (bignum 1/2)) 2.0-2.0i)) (test (/ 1.0-1.0i -1/2) -2.0+2.0i) (when with-bignums (test (/ (bignum 1.0-1.0i) -1/2) -2.0+2.0i) (test (/ 1.0-1.0i (bignum -1/2)) -2.0+2.0i) (test (/ (bignum 1.0-1.0i) (bignum -1/2)) -2.0+2.0i)) (test2 (/ 1.0-1.0i 1.5) 0.6666666666666666-0.6666666666666666i) (when with-bignums (test2 (/ (bignum 1.0-1.0i) 1.5) 0.6666666666666666-0.6666666666666666i) (test2 (/ 1.0-1.0i (bignum 1.5)) 0.6666666666666666-0.6666666666666666i) (test2 (/ (bignum 1.0-1.0i) (bignum 1.5)) 0.6666666666666666-0.6666666666666666i)) (test2 (/ 1.0-1.0i -1.5) -0.6666666666666666+0.6666666666666666i) (when with-bignums (test2 (/ (bignum 1.0-1.0i) -1.5) -0.6666666666666666+0.6666666666666666i) (test2 (/ 1.0-1.0i (bignum -1.5)) -0.6666666666666666+0.6666666666666666i) (test2 (/ (bignum 1.0-1.0i) (bignum -1.5)) -0.6666666666666666+0.6666666666666666i)) (test (/ 1.0-1.0i 1.0+1.0i) 0.0-1.0i) (when with-bignums (test (/ (bignum 1.0-1.0i) 1.0+1.0i) 0.0-1.0i) (test (/ 1.0-1.0i (bignum 1.0+1.0i)) 0.0-1.0i) (test (/ (bignum 1.0-1.0i) (bignum 1.0+1.0i)) 0.0-1.0i)) (test (/ 1.0-1.0i 1.0-1.0i) 1.0) (when with-bignums (test (/ (bignum 1.0-1.0i) 1.0-1.0i) 1.0) (test (/ 1.0-1.0i (bignum 1.0-1.0i)) 1.0) (test (/ (bignum 1.0-1.0i) (bignum 1.0-1.0i)) 1.0)) (test2 (/ 1.0-1.0i m1) 0.3333333333333333-0.3333333333333333i) (test (/ m1 1) 3) (test (/ m1 -1) -3) (test (/ m1 1/2) 6) (test (/ m1 -1/2) -6) (test (/ m1 1.5) 2.0) (test (/ m1 -1.5) -2.0) (test (/ m1 1.0+1.0i) 1.5-1.5i) (test (/ m1 1.0-1.0i) 1.5+1.5i) (test (/ m1 m1) 1) (set! (*s7* 'equivalent-float-epsilon) old-eps) ;; coverage tests for - (test (- 1 1) 0) (when with-bignums (test (- (bignum 1) 1) 0) (test (- 1 (bignum 1)) 0) (test (- (bignum 1) (bignum 1)) 0)) (test (- 1 -1) 2) (when with-bignums (test (- (bignum 1) -1) 2) (test (- 1 (bignum -1)) 2) (test (- (bignum 1) (bignum -1)) 2)) (test (- 1 1/2) 1/2) (when with-bignums (test (- (bignum 1) 1/2) 1/2) (test (- 1 (bignum 1/2)) 1/2) (test (- (bignum 1) (bignum 1/2)) 1/2)) (test (- 1 -1/2) 3/2) (when with-bignums (test (- (bignum 1) -1/2) 3/2) (test (- 1 (bignum -1/2)) 3/2) (test (- (bignum 1) (bignum -1/2)) 3/2)) (test (- 1 1.5) -0.5) (when with-bignums (test (- (bignum 1) 1.5) -0.5) (test (- 1 (bignum 1.5)) -0.5) (test (- (bignum 1) (bignum 1.5)) -0.5)) (test (- 1 -1.5) 2.5) (when with-bignums (test (- (bignum 1) -1.5) 2.5) (test (- 1 (bignum -1.5)) 2.5) (test (- (bignum 1) (bignum -1.5)) 2.5)) (test (- 1 1.0+1.0i) 0.0-1.0i) (when with-bignums (test (- (bignum 1) 1.0+1.0i) 0.0-1.0i) (test (- 1 (bignum 1.0+1.0i)) 0.0-1.0i) (test (- (bignum 1) (bignum 1.0+1.0i)) 0.0-1.0i)) (test (- 1 1.0-1.0i) 0.0+1.0i) (when with-bignums (test (- (bignum 1) 1.0-1.0i) 0.0+1.0i) (test (- 1 (bignum 1.0-1.0i)) 0.0+1.0i) (test (- (bignum 1) (bignum 1.0-1.0i)) 0.0+1.0i)) (test (- 1 m1) -2) (test2 (- 1 +nan.0) +nan.0) (when with-bignums (test2 (- (bignum 1) +nan.0) +nan.0) (test2 (- 1 (bignum +nan.0)) +nan.0) (test2 (- (bignum 1) (bignum +nan.0)) +nan.0)) (test (- -1 1) -2) (when with-bignums (test (- (bignum -1) 1) -2) (test (- -1 (bignum 1)) -2) (test (- (bignum -1) (bignum 1)) -2)) (test (- -1 -1) 0) (when with-bignums (test (- (bignum -1) -1) 0) (test (- -1 (bignum -1)) 0) (test (- (bignum -1) (bignum -1)) 0)) (test (- -1 1/2) -3/2) (when with-bignums (test (- (bignum -1) 1/2) -3/2) (test (- -1 (bignum 1/2)) -3/2) (test (- (bignum -1) (bignum 1/2)) -3/2)) (test (- -1 -1/2) -1/2) (when with-bignums (test (- (bignum -1) -1/2) -1/2) (test (- -1 (bignum -1/2)) -1/2) (test (- (bignum -1) (bignum -1/2)) -1/2)) (test (- -1 1.5) -2.5) (when with-bignums (test (- (bignum -1) 1.5) -2.5) (test (- -1 (bignum 1.5)) -2.5) (test (- (bignum -1) (bignum 1.5)) -2.5)) (test (- -1 -1.5) 0.5) (when with-bignums (test (- (bignum -1) -1.5) 0.5) (test (- -1 (bignum -1.5)) 0.5) (test (- (bignum -1) (bignum -1.5)) 0.5)) (test (- -1 1.0+1.0i) -2.0-1.0i) (when with-bignums (test (- (bignum -1) 1.0+1.0i) -2.0-1.0i) (test (- -1 (bignum 1.0+1.0i)) -2.0-1.0i) (test (- (bignum -1) (bignum 1.0+1.0i)) -2.0-1.0i)) (test (- -1 1.0-1.0i) -2.0+1.0i) (when with-bignums (test (- (bignum -1) 1.0-1.0i) -2.0+1.0i) (test (- -1 (bignum 1.0-1.0i)) -2.0+1.0i) (test (- (bignum -1) (bignum 1.0-1.0i)) -2.0+1.0i)) (test (- -1 m1) -4) (test2 (- -1 +nan.0) +nan.0) (when with-bignums (test2 (- (bignum -1) +nan.0) +nan.0) (test2 (- -1 (bignum +nan.0)) +nan.0) (test2 (- (bignum -1) (bignum +nan.0)) +nan.0)) (test (- 1/2 1) -1/2) (when with-bignums (test (- (bignum 1/2) 1) -1/2) (test (- 1/2 (bignum 1)) -1/2) (test (- (bignum 1/2) (bignum 1)) -1/2)) (test (- 1/2 -1) 3/2) (when with-bignums (test (- (bignum 1/2) -1) 3/2) (test (- 1/2 (bignum -1)) 3/2) (test (- (bignum 1/2) (bignum -1)) 3/2)) (test (- 1/2 1/2) 0) (when with-bignums (test (- (bignum 1/2) 1/2) 0) (test (- 1/2 (bignum 1/2)) 0) (test (- (bignum 1/2) (bignum 1/2)) 0)) (test (- 1/2 -1/2) 1) (when with-bignums (test (- (bignum 1/2) -1/2) 1) (test (- 1/2 (bignum -1/2)) 1) (test (- (bignum 1/2) (bignum -1/2)) 1)) (test (- 1/2 1.5) -1.0) (when with-bignums (test (- (bignum 1/2) 1.5) -1.0) (test (- 1/2 (bignum 1.5)) -1.0) (test (- (bignum 1/2) (bignum 1.5)) -1.0)) (test (- 1/2 -1.5) 2.0) (when with-bignums (test (- (bignum 1/2) -1.5) 2.0) (test (- 1/2 (bignum -1.5)) 2.0) (test (- (bignum 1/2) (bignum -1.5)) 2.0)) (test (- 1/2 1.0+1.0i) -0.5-1.0i) (when with-bignums (test (- (bignum 1/2) 1.0+1.0i) -0.5-1.0i) (test (- 1/2 (bignum 1.0+1.0i)) -0.5-1.0i) (test (- (bignum 1/2) (bignum 1.0+1.0i)) -0.5-1.0i)) (test (- 1/2 1.0-1.0i) -0.5+1.0i) (when with-bignums (test (- (bignum 1/2) 1.0-1.0i) -0.5+1.0i) (test (- 1/2 (bignum 1.0-1.0i)) -0.5+1.0i) (test (- (bignum 1/2) (bignum 1.0-1.0i)) -0.5+1.0i)) (test (- 1/2 m1) -5/2) (test2 (- 1/2 +nan.0) +nan.0) (when with-bignums (test2 (- (bignum 1/2) +nan.0) +nan.0) (test2 (- 1/2 (bignum +nan.0)) +nan.0) (test2 (- (bignum 1/2) (bignum +nan.0)) +nan.0)) (test (- -1/2 1) -3/2) (when with-bignums (test (- (bignum -1/2) 1) -3/2) (test (- -1/2 (bignum 1)) -3/2) (test (- (bignum -1/2) (bignum 1)) -3/2)) (test (- -1/2 -1) 1/2) (when with-bignums (test (- (bignum -1/2) -1) 1/2) (test (- -1/2 (bignum -1)) 1/2) (test (- (bignum -1/2) (bignum -1)) 1/2)) (test (- -1/2 1/2) -1) (when with-bignums (test (- (bignum -1/2) 1/2) -1) (test (- -1/2 (bignum 1/2)) -1) (test (- (bignum -1/2) (bignum 1/2)) -1)) (test (- -1/2 -1/2) 0) (when with-bignums (test (- (bignum -1/2) -1/2) 0) (test (- -1/2 (bignum -1/2)) 0) (test (- (bignum -1/2) (bignum -1/2)) 0)) (test (- -1/2 1.5) -2.0) (when with-bignums (test (- (bignum -1/2) 1.5) -2.0) (test (- -1/2 (bignum 1.5)) -2.0) (test (- (bignum -1/2) (bignum 1.5)) -2.0)) (test (- -1/2 -1.5) 1.0) (when with-bignums (test (- (bignum -1/2) -1.5) 1.0) (test (- -1/2 (bignum -1.5)) 1.0) (test (- (bignum -1/2) (bignum -1.5)) 1.0)) (test (- -1/2 1.0+1.0i) -1.5-1.0i) (when with-bignums (test (- (bignum -1/2) 1.0+1.0i) -1.5-1.0i) (test (- -1/2 (bignum 1.0+1.0i)) -1.5-1.0i) (test (- (bignum -1/2) (bignum 1.0+1.0i)) -1.5-1.0i)) (test (- -1/2 1.0-1.0i) -1.5+1.0i) (when with-bignums (test (- (bignum -1/2) 1.0-1.0i) -1.5+1.0i) (test (- -1/2 (bignum 1.0-1.0i)) -1.5+1.0i) (test (- (bignum -1/2) (bignum 1.0-1.0i)) -1.5+1.0i)) (test (- -1/2 m1) -7/2) (test2 (- -1/2 +nan.0) +nan.0) (when with-bignums (test2 (- (bignum -1/2) +nan.0) +nan.0) (test2 (- -1/2 (bignum +nan.0)) +nan.0) (test2 (- (bignum -1/2) (bignum +nan.0)) +nan.0)) (test (- 1.5 1) 0.5) (when with-bignums (test (- (bignum 1.5) 1) 0.5) (test (- 1.5 (bignum 1)) 0.5) (test (- (bignum 1.5) (bignum 1)) 0.5)) (test (- 1.5 -1) 2.5) (when with-bignums (test (- (bignum 1.5) -1) 2.5) (test (- 1.5 (bignum -1)) 2.5) (test (- (bignum 1.5) (bignum -1)) 2.5)) (test (- 1.5 1/2) 1.0) (when with-bignums (test (- (bignum 1.5) 1/2) 1.0) (test (- 1.5 (bignum 1/2)) 1.0) (test (- (bignum 1.5) (bignum 1/2)) 1.0)) (test (- 1.5 -1/2) 2.0) (when with-bignums (test (- (bignum 1.5) -1/2) 2.0) (test (- 1.5 (bignum -1/2)) 2.0) (test (- (bignum 1.5) (bignum -1/2)) 2.0)) (test (- 1.5 1.5) 0.0) (when with-bignums (test (- (bignum 1.5) 1.5) 0.0) (test (- 1.5 (bignum 1.5)) 0.0) (test (- (bignum 1.5) (bignum 1.5)) 0.0)) (test (- 1.5 -1.5) 3.0) (when with-bignums (test (- (bignum 1.5) -1.5) 3.0) (test (- 1.5 (bignum -1.5)) 3.0) (test (- (bignum 1.5) (bignum -1.5)) 3.0)) (test (- 1.5 1.0+1.0i) 0.5-1.0i) (when with-bignums (test (- (bignum 1.5) 1.0+1.0i) 0.5-1.0i) (test (- 1.5 (bignum 1.0+1.0i)) 0.5-1.0i) (test (- (bignum 1.5) (bignum 1.0+1.0i)) 0.5-1.0i)) (test (- 1.5 1.0-1.0i) 0.5+1.0i) (when with-bignums (test (- (bignum 1.5) 1.0-1.0i) 0.5+1.0i) (test (- 1.5 (bignum 1.0-1.0i)) 0.5+1.0i) (test (- (bignum 1.5) (bignum 1.0-1.0i)) 0.5+1.0i)) (test (- 1.5 m1) -1.5) (test2 (- 1.5 +nan.0) +nan.0) (when with-bignums (test2 (- (bignum 1.5) +nan.0) +nan.0) (test2 (- 1.5 (bignum +nan.0)) +nan.0) (test2 (- (bignum 1.5) (bignum +nan.0)) +nan.0)) (test (- -1.5 1) -2.5) (when with-bignums (test (- (bignum -1.5) 1) -2.5) (test (- -1.5 (bignum 1)) -2.5) (test (- (bignum -1.5) (bignum 1)) -2.5)) (test (- -1.5 -1) -0.5) (when with-bignums (test (- (bignum -1.5) -1) -0.5) (test (- -1.5 (bignum -1)) -0.5) (test (- (bignum -1.5) (bignum -1)) -0.5)) (test (- -1.5 1/2) -2.0) (when with-bignums (test (- (bignum -1.5) 1/2) -2.0) (test (- -1.5 (bignum 1/2)) -2.0) (test (- (bignum -1.5) (bignum 1/2)) -2.0)) (test (- -1.5 -1/2) -1.0) (when with-bignums (test (- (bignum -1.5) -1/2) -1.0) (test (- -1.5 (bignum -1/2)) -1.0) (test (- (bignum -1.5) (bignum -1/2)) -1.0)) (test (- -1.5 1.5) -3.0) (when with-bignums (test (- (bignum -1.5) 1.5) -3.0) (test (- -1.5 (bignum 1.5)) -3.0) (test (- (bignum -1.5) (bignum 1.5)) -3.0)) (test (- -1.5 -1.5) 0.0) (when with-bignums (test (- (bignum -1.5) -1.5) 0.0) (test (- -1.5 (bignum -1.5)) 0.0) (test (- (bignum -1.5) (bignum -1.5)) 0.0)) (test (- -1.5 1.0+1.0i) -2.5-1.0i) (when with-bignums (test (- (bignum -1.5) 1.0+1.0i) -2.5-1.0i) (test (- -1.5 (bignum 1.0+1.0i)) -2.5-1.0i) (test (- (bignum -1.5) (bignum 1.0+1.0i)) -2.5-1.0i)) (test (- -1.5 1.0-1.0i) -2.5+1.0i) (when with-bignums (test (- (bignum -1.5) 1.0-1.0i) -2.5+1.0i) (test (- -1.5 (bignum 1.0-1.0i)) -2.5+1.0i) (test (- (bignum -1.5) (bignum 1.0-1.0i)) -2.5+1.0i)) (test (- -1.5 m1) -4.5) (test2 (- -1.5 +nan.0) +nan.0) (when with-bignums (test2 (- (bignum -1.5) +nan.0) +nan.0) (test2 (- -1.5 (bignum +nan.0)) +nan.0) (test2 (- (bignum -1.5) (bignum +nan.0)) +nan.0)) (test (- m1 1) 2) (test (- m1 -1) 4) (test (- m1 1/2) 5/2) (test (- m1 -1/2) 7/2) (test (- m1 1.5) 1.5) (test (- m1 -1.5) 4.5) (test (- m1 1.0+1.0i) 2.0-1.0i) (test (- m1 1.0-1.0i) 2.0+1.0i) (test (- m1 m1) 0) (test2 (- m1 +nan.0) +nan.0) (test2 (- +nan.0 1) +nan.0) (when with-bignums (test2 (- (bignum +nan.0) 1) +nan.0) (test2 (- +nan.0 (bignum 1)) +nan.0) (test2 (- (bignum +nan.0) (bignum 1)) +nan.0)) (test2 (- +nan.0 -1) +nan.0) (when with-bignums (test2 (- (bignum +nan.0) -1) +nan.0) (test2 (- +nan.0 (bignum -1)) +nan.0) (test2 (- (bignum +nan.0) (bignum -1)) +nan.0)) (test2 (- +nan.0 1/2) +nan.0) (when with-bignums (test2 (- (bignum +nan.0) 1/2) +nan.0) (test2 (- +nan.0 (bignum 1/2)) +nan.0) (test2 (- (bignum +nan.0) (bignum 1/2)) +nan.0)) (test2 (- +nan.0 -1/2) +nan.0) (when with-bignums (test2 (- (bignum +nan.0) -1/2) +nan.0) (test2 (- +nan.0 (bignum -1/2)) +nan.0) (test2 (- (bignum +nan.0) (bignum -1/2)) +nan.0)) (test2 (- +nan.0 1.5) +nan.0) (when with-bignums (test2 (- (bignum +nan.0) 1.5) +nan.0) (test2 (- +nan.0 (bignum 1.5)) +nan.0) (test2 (- (bignum +nan.0) (bignum 1.5)) +nan.0)) (test2 (- +nan.0 -1.5) +nan.0) (when with-bignums (test2 (- (bignum +nan.0) -1.5) +nan.0) (test2 (- +nan.0 (bignum -1.5)) +nan.0) (test2 (- (bignum +nan.0) (bignum -1.5)) +nan.0)) (test2 (- +nan.0 1.0+1.0i) +nan.0-1.0i) (when with-bignums (test2 (- (bignum +nan.0) 1.0+1.0i) +nan.0-1.0i) (test2 (- +nan.0 (bignum 1.0+1.0i)) +nan.0-1.0i) (test2 (- (bignum +nan.0) (bignum 1.0+1.0i)) +nan.0-1.0i)) (test2 (- +nan.0 1.0-1.0i) +nan.0+1.0i) (when with-bignums (test2 (- (bignum +nan.0) 1.0-1.0i) +nan.0+1.0i) (test2 (- +nan.0 (bignum 1.0-1.0i)) +nan.0+1.0i) (test2 (- (bignum +nan.0) (bignum 1.0-1.0i)) +nan.0+1.0i)) (test2 (- +nan.0 m1) +nan.0) (test2 (- +nan.0 +nan.0) +nan.0) (when with-bignums (test2 (- (bignum +nan.0) +nan.0) +nan.0) (test2 (- +nan.0 (bignum +nan.0)) +nan.0) (test2 (- (bignum +nan.0) (bignum +nan.0)) +nan.0)) ;; coverage tests for + (test (+ 1 1) 2) (when with-bignums (test (+ (bignum 1) 1) 2) (test (+ 1 (bignum 1)) 2) (test (+ (bignum 1) (bignum 1)) 2)) (test (+ 1 -1) 0) (when with-bignums (test (+ (bignum 1) -1) 0) (test (+ 1 (bignum -1)) 0) (test (+ (bignum 1) (bignum -1)) 0)) (test (+ 1 1/2) 3/2) (when with-bignums (test (+ (bignum 1) 1/2) 3/2) (test (+ 1 (bignum 1/2)) 3/2) (test (+ (bignum 1) (bignum 1/2)) 3/2)) (test (+ 1 -1/2) 1/2) (when with-bignums (test (+ (bignum 1) -1/2) 1/2) (test (+ 1 (bignum -1/2)) 1/2) (test (+ (bignum 1) (bignum -1/2)) 1/2)) (test (+ 1 1.5) 2.5) (when with-bignums (test (+ (bignum 1) 1.5) 2.5) (test (+ 1 (bignum 1.5)) 2.5) (test (+ (bignum 1) (bignum 1.5)) 2.5)) (test (+ 1 -1.5) -0.5) (when with-bignums (test (+ (bignum 1) -1.5) -0.5) (test (+ 1 (bignum -1.5)) -0.5) (test (+ (bignum 1) (bignum -1.5)) -0.5)) (test (+ 1 1.0+1.0i) 2.0+1.0i) (when with-bignums (test (+ (bignum 1) 1.0+1.0i) 2.0+1.0i) (test (+ 1 (bignum 1.0+1.0i)) 2.0+1.0i) (test (+ (bignum 1) (bignum 1.0+1.0i)) 2.0+1.0i)) (test (+ 1 1.0-1.0i) 2.0-1.0i) (when with-bignums (test (+ (bignum 1) 1.0-1.0i) 2.0-1.0i) (test (+ 1 (bignum 1.0-1.0i)) 2.0-1.0i) (test (+ (bignum 1) (bignum 1.0-1.0i)) 2.0-1.0i)) (test (+ 1 m1) 4) (test2 (+ 1 +nan.0) +nan.0) (when with-bignums (test2 (+ (bignum 1) +nan.0) +nan.0) (test2 (+ 1 (bignum +nan.0)) +nan.0) (test2 (+ (bignum 1) (bignum +nan.0)) +nan.0)) (test (+ -1 1) 0) (when with-bignums (test (+ (bignum -1) 1) 0) (test (+ -1 (bignum 1)) 0) (test (+ (bignum -1) (bignum 1)) 0)) (test (+ -1 -1) -2) (when with-bignums (test (+ (bignum -1) -1) -2) (test (+ -1 (bignum -1)) -2) (test (+ (bignum -1) (bignum -1)) -2)) (test (+ -1 1/2) -1/2) (when with-bignums (test (+ (bignum -1) 1/2) -1/2) (test (+ -1 (bignum 1/2)) -1/2) (test (+ (bignum -1) (bignum 1/2)) -1/2)) (test (+ -1 -1/2) -3/2) (when with-bignums (test (+ (bignum -1) -1/2) -3/2) (test (+ -1 (bignum -1/2)) -3/2) (test (+ (bignum -1) (bignum -1/2)) -3/2)) (test (+ -1 1.5) 0.5) (when with-bignums (test (+ (bignum -1) 1.5) 0.5) (test (+ -1 (bignum 1.5)) 0.5) (test (+ (bignum -1) (bignum 1.5)) 0.5)) (test (+ -1 -1.5) -2.5) (when with-bignums (test (+ (bignum -1) -1.5) -2.5) (test (+ -1 (bignum -1.5)) -2.5) (test (+ (bignum -1) (bignum -1.5)) -2.5)) (test (+ -1 1.0+1.0i) 0.0+1.0i) (when with-bignums (test (+ (bignum -1) 1.0+1.0i) 0.0+1.0i) (test (+ -1 (bignum 1.0+1.0i)) 0.0+1.0i) (test (+ (bignum -1) (bignum 1.0+1.0i)) 0.0+1.0i)) (test (+ -1 1.0-1.0i) 0.0-1.0i) (when with-bignums (test (+ (bignum -1) 1.0-1.0i) 0.0-1.0i) (test (+ -1 (bignum 1.0-1.0i)) 0.0-1.0i) (test (+ (bignum -1) (bignum 1.0-1.0i)) 0.0-1.0i)) (test (+ -1 m1) 2) (test2 (+ -1 +nan.0) +nan.0) (when with-bignums (test2 (+ (bignum -1) +nan.0) +nan.0) (test2 (+ -1 (bignum +nan.0)) +nan.0) (test2 (+ (bignum -1) (bignum +nan.0)) +nan.0)) (test (+ 1/2 1) 3/2) (when with-bignums (test (+ (bignum 1/2) 1) 3/2) (test (+ 1/2 (bignum 1)) 3/2) (test (+ (bignum 1/2) (bignum 1)) 3/2)) (test (+ 1/2 -1) -1/2) (when with-bignums (test (+ (bignum 1/2) -1) -1/2) (test (+ 1/2 (bignum -1)) -1/2) (test (+ (bignum 1/2) (bignum -1)) -1/2)) (test (+ 1/2 1/2) 1) (when with-bignums (test (+ (bignum 1/2) 1/2) 1) (test (+ 1/2 (bignum 1/2)) 1) (test (+ (bignum 1/2) (bignum 1/2)) 1)) (test (+ 1/2 -1/2) 0) (when with-bignums (test (+ (bignum 1/2) -1/2) 0) (test (+ 1/2 (bignum -1/2)) 0) (test (+ (bignum 1/2) (bignum -1/2)) 0)) (test (+ 1/2 1.5) 2.0) (when with-bignums (test (+ (bignum 1/2) 1.5) 2.0) (test (+ 1/2 (bignum 1.5)) 2.0) (test (+ (bignum 1/2) (bignum 1.5)) 2.0)) (test (+ 1/2 -1.5) -1.0) (when with-bignums (test (+ (bignum 1/2) -1.5) -1.0) (test (+ 1/2 (bignum -1.5)) -1.0) (test (+ (bignum 1/2) (bignum -1.5)) -1.0)) (test (+ 1/2 1.0+1.0i) 1.5+1.0i) (when with-bignums (test (+ (bignum 1/2) 1.0+1.0i) 1.5+1.0i) (test (+ 1/2 (bignum 1.0+1.0i)) 1.5+1.0i) (test (+ (bignum 1/2) (bignum 1.0+1.0i)) 1.5+1.0i)) (test (+ 1/2 1.0-1.0i) 1.5-1.0i) (when with-bignums (test (+ (bignum 1/2) 1.0-1.0i) 1.5-1.0i) (test (+ 1/2 (bignum 1.0-1.0i)) 1.5-1.0i) (test (+ (bignum 1/2) (bignum 1.0-1.0i)) 1.5-1.0i)) (test (+ 1/2 m1) 7/2) (test2 (+ 1/2 +nan.0) +nan.0) (when with-bignums (test2 (+ (bignum 1/2) +nan.0) +nan.0) (test2 (+ 1/2 (bignum +nan.0)) +nan.0) (test2 (+ (bignum 1/2) (bignum +nan.0)) +nan.0)) (test (+ -1/2 1) 1/2) (when with-bignums (test (+ (bignum -1/2) 1) 1/2) (test (+ -1/2 (bignum 1)) 1/2) (test (+ (bignum -1/2) (bignum 1)) 1/2)) (test (+ -1/2 -1) -3/2) (when with-bignums (test (+ (bignum -1/2) -1) -3/2) (test (+ -1/2 (bignum -1)) -3/2) (test (+ (bignum -1/2) (bignum -1)) -3/2)) (test (+ -1/2 1/2) 0) (when with-bignums (test (+ (bignum -1/2) 1/2) 0) (test (+ -1/2 (bignum 1/2)) 0) (test (+ (bignum -1/2) (bignum 1/2)) 0)) (test (+ -1/2 -1/2) -1) (when with-bignums (test (+ (bignum -1/2) -1/2) -1) (test (+ -1/2 (bignum -1/2)) -1) (test (+ (bignum -1/2) (bignum -1/2)) -1)) (test (+ -1/2 1.5) 1.0) (when with-bignums (test (+ (bignum -1/2) 1.5) 1.0) (test (+ -1/2 (bignum 1.5)) 1.0) (test (+ (bignum -1/2) (bignum 1.5)) 1.0)) (test (+ -1/2 -1.5) -2.0) (when with-bignums (test (+ (bignum -1/2) -1.5) -2.0) (test (+ -1/2 (bignum -1.5)) -2.0) (test (+ (bignum -1/2) (bignum -1.5)) -2.0)) (test (+ -1/2 1.0+1.0i) 0.5+1.0i) (when with-bignums (test (+ (bignum -1/2) 1.0+1.0i) 0.5+1.0i) (test (+ -1/2 (bignum 1.0+1.0i)) 0.5+1.0i) (test (+ (bignum -1/2) (bignum 1.0+1.0i)) 0.5+1.0i)) (test (+ -1/2 1.0-1.0i) 0.5-1.0i) (when with-bignums (test (+ (bignum -1/2) 1.0-1.0i) 0.5-1.0i) (test (+ -1/2 (bignum 1.0-1.0i)) 0.5-1.0i) (test (+ (bignum -1/2) (bignum 1.0-1.0i)) 0.5-1.0i)) (test (+ -1/2 m1) 5/2) (test2 (+ -1/2 +nan.0) +nan.0) (when with-bignums (test2 (+ (bignum -1/2) +nan.0) +nan.0) (test2 (+ -1/2 (bignum +nan.0)) +nan.0) (test2 (+ (bignum -1/2) (bignum +nan.0)) +nan.0)) (test (+ 1.5 1) 2.5) (when with-bignums (test (+ (bignum 1.5) 1) 2.5) (test (+ 1.5 (bignum 1)) 2.5) (test (+ (bignum 1.5) (bignum 1)) 2.5)) (test (+ 1.5 -1) 0.5) (when with-bignums (test (+ (bignum 1.5) -1) 0.5) (test (+ 1.5 (bignum -1)) 0.5) (test (+ (bignum 1.5) (bignum -1)) 0.5)) (test (+ 1.5 1/2) 2.0) (when with-bignums (test (+ (bignum 1.5) 1/2) 2.0) (test (+ 1.5 (bignum 1/2)) 2.0) (test (+ (bignum 1.5) (bignum 1/2)) 2.0)) (test (+ 1.5 -1/2) 1.0) (when with-bignums (test (+ (bignum 1.5) -1/2) 1.0) (test (+ 1.5 (bignum -1/2)) 1.0) (test (+ (bignum 1.5) (bignum -1/2)) 1.0)) (test (+ 1.5 1.5) 3.0) (when with-bignums (test (+ (bignum 1.5) 1.5) 3.0) (test (+ 1.5 (bignum 1.5)) 3.0) (test (+ (bignum 1.5) (bignum 1.5)) 3.0)) (test (+ 1.5 -1.5) 0.0) (when with-bignums (test (+ (bignum 1.5) -1.5) 0.0) (test (+ 1.5 (bignum -1.5)) 0.0) (test (+ (bignum 1.5) (bignum -1.5)) 0.0)) (test (+ 1.5 1.0+1.0i) 2.5+1.0i) (when with-bignums (test (+ (bignum 1.5) 1.0+1.0i) 2.5+1.0i) (test (+ 1.5 (bignum 1.0+1.0i)) 2.5+1.0i) (test (+ (bignum 1.5) (bignum 1.0+1.0i)) 2.5+1.0i)) (test (+ 1.5 1.0-1.0i) 2.5-1.0i) (when with-bignums (test (+ (bignum 1.5) 1.0-1.0i) 2.5-1.0i) (test (+ 1.5 (bignum 1.0-1.0i)) 2.5-1.0i) (test (+ (bignum 1.5) (bignum 1.0-1.0i)) 2.5-1.0i)) (test (+ 1.5 m1) 4.5) (test2 (+ 1.5 +nan.0) +nan.0) (when with-bignums (test2 (+ (bignum 1.5) +nan.0) +nan.0) (test2 (+ 1.5 (bignum +nan.0)) +nan.0) (test2 (+ (bignum 1.5) (bignum +nan.0)) +nan.0)) (test (+ -1.5 1) -0.5) (when with-bignums (test (+ (bignum -1.5) 1) -0.5) (test (+ -1.5 (bignum 1)) -0.5) (test (+ (bignum -1.5) (bignum 1)) -0.5)) (test (+ -1.5 -1) -2.5) (when with-bignums (test (+ (bignum -1.5) -1) -2.5) (test (+ -1.5 (bignum -1)) -2.5) (test (+ (bignum -1.5) (bignum -1)) -2.5)) (test (+ -1.5 1/2) -1.0) (when with-bignums (test (+ (bignum -1.5) 1/2) -1.0) (test (+ -1.5 (bignum 1/2)) -1.0) (test (+ (bignum -1.5) (bignum 1/2)) -1.0)) (test (+ -1.5 -1/2) -2.0) (when with-bignums (test (+ (bignum -1.5) -1/2) -2.0) (test (+ -1.5 (bignum -1/2)) -2.0) (test (+ (bignum -1.5) (bignum -1/2)) -2.0)) (test (+ -1.5 1.5) 0.0) (when with-bignums (test (+ (bignum -1.5) 1.5) 0.0) (test (+ -1.5 (bignum 1.5)) 0.0) (test (+ (bignum -1.5) (bignum 1.5)) 0.0)) (test (+ -1.5 -1.5) -3.0) (when with-bignums (test (+ (bignum -1.5) -1.5) -3.0) (test (+ -1.5 (bignum -1.5)) -3.0) (test (+ (bignum -1.5) (bignum -1.5)) -3.0)) (test (+ -1.5 1.0+1.0i) -0.5+1.0i) (when with-bignums (test (+ (bignum -1.5) 1.0+1.0i) -0.5+1.0i) (test (+ -1.5 (bignum 1.0+1.0i)) -0.5+1.0i) (test (+ (bignum -1.5) (bignum 1.0+1.0i)) -0.5+1.0i)) (test (+ -1.5 1.0-1.0i) -0.5-1.0i) (when with-bignums (test (+ (bignum -1.5) 1.0-1.0i) -0.5-1.0i) (test (+ -1.5 (bignum 1.0-1.0i)) -0.5-1.0i) (test (+ (bignum -1.5) (bignum 1.0-1.0i)) -0.5-1.0i)) (test (+ -1.5 m1) 1.5) (test2 (+ -1.5 +nan.0) +nan.0) (when with-bignums (test2 (+ (bignum -1.5) +nan.0) +nan.0) (test2 (+ -1.5 (bignum +nan.0)) +nan.0) (test2 (+ (bignum -1.5) (bignum +nan.0)) +nan.0)) (test (+ 1.0+1.0i 1) 2.0+1.0i) (when with-bignums (test (+ (bignum 1.0+1.0i) 1) 2.0+1.0i) (test (+ 1.0+1.0i (bignum 1)) 2.0+1.0i) (test (+ (bignum 1.0+1.0i) (bignum 1)) 2.0+1.0i)) (test (+ 1.0+1.0i -1) 0.0+1.0i) (when with-bignums (test (+ (bignum 1.0+1.0i) -1) 0.0+1.0i) (test (+ 1.0+1.0i (bignum -1)) 0.0+1.0i) (test (+ (bignum 1.0+1.0i) (bignum -1)) 0.0+1.0i)) (test (+ 1.0+1.0i 1/2) 1.5+1.0i) (when with-bignums (test (+ (bignum 1.0+1.0i) 1/2) 1.5+1.0i) (test (+ 1.0+1.0i (bignum 1/2)) 1.5+1.0i) (test (+ (bignum 1.0+1.0i) (bignum 1/2)) 1.5+1.0i)) (test (+ 1.0+1.0i -1/2) 0.5+1.0i) (when with-bignums (test (+ (bignum 1.0+1.0i) -1/2) 0.5+1.0i) (test (+ 1.0+1.0i (bignum -1/2)) 0.5+1.0i) (test (+ (bignum 1.0+1.0i) (bignum -1/2)) 0.5+1.0i)) (test (+ 1.0+1.0i 1.5) 2.5+1.0i) (when with-bignums (test (+ (bignum 1.0+1.0i) 1.5) 2.5+1.0i) (test (+ 1.0+1.0i (bignum 1.5)) 2.5+1.0i) (test (+ (bignum 1.0+1.0i) (bignum 1.5)) 2.5+1.0i)) (test (+ 1.0+1.0i -1.5) -0.5+1.0i) (when with-bignums (test (+ (bignum 1.0+1.0i) -1.5) -0.5+1.0i) (test (+ 1.0+1.0i (bignum -1.5)) -0.5+1.0i) (test (+ (bignum 1.0+1.0i) (bignum -1.5)) -0.5+1.0i)) (test (+ 1.0+1.0i 1.0+1.0i) 2.0+2.0i) (when with-bignums (test (+ (bignum 1.0+1.0i) 1.0+1.0i) 2.0+2.0i) (test (+ 1.0+1.0i (bignum 1.0+1.0i)) 2.0+2.0i) (test (+ (bignum 1.0+1.0i) (bignum 1.0+1.0i)) 2.0+2.0i)) (test (+ 1.0+1.0i 1.0-1.0i) 2.0) (when with-bignums (test (+ (bignum 1.0+1.0i) 1.0-1.0i) 2.0) (test (+ 1.0+1.0i (bignum 1.0-1.0i)) 2.0) (test (+ (bignum 1.0+1.0i) (bignum 1.0-1.0i)) 2.0)) (test (+ 1.0+1.0i m1) 4.0+1.0i) (test2 (nan? (+ 1.0+1.0i +nan.0)) #t) (when with-bignums (test2 (nan? (+ (bignum 1.0+1.0i) +nan.0)) #t) (test2 (nan? (+ 1.0+1.0i (bignum +nan.0))) #t) (test2 (nan? (+ (bignum 1.0+1.0i) (bignum +nan.0))) #t)) (test (+ 1.0-1.0i 1) 2.0-1.0i) (when with-bignums (test (+ (bignum 1.0-1.0i) 1) 2.0-1.0i) (test (+ 1.0-1.0i (bignum 1)) 2.0-1.0i) (test (+ (bignum 1.0-1.0i) (bignum 1)) 2.0-1.0i)) (test (+ 1.0-1.0i -1) 0.0-1.0i) (when with-bignums (test (+ (bignum 1.0-1.0i) -1) 0.0-1.0i) (test (+ 1.0-1.0i (bignum -1)) 0.0-1.0i) (test (+ (bignum 1.0-1.0i) (bignum -1)) 0.0-1.0i)) (test (+ 1.0-1.0i 1/2) 1.5-1.0i) (when with-bignums (test (+ (bignum 1.0-1.0i) 1/2) 1.5-1.0i) (test (+ 1.0-1.0i (bignum 1/2)) 1.5-1.0i) (test (+ (bignum 1.0-1.0i) (bignum 1/2)) 1.5-1.0i)) (test (+ 1.0-1.0i -1/2) 0.5-1.0i) (when with-bignums (test (+ (bignum 1.0-1.0i) -1/2) 0.5-1.0i) (test (+ 1.0-1.0i (bignum -1/2)) 0.5-1.0i) (test (+ (bignum 1.0-1.0i) (bignum -1/2)) 0.5-1.0i)) (test (+ 1.0-1.0i 1.5) 2.5-1.0i) (when with-bignums (test (+ (bignum 1.0-1.0i) 1.5) 2.5-1.0i) (test (+ 1.0-1.0i (bignum 1.5)) 2.5-1.0i) (test (+ (bignum 1.0-1.0i) (bignum 1.5)) 2.5-1.0i)) (test (+ 1.0-1.0i -1.5) -0.5-1.0i) (when with-bignums (test (+ (bignum 1.0-1.0i) -1.5) -0.5-1.0i) (test (+ 1.0-1.0i (bignum -1.5)) -0.5-1.0i) (test (+ (bignum 1.0-1.0i) (bignum -1.5)) -0.5-1.0i)) (test (+ 1.0-1.0i 1.0+1.0i) 2.0) (when with-bignums (test (+ (bignum 1.0-1.0i) 1.0+1.0i) 2.0) (test (+ 1.0-1.0i (bignum 1.0+1.0i)) 2.0) (test (+ (bignum 1.0-1.0i) (bignum 1.0+1.0i)) 2.0)) (test (+ 1.0-1.0i 1.0-1.0i) 2.0-2.0i) (when with-bignums (test (+ (bignum 1.0-1.0i) 1.0-1.0i) 2.0-2.0i) (test (+ 1.0-1.0i (bignum 1.0-1.0i)) 2.0-2.0i) (test (+ (bignum 1.0-1.0i) (bignum 1.0-1.0i)) 2.0-2.0i)) (test (+ 1.0-1.0i m1) 4.0-1.0i) (test2 (+ 1.0-1.0i +nan.0) +nan.0-1.0i) (when with-bignums (test2 (+ (bignum 1.0-1.0i) +nan.0) +nan.0-1.0i) (test2 (+ 1.0-1.0i (bignum +nan.0)) +nan.0-1.0i) (test2 (+ (bignum 1.0-1.0i) (bignum +nan.0)) +nan.0-1.0i)) (test (+ m1 1) 4) (test (+ m1 -1) 2) (test (+ m1 1/2) 7/2) (test (+ m1 -1/2) 5/2) (test (+ m1 1.5) 4.5) (test (+ m1 -1.5) 1.5) (test (+ m1 1.0+1.0i) 4.0+1.0i) (test (+ m1 1.0-1.0i) 4.0-1.0i) (test (+ m1 m1) 6) (test2 (+ m1 +nan.0) +nan.0) (test2 (let () (define (func) (+ -nan.0 (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0+1.0i) (test2 (let () (define (func) (+ (bignum -nan.0) (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0+1.0i) (test2 (let () (define (func) (+ -nan.0 1+i)) (define (hi) (func)) (hi)) +nan.0+1.0i) (test2 (let () (define (func) (+ (bignum -nan.0) 1+i)) (define (hi) (func)) (hi)) +nan.0+1.0i) (test2 (+ +nan.0 1+i) +nan.0+1.0i) (test2 (+ +nan.0 (bignum 1+i)) +nan.0+1.0i) (test2 (+ (bignum +nan.0) (bignum 1+i)) +nan.0+1.0i) (test2 (+ (bignum +nan.0) 1+i) +nan.0+1.0i) (test2 (let () (define (func) (- -nan.0 (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0-1.0i) (test2 (let () (define (func) (- (bignum -nan.0) (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0-1.0i) (test2 (let () (define (func) (- -nan.0 1+i)) (define (hi) (func)) (hi)) +nan.0-1.0i) (test2 (let () (define (func) (- (bignum -nan.0) 1+i)) (define (hi) (func)) (hi)) +nan.0-1.0i) (test2 (- +nan.0 1+i) +nan.0-1.0i) (test2 (- +nan.0 (bignum 1+i)) +nan.0-1.0i) (test2 (- (bignum +nan.0) (bignum 1+i)) +nan.0-1.0i) (test2 (- (bignum +nan.0) 1+i) +nan.0-1.0i) (test2 (let () (define (func) (* +nan.0 (bignum 1+i))) (define (hi) (func)) (hi)) +nan.0+nan.0i) ) ;;; -------------------------------------------------------------------------------- ;;; errors ;;; -------------------------------------------------------------------------------- (let () (for-each (lambda (op) (for-each (lambda (arg) (let ((val (catch #t (lambda () (op arg)) (lambda args 'error)))) (if (not (eq? val 'error)) (format #t "(~A ~A) -> ~A (expected 'error)~%" op arg val))) (let ((val (catch #t (lambda () (op 0 arg)) (lambda args 'error)))) (if (not (eq? val 'error)) (format #t "(~A 0 ~A) -> ~A (expected 'error)~%" op arg val))) (let ((val (catch #t (lambda () (op 0 1 arg)) (lambda args 'error)))) (if (not (eq? val 'error)) (format #t "(~A 0 1 ~A) -> ~A (expected 'error)~%" op arg val))) (if with-bignums (let ((val (catch #t (lambda () (op (expt 2 60) arg)) (lambda args 'error)))) (if (not (eq? val 'error)) (format #t "(~A 2^60 ~A) -> ~A (expected 'error)~%" op arg val))))) (list "hi" () #\a (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs #t _ht_ _undef_ _null_ _c_obj_ :hi (if #f #f) (lambda (a) (+ a 1)) # # # :rest))) (list exact? inexact? zero? positive? negative? even? odd? quotient remainder modulo truncate floor ceiling round abs max min gcd lcm expt exact->inexact inexact->exact rationalize numerator denominator imag-part real-part magnitude angle make-polar complex sqrt exp log sin cos tan asin acos atan number->string + - * / < > <= >= =))) (let ((d 3.14) (i 32) (r 2/3) (c 1.5+0.3i)) (let ((check-vals (lambda (name) (if (or (not (= d 3.14)) ; (> (abs (- d 3.14)) 1e-16) ; (- 3.14 (bignum "3.14")) is around 1e-17! (not (= i 32)) (not (= r 2/3)) (not (= c 1.5+0.3i))) ; (> (magnitude (- c 1.5+0.3i)) 1e-16)) (begin (display name) (display " changed ") (if (not (= i 32)) (begin (display "stored integer to: ") (display i)) (if (not (= r 2/3)) (begin (display "stored ratio to: ") (display r)) (if (not (= d 3.14)) (begin (display "stored real to: ") (display d)) (begin (display "stored complex to: ") (display c))))) (display "?") (newline)))))) (for-each (lambda (op) (let ((x (catch #t (lambda () (op i)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op r)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op d)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op c)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op i d)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op r d)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op d d)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op c d)) (lambda args 'error)))) (check-vals op))) (list number->string string->number complex magnitude abs exp make-polar angle sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin number? integer? real? complex? rational? even? odd? zero? positive? negative? real-part imag-part numerator denominator rationalize exact? inexact? exact->inexact inexact->exact floor ceiling truncate round logior logxor logand lognot logbit? ash integer-length + - * / quotient remainder expt = max min modulo < > <= >= lcm gcd )))) (when with-bignums (test (bignum "1/3.0") 'error) (let ((d (bignum "3.14")) (i (bignum "32")) (r (bignum "2/3")) (c (bignum "1.5+0.3i"))) (let ((check-vals (lambda (name) (if (or (not (= d (bignum "3.14"))) ; see above (not (= i 32)) (not (= r 2/3)) (not (= c (bignum "1.5+0.3i")))) (begin (display name) (display " changed ") (if (not (= i 32)) (begin (display "stored integer to: ") (display i)) (if (not (= r 2/3)) (begin (display "stored ratio to: ") (display r)) (if (not (= d 3.14)) (begin (display "stored real to: ") (display d)) (begin (display "stored complex to: ") (display c))))) (display "?") (newline)))))) (for-each (lambda (op) (let ((x (catch #t (lambda () (op i)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op r)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op d)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op c)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op i d)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op r d)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op d d)) (lambda args 'error)))) (check-vals op)) (let ((x (catch #t (lambda () (op c d)) (lambda args 'error)))) (check-vals op))) (list number->string string->number complex magnitude abs exp make-polar angle sin cos tan sinh cosh tanh atan sqrt log asinh acosh atanh acos asin number? integer? real? complex? rational? even? odd? zero? positive? negative? real-part imag-part numerator denominator rationalize exact? inexact? exact->inexact inexact->exact floor ceiling truncate round logior logxor logand lognot logbit? ash integer-length + - * / quotient remainder expt = max min modulo < > <= >= lcm gcd )))) (for-each (lambda (arg) (test (bignum "1.0" arg) 'error)) (list -1 0 #\a #(1 2 3) 2/3 1.5+0.3i 1+i () 'hi abs "hi" #(()) (list 1 2 3) '(1 . 2) (lambda () 1)))) #| (let ((funcs (list make-polar complex magnitude angle real-part imag-part numerator denominator rationalize abs exp log sin cos tan asin acos atan sinh cosh tanh asinh acosh atanh sqrt floor ceiling truncate round lcm gcd + - * / max min quotient remainder modulo = < > <= >= even? odd? zero? positive? negative? infinite? inexact->exact exact->inexact integer-length logior logxor logand lognot logbit? ash integer-decode-float exact? inexact? number? integer? real? complex? rational? nan?; number->string expt )) (func-names (list 'make-polar 'complex 'magnitude 'angle 'real-part 'imag-part 'numerator 'denominator 'rationalize 'abs 'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt 'floor 'ceiling 'truncate 'round 'lcm 'gcd '+ '- '* '/ 'max 'min 'quotient 'remainder 'modulo '= '< '> '<= '>= 'even? 'odd? 'zero? 'positive? 'negative? 'infinite? 'inexact->exact 'exact->inexact 'integer-length 'logior 'logxor 'logand 'lognot 'logbit? 'ash 'integer-decode-float 'exact? 'inexact? 'number? 'integer? 'real? 'complex? 'rational? 'nan?; 'number->string 'expt )) (args (list 0 1 -1))) (define (for-each-subset-permuted func name args) (let* ((ar (arity func)) (min-args (car ar)) (max-args (min 1000 (cdr ar)))) (if (= min-args 0) (set! min-args 1)) (for-each-subset (lambda s-args (if (<= min-args (length s-args) max-args) (for-each-permutation (lambda p-args (catch #t (lambda () (let ((val (apply func p-args))) (format #t "(let ((new-val (catch-it (~A ~{~A~^ ~})))) " name p-args) (if (not (number? val)) (format #t "(if (not (equal? new-val ~A)) (format #t \"(~A ~{~A~^ ~}) -> ~~A~~%\" new-val)))~%" val name p-args) (if (nan? val) (format #t "(if (not (nan? new-val)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not NaN?~~%\" new-val)))~%" name p-args) (if (infinite? val) (format #t "(if (not (infinite? new-val)) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not inf?~~%\" new-val)))~%" name p-args) (format #t "(if (> (magnitude (- new-val ~A)) 1e-6) (format #t \"(~A ~{~A~^ ~}) -> ~~A, not ~A~~%\" new-val)))~%" val name p-args val)))))) (lambda e-args (format *stderr* "~A~%" e-args) ''error))) s-args))) args))) (with-output-to-file "t248.data" (lambda () (format #t "(define-macro (catch-it tst)~% `(catch #t (lambda () ,tst) (lambda args 'error)))~%") (for-each (lambda (func name) (for-each-subset-permuted func name args)) funcs func-names)))) |# ;(gc) ;;; -------------------------------------------------------------------------------- ;;; ;;; fft from s7.html (define* (cfft! data n (dir 1)) ; (complex data) (if (not n) (set! n (length data))) (do ((i 0 (+ i 1)) (j 0)) ((= i n)) (if (> j i) (let ((temp (data j))) (set! (data j) (data i)) (set! (data i) temp))) (let ((m (/ n 2))) (do () ((or (< m 2) (< j m))) (set! j (- j m)) (set! m (/ m 2))) (set! j (+ j m)))) (let ((ipow (floor (log n 2))) (prev 1)) (do ((lg 0 (+ lg 1)) (mmax 2 (* mmax 2)) (pow (/ n 2) (/ pow 2)) (theta (complex 0.0 (* pi dir)) (* theta 0.5))) ((= lg ipow)) (let ((wpc (exp theta)) (wc 1.0)) (do ((ii 0 (+ ii 1))) ((= ii prev)) (do ((jj 0 (+ jj 1)) (i ii (+ i mmax)) (j (+ ii prev) (+ j mmax))) ((>= jj pow)) (let ((tc (* wc (data j)))) (set! (data j) (- (data i) tc)) (set! (data i) (+ (data i) tc)))) (set! wc (* wc wpc))) (set! prev mmax)))) data) (test (equivalent? (cfft! (list 0.0 1+i 0.0 0.0)) '(1+1i -1+1i -1-1i 1-1i)) #t) (test (equivalent? (cfft! (vector 0.0 1+i 0.0 0.0)) #(1+1i -1+1i -1-1i 1-1i)) #t) (let ((size 32)) (let ((v (make-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (set! (v i) (random 1.0))) (let ((copy-v (copy v))) (cfft! v size) (cfft! v size -1) (do ((i 0 (+ i 1))) ((= i size)) (set! (v i) (/ (v i) size)) (if (or (> (abs (imag-part (v i))) 1e-14) (> (magnitude (- (v i) (copy-v i))) 1e-14)) (format *stderr* ";cfft! reals: ~D: ~A ~A~%" i (v i) (copy-v i))))))) (let ((size 32)) (let ((v (make-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (set! (v i) (random 100))) (let ((copy-v (copy v))) (cfft! v size) (cfft! v size -1) (do ((i 0 (+ i 1))) ((= i size)) (set! (v i) (/ (v i) size)) (if (or (> (abs (imag-part (v i))) 1e-12) (> (magnitude (- (v i) (copy-v i))) 1e-12)) (format *stderr* ";cfft! ints: ~D: ~A ~A~%" i (v i) (copy-v i))))))) (let ((size 32)) (let ((v (make-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (set! (v i) (random 1+i))) (let ((copy-v (copy v))) (cfft! v size) (cfft! v size -1) (do ((i 0 (+ i 1))) ((= i size)) (set! (v i) (/ (v i) size)) (if (> (magnitude (- (v i) (copy-v i))) 1e-12) (format *stderr* ";cfft! complex: ~D: ~A ~A~%" i (v i) (copy-v i))))))) (when with-bignums (let ((size 32)) (let ((data (make-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (set! (data i) (complex (bignum (number->string (random 1.0))) (bignum (number->string (random 1.0)))))) (let ((old-data (copy data))) (cfft! data size) (cfft! data size -1) (do ((i 0 (+ i 1))) ((= i size)) (set! (data i) (/ (data i) size)) (if (> (magnitude (- (data i) (old-data i))) 1e-14) (format *stderr* ";cfft! big: ~D: ~A~%" i (magnitude (- (old-data i) (data i)))))))))) #| ;;; 1048576 forces us to 4608000, 32568 512000 (let ((size 65536)) (let ((v (make-vector size))) (do ((i 0 (+ i 1))) ((= i size)) (set! (v i) (random 1+i))) (let ((copy-v (copy v))) (cfft! v size) (cfft! v size -1) (do ((i 0 (+ i 1))) ((= i size)) (set! (v i) (/ (v i) size)) (if (> (magnitude (- (v i) (copy-v i))) 1e-10) (format *stderr* "~D: ~A (~A ~A)~%" (magnitude (- (v i) (copy-v i))) i (v i) (copy-v i))))))) |# (define khar car) (load "stuff.scm") (let () ;(load "stuff.scm" (curlet)) ;; this tickled a tree-cyclic? bug (when full-s7test (let () (define (char-permute op . args) (let ((form `(let () (define (t1) (let ((x #\a) (y #\A) (fv (make-float-vector 4))) (do ((i 0 (+ i 1)) (x1 1.0 (+ x1 1.0))) ((= i 4) fv) (if (,op ,@args) (float-vector-set! fv i x1) (float-vector-set! fv i 0.0))))) (define (t2) (let ((x #\a) (y #\A) (fv (make-float-vector 4))) (do ((i 0 (+ i 1)) (x1 1.0 (+ x1 1.0))) ((= i 4) fv) (if (apply ,op (list ,@args)) (float-vector-set! fv i x1) (float-vector-set! fv i 0.0))))) (let ((v1 (t1)) (v2 (t2))) (if (not (equivalent? v1 v2)) (format *stderr* "char-permute ~A, ~A -> ~A ~A~%" op args v1 v2)))))) (eval (copy form :readable)))) (for-each (lambda (op) (for-each-subset (lambda s-args (if (= (length s-args) 2) (for-each-permutation (lambda args (apply char-permute op args)) s-args))) (list 'x 'y #\b #\newline))) (if (provided? 'pure-s7) (list 'char=? 'char? 'char>=?) (list 'char=? 'char? 'char>=? 'char-ci=? 'char-ci? 'char-ci>=?))))) (typed-let ((i 0 integer?) (x () list?)) (test (set! i 3) 3) (test (set! i pi) 'error) (test (set! x (list 3)) '(3)) (when with-bignums (test (set! i (bignum 3)) 3)) (test (set! x pi) 'error)) (let ((i 0)) (typed-let ((i () list?)) (set! i ())) (set! i 2)) (typed-let ((i 0) (x pi real?)) (test (set! i ()) ()) (test (set! x ()) 'error)) (let () (define f1 (typed-lambda (i j) (+ i j))) (test (procedure-source f1) '(lambda (i j) (+ i j))) (test (f1 2 3) 5) (define f2 (typed-lambda i i)) (test (procedure-source f2) '(lambda i i)) (test (f2 2 3) '(2 3)) (define f3 (typed-lambda ((i integer?) (x real?) y) (+ i x y))) (test (procedure-source f3) '(lambda (i x y) (unless (integer? i) (error 'wrong-type-arg "~S is not ~S~%" 'i 'integer?)) (unless (real? x) (error 'wrong-type-arg "~S is not ~S~%" 'x 'real?)) (+ i x y))) (test (f3 2 3.0 1/2) 5.5) (test (catch #t (lambda () (f3 2 1+i 1/2)) (lambda (type info) (apply format #f info))) "x is not real?\n") (test (catch #t (lambda () (f3 1/2 1.0 1/2)) (lambda (type info) (apply format #f info))) "i is not integer?\n") (define f4 (typed-lambda (i . j) (+ i (car j)))) (test (procedure-source f4) '(lambda (i . j) (+ i (car j)))) (test (f4 2 3) 5) (define f5 (typed-lambda ((i integer?) . j) (+ i (car j)))) (test (procedure-source f5) '(lambda (i . j) (unless (integer? i) (error 'wrong-type-arg "~S is not ~S~%" 'i 'integer?)) (+ i (car j)))) (test (f5 2 3) 5) (test (catch #t (lambda () (f5 1/2 1.0)) (lambda (type info) (apply format #f info))) "i is not integer?\n")) (let () (define f (let ((+signature+ '(integer? #t #t))) ; this is inconsistent with vector/hash-table sigs -- maybe if func itself use in error checks? (lambda (y z) (let ((x y)) (set! (setter 'x) (if (not (integer? x)) (error "x is supposed to be an integer") (lambda (s v) (if (integer? v) v x)))) (set! x z) x)))) (test (f 0 2) 2) (test (f 0 "2") 0) (test (f "0" 2) 'error)) (let ((lt (with-let (inlet 'a 0) (set! (setter 'a) (lambda (s v) 32)) (curlet)))) (test (lt 'a) 0) (set! (lt 'a) 1) (test (lt 'a) 32)) (test (typed-inlet (i 0 integer?)) (inlet 'i 0)) (test (let () (define (f124) (equal? (typed-inlet (i 0 integer?)) (inlet 'i 0))) (f124)) #t) (test (typed-inlet (i "a" integer?)) 'error) (let ((lt (typed-inlet (a 0 integer?)))) (set! (lt 'a) 32) (test (lt 'a) 32)) (test (first '(1 2 3 4 5 6 7 8 9 10)) 1) (test (second '(1 2 3 4 5 6 7 8 9 10)) 2) (test (third '(1 2 3 4 5 6 7 8 9 10)) 3) (test (fourth '(1 2 3 4 5 6 7 8 9 10)) 4) (test (fifth '(1 2 3 4 5 6 7 8 9 10)) 5) (test (sixth '(1 2 3 4 5 6 7 8 9 10)) 6) (test (seventh '(1 2 3 4 5 6 7 8 9 10)) 7) (test (eighth '(1 2 3 4 5 6 7 8 9 10)) 8) (test (ninth '(1 2 3 4 5 6 7 8 9 10)) 9) (test (tenth '(1 2 3 4 5 6 7 8 9 10)) 10) (test (first #(1 2 3 4 5 6 7 8 9 10)) 1) (test (second #(1 2 3 4 5 6 7 8 9 10)) 2) (test (third #(1 2 3 4 5 6 7 8 9 10)) 3) (test (fourth #(1 2 3 4 5 6 7 8 9 10)) 4) (test (fifth #(1 2 3 4 5 6 7 8 9 10)) 5) (test (sixth #(1 2 3 4 5 6 7 8 9 10)) 6) (test (seventh #(1 2 3 4 5 6 7 8 9 10)) 7) (test (eighth #(1 2 3 4 5 6 7 8 9 10)) 8) (test (ninth #(1 2 3 4 5 6 7 8 9 10)) 9) (test (tenth #(1 2 3 4 5 6 7 8 9 10)) 10) (test (first "1234567890") #\1) (test (second "1234567890") #\2) (test (third "1234567890") #\3) (test (fourth "1234567890") #\4) (test (fifth "1234567890") #\5) (test (sixth "1234567890") #\6) (test (seventh "1234567890") #\7) (test (eighth "1234567890") #\8) (test (ninth "1234567890") #\9) (test (tenth "1234567890") #\0) (test (+ 4 (n-values 2 (values 1 2 3))) 7) (test (let () (define (f) (values 1 2 3)) (+ 4 (n-values 2 (f)))) 7) (test (let () (define (f) (values 1 2 3)) (+ 4 (n-values 1 (f)))) 5) (test (let () (define (f) (values 1 2 3)) (+ 4 (n-values 3 (f)))) 10) (test (let () (define (f) (values 1 2 3)) (+ 4 (n-values 12 (f)))) 10) (test (let () (define (f) 3) (+ 4 (n-values 12 (f)))) 7) ; (test (let () (define (f1) (values 1 2 3)) (n-values 0 (f1))) #) ; (test (let () (define (f) (values)) (+ 4 (n-values 0))) 'error) ; + second argument, # etc (for-each (lambda (obj) (test (empty? obj) #t) (test (not (sequence? obj)) #f)) (list "" () #() (hash-table) (inlet) (if with-block (block) (float-vector)) (float-vector) #2d())) (for-each (lambda (obj) (test (empty? obj) #f) (test (not (sequence? obj)) #t) (test (not (applicable? obj)) #f)) (list abs (lambda () 1) quasiquote)) (for-each (lambda (obj) (test (empty? obj) #f) (test (indexable? obj) #f) (test (applicable? obj) #f) (test (not (sequence? obj)) #t)) (list #\null #\a 1 'a-symbol 1/0 (log 0) 3.14 3/4 1.0+1.0i #t :hi (if #f #f))) (test (sequence?) 'error) (test (sequence? () '(1)) 'error) (test (->predicate 1) integer?) (test (->predicate (curlet)) let?) (test (->predicate #) eof-object?) (test (->predicate (cons 1 2)) pair?) (test (->predicate :hi) keyword?) (test (->predicate #\a) char?) (test (->predicate) 'error) (when with-block (add-predicate block?) (test (->predicate (block 1 2)) block?)) (test (let ((a 1) (b "hi")) (value->symbol "hi")) 'b) (test (typeq? 1 2) #t) (test (typeq? #\a #\space #\b) #t) (test (typeq?) #t) (test (typeq? 1.2) #t) (test (typeq? 1 1/2) #f) (test (typeq? "hi" "" (string #\null) "abc") #t) (test (typeq? 1.0 pi) #t) (test (typeq? # (if #f #f)) #t) (test (let ((x 1)) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 32) (test (let ((x 1.0)) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 2) (test (let ((x ())) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 0) (test (let ((x "hi")) (typecase x ((integer?) 32) ((real? string?) 2) (else 0))) 2) (test (let ((x 0)) (typecase (set! x (+ x 1)) ((even?) -1) ((odd?) 1))) 1) ;; 2^n and 2^n-1 are tested above as are log-n-of et al and the ldb/dpb functions (test (lognand 1 2) -1) (test (lognand -1 1) -2) (test (lognand -1 -2) 1) (test (lognand 123 321) -66) (test (lognor -1 -2) 0) (test (lognor 1 2) -4) (test (lognor 123 321) -380) (test (lognor 0 1) -2) (test (logeqv 1) 1) (test (logeqv) -1) (test (logeqv 1 2) -4) (test (logeqv -1 2) 2) (test (logeqv -1 123 321) -315) (test (logeqv 1 2 3 4) -5) (test (logeqv 1 2 3 4 5) 1) (test (iota 0) ()) (test (iota 3) '(0 1 2)) (test (iota -1) 'error) (test (iota 3 -2) '(-2 -1 0)) (test (union vector '(1 2 3) #() #(4 2 1)) #(1 2 3 4)) (test (union string '(#\a) #(#\b) "abcde") "abcde") (test (union vector) #()) (test (equal? (union list '(1 2 3) ()) '(1 2 3)) #t) (test (let? (union inlet (inlet 'a 2) (inlet 'b 3))) #t) (test ((union inlet '(a 1) #(b 2)) 'b) 2) (test ((union hash-table (hash-table 'a 1) (hash-table 'a 1 'b 2)) 'b) 2) (test (intersection vector) #()) (test (intersection list '(1 2 3) #()) ()) (test (intersection list '(1 2 3) #(4 5 1 9)) '(1)) ; pair: unbound variable (num-test ((intersection float-vector '(1 2 3) #(4 5 1 9 3)) 0) 1.0) (test (intersection (lambda x (subvector (apply vector x) 0 4 '(2 2))) '(1 2 3 4 5) #(4 5 1 9 3)) #2d((1 3) (4 5))) (when with-block (test (block? (intersection block '(1.0 2.0) #(1.0))) #t) (test (block? (intersection block (block 1.0 2.0) #(2.0))) #t)) (test (intersection list '(1 2 3) '(3 2 1)) '(1 2 3)) (test (intersection inlet (inlet 'a 1 'b 2) (inlet 'b 3)) (inlet)) (test (intersection inlet (inlet 'a 1 'b 2) (inlet 'b 2)) (inlet 'b 2)) (test (symmetric-difference list '(1 2 3)) '(1 2 3)) (test (symmetric-difference list ()) ()) (test (symmetric-difference list '(1 2 3) '(1 2 4)) '(3 4)) (test (symmetric-difference list '(1 2 3) '(1 2 4) '(3 1 5)) '(1 4 5)) (test (asymmetric-difference list '(1 2 3) '(1 2 4)) '(4)) (test (asymmetric-difference list ()) ()) (test (asymmetric-difference list '(1 2 3)) ()) (test (null? (cl-set-difference list () ())) #t) (test (null? (cl-set-difference list () '(1 2 3))) #t) (test (null? (cl-set-difference list '(1 2 3 4) '(4 3 2 1))) #t) (test (null? (cl-set-difference list '(1 2 3 4) '(2 4 3 1))) #t) (test (null? (cl-set-difference list '(1 2 3 4) '(1 3 4 2))) #t) (test (null? (cl-set-difference list '(1 2 3 4) '(1 3 2 4))) #t) (test (power-set list ()) '(())) (test (power-set list '(1)) '(() (1))) (test (power-set list '(1 2)) '(() (2) (1) (1 2))) (test (power-set list '(1 2 3)) '(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))) (test (apply union list (power-set list '(1 2 3))) '(3 2 1)) ;; this used to be built into s7.c (test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64)) (+ a b)) 96) (test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64) (set! a (+ b 1))) (+ a b)) 129) (test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32 64 12) (+ a b))) 'error) ; was 96) (test (let ((a 1) (b 2)) (multiple-value-set! (a b) (values 32)) (cons a b)) 'error) ; was '(32 . #f)) (test (multiple-value-set! #() "1234" #(0 1 2 3 4)) 'error) (test (multiple-value-set! "" #(0 1 2 3 4) :readable) 'error) (test (multiple-value-set! () #(0 1 2 3 4) :readable) 'error) (test (multiple-value-set! () ()) ()) (test (multiple-value-set! () () 1 2) 2) (test (hash-table->alist (hash-table)) ()) (test (hash-table->alist (hash-table 'a 1)) '((a . 1))) (test (let ((lst (hash-table->alist (hash-table 'a 1 'b 2)))) (or (equal? lst '((a . 1) (b . 2))) (equal? lst '((b . 2) (a . 1))))) #t) (test (merge-hash-tables (hash-table) (hash-table 'a 1)) (hash-table 'a 1)) (test (merge-hash-tables (hash-table 'a 1 'b 2) (hash-table 'a 1)) (hash-table 'a 1 'b 2)) (test (union hash-table (hash-table 'a 1 'b 2) (hash-table 'a 1)) (hash-table 'a 1 'b 2)) (test (with-let (union inlet (inlet 'a 1) (inlet 'b 2)) (+ a b)) 3) (let () (define e (let ((e's (list (inlet 'a 1 'b 2) (inlet 'a 3 'b 4)))) (lambda (sym) (apply values (map (lambda (e1) (if (defined? sym e1) (e1 sym) (values))) e's))))) (test (+ (e 'a) (e 'b)) 10)) (test (find-if (lambda (x) (= x 3)) '(1 2 3 4)) 3) (test (find-if (lambda (x) (= x 3)) '(1 2 5 4)) #f) (test (find-if (lambda (x) (= x 3)) ()) #f) (test (index-if (lambda (x) (= x 3)) '(1 2 3 4)) 2) (test (index-if (lambda (x) (= x 1)) '(1 2 3 4)) 0) (test (index-if (lambda (x) (= x 3)) '(1 2 5 4)) #f) (test (index-if (lambda (x) (= x 3)) ()) #f) (test (index-if (lambda (x) (equal? (cdr x) 2)) (hash-table 'a 1 'b 2)) 'b) (test (count-if (lambda (x) (= x 3)) ()) 0) (test (count-if (lambda (x) (= x 3)) '(1 2)) 0) (test (count-if (lambda (x) (= x 3)) '(3 3)) 2) (test (every? (lambda (x) (= x 3)) ()) #t) (test (every? (lambda (x) (= x 3)) '(1 2)) #f) (test (every? (lambda (x) (= x 3)) '(1 3)) #f) (test (every? (lambda (x) (= x 3)) '(3 3 3)) #t) (test (any? (lambda (x) (= x 3)) ()) #f) (test (any? (lambda (x) (= x 3)) '(1 2)) #f) (test (not (any? (lambda (x) (= x 3)) '(1 3))) #f) (test (not (any? (lambda (x) (= x 3)) '(3 3 3))) #f) (test (collect-if list (lambda (x) (> x 3)) ()) ()) (test (collect-if list (lambda (x) (> x 3)) '(1)) ()) (test (collect-if list (lambda (x) (> x 3)) '(1 3 4)) '(4)) (test (collect-if list (lambda (x) (> x 3)) '(1 3 4 2 1 5 1)) '(4 5)) (test (collect-if list integer? 1) 'error) (test (collect-if inlet (let ((syms ())) (lambda (x) (and (not (memq (car x) syms)) (set! syms (cons (car x) syms))))) (inlet 'a 1 'b 2 'a 3)) (inlet 'b 2 'a 1)) ;; i.e. clean out shadowed vars, ((inlet 'a 1 'b 2 'a 3) 'a) -> 3 (test (remove-if list (lambda (x) (> x 3)) ()) ()) (test (remove-if list (lambda (x) (> x 3)) '(1)) '(1)) (test (remove-if list (lambda (x) (> x 3)) '(1 3 4)) '(1 3)) (test (remove-if list (lambda (x) (> x 3)) '(1 3 4 2 1 5 1)) '(1 3 2 1 1)) (test (let ((e (inlet 'a 1 'b 2 'c 3))) (remove-if inlet (lambda (x) (= (cdr x) 2)) e)) (inlet 'a 1 'c 3)) (test (let ((ht (hash-table 'a 1 'b 2 'c 3))) (remove-if hash-table (lambda (x) (= (cdr x) 2)) ht)) (hash-table 'a 1 'c 3)) (test (remove-if vector (lambda (x) (integer? x)) #(() #\a 3/2 2 21 "hi")) #(() #\a 3/2 "hi")) (test (remove-if list integer? 1) 'error) (test (nonce list ()) ()) (test (nonce list '(1 2)) '(1 2)) (test (nonce list '(1 1)) ()) (test (nonce list '(1 2 3 1 3 1 1)) '(2)) (test (member? 1 ()) #f) (test (member? 1 '(2 3)) #f) (test (member? 1 '(2 1 3)) 1) (test (concatenate list ()) ()) (test (concatenate list () #() "") ()) (test (concatenate vector '(1) #() "2") #(1 #\2)) (test (concatenate string '(#\1 #\2) "34" #(#\5)) "12345") (test (concatenate inlet (inlet 'a 1) (inlet 'b 2 'a 3)) (inlet 'a 1 'b 2 'a 3)) (test (full-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1) (test (full-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) #f) (test (full-count-if (lambda (x) (and (integer? x) (= x 1))) '(1 2 (3 4 1) (5 (6 (1))))) 3) (test (let ((l1 '(1 2))) (full-count-if (lambda (x) (and (integer? x) (= x 2))) (list 1 l1 2 l1 3 l1))) 4) (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '(1 2 3)) '(2)) (test (full-index-if (lambda (x) (= (cdr x) 3)) (hash-table 'a 1 'b 3)) '(b)) (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '(1 (2 3))) '(1 1)) (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) '((1 (2 (3))))) '(0 1 1 0)) (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) #((1 (2 #(3))))) '(0 1 1 0)) (test (full-index-if (lambda (x) (and (integer? x) (= x 3))) (hash-table 'a 1 'b #(1 2 3))) '(b 2)) (test (full-index-if (lambda (x) (and (integer? x) (= x 4))) (hash-table 'a 1 'b #(1 2 3))) #f) (test (let ((lst (list 1 2))) (set-cdr! lst lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1)) (test (let ((lst (list 1 2))) (set-cdr! (cdr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2)) (test (let ((lst (list 1 2 3))) (set-cdr! (cddr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2 3)) (test (let ((lst (list 1 2 3 4))) (set-cdr! (cdddr lst) lst) (let ((i (make-complete-iterator lst))) (map values i))) '(1 2 3 4)) (test (let ((v '(1 2 . 3))) (let ((i (make-complete-iterator v))) (map values i))) '(1 2 3)) (test (let ((v '(1 2 #(4 5) ("67")))) (let ((i (make-complete-iterator v))) (map values i))) '(1 2 #(4 5) 4 5 ("67") "67" #\6 #\7)) (test (let ((v (list (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list (circular-list 1) 1)) (test (let ((v (list (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list (circular-list 1 2) 1 2)) (test (let ((v (cons 3 (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) '(3 1)) (test (let ((v (cons 3 (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) '(3 1 2)) (test (let ((v (list 3 (circular-list 1)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list 3 (circular-list 1) 1)) (test (let ((v (list 3 (circular-list 1 2)))) (let ((iter (make-complete-iterator v))) (map values iter))) (list 3 (circular-list 1 2) 1 2)) (test (let ((v (vector (list 4 5) (circular-list 1 2 3) (cons 6 (cons 7 8))))) (let ((iter (make-complete-iterator v))) (map values iter))) (list (list 4 5) 4 5 (circular-list 1 2 3) 1 2 3 (cons 6 (cons 7 8)) 6 7 8)) (test (let ((lst (list 1 2))) (let ((v (list lst lst))) (let ((iter (make-complete-iterator v))) (map values iter)))) '((1 2) 1 2)) (test (let ((lst (circular-list 1))) (let ((v (list lst lst))) (let ((iter (make-complete-iterator v))) (map values iter)))) (list (circular-list 1) 1)) (let ((v (circular-list 1))) (set-car! v v) (test (let ((i5 (make-complete-iterator v))) (map values i5)) ())) (let ((v (vector 1))) (set! (v 0) v) (test (let ((i4 (make-complete-iterator v))) (map values i4)) ())) (let ((v (vector 1)) (lst (circular-list 2))) (set! (v 0) lst) (set-car! lst v) (test (let ((i1 (make-complete-iterator v))) (map values i1)) (list lst))) ; not v because it's the outermost container? (let ((v (vector 1)) (lst (circular-list 2))) (set! (v 0) lst) (set-car! lst v) (test (let ((i2 (make-complete-iterator (list v)))) (map values i2)) (list v lst))) (let ((v (vector 1 2))) (set! (v 1) v) (set! (v 0) v) (test (let ((i3 (make-complete-iterator (list v)))) (map values i3)) (list v))) (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1) (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) #f) (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (circular-list 2 3 1 4)) 1) (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 1 4) 3)) 1) (test (safe-find-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 4) 3)) #f) (test (let ((v (vector 1 2))) (set! (v 1) v) (safe-find-if (lambda (x) (and (integer? x) (= x 1))) v)) 1) (test (let ((v (vector 1 2)) (lst (list 1 2))) (set! (v 1) lst) (set! (lst 1) v) (safe-find-if (lambda (x) (and (integer? x) (= x 1))) v)) 1) (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6 1))) 1) (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) '(2 (3 (4 5) 6))) 0) (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (circular-list 2 3 1 4)) 1) (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 1 4) 3)) 1) (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 (circular-list 2 3 4) 3)) 0) (test (safe-count-if (lambda (x) (and (integer? x) (= x 1))) (vector 2 #(1) (circular-list 2 1 3 1 4) 3)) 3) (test (let ((v (vector 1 2))) (set! (v 1) v) (safe-count-if (lambda (x) (and (integer? x) (= x 1))) v)) 1) (test (let ((v (vector 1 2)) (lst (list 1 2))) (set! (v 1) lst) (set! (lst 1) v) (safe-count-if (lambda (x) (and (integer? x) (= x 1))) v)) 2) (let ((x 1) (y 2)) (let*-temporarily ((x 32) (y x)) (test (list x y) '(32 32))) (test (list x y) '(1 2))) (let ((a (vector 1 2 3)) (x 1) (y 32) (z 0)) (let*-temporarily (((a x) y) (z (a x))) (test (list (a x) y z) '(32 32 32))) (test (list (a x) y z) '(2 32 0))) (test (make-directory-iterator #\a) 'error) (test (catch #t (lambda () (let ((f (make-directory-iterator (append "/home/" username "/libxm")))) (f) ((iterator-sequence f) #) #f)) (lambda args #f)) #f) (let ((a 3)) (let/setter ((a 1) (b 2 (lambda (s v) (+ v a)))) (set! a (+ a 1)) (set! b (+ a b)) (test (list a b) '(2 7)))) (let () (let/setter ((a 1 (lambda (s v) (- v 1))) (b 2 (lambda (s v) (+ v 1)))) (set! a (+ a 1)) (set! b (+ a b)) (test (list a b) '(1 4)))) (let () (define-macro (inlet/setter . fields) ;; (inlet/setter (name value [setter]) ...) (let ((setters (map (lambda (binding) (and (pair? (cddr binding)) (caddr binding))) fields)) (gsetters (gensym)) (glet (gensym))) `(let ((,gsetters (list ,@setters)) (,glet (inlet ,@(map (lambda (binding) `(cons ',(car binding) ,(cadr binding))) fields)))) ,@(do ((setter setters (cdr setter)) (var fields (cdr var)) (i 0 (+ i 1)) (result ())) ((null? setter) (reverse result)) (if (car setter) (set! result (cons `(set! (setter (quote ,(caar var)) ,glet) (list-ref ,gsetters ,i)) result)))) ,glet))) (let ((lt (inlet/setter (a 1) (b 2 (lambda (s v) (+ v 1)))))) (set! (lt 'a) 21) (set! (lt 'b) 3) (test (list (lt 'a) (lt 'b)) '(21 4)))) (test (let ((x 32)) (define gx (elambda () (*env* 'x))) (let ((x 100)) (let ((x 12)) (gx)))) 12) (test (let () (define hi (elambda (x) (string->symbol "b"))) (eq? (hi 1) 'b)) #t) (test (let () (define hi (elambda (x) (+ (*env* 'y) x))) (let ((y 3)) (hi 1))) 4) (test (letrec ((efunc (elambda (x) (if (= x 0) 0 (efunc (- x 1)))))) (efunc 3)) 0) (test (let ((y 1)) (define hi (elambda (x z) (if (= x z) (display "oops")) (+ z x (*env* 'y)))) (hi 2 3)) 6) (test (let ((y 1)) (define hi (elambda (x z) (if (= x z) (display "oops")) (+ z x (*env* 'y)))) (let ((y 12)) (hi 2 3))) 17) (test (let ((vals #(0 0 0))) (define rx (rlambda ((a (+ c 1))) (+ a 2))) (set! (vals 0) (rx 5)) (let ((c 3)) (set! (vals 1) (rx))) ; error if lambda* not rlambda (let ((c 5)) (set! (vals 2) (rx))) vals) #(7 6 8)) (test (let ((x 3)) (define rx (rlambda ((a x)) (if (> a 0) (rx (- a 1)) 0))) (rx)) 0) (test (let () (define rx (rlambda ((a x)) (if (> a 0) (let ((x (- x 1))) (rx)) 0))) (let ((x 3)) (rx))) 0) (test (let ((a 1) (b 2)) (eval-case 1 ((a) 123) ((b) 321) (else 0))) 123) (test (let ((a 1) (b 2) (c 3)) (eval-case 3 ((a c) 123) ((b) 321) (else 0))) 123) (test (let ((a 1) (b 2)) (eval-case 3 ((a) 123) ((b) 321) (((+ a b)) -1) (else 0))) -1) (test (let ((a 1) (b 2)) (eval-case 6 ((a (* (+ a 2) b)) 123) ((b) 321) (((+ a b)) -1) (else 0))) 123) (test (let ((a 1) (b 2) (c 5)) (eval-case (set! c (+ c 1)) ((a (* (+ a 2) b)) 123) ((b) 321) (((+ a b)) -1) (else 0))) 123) (test (let ((a 1) (b 2) (c 5)) (eval-case (set! c (+ c 1)) ((b) 321) ((+ a b) -1) ((a (* (+ a 2) b)) 123) (((+ a b)) -1) (else 0))) 123) (test (linearize (circular-list 1 2 3)) '(1 2 3)) (test (linearize ()) ()) (test (linearize (let ((lst (list 1 2 3 4))) (set-cdr! (list-tail lst 3) (cdr lst)) lst)) '(1 2 3 4)) (test (flatten-let (with-let (inlet) (let ((x 1)) (curlet)))) (inlet 'x 1)) (test (flatten-let (with-let (inlet) (let ((x 1)) (let ((y 2)) (curlet))))) (inlet 'x 1 'y 2)) (test (clamp 1 0 3) 1) (test (clamp 1 2 3) 2) (test (clamp 1 4 3) 3) (test (n-choose-k 4 4) 1) (test (n-choose-k 4 3) 4) (test (n-choose-k 4 2) 6) (test (n-choose-k 4 1) 4) (test (n-choose-k 4 0) 1) (load "reactive.scm") (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ b c)) (set! b 4) (set! c 5) a) 9) (test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (reactive-set! a (+ b c)) (set! c 5) a) 14) (test (let ((expr 21) (symbol 1)) (reactive-set! expr (* symbol 2)) (set! symbol 3) expr) 6) (test (let ((a 21) (b 1)) (reactive-set! a (* b 2)) (set! b 3) a) 6) (test (let ((s 21) (v 1)) (reactive-set! s (* v 2)) (set! v 3) s) 6) (test (let ((a 21) (v 1)) (reactive-set! a (* v 2)) (set! v 3) a) 6) (test (let ((symbol 21) (nv 1)) (reactive-set! symbol (* nv 2)) (set! nv 3) symbol) 6) (test (let ((outer 0)) (let ((nv 21) (sym 1)) (let ((inner 1)) (reactive-set! nv (* sym 2)) (set! sym 3) nv))) 6) (test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (let ((a 10)) (set! a (+ b 5)) (list a b))) '(10 5)) (test (let ((a 1) (b 2)) (reactive-set! b (+ a 4)) (list (let ((b 10)) (set! a (+ b 5)) a) b)) '(15 19)) (test (let ((a 1) (b 2) (c 3)) (reactive-set! b (+ c 4)) (let ((a 0)) (reactive-set! a (+ b c)) (set! c 5) a)) 14) (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (reactive-set! b (+ c 4))) (list a b c)) '(7 7 3)) (test (let ((a 1) (b 2) (c 3)) (reactive-set! a (+ 1 (reactive-set! b (+ c 4)))) (list a b c)) '(8 7 3)) (test (let ((a 1) (x 0)) (reactive-set! x (* a 2)) (reactive-set! a (* x 2)) (set! x 2) a) 4) (test (let ((a 1)) (let ((b 0) (c 0)) (reactive-set! b (* a 2)) (reactive-set! c (* a 3)) (let ((x 0)) (reactive-set! x (+ a b c)) (set! a 2) x))) 12) (test (let ((x 0)) (let ((a 1)) (reactive-set! x (* 2 a)) (set! a 2)) x) 4) (test (let ((x 0) (a 1)) (reactive-set! x (+ a 1)) (reactive-set! a (+ x 2)) (set! a 3) (set! x 4) (list x a)) (list 4 6)) (test (let ((x 0) (a 1) (b 0)) (reactive-set! x (+ a 2)) (let ((x 2)) (reactive-set! x (+ a 1)) (set! a 4) (set! b x)) (list x a b)) (list 6 4 5)) (test (let ((x 0)) (reactive-set! x (* 3 2)) x) 6) (test (let ((x 0)) (reactive-set! x (* pi 2)) x) (* pi 2)) (test (let ((x 0)) (let ((a 1)) (reactive-set! x a) (set! a 2)) x) 2) (test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (reactive-set! a (* b 2)) (set! b 3) a) 6) ; old setter ignored (test (let ((a 21) (b 1)) (set! (setter 'b) (lambda (x y) (* 2 y))) (let ((b 2)) (reactive-set! a (* b 2)) (set! b 3) a)) 6) (test (reactive-let () 3) 3) (test (let ((a 1)) (reactive-let ((b (+ a 1))) b)) 2) (test (let ((a 1)) (+ (reactive-let ((b (+ a 1))) (set! a 3) b) a)) 7) (test (let ((a 1)) (+ (reactive-let ((b (+ a 1)) (a 0)) (set! a 3) b) a)) 3) (test (let ((a 1)) (reactive-let ((a 2) (b (* a 3))) (set! a 3) b)) 3) (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! a 3) b)) 3) (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2)) (b (* a 3))) (set! b 3) a)) 4) (test (let ((a 1) (b 2)) (reactive-let ((a (* b 2))) (set! b 3) a)) 6) (test (let ((a 1)) (reactive-let ((b (+ a 1))) (set! a 3) b)) 4) (test (let ((a 1)) (reactive-let ((b (+ a 1)) (c (* a 2))) (set! a 3) (+ c b))) 10) (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (+ b c))) 11) ;(test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3)) (setter 'a)) #f) (test (let ((a 1) (d 2)) (reactive-let ((b (+ a d)) (c (* a d)) (d 0)) (set! a 3) (set! d 12) (+ b c))) 11) (test (let ((a 1) (b 2)) (+ (reactive-let ((b (+ a 1)) (c (* b 2))) (set! a 3) (+ b c)) a b)) 13) ;c=4 because it watches the outer b (test (let ((a 1)) (reactive-let ((b (* a 2))) (reactive-let ((c (* a 3))) (set! a 2) (+ b c)))) 10) (test (let ((a 1)) (reactive-let ((b (* a 2))) (let ((d (reactive-let ((c (* a 3))) c))) (set! a 2) (+ b d)))) 7) (test (let ((a 1)) (reactive-let ((b (* a 2))) (+ (reactive-let ((c (* a 3))) c) (set! a 2) b))) 9) ; a=2 is added to b=4 and c=3 (test (let ((a 1)) (reactive-let ((b (+ a 1))) (reactive-let ((c (* b 2))) (begin (set! a 3) (+ c b))))) 12) (test (reactive-let ((a (lambda (b) b))) (a 1)) 1) (test (reactive-let ((a (let ((b 1) (c 2)) (+ b c)))) a) 3) (test (let ((b 1)) (reactive-let ((a (let ((b 1) (c 2)) (+ b c))) (c (* b 2))) (set! b 43) c)) 86) (num-test (let ((x 0.0)) (reactive-let ((y (sin x))) (set! x 1.0) y)) (sin 1.0)) (test (let ((a 1)) (reactive-let ((b a) (c a)) (set! a 3) (list b c))) '(3 3)) (test (let ((a 1)) (reactive-let ((b a)) (reactive-let ((c (* b a))) (set! a 3) (list b c)))) '(3 9)) (test (let ((a 1) (b 2)) (reactive-let ((c a) (d (* b a))) (set! a 3) (list a b c d))) '(3 2 3 6)) (test (let ((a 1)) (reactive-let ((b (* a 2)) (c (* a 3)) (d (* a 4))) (set! a 2) (list a b c d))) '(2 4 6 8)) (test (let ((b 2)) (reactive-let ((a (* b 2))) (+ (reactive-let ((a (* b 3))) (set! b 3) a) a))) 15) (test (let ((a 1)) (reactive-let* ((b a) (c (* b a))) (set! a 3) (list b c))) '(3 9)) (test (let ((a 1)) (reactive-let* ((b a) (x (+ a b))) (set! a 3) (list b x))) '(3 6)) (num-test (let ((x 0.0)) (reactive-let* ((y x) (z (* y (cos x)))) (set! x 1.0) z)) (cos 1.0)) (test (let ((a 1) (b 32)) (reactive-let* ((b a) (c (+ b 1))) c)) 2) #| (let ((e (let ((a 1) (b 2)) (reactive-lambda* (s v) ((curlet) s)) (curlet)))) ; constant let (test (set! (e 'a) 32) 1) (set! (e 'b) 12) (test (e 'b) 2) (test (with-let e (set! a 32) a) 1)) (let () (define (make-library) (let ((A 1.0) ; define a library with 2 globals (A and B) and a function (f1) (B 2.0)) (reactive-lambda* (s v) ; make sure B is always twice A (case s ((A) (set! B (* 2 v))) ((B) (set! A (/ v 2)))) v) (define (f1 x) (+ A (* B x))) (curlet))) (with-let (make-library) (num-test (f1 3.0) 7.0) (set! A 3.0) (num-test B 6.0) (num-test (f1 3.0) 21.0) (set! B 4.0) (num-test (f1 3.0) 14.0))) |# (let ((lst ())) (call-with-input-vector (vector 1 2 3 4) (lambda (p) (do ((i 0 (+ i 1))) ((= i 4)) (set! lst (cons (read p) lst))))) (test lst '(4 3 2 1))) (test (call-with-output-vector (lambda (p) (do ((i 0 (+ i 1))) ((= i 4)) (write (* i 2) p) (display (* i 4) p) (format p "~A" i)))) #(0 0 "0" 2 4 "1" 4 8 "2" 6 12 "3")) (test (subsequence (list 1 2 3 4)) (list 1 2 3 4)) (test (subsequence (list 1 2 3 4) 1) (list 2 3 4)) (test (subsequence (list 1 2 3 4) 1 3) (list 2 3)) (test (subsequence (list 1 2 3 4) 3 3) ()) (test (subsequence #(1 2 3 4) 2) #(3 4)) (test (subsequence "1234" 1) "234") (when with-block (test (subsequence (block .1 .2 .3 .4) 1 3) (block .2 .3))) (let ((e (openlet (inlet 'value #(1 2 3 4))))) (test (subsequence e 1 3) #(2 3)) (test (subsequence e 1) #(2 3 4)) (test (apply subsequence e ()) #(1 2 3 4)) (test (subsequence e) #(1 2 3 4))) (when full-s7test (test (pair? (member :heap-size (*s7*->list))) #t)) ;; sandbox (test (sandbox '(+ 1 2)) 3) ; (test (sandbox '(let ((x (floor pi))) (+ x 1))) 4) ; (test (sandbox '(+ 1 x)) "error: 'x is unbound in (+ 1 x)") ; this now includes the file name and line number ; (test (sandbox '(let ((p (open-output-string))) (display (+ 2 3) p) (get-output-string p))) "5") (test (sandbox '(begin (define-macro (_mx_ x) `(+ ,x 1)) (_mx_ 2))) 3) (test (sandbox '(let ((_fx_ (lambda (x) (+ x 1)))) (_fx_ 2))) 3) ;; *1* (test (sandbox '(set! (*s7* 'autoloading?) #t)) #f) (test (sandbox '(,file-exists? "lint.scm")) #f) ; unquote (if (provided? 'snd) (test (sandbox '(set! *clm-srate* ())) #f)) ;; *2* (test (sandbox `(eval '(+ 1 2))) #f) (test (sandbox '(open-input-file "lint.scm")) #f) (test (sandbox '(error (exit))) #f) (test (sandbox '(error)) "error: error: not enough arguments: (error)") (test (sandbox '(exit)) #f) (test (sandbox '(begin (define-macro (mx x) `(,file-exists? ,x)) (mx "lint.scm"))) #f) (test (sandbox '(begin (define-macro (mx x) `(,(symbol "file" "-exists?") ,x)) (mx "lint.scm"))) #f) (test (let ((fx exit)) (sandbox '(fx))) "error: unbound variable fx in (fx)") (test (sandbox '(let ((_fxex_ exit)) (_fxex_))) #f) (test (sandbox '((symbol->value 'exit))) #f) ;(begin (define _fxit_ exit) (test (sandbox '(_fxit_)) #f)) ; or4 unbound var in this context (test (sandbox '(begin (define-macro (_mx_ x) `(,(string->symbol "file-exists?") ,x)) (_mx_ "lint.scm"))) #f) (test (sandbox '(begin (set! baddies ()) (let ((abs #_exit)) (abs 1)))) #f) ;; *3* (test (let-temporarily ((abs exit)) (sandbox '(abs 1))) #f) ;; *4* (test (sandbox '(let ((abs #_exit)) (abs 1))) #f) (test (sandbox '(begin (define-macro (mx x) `(#_file-exists? ,x)) (mx "lint.scm"))) #f) (test (cdr-assoc 'a '((a . 1) (b . 2))) 1) (test (cdr-assoc 'c '((a . 1) (b . 2))) #f) (test (cdr-assoc 'c ()) #f) (test (adjoin 'a ()) '(a)) (test (adjoin 'a '(a)) '(a)) (test (adjoin 'a '(b a c)) '(b a c)) (test (adjoin 'a '(b c)) '(a b c))) (let () (require write.scm) (define (ppc obj) (pp obj)) (test (let ((i 3)) (ppc i)) "3") (if (not (string=? (pp '(lambda* (a b) (+ a b) (* 1 2))) "(lambda* (a b)\n (+ a b)\n (* 1 2))")) (format *stderr* "pp 1~%")) (if (not (string=? (pp '(let ((a 1) (b 2)) (+ a b))) "(let ((a 1)\n (b 2))\n (+ a b))")) (format *stderr* "pp 2~%")) (if (not (string=? (pp '(let () (+ a b))) "(let ()\n (+ a b))")) (format *stderr* "pp 2a~%")) (if (not (string=? (pp '(begin (+ 1 2) (* 2 3))) "(begin\n (+ 1 2)\n (* 2 3))")) (format *stderr* "pp 3~%")) (if (not (string=? (pp '(case a ((a b c) 1) ((d) 2) (else 3))) "(case a\n ((a b c) 1)\n ((d) 2)\n (else 3))")) (format *stderr* "pp 4: ~A~%" (pp '(case a ((a b c) 1) ((d) 2) (else 3))))) (if (not (string=? (pp '(cond ((> a 1) 2) ((< a 3) 3) (#t 4))) "(cond ((> a 1) 2)\n ((< a 3) 3)\n (#t 4))")) (format *stderr* "pp 5~%")) (if (not (string=? (pp '(catch 'x (lambda () 32) (lambda args 'error))) "(catch 'x\n (lambda ()\n 32)\n (lambda args\n 'error))")) (format *stderr* "pp 6~%")) (if (not (string=? (pp '(if a '(1 2 3))) "(if a '(1 2 3))")) (format *stderr* "pp7~%")) (if (not (= ((funclet pretty-print) '*pretty-print-length*) 100)) (format *stderr* "*pretty-print-length*: ~A~%" ((funclet pretty-print) '*pretty-print-length*))) (if (not (= ((funclet pretty-print) '*pretty-print-spacing*) 2)) (format *stderr* "*pretty-print-spacing*: ~A~%" ((funclet pretty-print) '*pretty-print-spacing*))) (if (not (string=? (pp '(+ pi +nan.0 1.123456)) "(+ pi +nan.0 1.123456)")) (format *stderr* "pp8~%")) (if (not (string=? (pp 3.1415123123213) "3.1415")) (format *stderr* "pp9: ~A~%" (pp 3.1415123123213))) (let-temporarily ((((funclet pretty-print) '*pretty-print-float-format*) "~,12F")) (if (not (string=? (pp 3.1415123123213) "3.141512312321")) (format *stderr* "pp10: ~A~%" (pp 3.1415123123213)))) ;(set! ((funclet pretty-print) '*pretty-print-spacing*) 8) (let-temporarily ((((funclet pretty-print) '*pretty-print-spacing*) 8)) (if (not (string=? (pp '(let () (+ a b))) "(let ()\n (+ a b))")) (format *stderr* "pp 11~%"))) (if (not (string-wi=? (pp (let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>)) "(let ((<1> (hash-table)))\n (set! (<1> 'a) <1>)\n <1>)\n")) (format *stderr* "pp cyclic hash: ~S\n" (pp (let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>)))) (let ((lt (openlet (inlet 'pretty-print (lambda* (obj port (col 0)) (display "(special-inlet)" port)))))) (test (with-output-to-string (lambda () (pretty-print lt))) "(special-inlet)")) (test (let () (define (func) (let ((x #f) (i 0)) (list (values (ldb 0+1e18i `((x 1))) (block-ref (documentation)))))) (define (hi) (func)) (hi)) 'error) ;safe_closure_aa_a bug (if (not (= ((funclet pretty-print) '*pretty-print-spacing*) 2)) (format *stderr* "*pretty-print-spacing*: ~A~%" ((funclet pretty-print) '*pretty-print-spacing*))) (test (pretty-print (hash-table 'a 2.0) (open-output-function (lambda (a) (values a (+ a 1))))) 'error) ; test of function output char mv check (let () ; op_safe_c_sp_mv followed later by cdr of value picking up uncleared mv bit (define (_f8_ x) (let-temporarily ((x (+ x 1))) (values x x))) (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (pretty-print (list-values #t (_f8_ 1)) #f)))) (test (func) #t)) ; #t = do loop value (test (pp (list #_if (list '> 3 2) #_case abs)) "(#_if (> 3 2) #_case abs)") (test (pp (list #_set! 'sym 32)) "(#_set! sym 32)") (test (pp (list 'set! 'sym 32)) "(set! sym 32)") (test (string-wi=? (pp (list #_catch #t (list #_lambda () (list 'abs 'x)) (list #_lambda (list 'type 'info) #f))) "(#_catch #t (#_lambda () (abs x)) (#_lambda (type info) #f))") #t) (test (string-wi=? (pp (list '#_define 'x 32)) "(#_define x 32)") #t) (test (string-wi=? (pp (list 'define 'x 32)) "(define x 32)") #t) (test (string-wi=? (pp (list #_unless (list '< 2 1) (list 'display 'ok) #f)) "(#_unless (< 2 1) (display ok) #f)") #t) (test (string-wi=? (pp (list 'when (list '< 2 1) (list 'display 'ok))) "(when (< 2 1) (display ok))") #t) (test (string-wi=? (pp (list #_letrec (list (list 'i 32) (list 'j 12)) (list '+ 'i 'j))) "(#_letrec ((i 32) (j 12)) (+ i j))") #t) (test (string-wi=? (pp (list #_let* 'loop (list (list 'i 10) (list 'j 12)) (list '+ 'i 'j))) "(#_let* loop ((i 10) (j 12)) (+ i j))") #t) (test (string-wi=? (pp (list #_and (list 'or #t) #f)) "(#_and (or #t) #f)") #t) ) (let () (require r7rs.scm) ;;; boolean=? (test (boolean=? #f #f) #t) (test (boolean=? #f #t) #f) (test (boolean=? #f #f #f) #t) (test (boolean=? #t #t) #t) (test (boolean=? #f #f #t #f) #f) (test (boolean=? #f (values) #f) #f) (test (boolean=? 1 #t) #f) ;(test (boolean=?) 'error) ;(test (boolean=? #f) 'error) (for-each (lambda (arg) (if (boolean=? #f arg) (format #t ";(boolean=? #f ~A) -> #t?~%" arg))) (list "hi" '(1 2) () "" #() (integer->char 65) 1 'a-symbol (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) :hi (if #f #f) # # #)) (test (boolean=? #f #false) #t) (test (boolean=? #t #true) #t) ;;; symbol=? (test (symbol=? 'hi 'hi) #t) (test (symbol=? 'hi 'hi 'hi) #t) (test (symbol=? 'hi 'hi 'ho) #f) (test (symbol=? 'hi 'hi pi) #f) (test (symbol=? #f 'hi) #f) (for-each (lambda (arg) (if (symbol=? 'abs arg) (format #t ";(symbol=? 'abs ~A) -> #t?~%" arg))) (list "hi" (integer->char 65) 1 (list 1 2) '#t '3 (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) # #)) ;(test (symbol=?) 'error) ;(test (symbol=? 'hi) 'error) (test (symbol=? :hi :hi) #t) (test (symbol=? :hi hi:) #f) (let () (test (provided? 'locals) #f) (provide 'locals) (test (provided? 'locals) #t) (test (pair? (memq 'locals (features))) #t) (test (pair? (memq 'locals *features*)) #t) (test (equal? (features) *features*) #t)) (test (memq 'locals (features)) #f) (test (equal? (features) *features*) #t) ;; from chibi scheme I think (let*-values (((root rem) (exact-integer-sqrt 32))) (test (* root rem) 35)) (test (let ((a 'a) (b 'b) (x 'x) (y 'y)) (let*-values (((a b) (values x y)) ((x y) (values a b))) (list a b x y))) '(x y x y)) (test (force (r7rs-delay (+ 1 2))) 3) (test (let ((p (r7rs-delay (+ 1 2)))) (list (force p) (force p))) '(3 3)) (let () (define integers (letrec ((next (lambda (n) (r7rs-delay (cons n (next (+ n 1))))))) (next 0))) (define head (lambda (stream) (car (force stream)))) (define tail (lambda (stream) (cdr (force stream)))) (test (head (tail (tail integers))) 2) (define (stream-filter p? s) (delay-force (if (null? (force s)) (r7rs-delay '()) (let ((h (car (force s))) (t (cdr (force s)))) (if (p? h) (r7rs-delay (cons h (stream-filter p? t))) (stream-filter p? t)))))) (test (head (tail (tail (stream-filter odd? integers)))) 5)) (let () (define radix (make-parameter 10 (lambda (x) (if (and (integer? x) (<= 2 x 16)) x (error 'wrong-type-arg "invalid radix"))))) (define (f n) (number->string n (radix))) (test (f 12) "12") (test (parameterize ((radix 2)) (f 12)) "1100") (test (f 12) "12")) (let () (define plus (case-lambda (() 0) ((x) x) ((x y) (+ x y)) ((x y z) (+ (+ x y) z)) (args (apply + args)))) (test (plus) 0) (test (plus 1) 1) (test (plus 1 2) 3) (test (plus 1 2 3) 6) (test (plus 1 2 3 4) 10) (define mult (case-lambda (() 1) ((x) x) ((x y) (* x y)) ((x y . z) (apply mult (* x y) z)))) (test (mult) 1) (test (mult 1) 1) (test (mult 1 2) 2) (test (mult 1 2 3) 6) (test (mult 1 2 3 4) 24)) (test (let () (define-values (x y) (values 1 2)) (+ x y)) 3) ;; from Guile: (test (let () (define-values () (values)) #f) #f) ; just avoid dumb error (test (let () (define-values (x) 1) x) 1) (test (let () (define-values (x y) (values 2 3)) (+ x y)) 5) (test (let () (define-values (x y z) (values 4 5 6)) (+ x y z)) 15) (test (let () (define-values (x . y) (values 'a 'b 'c 'd)) (list x y)) '(a (b c d))) (test (let () (define-values (x y . z) (values 'x 'y 'z 'w)) (list x y z)) '(x y (z w))) (test (let () (define-values x (values 1 2 3)) x) '(1 2 3)) (test (call-with-values (lambda () (exact-integer-sqrt 4)) list) '(2 0)) (test (call-with-values (lambda () (exact-integer-sqrt 5)) list) '(2 1)) (test (let-values (((x) (values 1))) x) 1) (test (let-values ((x (values 1))) x) '(1)) (test (let-values (((x) (values 1)) ((y) (values 2))) (list x y)) '(1 2)) (test (let ((x 32)) (let-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y))) '(1 33)) (test (let-values (((x y) (values 1 2))) (list x y)) '(1 2)) (test (let ((d 32)) (let-values (((a) 1) ((c d e) (values 3 4 5)) ((b) d)) (+ a b (* c d e)))) (let ((d 32)) (with-let (apply sublet (curlet) (list ((lambda (a) (values :a a)) 1) ((lambda (c d e) (values :c c :d d :e e)) (values 3 4 5)) ((lambda (b) (values :b b)) d))) (+ a b (* c d e))))) (test (let ((a 32) (b -1)) (let-values (((a b) (values 1 2)) ((x y) (values a b))) (list a b x y))) (let ((a 32) (b -1)) (with-let (apply sublet (curlet) (list ((lambda (a b) (values :a a :b b)) (values 1 2)) ((lambda (x y) (values :x x :y y)) (values a b)))) (list a b x y)))) (test (let ((a 1)) (let ((b (let-values (((a . b) (values 2 3)) (c (begin (set! a 9) 4))) (list a b c)))) (cons a b))) '(9 2 (3) (4))) (test (let* ((a 1) (b (let-values (((a . b) (values 2 3)) (c (begin (set! a 9) 4))) (list a b c)))) (cons a b)) '(9 2 (3) (4))) (test (let-values (((a b c) (values 1 2 3)) ((d . e) (values 4 5))) (list a b c d e)) '(1 2 3 4 (5))) (test (let-values (((a b c) (values 1 2 3)) ((d . e) (values 4 5 6))) (list a b c d e)) '(1 2 3 4 (5 6))) ;; a=1 here, so use aa (test (let-values (((aa b) (values 1 2)) ((c d) (values aa 4))) (+ aa b c d)) 'error) ; 'a not in scope (let () ; from bug-guile (define* (newton-sqrt x (tolerance 0.001) (guess 1)) (if (< (abs (- x (* guess guess))) tolerance) (values guess (abs (- x (* guess guess))) tolerance) (newton-sqrt x tolerance (/ (+ guess (/ x guess)) 2)))) (let-values (((root diff tolerance) (newton-sqrt 1000))) (num-test (exact->inexact diff) 3.6992436605487455e-4) (test tolerance 0.001) (test (< diff tolerance) #t) (test (< diff (inexact->exact tolerance)) #t) (test (< (exact->inexact diff) tolerance) #t))) (test (let*-values (((x) (values 1))) x) 1) (test (let*-values ((x (values 1))) x) '(1)) (test (let*-values (((x) (values 1)) ((y) (values 2))) (list x y)) '(1 2)) (test (let*-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y)) '(1 2)) (test (let*-values (((x y) (values 1 2))) (list x y)) '(1 2)) (test (let*-values (((a) 1) ((c d e) (values 3 4 5)) ((b) d)) (+ a b (* c d e))) (let ((a 1)) ((lambda (c d e) (let ((b d)) (+ a b (* c d e)))) (values 3 4 5)))) (test (let*-values (((a b) (values 1 2)) ((x y) (values a b))) (list a b x y)) ((lambda (a b) ((lambda (x y) (list a b x y)) (values a b))) (values 1 2))) (test (let ((a 1)) (let ((b (let*-values (((a . b) (values 2 3)) (c (begin (set! a 9) 4))) (list a b c)))) (cons a b))) '(1 9 (3) (4))) (test (let* ((a 1) (b (let*-values (((a . b) (values 2 3)) (c (begin (set! a 9) 4))) (list a b c)))) (cons a b)) '(1 9 (3) (4))) (test (vector-copy #()) #()) (test (vector-copy #(a b c)) #(a b c)) (test (vector-copy #(a b c) 1) #(b c)) (test (vector-copy #(a b c) 1 2) #(b)) (let ((e (box 1))) (test (box? e) #t) (test (unbox e) 1) (test (e 'value) 1) (set-box! e 2) (test (unbox e) 2)) (let () ; R Adamkovic (define-record-type (make-proxy type) proxy? (type proxy-type)) (let ((proxies (list (make-proxy 'one) (make-proxy 'two)))) (test (proxy-type (list-ref proxies 0)) 'one) (test (proxy-type (list-ref proxies 1)) 'two) (test (proxy? (list-ref proxies 0)) #t) (test (proxy? (list-ref proxies 1)) #t))) ;; from bug-guile (let () (define (x y) (foo y)) (define-record-type q (make-q foo) q? (foo foo)) (test (x (make-q "1")) "1")) ) ;;; -------------------------------- debug.scm -------------------------------- (unless (or with-windows (positive? (*s7* 'profile))) (require debug.scm) (let () (define (string-wid=? s1 s2) ; ignore white-space and after ; (let-temporarily (((*s7* 'debug) 1)) (let ((iter1 (make-iterator s1)) (iter2 (make-iterator s2))) (let wi-loop ((i1 (iterate iter1)) (i2 (iterate iter2))) (cond ((eq? i1 #\;) (let bloop ((c (iterate iter1))) (if (eq? c #) (error 'missing-newline "can't find end of comment") (if (char=? c #\newline) (wi-loop (iterate iter1) i2) (bloop (iterate iter1)))))) ((eq? i2 #\;) (let bloop ((c (iterate iter2))) (if (eq? c #) (error 'missing-newline "can't find end of comment") (if (char=? c #\newline) (wi-loop i1 (iterate iter2)) (bloop (iterate iter2)))))) ((eq? i1 i2) (or (eq? i1 #) (wi-loop (iterate iter1) (iterate iter2)))) ((and (char? i1) (char-whitespace? i1)) (wi-loop (iterate iter1) i2)) (else (and (char? i2) (char-whitespace? i2) (wi-loop i1 (iterate iter2))))))))) (define-macro (db-test test expected) `(let-temporarily (((*s7* 'debug) 1)) (let ((result (call-with-output-string (lambda (p) (let-temporarily (((debug-port) p)) ,test))))) (unless (string-wid=? result ,expected) (format *stderr* "~S -> ~S~%" ',test result))))) (define (g1 a) (+ a 1)) (define (g2 b) (g1 (+ b 1))) (define (g3 c) (g2 (+ c 1))) (set! ((funclet trace-in) '*debug-max-spaces*) 40) (set! (*s7* 'debug) 2) (define (g l1 l2) (car l1)) (db-test (g '(1 2 3) '(4 5)) "(g (quote (1 2 3)) (quote (4 5))) ; g: s7test.scm[49] called from s7test.scm[50]\n -> 1") (unless (string=? (object->string (procedure-source g)) "(lambda (l1 l2) (trace-in (curlet)) (car l1))") (format *stderr* "source g: ~S~%" (procedure-source g))) (set! (*s7* 'debug) 1) (define (h) (let-temporarily (((*s7* 'debug) 3)) (for-each (lambda (x) (+ x 1)) ; this fools (*function* (curlet)) -- 'h (list 1 2)))) (trace h) (db-test (h) "(h) ; h: s7test.scm[90932] called from line 91217? -> #") (set! (debug-stack) (make-vector 64 #f)) (set! (*s7* 'debug) 2) (define (factorial n) (if (<= n 1) 1 (begin (show-debug-stack) (let ((f (factorial (- n 1)))) (* n f))))) (db-test (factorial 4) "(factorial 4) ; factorial: s7test.scm[74] called from s7test.scm[82] stack: (factorial 4) (factorial 3) ; factorial: s7test.scm[74] called from s7test.scm[82] stack: (factorial 4) (factorial 3) (factorial 2) ; factorial: s7test.scm[74] called from s7test.scm[82] stack: (factorial 4) (factorial 3) (factorial 2) (factorial 1) ; factorial: s7test.scm[74] called from s7test.scm[82] -> 1 -> 2 -> 6 -> 24") (define-macro (mac x) `(+ ,x 1)) (db-test (mac (+ 2 3)) "(mac (+ 2 3)) ; mac: s7test.scm[107] called from s7test.scm[110] -> (+ (+ 2 3) 1)") (set! (*s7* 'debug) 3) (define sf (let ((object->string (lambda (obj . arg) "#"))) (openlet (lambda (x) (+ x 1))))) (db-test (object->string sf) "(_ sf ()) ; called from s7test.scm[124] -> \"#\"") (set! (*s7* 'debug) 1) (define lt (inlet 'func (define (func x) (+ x 1)))) (trace (lt 'func)) (db-test ((lt 'func) 3) "(func 3) ; func: s7test.scm[132] called from s7test.scm[133] -> 4") (define lt1 (let () (define (func1 y) (* y 2)) (curlet))) (trace (with-let lt1 func1)) (db-test ((with-let lt1 func1) 4) "(func1 4) ; func1: s7test.scm[140] called from s7test.scm[142] -> 8") (define func2 (dilambda (lambda (x) (+ x 1)) (lambda (x y) (* x y)))) (db-test (func2 3) "") (db-test (set! (func2 3) 4) "") (trace func2) (db-test (func2 3) "(func2 3) ; func2: s7test.scm[150] called from s7test.scm[152] -> 4") (db-test (set! (func2 3) 4) "") (define ht (hash-table 'a (inlet 'func3 (define (func3 z) (- z 1))))) (db-test (((ht 'a) 'func3) 3) "") (trace ((ht 'a) 'func3)) (db-test (((ht 'a) 'func3) 4) "(func3 4) ; func3: s7test.scm[161] called from s7test.scm[163] -> 3") (trace abs) (db-test (abs -23) "(abs -23) ; abs: s7test.scm[165] called from s7test.scm[167] -> 23") (define v (make-vector 3 #f)) (set! (vector-ref v 2) 3) (db-test v "") (trace vector-ref) (db-test (vector-ref v 0) "(vector-ref #(#f #f 3) 0) ; vector-ref: s7test.scm[164] called from s7test.scm[165] -> #f") (set! (vector-ref v 1) 2) (unless (equal? v #(#f 2 3)) (format *stderr* "v: ~S~%" v)) (trace g1) (db-test (g3 2) "(g1 4) ; g1: s7test.scm[169] called from s7test.scm[170] -> 5") ;(set! (*s7* 'debug) 3) (define (f) (let-temporarily (((*s7* 'debug) 3)) (for-each (lambda (x) x) (list 1 2 3)))) (trace f) (db-test (f) "(f) ; f: s7test.scm[91037] called from line 91207? -> #") (set! (*s7* 'debug) 1) (define func5 (dilambda (lambda (a) a) (lambda (a b) (* a b)))) (trace (setter func5)) (db-test (set! (func5 6) 3) "(_ 6 3) ; _: s7test.scm[194] called from s7test.scm[195] -> 18") (db-test (func5 3) "") (define* (func6 a (b 3)) (+ a b)) (trace func6) (db-test (func6 2) "(func6 2 3) ; func6: s7test.scm[200] called from s7test.scm[201] -> 5") (db-test (func6 :b 3 :a 2) "(func6 2 3) ; func6: s7test.scm[200] called from s7test.scm[202] -> 5") (define (func7 . args) (apply + args)) (trace func7) (db-test (func7 1 2 3) "(func7 1 2 3) ; func7: s7test.scm[207] called from s7test.scm[208] -> 6") (define (func8 a . b) (cons a b)) (trace func8) (db-test (func8 1 2 3) "(func8 1 2 3) ; func8: s7test.scm[212] called from s7test.scm[213] -> (1 2 3)") (db-test (func8 '(1 4) 2 3) "(func8 (quote (1 4)) 2 3) ; func8: s7test.scm[212] called from s7test.scm[214] -> ((1 4) 2 3)") (define func9 (let ((local 0)) (lambda (x) (set! local (+ local 1)) (+ local x)))) (trace func9) (db-test (func9 2) "(func9 2) ; func9: s7test.scm[219] called from s7test.scm[220] -> 3") (db-test (func9 2) "(func9 2) ; func9: s7test.scm[219] called from s7test.scm[221] -> 4") (define-macro (mac1 x) `(+ ,x 1)) (trace mac1) (db-test (mac1 2) "(mac1 2) ; called from s7test.scm[228] -> (+ 2 1)") (define* (func11 a (b 1)) (+ a b)) (trace func11) (db-test (func11 2) "(func11 2 1) ; func11: s7test.scm[232] called from s7test.scm[233] -> 3") (db-test (func11 2 3) "(func11 2 3) ; func11: s7test.scm[232] called from s7test.scm[234] -> 5") (define-macro* (mac3 a (b 1)) `(+ ,a ,b)) (trace mac3) (db-test (mac3 2) "(mac3 2 1) ; called from s7test.scm[241] -> (+ 2 1)") (db-test (mac3 2 3) "(mac3 2 3) ; called from s7test.scm[242] -> (+ 2 3)") (define mac4 (macro (x) `(+ ,x 1))) (trace mac4) (db-test (mac4 3) "(mac4 3) ; called from s7test.scm[247] -> (+ 3 1)") (untrace abs) (db-test (abs -24) "") (untrace g1) (db-test (g3 2) "") (untrace vector-ref) (db-test (set! (vector-ref v 1) 2) "") (untrace (setter func5)) (db-test (set! (func5 6) 3) "") (untrace (lt 'func)) (db-test ((lt 'func) 3) "") (untrace (with-let lt1 func1)) (db-test ((with-let lt1 func1) 4) "") (untrace func2) (db-test (func2 3) "") (db-test (set! (func2 3) 4) "") (untrace ((ht 'a) 'func3)) (db-test (((ht 'a) 'func3) 4) "") (untrace func6) (db-test (func6 2) "") (db-test (func6 :b 3 :a 2) "") (untrace func7) (db-test (func7 1 2 3) "") (untrace func8) (db-test (func8 1 2 3) "") (untrace func9) (db-test (func9 2) "") (db-test (func9 2) "") (untrace mac1) (db-test (mac1 2) "") (untrace func11) (db-test (func11 2 3) "") (untrace mac3) (db-test (mac3 2) "") (define var1 32) (watch var1) (db-test (set! var1 12) "var1 set! to 12") (unwatch var1) (db-test (set! var1 10) "") (let ((var2 10)) (watch var2) (db-test (set! var2 12) "var2 set! to 12") (unwatch var2) (db-test (set! var2 10) "")) (let ((lt (inlet 'var3 1))) (watch (lt 'var3)) (db-test (let-set! lt 'var3 12) "var3 set! to 12") (db-test (with-let lt (set! var3 12)) "var3 set! to 12") (unwatch (lt 'var3)) (db-test (let-set! lt 'var3 10) "") (db-test (with-let lt (set! var3 10)) "")) (let ((ht (hash-table 'lt (inlet 'var4 1)))) (watch ((ht 'lt) 'var4)) (db-test (set! ((ht 'lt) 'var4) 12) "var4 set! to 12") (unwatch ((ht 'lt) 'var4)) (db-test (set! ((ht 'lt) 'var4) 10) "")) (define var5 3) (set! (setter 'var5) (lambda (s v) (* v 2))) (db-test (set! var5 4) "") (watch var5) (db-test (set! var5 5) "var5 set! to 5") (unwatch var5) (db-test (set! var5 6) "") (unless with-bignums (define (gerr x) (+ x "sa")) (trace gerr) (db-test (catch #t (lambda () (gerr 3)) (lambda (type info) (apply format (debug-port) info))) "(gerr 3) ; gerr: s7test.scm[342] called from s7test.scm[348] + second argument, \"sa\", is a string but should be a number")) (unless (= ((funclet trace-in) '*debug-spaces*) 0) (format *stderr* "spaces: ~S~%" ((funclet trace-in) '*debug-spaces*))) (define (gmv x y) (values x y)) (trace gmv) (define (cgmv) (list (gmv 1 2))) (db-test (cgmv) "(gmv 1 2) ; gmv: s7test.scm[401] called from s7test.scm[401] -> (values 1 2)") )) ;;; end debug.scm ;;; -------------------------------- profile.scm -------------------------------- (let () (let-temporarily (((*s7* 'profile) 1)) (define (g1 x) x) (define (f) (do ((i 0 (+ i 1))) ((= i 10)) (g1 i))) (f) (let ((str (call-with-output-string (lambda (p) (let-temporarily (((profile-port) p)) (show-profile)))))) (clear-profile) (let ((pos (string-position "cell " str))) ; "cell allocations" changes (set! str (substring str 0 pos))) (test (string-wi=? str "info: f: calls 1, time 0.0000 0.0000 g1: calls 10, time 0.0000 0.0000") #t)) (define (g2 x) (+ x 1)) (define (g3 x) (+ (g2 x) 1)) (define (g4 x) (+ (g3 x) 1)) (define (f1) (do ((i 0 (+ i 1))) ((= i 3)) (g4 (- i 1)))) (f1) (let ((str (call-with-output-string (lambda (p) (let-temporarily (((profile-port) p)) (show-profile)))))) (clear-profile) (let ((pos (string-position "cell " str))) (set! str (substring str 0 pos))) (test (string-wi=? str "info: f1: calls 1, time 0.0000 0.0000 g4: calls 3, time 0.0000 0.0000 g3: calls 3, time 0.0000 0.0000 g2: calls 3, time 0.0000 0.0000") #t)))) ;;; -------------------------------------------------------------------------------- ;;; ;;; cload c-define tests ;;; (see libc.scm et al below) (require cload.scm) (when (provided? 'snd) (c-define '((double j0 (double)) (double j1 (double)) (double erf (double)) (double erfc (double)) (double lgamma (double))) "m" "math.h") (num-test (m:j0 1.0) 0.76519768655797) (num-test (m:j1 1.0) 0.44005058574493) (num-test (m:j0 1/2) 0.93846980724081) (num-test (m:erf 1.0) 0.84270079294971) (num-test (m:erf 2) 0.99532226501895) (num-test (m:erfc 1.0) 0.15729920705029) (num-test (m:lgamma 2/3) 0.30315027514752) (let () (c-define '(char* getenv (char*))) (c-define '(int setenv (char* char* int))) (test (string? (getenv "HOST")) #t)) (test (defined? 'setenv) #f) (let () (define local-file-exists? (let () ; define F_OK and access only within this let (c-define '((int F_OK) (int access (char* int))) "" "unistd.h") (lambda (arg) (= (access arg F_OK) 0)))) (define delete-file (let () (c-define '(int unlink (char*)) "" "unistd.h") (lambda (file) (= (unlink file) 0)))) ; 0=success (test (local-file-exists? "s7test.scm") #t)) (c-define '((in-C "static struct timeval overall_start_time; \n\ static bool time_set_up = false; \n\ static double get_internal_real_time(void) \n\ { \n\ struct timezone z0; \n\ struct timeval t0; \n\ double secs; \n\ if (!time_set_up) {gettimeofday(&overall_start_time, &z0); time_set_up = true;} \n\ gettimeofday(&t0, &z0); \n\ secs = difftime(t0.tv_sec, overall_start_time.tv_sec);\n\ return(secs + 0.000001 * (t0.tv_usec - overall_start_time.tv_usec)); \n\ }") (double get_internal_real_time (void))) "" '("time.h" "sys/time.h")) (define-macro (new-time func) `(let ((start (get_internal_real_time))) ,func (- (get_internal_real_time) start))) (test (real? (new-time (do ((i 0 (+ i 1))) ((= i 30) i)))) #t) (when (provided? 'linux) (c-define '(int getpid (void)) "" "unistd.h") (call-with-input-file (format #f "/proc/~D/status" (getpid)) (lambda (p) (let ((name (substring (read-line p) 6))) (do ((str (read-line p) (read-line p))) ((eof-object? str)) (if (string=? (substring str 0 6) "VmRSS:") (let ((size (with-input-from-string (substring str 7) read))) (format #t "~%~A size: ~A kB, time: ~A~%" name size (*s7* 'cpu-time)))))))))) (let ((ifunc-var 32)) (c-define `((C-function ("ifunc" ifunc "add 2 ints" 2)) (in-C "static s7_pointer ifunc (s7_scheme *sc, s7_pointer args) { return(s7_make_integer(sc, s7_integer(s7_car(args)) + s7_integer(s7_cadr(args)))); }")) "" () "" "" "t8") (test (ifunc ifunc-var 2) 34)) ;;; -------------------------------------------------------------------------------- (when with-block (let () (define (catch1) (catch #t (lambda () (asdf 21)) (lambda args 12))) (with-output-to-file "tmp343.scm" (lambda () (display " (catch #t (lambda () (asdf-tmp343 21)) (lambda args 12)) "))) (let ((val1 (catch1)) (val2 (eval-string "(catch1)")) (val3 (eval-string " (catch #t (lambda () (asdf 21)) (lambda args 12)) ")) (val4 (eval '(catch1))) (val5 (eval '(catch #t (lambda () (asdf 21)) (lambda args 12)))) (val6 (load "tmp343.scm")) (val7 (sload "tmp343.scm")) (val8 (scall catch1 ())) (val9 (eval (call-with-input-file "tmp343.scm" read))) (val10 (eval (call-with-input-file "tmp343.scm" sread))) (val11 (swind (lambda () #f) catch1 (lambda () #f))) (val12 (seval '(catch #t (lambda () (asdf 21)) (lambda args 12)))) (val13 (sevalstr " (catch #t (lambda () (asdf 21)) (lambda args 12)) "))) (test (list val1 val2 val3 val4 val5 val6 val7 val8 val9 val10 val11 val12 val13) '(12 12 12 12 12 12 12 12 12 12 12 12 12))) (delete-file "tmp343.scm") (define (catch2) (catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args 32))))) (with-output-to-file "tmp343.scm" (lambda () (display " (catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args 32)))) "))) (let ((val1 (catch2)) (val2 (eval-string "(catch2)")) (val3 (eval-string " (catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args 32)))) ")) (val4 (eval '(catch2))) (val5 (eval '(catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args 32)))))) (val6 (load "tmp343.scm")) (val7 (sload "tmp343.scm")) (val8 (scall catch2 ())) (val9 (eval (call-with-input-file "tmp343.scm" read))) (val10 (eval (call-with-input-file "tmp343.scm" sread))) (val11 (swind (lambda () #f) catch2 (lambda () #f))) (val12 (seval '(catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args 32)))))) (val13 (sevalstr " (catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args 32)))) "))) (test (list val1 val2 val3 val4 val5 val6 val7 val8 val9 val10 val11 val12 val13) '(32 32 32 32 32 32 32 32 32 32 32 32 32))) (delete-file "tmp343.scm") (define (catch3) (catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args (catch #t (lambda () (sfsa 32)) (lambda args 64))))))) (with-output-to-file "tmp343.scm" (lambda () (display "(catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args (catch #t (lambda () (sfsa 32)) (lambda args 64)))))) "))) (let ((val1 (catch3)) (val2 (eval-string "(catch3)")) (val3 (eval-string " (catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args (catch #t (lambda () (sfsa 32)) (lambda args 64)))))) ")) (val4 (eval '(catch3))) (val5 (eval '(catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args (catch #t (lambda () (sfsa 32)) (lambda args 64)))))))) (val6 (load "tmp343.scm")) (val7 (sload "tmp343.scm")) (val8 (scall catch3 ())) (val9 (eval (call-with-input-file "tmp343.scm" read))) (val10 (eval (call-with-input-file "tmp343.scm" sread))) (val11 (swind (lambda () #f) catch3 (lambda () #f))) (val12 (seval '(catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args (catch #t (lambda () (sfsa 32)) (lambda args 64)))))))) (val13 (sevalstr " (catch #t (lambda () (asdf 21)) (lambda args (catch #t (lambda () (fdsa 12)) (lambda args (catch #t (lambda () (sfsa 32)) (lambda args 64)))))) "))) (test (list val1 val2 val3 val4 val5 val6 val7 val8 val9 val10 val11 val12 val13) '(64 64 64 64 64 64 64 64 64 64 64 64 64))))) ;;; -------------------------------------------------------------------------------- (let ((e (openlet (inlet 'absolute-value (lambda (x) (abs x)))))) (test (+ 3 ((e 'absolute-value) -3)) 6) (test (catch #t (lambda () (+ ((e 'absolute-value) -3) 32)) (lambda args "oops")) 35) (test (catch #t (lambda () (+ ((e 'absolute-value) "oops") 32)) (lambda args 35)) 35)) (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (if (negative? x) (- x) x))))))) (test (+ 3 (abs e)) 6) (test (catch #t (lambda () (+ (abs e) 32)) (lambda args "oops")) 35) (set! (e 'x) "oops") (test (catch #t (lambda () (+ (abs e) 32)) (lambda args 35)) 35)) (test (+ 32 (call-with-exit (lambda (return) (let ((e (lambda (x) (return (if (negative? x) (- x) x))))) (+ 123 (e -321)))))) 353) (test (+ 32 (catch #t (lambda () (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (error 'oops (if (negative? x) (- x) x)))))))) (+ 123 (abs e) -321))) (lambda args 3))) 35) (test (+ 32 (catch #t (lambda () (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (throw 'oops (if (negative? x) (- x) x)))))))) (+ 123 (abs e) -321))) (lambda args 3))) 35) (test (+ 32 (call-with-exit (lambda (return) (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x)))))))) (+ 123 (abs e) -321))))) 35) (test (+ 32 (call-with-exit (lambda (return) (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x)))))))) (+ 123 (eval `(abs e)) -321))))) 35) (test (+ 32 (catch #t (lambda () (call-with-exit (lambda (return) (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x)))))))) (+ 123 (error 'oops (abs e)) -321))))) (lambda args 3))) 35) (test (+ 32 (call-with-exit (lambda (return) (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x)))))))) (let ((e1 (openlet (inlet 'abs (lambda (x) (abs e)))))) (+ 123 (abs e1) -321)))))) 35) (test (+ 32 (call-with-exit (lambda (return) (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x)))))))) (let ((e1 (openlet (inlet 'abs (lambda (x) (abs e)))))) (let ((e2 (openlet (inlet 'abs (lambda (x) (abs e1)))))) (+ 123 (abs e2) -321))))))) 35) (let () ; optimize these things (define (tst-it) (+ 32 (call-with-exit (lambda (return) (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x)))))))) (+ 123 (abs e) -321)))))) (test (tst-it) 35)) ; (+ 123 3 -321 32) is -163 (let () (define (tst-it1) (+ 32 (catch 'ok (lambda () (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (throw 'ok (if (negative? x) (- x) x)))))))) (+ 123 (abs e) -321))) (lambda (type info) (car info))))) (test (tst-it1) 35)) (let () (define (tst-it2) (+ 32 (call/cc (lambda (return) (let ((e (openlet (inlet 'x -3 'abs (lambda (e) (let ((x (e 'x))) (return (if (negative? x) (- x) x)))))))) (+ 123 (abs e) -321)))))) (test (tst-it2) 35)) ;;; reader-cond (test (eval-string "(reader-cond)") 'error) ; eval-string else (reader-cond) is not wrapped in catch (test (let () (define (func) (do ((x 0 (+ x 1)) (i 0 (+ i 1))) ((>= x 1) (reader-cond (symbol +iterator+ (bignum 1234) `(x 1)))))) (func) (func)) 'error) ;op_dox_no_body (define (rt2) (reader-cond ((> 3 2) `(+ 1 2)) (#t 'error))) (test (rt2) '(+ 1 2)) (define (rt3) (reader-cond ((> 3 2) (+ 1 2)) (#t 'error))) (test (rt3) 3) (define (rt2) (reader-cond ((> 3 2)) (#t 'error))) (test (rt2) #t) (define (rt2) (reader-cond ((> 3 2) (values 1 2 3)) (#t 'error))) (test (+ (rt2) 4) 10) (define (rt2) (reader-cond ((assq 'x '((a . 3) (x . 4))) => cdr) (#t 'error))) (test (+ (rt2) 2) 6) (let () (define (f1) (let ((x 1) (y 1)) (reader-cond ((not (provided? 'asdf)) (set! x (+ x 1)) (set! x (+ x 1))) (#t (set! x (- x 1)))) (reader-cond ((provided? 'asdf) (set! y (+ y 1)) (set! y (+ y 1))) (#t (set! y (- y 1)))) (list x y))) (f1) (test (f1) (list 3 0))) (test (list 1 (reader-cond ((> 3 2) 2 3 4)) 5) (list 1 2 3 4 5)) (define-expansion (__exp1__) (values 1 2 3)) (test (begin (reader-cond ((> pi 3) (reader-cond ((= pi 3) #f) ((not (= pi 3)) 32))) (else #f))) 32) (define-expansion (s7test-comment str) (values)) ; this must be at the top-level, "comment" used as local var in lint.scm (test (+ 1 (s7test-comment "one") 2 (s7test-comment "two")) 3) #| (let () (test (abs (+ 2 -3)) (+ 1)) (define-macro (protected-let vars . body) ;; locals outside this let are not changed (and aren't accessible), ;; and we'll protect the current rootlet values of built-ins `(with-let (inlet :in (apply inlet ',(map (lambda (f) (values (car f) ((rootlet) (car f)))) (unlet)))) (dynamic-wind (lambda () #f) (lambda () (let ,vars ,@body)) (lambda () (for-each (lambda (f) ; if any built-in's value has changed in the protected-let, reset it (let ((value-before-let (in (car f)))) (unless (equal? (symbol->value (car f)) value-before-let) (apply set! (list (car f) (if (eq? value-before-let #) ; it was not changed before (cdr f) ; so use the start-up value value-before-let)))))) (unlet)))))) (let ((abs 32)) (let ((val (protected-let () (set! abs 64) (set! + 0) (test (- + abs) -64) 12))) (test (+ val abs) 44))) (test (abs (+ 2 -3)) (+ 1)) (define-macro (local-let vars . body) ;; locals outside this let are accessible and can be changed, but we'll protect them and the current rootlet values of built-ins `(let ((in (apply inlet (curlet) ',(map (lambda (f) (values (car f) ((rootlet) (car f)))) (unlet))))) (dynamic-wind (lambda () #f) (lambda () (let ,vars ,@body)) (lambda () (let ((out (unlet))) (when (out 'set!) ; in case set! was changed -- see example below (eval `(define set! #_set!) (rootlet))) (for-each (lambda (f) (let ((value-before-let (in (car f)))) (unless (or (equal? (symbol->value (car f)) value-before-let) (eq? 'set! (car f))) (apply #_set! (list (car f) (if (eq? value-before-let #) (cdr f) value-before-let)))))) (inlet in out))))))) (let ((abs 32) (a 20)) (let ((val (local-let () (set! abs 64) (set! + 0) (set! a 1) (test (- + abs) -64) 12))) (test (+ abs a val) 64))) (test (abs -1) (+ 1))) |# (let () (define (f1) (let ((lst (list 1 2 (reader-cond ((> 1 0) 3) (else 4)) 5 6))) lst)) (test (f1) '(1 2 3 5 6)) (define (f2) (let ((lst (list 1 2 (reader-cond ((> 1 0) 3 4)) 5 6))) lst)) (test (f2) '(1 2 3 4 5 6)) (define (f3) (list (__exp1__) 5)) (test (f3) '(1 2 3 5)) (define (f4) (+ (__exp1__) (__exp1__))) (test (f4) 12) (define (f5) (let ((lst (list (reader-cond ((> 1 0) (__exp1__)) (else 4)) 5 6))) lst)) (test (f5) '(1 2 3 5 6)) (define (f6) (let ((lst ((reader-cond ((> 1 0) list) (else cons)) 1 2))) lst)) (test (f6) '(1 2)) (define (f7) (let ((lst ((reader-cond ((= 1 0) vector) ((< 1 0) list) (else cons)) 1 2))) lst)) (test (f7) '(1 . 2)) (define (f8) (let ((lst ((reader-cond ((> 1 0) quote)) (+ 2 3)))) lst)) (test (f8) '(+ 2 3)) (define (f9) (let ((lst ((reader-cond ((= 1 0) #f) (else quote)) (2 3)))) lst)) ; this changed -- original made no sense 13-Aug-23 (test (f9) '(2 3)) (define (f10) (let ((lst (vector 0 (reader-cond ((> 1 0) (+ 2 3))) 2))) lst)) (test (f10) #(0 5 2)) (define (f11) (let ((lst `(0 ,(reader-cond ((> 1 0) (+ 2 3))) 2))) lst)) (test (f11) '(0 5 2))) (test (let ((v (vector 1 (reader-cond (#t 32)) 890))) v) #(1 32 890)) (test (let ((v (vector 1 (reader-cond (#t 2 3)) 4))) v) #(1 2 3 4)) (test (let ((v (vector 1 (reader-cond ((+ 2 3))) 4))) v) #(1 5 4)) ;;; even worse: ;; (define (reader-cond ((display "defining hiho\n" *stderr*) hiho)) (lambda () "hiho")) ;; (format *stderr* "~S~%" (hiho)) (test (let () (define (f a (reader-cond ((provided? 'surreals) b))) a) (f 1)) 1) (test (let ((x #f)) (define (fop5 x y) (apply x (list y))) (fop5 ((let () reader-cond) (#t 0 (values 2 3))))) 'error) ;(test (do ((i 0 (+ i 1))) ((= i 1)) ((let () reader-cond) (#t (values #f #f) 3))) #t) (test ((lambda args (car args)) (call-with-exit (lambda (_x_) (((vector reader-cond) 0) (#t 3 (apply values (make-list 2 1)) 3))))) 3) ; here we return values via reader-cond (test (let ((x ((let () reader-cond) (#t (values 1 2 3 4) 3)))) x) 'error) ;; -> (let ((x (values #f 3))) x): "let: can't bind x to (values #f 3)" since we return #f for the (values 1 2 3 4) in splice_in_values and reader-cond adds the values (define-expansion (reader-if test true . false) (let ((test-val (eval test))) (if test-val true (and (pair? false) (car false))))) (define-expansion (reader-when test . true) (if (null? true) (error 'syntax-error "reader-when has no body?") (let ((test-val (eval test))) (if test-val (apply values true) (values))))) (define-expansion (reader-case select . clauses) (if (null? clauses) (error 'syntax-error "reader-case has no clauses") (let ((key (eval select))) (call-with-exit (lambda (return) (for-each (lambda (clause) (if (or (eq? (car clause) 'else) (memv key (car clause))) (return (apply values (cdr clause))))) clauses) (values)))))) (define-expansion (evaporates) (values)) (test (abs -1 (evaporates)) 1) (test (eval-string "(abs -1 (evaporates 2))") 'error) (define global-val 0) (when (eq? (rootlet) (curlet)) (test (reader-if (= global-val 0) (display "ok1" #f)) "ok1") (test (display (reader-if (= global-val 2) "oops" "2") #f) "2") (test (reader-cond ((= global-val 0) (display "ok2" #f))) "ok2") (test (with-output-to-string (lambda () (reader-cond ((= global-val 0) (display "o") (display "k") (display "3"))))) "ok3") (reader-cond ((= global-val 3) (display "oops1\n"))) (reader-if (= global-val 3) (display "oops2\n")) (test (display (reader-cond ((= global-val 0) "ok4") (else "oops3")) #f) "ok4") (test (display (reader-if (= global-val 0) "ok5" "oops5") #f) "ok5") (define (gf11 a) (reader-cond ((= global-val 0) (let ((b (+ a 1))) (* 2 b))) (else (* a 3)))) (test (display (gf11 1) #f) 4) (define (gf12 a) (reader-if (= global-val 0) (let ((b (+ a 1))) (* 2 b)) (* a 3))) (test (display (gf12 1) #f) 4) (define (gf13 a) (reader-cond ((= global-val 0) (set! a (+ a 1)) (* 2 a)) (else (* a 3)))) (test (display (gf13 1) #f) 4) (test (reader-when (= global-val 0) (display "ok6" #f)) "ok6") (test (display (reader-when (= global-val 0) "ok7") #f) "ok7") (reader-when (= global-val 1) (display "oops7\n")) (test (display (reader-when (= global-val 1) "oops8")) 'error) ; error because global-val not = 1 -> not enough arguments to display (test (eval-string "(reader-when (= global-val 0))") 'error) ; no body (test (with-output-to-string (lambda () (reader-when (= global-val 0) (display (+ global-val 1)) (display "ok8")))) "1ok8") (test (display (list (reader-cond ((= global-val 0) 1 2 3))) #f) '(1 2 3)) (test (display (list (reader-when (= global-val 0) 1 2 3)) #f) '(1 2 3)) ; does this make sense?? (define (gf14 a) (reader-when (= global-val 0) (set! a (+ a 1)) (* 2 a))) (test (gf14 1) 4) (test (with-output-to-string (lambda () (values (display "o") (display "k") (display "9")))) "ok9") (test (reader-case global-val ((0) (display "ok10" #f)) (else (display "oops10\n"))) "ok10") (reader-case global-val ((1) (display "oops111\n")) ((2) (display "oops112\n"))) (test (reader-case global-val ((1 2 3) (display "oops114\n")) ((0) (display "ok11" #f)) (else (display "oops115\n"))) "ok11") (test (reader-case global-val ((1) (display "oops15\n")) (else (display "ok12" #f))) "ok12") (test (eval-string "(reader-case global-val)") 'error) ; error reader-case has no clauses (test (display (reader-case global-val ((0) "ok13") (else "oops13")) #f) "ok13") (test (display (reader-cond ((= global-val 0) (reader-if (= global-val 1) "3" "ok14"))) #f) "ok14") (test (reader-cond ((= global-val 0) (display (reader-if (= global-val 1) "3" "ok15") #f))) "ok15") ) ;;; end reader-cond (let () (define (test-abs) (define (abs x) (+ x 1)) (test (abs -1) 0)) (test-abs) (define (test-sin) (let ((sin (lambda (x) (+ x 2)))) (test (sin -1) 1))) (test-sin) (define (test-cos) (define cos (lambda (x) (+ x 3))) (test (cos -1) 2)) (test-cos) (define test-log (lambda () (define log (let () (lambda (x) (+ x 4)))) (test (log -1) 3))) (test-log) (define test-tan (let ((tan (lambda (x) (+ x 5)))) (lambda () (test (tan -1) 4)))) (test-tan) (define (test-acos) (let () (define (acos x) (+ x 6)) (test (acos -1) 5))) (test-acos) (define (test-acos1) (let () (if #f (define (acos x) (+ x 6))) (test (acos 1) 0))) (test-acos1) (define (test-acos2) (let () (if #t (define (acos x) (+ x 6))) (test (acos -3) 3))) (test-acos2) (define (test-atan) (define (atan x) (+ x 7)) (test (atan -1) 6)) (test-atan) (define (test-atan1) (if #f (define (atan x) (+ x 7))) (test (atan 0) 0)) (test-atan1) (define (test-asin) (define asin (let () (lambda (x) (+ x 8)))) (test (asin -1) 7)) (test-asin) (define test-sinh (lambda () (define sinh (lambda (x) (+ x 9))) (test (sinh -1) 8))) (test-sinh)) (unless with-bignums (let () (define-class quaternion () '((r 0) (i 0) (j 0) (k 0)) (list (list 'real-part (lambda (obj) (obj 'r))) (list 'imag-part (lambda (obj) (vector (obj 'i) (obj 'j) (obj 'k)))) (list 'number? (lambda (obj) #t)) (list 'complex? (lambda (obj) #f)) (list 'real? (lambda (obj) #f)) (list 'integer? (lambda (obj) #f)) (list 'rational? (lambda (obj) #f)) (list '+ (lambda orig-args (let add ((r ()) (i ()) (j ()) (k ()) (args orig-args)) (if (null? args) (make-quaternion (apply + r) (apply + i) (apply + j) (apply + k)) (let ((n (car args))) (cond ((real? n) (add (cons n r) i j k (cdr args))) ((complex? n) (add (cons (real-part n) r) (cons (imag-part n) i) j k (cdr args))) ((quaternion? n) (add (cons (n 'r) r) (cons (n 'i) i) (cons (n 'j) j) (cons (n 'k) k) (cdr args))) ((openlet? n) (if (eq? n (car orig-args)) (error 'missing-method "+ can't handle these arguments: ~A" args) (apply (n '+) (make-quaternion (apply + r) (apply + i) (apply + j) (apply + k)) (cdr args)))) ;; this code is trying to make sure we don't start bouncing: ;; if (+ q1 o1) goes to (o1 '+) which also can't handle this ;; combination, don't bounce back here! ;; In the current case, it would be (+ o1 q1) bouncing us here. ;; we're assuming (+ a b c) = (+ (+ a b) c), and that any other ;; + method will behave that way. I think the optimizer also ;; assumes that (+ a b) = (+ b a). (else (error 'wrong-type-arg "+ argument ~A is not a number" n)))))))) (list '- (lambda args (let ((first (car args))) (if (null? (cdr args)) ; (- q) is not the same as (- q 0) (make-quaternion (- (first 'r)) (- (first 'i)) (- (first 'j)) (- (first 'k))) (let ((q (cond ((real? first) (make-quaternion first 0 0 0)) ((complex? first) (make-quaternion (real-part first) (imag-part first) 0 0)) (else (copy first)))) (n (apply + (cdr args)))) (cond ((real? n) (set! (q 'r) (- (q 'r) n)) q) ((complex? n) (make-quaternion (- (q 'r) (real-part n)) (- (q 'i) (imag-part n)) (q 'j) (q 'k))) ((quaternion? n) (make-quaternion (- (q 'r) (n 'r)) (- (q 'i) (n 'i)) (- (q 'j) (n 'j)) (- (q 'k) (n 'k)))) (else (apply (n '-) (list q n))))))))) )) (let ((old-make-quaternion make-quaternion)) (varlet (outlet (curlet)) (cons 'make-quaternion (lambda args (let ((q (apply old-make-quaternion args))) (if (or (not (real? (q 'r))) (not (real? (q 'i))) (not (real? (q 'j))) (not (real? (q 'k)))) (error 'wrong-type-arg "quaternion fields should all be real: ~A" q) q)))))) (define-class pfloat () ; don't clobber built-in float?! '((x 0.0)) (list (list '+ (lambda orig-args (let add ((x ()) (args orig-args)) (if (null? args) (make-pfloat (apply + x)) (let ((n (car args))) (cond ((pfloat? n) (add (cons (n 'x) x) (cdr args))) ((real? n) (add (cons n x) (cdr args))) ((complex? n) (add (cons (real-part n) x) (cdr args))) ((openlet? n) (if (eq? n (car orig-args)) (error 'missing-method "+ can't handle these arguments: ~A" args) (apply (n '+) (make-pfloat (apply + x)) (cdr args)))) (else (error 'wrong-type-arg "+ argument ~A is not a number" n)))))))) (list 'number? (lambda (obj) #t)))) (let ((q1 (make-quaternion 1.0 1.0 0.0 0.0))) (test (complex? q1) #f) (test (number? q1) #t) (test (quaternion? q1) #t) (test (quaternion? 1) #f) (test (quaternion? 1+i) #f) (test (integer? q1) #f) (test (real? q1) #f) (test (rational? q1) #f) (test (real-part q1) 1.0) (test (imag-part q1) #(1.0 0.0 0.0)) (test (eq? q1 q1) #t) (test (eqv? q1 q1) #t) (test (equal? q1 q1) #t) (let ((q2 (make-quaternion 1.0 1.0 0.0 0.0))) (test (eq? q1 q2) #f) (test (eqv? q1 q2) #f) (test (equal? q1 q2) #t) (set! (q2 'r) 2.0) (test (equal? q1 q2) #f) (test (+ q1) q1) (test (+ 1 q1) q2) (test (+ q1 1) q2) (test (+ 1/2 q1 1/2) q2) (test (+ .5 1/2 q1) q2) (test (+ 1+i q1 0-i) q2) (test (+ 1.0 q1) q2) (test (+ q1 1+i 0-i) q2) (test (+ 0+i q1 1 0-i) q2) (test (- q1) (make-quaternion -1.0 -1.0 0.0 0.0)) (test (- q1 1) (make-quaternion 0.0 1.0 0.0 0.0)) (test (- q1 1 0.0+i) (make-quaternion 0.0 0.0 0.0 0.0)) (test (- 1 q1) (make-quaternion 0.0 -1.0 0.0 0.0)) (test (+ (make-pfloat 1.0) 1.0) (make-pfloat 2.0)) (test (+ (make-quaternion 1 0 0 0) (make-pfloat 1.0)) 'error) (test (+ (make-pfloat 1.0) 2 (make-quaternion 1 1 1 1)) 'error) (test (+ 1 (make-pfloat 1.0) 2 (make-quaternion 1 1 1 1)) 'error) (test (make-quaternion 1 2+i 0 0) 'error) (test (make-quaternion 1 2 3 "hi") 'error) (let () (define (a1 q) (+ q 1)) (test (a1 q1) (make-quaternion 2.0 1.0 0.0 0.0))) (let () (define (a1 q) (+ q 1)) (test (a1 (+ q1 1)) (make-quaternion 3.0 1.0 0.0 0.0))) (let () (define (a1 q) (+ q 1)) (test (a1 (- q1 1)) q1)) (let () (define (a1 q) (+ q 1)) (test (a1 (+ 1 q1)) (make-quaternion 3.0 1.0 0.0 0.0))) (let () (define (a1 q) (+ q 1)) (test (a1 (- 1 q1)) (make-quaternion 1.0 -1.0 0.0 0.0))) (let () (define (a1 q) (+ q 1)) (test (a1 (+ q1 q1)) (make-quaternion 3.0 2.0 0.0 0.0))) (let () (define (a1 q) (+ 1 q)) (test (a1 q1) (make-quaternion 2.0 1.0 0.0 0.0))) (let () (define (a1 q) (+ q q)) (test (a1 q1) (make-quaternion 2.0 2.0 0.0 0.0))) (let () (define (a1 q) (- q 1)) (test (a1 q1) (make-quaternion 0.0 1.0 0.0 0.0))) (let () (define (a2 q p) (+ q p)) (test (a2 q1 q2) (make-quaternion 3.0 2.0 0.0 0.0))) (let () (define (a2 q p) (+ q p)) (test (a2 (+ 1 q1) (+ q2 1)) (make-quaternion 5.0 2.0 0.0 0.0))) ))) (let ((e1 (openlet (inlet 'x 3 '* (lambda args (if (number? (car args)) ; are we the first? (apply * (car args) ((cadr args) 'x) (cddr args)) (apply * ((car args) 'x) (cdr args)))))))) (let ((e2 (copy e1))) (set! (e2 'x) 4) (test (* 2 e1 e2 5) 120) (test (* e1 e2 5) 60) (test (* e1 e2) 12) (test (* e1) 3) (test (* 2 e1 e2) 24) (test (* 2 e1 4) 24) (test (* e1 2 e2 e1) 72)))) (let () (begin (define fvector? #f) (define make-fvector #f) (let ((type (gensym)) (->float (lambda (x) (if (real? x) (* x 1.0) (error 'wrong-type-arg "fvector new value is not a real: ~A" x))))) (set! make-fvector (lambda* (len (init 0.0)) (openlet (inlet 'v (make-vector len (->float init)) 'type type 'length (lambda (e) len) 'let-set-fallback (lambda (fv i val) (#_vector-set! (fv 'v) i (->float val))) 'let-ref-fallback (lambda (fv i) (#_vector-ref (fv 'v) i)))))) (set! fvector? (lambda (p) (and (let? p) (eq? (p 'type) type)))))) (let ((f (make-fvector 10))) (test (fvector? f) #t) (test (length f) 10) (test (f 0) 0.0) (set! (f 1) 123) (test (f 1) 123.0))) (define-macro (_do4_ . args) `(do ((__var__ #f) (_i_ 0 (+ _i_ 1))) ((= _i_ 1) __var__) (set! __var__ ,@args))) (let () (define (baser-method func) (lambda largs (if (let? (car largs)) (apply func ((car largs) 'c) (cdr largs)) (if (let? (cadr largs)) (apply func (car largs) ((cadr largs) 'c) (cddr largs)) (if (let? (caddr largs)) (apply func (car largs) (cadr largs) ((caddr largs) 'c) (cdddr largs)) (apply func (car largs) (cadr largs) (caddr largs) ((cadddr largs) 'c) (cddddr largs))))))) (test (numerator (openlet (inlet 'c 1/9223372036854775807 'numerator (baser-method numerator)))) 1) (test (cdaadr (openlet (inlet 'c '((1 (2)) (((3) 4))) 'cdaadr (baser-method cdaadr)))) '(4)) (test (cadadr (openlet (inlet 'c '((1 2) (3 4)) 'cadadr (baser-method cadadr)))) 4) (test (caadar (openlet (inlet 'c '((1 (2)) (((3) 4))) 'caadar (baser-method caadar)))) 2) (test (caaadr (openlet (inlet 'c '((1 (2)) (((3) 4))) 'caaadr (baser-method caaadr)))) '(3)) (test (boolean? (openlet (inlet 'c #f 'boolean? (baser-method boolean?)))) #t) (test (number->string (openlet (inlet 'c 1/9223372036854775807 'number->string (baser-method number->string)))) "1/9223372036854775807") (test (lognot (openlet (inlet 'c '9223372036854775807 'lognot (baser-method lognot)))) -9223372036854775808) (unless pure-s7 (test (vector-length (openlet (inlet 'c #() 'vector-length (baser-method vector-length)))) 0)) (test (round (openlet (inlet 'c 1/9223372036854775807 'round (baser-method round)))) 0) ;(test (string-upcase (openlet (inlet 'c #u(104 105 52 53 53) 'string-upcase (baser-method string-upcase)))) "HI455") (test (vector? (openlet (inlet 'c #() 'vector? (baser-method vector?)))) #t) (test (null? (openlet (inlet 'c () 'null? (baser-method null?)))) #t) (test (keyword? (openlet (inlet 'c ':key 'keyword? (baser-method keyword?)))) #t) (test (real? (openlet (inlet 'c 1/9223372036854775807 'real? (baser-method real?)))) #t) (test (length (openlet (inlet 'c () 'length (baser-method length)))) 0) (test (pair? (openlet (inlet 'c '(1) 'pair? (baser-method pair?)))) #t) (test (number? (openlet (inlet 'c 1/9223372036854775807 'number? (baser-method number?)))) #t) (test (odd? (openlet (inlet 'c '9223372036854775807 'odd? (baser-method odd?)))) #t) ;(test (symbol (openlet (inlet 'c #u(104 105 52 53 53) 'symbol (baser-method symbol)))) 'hi455) (test (cdar (openlet (inlet 'c '((1 2)) 'cdar (baser-method cdar)))) '(2)) (test (even? (openlet (inlet 'c -9223372036854775808 'even? (baser-method even?)))) #t) (test (caar (openlet (inlet 'c '((1 2)) 'caar (baser-method caar)))) 1) (test (negative? (openlet (inlet 'c -1/9223372036854775807 'negative? (baser-method negative?)))) #t) (test (floor (openlet (inlet 'c 1/9223372036854775807 'floor (baser-method floor)))) 0) (test (positive? (openlet (inlet 'c 1/9223372036854775807 'positive? (baser-method positive?)))) #t) (test (string (openlet (inlet 'c #\a 'string (baser-method string)))) "a") (test (rational? (openlet (inlet 'c 1/9223372036854775807 'rational? (baser-method rational?)))) #t) ;(unless pure-s7 (test (string-copy (openlet (inlet 'c #u(104 105 52 53 53) 'string-copy (baser-method string-copy)))) "hi455")) ;(test (string->keyword (openlet (inlet 'c #u(104 105 52 53 53) 'string->keyword (baser-method string->keyword)))) :hi455) (unless pure-s7 (test (inexact? (openlet (inlet 'c 1.5+1i 'inexact? (baser-method inexact?)))) #t)) (test (char? (openlet (inlet 'c #\a 'char? (baser-method char?)))) #t) (test (exact? (openlet (inlet 'c 1/9223372036854775807 'exact? (baser-method exact?)))) #t) ;(test (format (openlet (inlet 'c #u(104 105 52 53 53) 'format (baser-method format)))) "hi455") (test (cadar (openlet (inlet 'c '((1 2)) 'cadar (baser-method cadar)))) '2) (test (char-lower-case? (openlet (inlet 'c #\a 'char-lower-case? (baser-method char-lower-case?)))) #t) (test (char-upcase (openlet (inlet 'c #\a 'char-upcase (baser-method char-upcase)))) #\A) (test (byte-vector? (openlet (inlet 'c #u(104 105 52 53 53) 'byte-vector? (baser-method byte-vector?)))) #t) ;(unless pure-s7 (test (string->list (openlet (inlet 'c #u(104 105 52 53 53) 'string->list (baser-method string->list)))) '(#\h #\i #\4 #\5 #\5))) (test (denominator (openlet (inlet 'c 1/9223372036854775807 'denominator (baser-method denominator)))) 9223372036854775807) (test (integer-length (openlet (inlet 'c '9223372036854775807 'integer-length (baser-method integer-length)))) 63) (test (integer? (openlet (inlet 'c '9223372036854775807 'integer? (baser-method integer?)))) #t) (test (char->integer (openlet (inlet 'c #\a 'char->integer (baser-method char->integer)))) 97) (test (min (openlet (inlet 'c 1/9223372036854775807 'real? (lambda (obj) (#_real? (obj 'c))) 'min (baser-method min)))) 1/9223372036854775807) (test (ceiling (openlet (inlet 'c 1/9223372036854775807 'ceiling (baser-method ceiling)))) 1) (test (max (openlet (inlet 'c 1/9223372036854775807 'real? (lambda (obj) (#_real? (obj 'c))) 'max (baser-method max)))) 1/9223372036854775807) (test (car (openlet (inlet 'c '(1) 'car (baser-method car)))) 1) (test (char-alphabetic? (openlet (inlet 'c #\a 'char-alphabetic? (baser-method char-alphabetic?)))) #t) (test (modulo 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'modulo (baser-method modulo)))) 0) ;(test (substring #u(104 105 52 53 53) (openlet (inlet 'c '0 'substring (baser-method substring)))) "hi455") ;(test (char-position #\a (openlet (inlet 'c #u(97 0 98) 'char-position (baser-method char-position)))) 0) (test (assv 1 (openlet (inlet 'c '((1 2)) 'assv (baser-method assv)))) '(1 2)) (test (assq 1 (openlet (inlet 'c '((1 2)) 'assq (baser-method assq)))) '(1 2)) (test (rationalize 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'rationalize (baser-method rationalize)))) 0) (test (subvector #(1 2) 0 1 (openlet (inlet 'c '(1) 'subvector (baser-method subvector)))) #(1)) ;(test (string>=? #u(52 53 104 105 53) (openlet (inlet 'c #u(52 53 104 105 53) 'string>=? (baser-method string>=?)))) #t) ;(test (string<=? #u(52 53 104 105 53) (openlet (inlet 'c #u(52 53 104 105 53) 'string<=? (baser-method string<=?)))) #t) ;(test (fill! #u(97 97 97 97 97) (openlet (inlet 'c 120 'fill! (baser-method fill!)))) 120) (test (string #\a (openlet (inlet 'c #\a 'string (baser-method string)))) "aa") (test (logbit? 9223372036854775807 (openlet (inlet 'c '0 'logbit? (baser-method logbit?)))) #t) (test (remainder 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 'remainder (baser-method remainder)))) 0) ;(if (not pure-s7) (test (string-ci>? #u(0 0 0 0 0) (openlet (inlet 'c #u(0) 'string-ci>? (baser-method string-ci>?)))) #t)) ;(if (not pure-s7) (test (string-ci=? #u(0 0 0 0 0) (openlet (inlet 'c #u(0 0 0 0 0) 'string-ci=? (baser-method string-ci=?)))) #t)) ;(test (string-ref #u(0 0 0 0 0) (openlet (inlet 'c '0 'string-ref (baser-method string-ref)))) #\null) ;(test (string-position #u(0 0 0 0 0) (openlet (inlet 'c #u(0 0 0 0 0) 'string-position (baser-method string-position)))) 0) ;(test (string>? #u(0 0 0 0 0) (openlet (inlet 'c #u(0) 'string>? (baser-method string>?)))) #t) ;(test (string>=? #u(52 53 104 105 53) #u(52 53 104 105 53) (openlet (inlet 'c #u(52 53 104 105 53) 'string>=? (baser-method string>=?)))) #t) (unless with-bignums (test (logxor (openlet (inlet 'c '9223372036854775807 'logxor (baser-method logxor)))) 9223372036854775807) (test (> 1/9223372036854775807 (openlet (inlet 'c -1/9223372036854775807 '> (baser-method >)))) #t) (test (= 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '= (baser-method =)))) #t) (test (< 1/9223372036854775807 (openlet (inlet 'c 1e+18 '< (baser-method <)))) #t) (test (/ 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '/ (baser-method /)))) 1) (test (- 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '- (baser-method -)))) 0) (test (+ 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '+ (baser-method +)))) 2/9223372036854775807) (test (= 1/9223372036854775807 1/9223372036854775807 (openlet (inlet 'c 1/9223372036854775807 '= (baser-method =)))) #t) (test (+ -1 (openlet (inlet 'c -1 '+ (baser-method +)))) -2) (test (- -1 (openlet (inlet 'c -1 '- (baser-method -)))) 0) (test (* (openlet (inlet 'c 2.0 '* (baser-method *))) 2.0) 4.0) (test (let ((x (openlet (inlet 'c -1 '- (baser-method -))))) (- x 1)) -2) (test (let ((x (openlet (inlet 'c 1.0 '- (baser-method -))))) (- 1.0 x)) 0.0) (test (* 3.0 (openlet (inlet 'c 2.0 '* (baser-method *))) 2.0) 12.0)) (test (symbol->string (openlet (inlet 'c 'a 'symbol->string (baser-method symbol->string)))) "a") (test (let? (outlet (openlet (inlet 'c (curlet) 'outlet (baser-method outlet)))) ) #t) (test (c-pointer? (c-pointer (openlet (inlet 'c 0 'c-pointer (baser-method c-pointer))))) #t)) (let ((e (openlet (inlet 'x (list 1 2 3) 'make-iterator (let ((+iterator+ #t)) (lambda (y) (#_make-iterator (y 'x)))))))) (test (map (lambda (z) (+ z 1)) e) '(2 3 4))) (let () (let ((x (openlet (inlet 'integer? (lambda (y) #t))))) (define (func) (let ((z (vector (integer? x) (vector (integer? x))))) (test (z 0) ((z 1) 0)))) (func))) (let () (require mockery.scm) (let ((v ((*mock-vector* 'make-mock-vector) 10 0))) (test (vector? v) #t) (let-temporarily (((*s7* 'print-length) 32)) (test (object->string v) "#(0 0 0 0 0 0 0 0 0 0)")) (test (length v) 10) (test (vector-length v) 10) (test (vector-dimensions v) '(10)) (test (vector-set! v 0 1) 1) (test (vector-ref v 0) 1) (test (v 0) 1) (test (set! (v 1) 2) 2) (test (v 1) 2) (fill! v 0) (test (v 'value) #(0 0 0 0 0 0 0 0 0 0)) (test (equivalent? v #(0 0 0 0 0 0 0 0 0 0)) #t) (test (equivalent? #(0 0 0 0 0 0 0 0 0 0) v) #t) (test (equivalent? v ((*mock-vector* 'make-mock-vector) 10 0)) #t) (unless pure-s7 (vector-fill! v 3 1 4)) (unless pure-s7 (test (v 'value) #(0 3 3 3 0 0 0 0 0 0))) (unless pure-s7 (test (vector->list v) '(0 3 3 3 0 0 0 0 0 0))) (unless pure-s7 (test (map (lambda (a) (+ a 1)) v) '(1 4 4 4 1 1 1 1 1 1))) (do ((i 0 (+ i 1))) ((= i 10)) (set! (v i) i)) (test (v 'value) #(0 1 2 3 4 5 6 7 8 9)) (for-each (lambda (x) (test (integer? x) #t)) v) (let ((v1 (subvector v 2 5 '(3)))) (test v1 #(2 3 4))) (sort! v >) (test (v 'value) #(9 8 7 6 5 4 3 2 1 0)) (test (reverse v) #(0 1 2 3 4 5 6 7 8 9)) (test (let* ((y (list 1)) (x ((*mock-vector* 'mock-vector) y))) (set! (y 0) x) (null? (cyclic-sequences x))) #f) (let ((v1 ((*mock-vector* 'make-mock-vector) 10 1))) (let ((v2 ((*mock-vector* 'make-mock-vector) 10 1))) (set! (v1 3) 32) (test (equal? (v1 'value) (v2 'value)) #f))) #| (let ((v1 #(1 2 3)) (v2 ((*mock-vector* 'make-mock-vector) 2 4))) (test (vector-append v1 v2) #(1 2 3 4 4)) (test (vector-append v2 v1) #(4 4 1 2 3)) (test (vector-append v1 v1 v2) #(1 2 3 1 2 3 4 4)) (test (vector-append v2 v2 v1) #(4 4 4 4 1 2 3))) |# (let ((v1 ((*mock-vector* 'mock-vector) 0 1 2 3 4))) (test (subsequence v1 0 2) #(0 1)))) (let ((v1 ((*mock-vector* 'mock-vector) 1 2 3 4)) (v2 ((*mock-vector* 'mock-vector) 2 3 4)) (v3 #(1 2 3 4)) (v4 #(2 3 4))) (vector-set! v2 0 v1) (vector-set! v1 0 v2) (vector-set! v4 0 v3) (vector-set! v3 0 v4) (test (equivalent? v1 v3) #f)) (let () (define (vset v i j k) (let ((x 3.0)) (vector-set! v 0 x) (vector-set! v j (vector-ref v i)) (vector-set! v i (+ (vector-ref v j) x)) (vector-set! v k x))) (let ((v (vector 1 2 0)) (i 0) (j 1) (k 2)) (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t)) (let ((v ((*mock-vector* 'mock-vector) 1 2 0)) (i 0) (j 1) (k 2)) (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t)) (let ((v (vector 1 2 0)) (i ((*mock-number* 'mock-number) 0)) (j ((*mock-number* 'mock-number) 1)) (k ((*mock-number* 'mock-number) 2))) (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t)) (let ((v ((*mock-vector* 'mock-vector) 1 2 0)) (i ((*mock-number* 'mock-number) 0)) (j ((*mock-number* 'mock-number) 1)) (k ((*mock-number* 'mock-number) 2))) (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t)) (let ((v (vector 1 2 0)) (i 0) (j ((*mock-number* 'mock-number) 1)) (k 2)) (vset v i j k) (test (equivalent? v #(6.0 3.0 3.0)) #t))) (test (+ ((*mock-number* 'mock-number) 1) ((*mock-number* 'mock-number) 2)) 3) (unless with-bignums (test (pair? (memv (log ((*mock-number* 'mock-number) 2) ((*mock-number* 'mock-number) 2)) '(1 1.0))) #t)) (test (let () (define (func) (with-let (mock-number 0) (make-polar 3 (cddadr #())))) (define (hi) (func)) (hi)) 'error) (test (/ ((*mock-number* 'mock-number) 0) 1) 0) (test (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 1-i) ((*mock-number* 'mock-number) 3/4)) 0.0) (test (make-float-vector 0 ((*mock-number* 'mock-number) 3)) #()) (test (make-complex-vector 0 ((*mock-number* 'mock-number) 3+i)) #()) (test (= ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0)) #t) (test (= ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0) #\a) 'error) (test (nan? (/ 0 1-1i +inf.0 +nan.0)) #t) (test (nan? (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 1-1i) ((*mock-number* 'mock-number) +inf.0) ((*mock-number* 'mock-number) +nan.0))) #t) (test (/ ((*mock-number* 'mock-number) 0) ((*mock-number* 'mock-number) 0.0)) 'error) (test (/ 0.0 0) 'error) (test (/ ((*mock-number* 'mock-number) 0.0) ((*mock-number* 'mock-number) 0)) 'error) (let ((X ((*mock-number* 'mock-number) 0))) (define (f1) (do ((i 0 (+ i 1))) ((= i 1) (= X 1)))) (test (f1) #f)) ; testing fx_c_equal_ic (test (length (append '(1) ((*mock-number* 'mock-number) 1))) -1) ; '(1 . 1) (test (number? (append ((*mock-number* 'mock-number) 1))) #t) (test (append ((*mock-number* 'mock-number) 1) ()) 'error) (test (fill! ((*mock-number* 'mock-number) 1) #\a) 'error) (test (reverse! ((*mock-number* 'mock-number) 1) #\a) 'error) (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t) (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "ho")) #f) (test (string=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "hi") #t) (test (string=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "hi") #t) (test (string=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t) (test (string<=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t) (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t) (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj")) #f) (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") 1) 'error) (test (string>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") ((*mock-number* 'mock-number) 1)) 'error) (test (string? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #f) (test (string? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hi")) #t) (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih")) #f) (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih") #\a) 'error) (test (string>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih") ((*mock-number* 'mock-number) 1)) 'error) (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t) (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\k)) #f) (test (char=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t) (test (char=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t) (test (char=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t) (test (char<=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t) (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t) (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j)) #f) (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j) 1) 'error) (test (char>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j) ((*mock-number* 'mock-number) 1)) 'error) (test (char? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #f) (test (char? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\i)) #t) (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m)) #f) (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) "a") 'error) (test (char>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) ((*mock-number* 'mock-number) 1)) 'error) (test (string-ci=? "hi" ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi")) #t) (test (string-ci=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "ho")) #f) (test (string-ci=? "hi" ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") "HI") #t) (test (string-ci=? ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi") "hi") #t) (test (string-ci=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi")) #t) (test (string-ci<=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t) (test (string-ci>=? ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi")) #t) (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj")) #f) (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hj") 1) 'error) (test (string-ci>=? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI") ((*mock-string* 'mock-string) "hj") ((*mock-number* 'mock-number) 1)) 'error) (test (string-ci? ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "hi") ((*mock-string* 'mock-string) "HI")) #f) (test (string-ci? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "HI")) #t) (test (string-ci>? ((*mock-string* 'mock-string) "HIHI") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "hih")) #f) (test (string-ci>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "HIH") ((*mock-string* 'mock-string) "hih") #\a) 'error) (test (string-ci>? ((*mock-string* 'mock-string) "hihi") ((*mock-string* 'mock-string) "hih") ((*mock-string* 'mock-string) "HIH") ((*mock-number* 'mock-number) 1)) 'error) (test (with-let ((*mock-string* 'mock-string) "1234") (substring "asdf" 2)) "df") ; there are a million more of these (test (#_with-input-from-string ((*mock-string* 'mock-string) "1234") (lambda () (read-line))) "1234") (test (let ((str ((*mock-string* 'mock-string) "1234"))) (fill! ms ms)) 'error) (test (let ((str ((*mock-string* 'mock-string) "1234")) (chr ((*mock-char* 'mock-char) #\a))) (string-fill! str chr)) #\a) (test (let ((str ((*mock-char* 'mock-char) #\a))) (string-fill! str #\a)) 'error) (let ((str ((*mock-string* 'mock-string) "1234")) (chr ((*mock-char* 'mock-char) #\a)) (num ((*mock-number* 'mock-number) 1))) (test (string-fill! "123" #\a str) 'error) (test (string-fill! "123" #\a 0 str) 'error) (test (string-fill! "123" #\a 0 chr) 'error) (test (string-fill! "123" #\a chr) 'error) (test (string-fill! "123" str) 'error) (test (string-fill! str #\a chr) 'error) (test (string-fill! str chr num) #\a) (test (string-fill! str num) 'error) (test (string-fill! num #\a) 'error) (test (string-fill! num chr) 'error) (unless pure-s7 (test (string-fill! "123" #\a num) #\a) (test (string-fill! "123" #\a 0 num) #\a))) (test (object->string ((*mock-number* 'mock-number) 1) :readable) "(openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?)))") (test (object->string (sublet ((*mock-number* 'mock-number) 1) :asdf 2) :readable) "(openlet (sublet *mock-number* :asdf 2))") (test (object->string (sublet (inlet :asdf 3) :mn ((*mock-number* 'mock-number) 1)) :readable) "(sublet (inlet :asdf 3) :mn (openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?))))") (test (format #f "~W" ((*mock-number* 'mock-number) 1)) "(openlet (immutable! (sublet *mock-number* :value 1 :mock-type 'mock-number?)))") (test (char-ci=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I)) #t) (test (char-ci=? #\i ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\k)) #f) (test (char-ci=? #\I ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) #\i) #t) (test (char-ci=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) #\i) #t) (test (char-ci=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #t) (test (char-ci<=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i)) #t) (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #t) (test (char-ci>=? ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\j)) #f) (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\J) 1) 'error) (test (char-ci>=? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\J) ((*mock-number* 'mock-number) 1)) 'error) (test (char-ci? ((*mock-char* 'mock-char) #\i) ((*mock-char* 'mock-char) #\I) ((*mock-char* 'mock-char) #\i)) #f) (test (char-ci? ((*mock-char* 'mock-char) #\P) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\i)) #t) (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\M) ((*mock-char* 'mock-char) #\m)) #f) (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\M) "a") 'error) (test (char-ci>? ((*mock-char* 'mock-char) #\p) ((*mock-char* 'mock-char) #\m) ((*mock-char* 'mock-char) #\m) ((*mock-number* 'mock-number) 1)) 'error) (let ((c1 ((*mock-c-pointer* 'mock-c-pointer) 0 1 2 3 4))) (test (c-pointer? c1) #t) (test (c-pointer-type c1) 1) (test (c-pointer-info c1) 2) (test (c-pointer-weak1 c1) 3) (test (c-pointer-weak2 c1) 4) (test (pair? (member (object->string c1) '("#" "#"))) #t) (test (fill! c1 #\a) 'error) (test (reverse! c1 #\a) 'error)) (unless with-bignums (let ((rs ((*mock-random-state* 'mock-random-state) 1234))) (test (random-state? rs) #t) (test (object->string rs) "#") (test (random-state->list rs) '(1234 1675393560)) (test (integer? (random rs)) 'error) (test (integer? (random 100 rs)) #t))) (let ((iter ((*mock-iterator* 'make-mock-iterator) "1234"))) (test (iterator? iter) #t) (test (object->string iter) "#") (test (iterator-sequence iter) "1234") (test (iterator-at-end? iter) #f) (test (iterate iter) #\1)) (let ((L ((*mock-pair* 'mock-pair) 1 2 3))) (let ((iter ((*mock-iterator* 'make-mock-iterator) L))) (test (iterate iter) 1) (test (iterate iter) 2) (test (iterate iter) 3) (test (iterate iter) #))) (test (with-let ((*mock-number* 'mock-number) 0) (random 1)) 0) (test (with-let ((*mock-char* 'mock-char) #\i) (char? 123)) #f) (define (stretchable-vector) (let ((local-ref (lambda (obj index) (if (>= index (length (obj 'value))) (obj 'initial-element) (#_vector-ref (obj 'value) index)))) (local-set! (lambda (obj index val) (if (>= index (length (obj 'value))) (set! (obj 'value) (copy (obj 'value) (make-vector (+ index 8) (obj 'initial-element))))) (#_vector-set! (obj 'value) index val)))) (openlet (sublet (*mock-vector* 'mock-vector-class) 'value (vector) 'mock-type 'mock-vector? 'object->string (lambda* (obj (w #t)) (format #f "#" (obj 'value))) 'initial-element #f 'vector-ref local-ref 'let-ref-fallback local-ref 'vector-set! local-set! 'let-set-fallback local-set!)))) (let ((v1 (stretchable-vector)) (ind 12)) (test (vector-length v1) 0) (test ((*mock-vector* 'mock-vector?) v1) #t) (test (v1 123) #f) (test (vector-length v1) 0) (test (object->string v1) "#") (set! (v1 ind) 32) (test (v1 ind) 32) (test (length v1) 20) (test (v1 11) #f)) (let ((ht ((*mock-hash-table* 'mock-hash-table) 'a 1 'b 2))) (test (ht 'a) 1) (test (hash-table? ht) #t) (test ((*mock-hash-table* 'mock-hash-table?) ht) #t) (test (vector? ht) #f) (test (equivalent? ht (hash-table 'a 1 'b 2)) #t) (test (hash-table-ref ht 'b) 2) (hash-table-set! ht 'c 3) (test (ht 'c) 3) (test (ht 'd) #f) (set! (ht 'c) 32) (test (hash-table-ref ht 'c) 32) (test (length ht) (*s7* 'default-hash-table-length)) (test (hash-table-entries ht) 3) (let ((ht1 (copy ht))) (test (hash-table-ref ht1 'b) 2) (test (hash-table-entries ht1) 3)) (let ((hti (make-iterator ht))) (for-each (lambda (x) (if (not (equal? x (hti))) (format *stderr* "hti not ~A~%" x))) ht)) (fill! ht ()) (test (hash-table-entries ht) 3)) (test (let ((v (vector 0 0))) (copy ((*mock-hash-table* 'mock-hash-table) 'b 2) v) v) #((b . 2) 0)) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (with-let ((*mock-hash-table* 'mock-hash-table) 'b 2) (undefined-function '(4) 1)))) (f)) 'error) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (with-let ((*mock-hash-table* 'mock-hash-table) 'b 2) (undefined-function 4)))) (f)) 'error) (unless pure-s7 (test (let ((e (openlet (inlet 'fill! (lambda (obj val) (string-fill! (obj 'value) val)) 'value "01234")))) (vector-fill! e #\a) (e 'value)) 'error)) (test (let ((e (openlet (inlet 'call/cc (lambda (obj) 32))))) (call/cc e)) 32) (test (let ((e (openlet (inlet 'call-with-current-continuation (lambda (obj) 32))))) (call/cc e)) 32) (let () ; from tmock, op_simple_do has_fn problem (define dolph-1 (lambda (N gamma) (let ((w (make-vector 256 1.0))) (do ((i 0 (+ i 1))) ((= i N)) (set! (w i) (abs i))) w))) (dolph-1 (expt 2 8) 0.5) (dolph-1 ((*mock-number* 'mock-number) (expt 2 8)) 0.5)) (define (gloomy-hash-table) (openlet (sublet (*mock-hash-table* 'mock-hash-table-class) 'value #f 'mock-type 'mock-hash-table? 'false (gensym) 'not-a-key #f 'hash-table-ref (lambda (obj key) (let ((val (#_hash-table-ref (obj 'value) key))) (if (eq? val (obj 'false)) #f (or val (obj 'not-a-key))))) 'hash-table-key? (lambda (obj key) (#_hash-table-ref (obj 'value) key))))) (define* (make-gloomy-hash-table (len 511) not-a-key) (let ((ht (gloomy-hash-table))) (set! (ht 'value) (make-hash-table len)) (set! (ht 'mock-type) 'mock-hash-table?) (set! (ht 'not-a-key) not-a-key) ht)) (define (hash-table-key? obj key) ((obj 'hash-table-key?) obj key)) (let ((ht (make-gloomy-hash-table :not-a-key 'nope))) (test (hash-table-key? ht 'a) #f) (test (hash-table-ref ht 'a) 'nope) (hash-table-set! ht 'a 1) (test (not (hash-table-key? ht 'a)) #f) (test (ht 'a) 1)) (let ((s ((*mock-string* 'mock-string) #\a #\b #\c))) (test (length s) 3) (unless pure-s7 (test (string-length s) 3)) (test (string? s) #t) (test (equivalent? s "abc") #t) (test ((*mock-string* 'mock-string?) s) #t) (test (string-append "asd" ((*mock-string* 'mock-string) "hi")) "asdhi") (test (append "asd" ((*mock-string* 'mock-string) "hi")) "asdhi") (test ((*mock-vector* 'mock-vector?) s) #f) (test (string-ref s 0) #\a) (test (string-set! s 0 #\A) #\A) (test (s 0) #\A) (test (set! (s 1) #\B) #\B) (test (s 1) #\B) (unless pure-s7 (test (string->list s) '(#\A #\B #\c))) (test (string-append s "d") "ABcd") (test (string-append "d" s "e") "dABce") (test (string-append "d" "f" s) "dfABc") (test (string-append "d" "f" s "gh") "dfABcgh") (test (reverse s) "cBA") (test (copy s) "ABc") (test (string-copy s) "ABc") (test (object->string s) "\"ABc\"") (test (string=? s "ABc") #t) (test (string=? "ABc" s) #t) (test (string=? s "ABC") #f) (test (substring s 0 1) "A") (test (string-downcase s) "abc") (test (string-upcase s) "ABC") (test (string->symbol s) 'ABc) (test (gensym? (gensym s)) #t) (test (string->keyword s) :ABc) (test (map values s) '(#\A #\B #\c)) (test (string>? s "ABC") #t) (test (string-ci>? s "ABC") #f) (test (string=? s "ABC") #t) (test (string-ci>=? s "ABC") #t) (test (string<=? s "ABC") #f) (test (string-ci<=? s "ABC") #t) (test (call-with-input-string s read) 'ABc) (test (with-input-from-string s read) 'ABc) (test (let ((p (open-input-string s))) (let ((r (read p))) (close-input-port p) r)) 'ABc) (unless pure-s7 (string-fill! s #\1) (test (s 0) #\1) (test (string->number s) 111)) (fill! s #\2) (test (s 1) #\2) (for-each (lambda (c) (if (not (char=? c #\2)) (format *stderr* ";fill! mock-string: ~C~%" c))) s) (test (format #f s) "222") (test (format #f "~A" s) "222") (test (format s) 'error) (test (eval-string s) 222) (test (string-position "2" s) 0) (test (string->byte-vector s) #u(50 50 50))) (let ((c ((*mock-char* 'mock-char) #\a))) (test (char? c) #t) (test ((*mock-char* 'mock-char?) c) #t) (test (equivalent? c #\a) #t) (test (fill! c 123) 'error) (test (reverse! c 123) 'error) (test (char-upcase c) #\A) (test (char-downcase c) #\a) (test (char->integer c) 97) (test (char-upper-case? c) #f) (test (char-lower-case? c) #t) (test (char-alphabetic? c) #t) (test (char-numeric? c) #f) (test (char-whitespace? c) #f) (test (char=? c #\A) #f) (test (char=? c #\a) #t) (test (char? c #\b) #f) (test (char>=? c #\b) #f) (test (char-ci=? c #\A) #t) (test (char-ci=? c #\a) #t) (test (char-ci? c #\b) #f) (test (char-ci>=? c #\b) #f) (test (char-position c "abc") 0) (test (char-position ((*mock-char* 'mock-char) #\b) "hoho" 63) #f) (test (char-position #\null "hoho" ((*mock-char* 'mock-char) #\b)) 'error) (test (char-position ((*mock-char* 'mock-char) #\null) "hoho" ((*mock-char* 'mock-char) #\b)) 'error) (test (object->string c #f) "a") (test (copy c) #\a) (test (string c #\b) "ab") (test (string #\c c) "ca") (test (string #\a c c #\b) "aaab") (test (format #f "~C" c) (format #f "~C" (c 'value))) (let ((str "0123")) (string-set! str 1 c) (test str "0a23")) ) (let () (define (char-ci=? . chars) (apply char=? (map char-upcase chars))) (define (f) (let ((c ((*mock-char* 'mock-char) #\a))) (char-ci=? c #\a))) (test (f) #t)) (let ((mock-number (*mock-number* 'mock-number)) (mock-number? (*mock-number* 'mock-number?))) (test ((lambda () (gcd (mock-number 1-i) ((lambda (a) (values a (+ a 1))) 2)))) 'error) (test (let () (define (func) (vector (values (lcm (mock-number 2.0) (values 1 2 3 4 5 6 7 8 9 10))))) (func)) 'error) (let ((i (mock-number 32)) (x (mock-number pi)) (z (mock-number 1+i)) (r (mock-number 3/2))) (let ((nums (list i r x z)) (rnums (list i r x))) (define (practically-equal? tst l1 l2) (call-with-exit (lambda (quit) (for-each (lambda (n1 n2) (when (not (number-ok? tst n1 n2)) (format *stderr* ";~S: ~A ~A~%" tst n1 n2) (quit #f))) l1 l2) #t))) (test (map mock-number? nums) '(#t #t #t #t)) (test (equivalent? i 32) #t) (if with-bignums (test (map object->string nums) '("32" "3/2" "3.141592653589793238462643383279502884195E0" "1.0+1.0i")) (test (map object->string nums) '("32" "3/2" "pi" "1.0+1.0i"))) (test (equivalent? (map copy nums) (list 32 3/2 pi 1+1i)) #t) (test (practically-equal? 'real-part (map real-part nums) (list 32 3/2 pi 1.0)) #t) (test (map imag-part nums) '(0 0 0.0 1.0)) (test (numerator i) 32) (test (numerator r) 3) (test (denominator i) 1) (test (denominator r) 2) (test (even? i) #t) (test (odd? i) #f) (test (map zero? nums) '(#f #f #f #f)) (test (map positive? rnums) '(#t #t #t)) (test (map negative? rnums) '(#f #f #f)) (test (map infinite? nums) '(#f #f #f #f)) (test (map nan? nums) '(#f #f #f #f)) (num-test (make-polar i r) (make-polar 32 3/2)) (num-test (make-polar x i) (make-polar pi 32)) (num-test (complex i r) (complex 32 3/2)) (test (practically-equal? 'magnitude (map magnitude nums) (list 32 3/2 pi (sqrt 2))) #t) (test (practically-equal? 'angle (map angle nums) '(0 0 0.0 0.7853981633974483)) #t) (num-test (rationalize x) (rationalize pi)) (test (let () (define (func) (>= (mock-number 4/3) (call-with-exit (lambda (return) (return 1 2))))) (func)) #f) (test (let () (define (func) (> (mock-number 4/3) (call-with-exit (lambda (return) (return 1 2))))) (func)) #f) (test (let () (define (func) (<= (mock-number 4/3) (call-with-exit (lambda (return) (return 3 2)))))(func)) #f) (test (let () (define (func) (< (mock-number 4/3) (call-with-exit (lambda (return) (return 3 2))))) (func)) #f) (test (let () (define (func) (max (mock-number 4/3) (call-with-exit (lambda (return) (return 1 2))))) (func)) 2) (test (let () (define (func) (min (mock-number 4/3) (call-with-exit (lambda (return) (return 2 1))))) (func)) 1) (test (let () (define (func) (min (mock-number 4) (call-with-exit (lambda (return) (return 2 1))))) (func)) 1) (test (let () (define (func) (+ (mock-number 4) (call-with-exit (lambda (return) (return 2 1))))) (func)) 7) (test (let () (define (func) (+ (mock-number 4) (call-with-exit (lambda (return) (return 1 2))))) (func)) 7) (test (let () (define (func) (>= (mock-number 4) (call-with-exit (lambda (return) (return 1 2))))) (func)) #f) (test (let () (define (func) (>= (mock-number 4) (call-with-exit (lambda (return) (return 2 1))))) (func)) #t) (test (let () (define (func) (>= (mock-number 4) (call-with-exit (lambda (return) (return (mock-number 1) 2))))) (func)) #f) (test (let () (define (func) (>= 4 (call-with-exit (lambda (return) (return 1 2))))) (func)) #f) (test (let () (define (func) (>= (mock-number 4) 3 (call-with-exit (lambda (return) (return 1 0 2))))) (func)) #f) (test (let () (define (func) (< (mock-number 4) (call-with-exit (lambda (return) (return 5 6))))) (func)) #t) (test (let () (define (func) (< 4 (call-with-exit (lambda (return) (return (mock-number 5) 6))))) (func)) #t) (test (let () (define (func) (< 4 (call-with-exit (lambda (return) (return 5 (mock-number 6)))))) (func)) #t) (test (practically-equal? 'abs (map abs rnums) '(32 3/2 3.141592653589793)) #t) (test (practically-equal? 'exp (map exp nums) '(78962960182680.69 4.481689070338065 23.14069263277927 1.468693939915885+2.287355287178842i)) #t) (test (practically-equal? 'log (map log nums) '(3.465735902799727 0.4054651081081644 1.1447298858494 0.3465735902799727+0.7853981633974483i)) #t) (test (practically-equal? 'sin (map sin nums) '(0.5514266812416906 0.9974949866040544 1.224646799147353e-16 1.298457581415977+0.6349639147847361i)) #t) (test (practically-equal? 'cos (map cos nums) '(0.8342233605065102 0.07073720166770291 -1.0 0.8337300251311491-0.9888977057628651i)) #t) (test (practically-equal? 'tan (map tan nums) '(0.6610060414837631 14.10141994717172 -1.224646799147353e-16 0.2717525853195117+1.083923327338695i)) #t) (test (practically-equal? 'asin (map asin nums) '(1.570796326794897-4.158638853279167i 1.570796326794897-0.9624236501192069i 1.570796326794897-1.811526272460853i 0.6662394324925153+1.061275061905036i)) #t) (test (practically-equal? 'acos (map acos nums) '(0+4.158638853279167i 0+0.9624236501192069i 0+1.811526272460853i 0.9045568943023813-1.061275061905036i)) #t) (test (practically-equal? 'atan (map atan nums) '(1.539556493364628 0.9827937232473291 1.262627255678912 1.017221967897851+0.4023594781085251i)) #t) (test (practically-equal? 'sinh (map sinh nums) '(39481480091340.34 2.129279455094817 11.54873935725775 0.6349639147847361+1.298457581415977i)) #t) (test (practically-equal? 'cosh (map cosh nums) '(39481480091340.34 2.352409615243247 11.59195327552152 0.8337300251311491+0.9888977057628651i)) #t) (test (practically-equal? 'tanh (map tanh nums) '(1.0 0.9051482536448664 0.99627207622075 1.083923327338695+0.2717525853195117i)) #t) (test (practically-equal? 'asinh (map asinh nums) '(4.15912713462618 1.194763217287109 1.862295743310848 1.061275061905036+0.6662394324925153i)) #t) (test (practically-equal? 'acosh (map acosh nums) '(4.158638853279167 0.9624236501192069 1.811526272460853 1.061275061905036+0.9045568943023813i)) #t) (test (practically-equal? 'atanh (map atanh nums) '(0.03126017849066698+1.570796326794897i 0.8047189562170503+1.570796326794897i 0.3297653149566991+1.570796326794897i 0.4023594781085251+1.017221967897851i)) #t) (test (practically-equal? 'sqrt (map sqrt nums) '(5.656854249492381 1.224744871391589 1.772453850905516 1.09868411346781+0.4550898605622273i)) #t) (test (practically-equal? 'expt (map (lambda (n) (expt n 2)) nums) '(1024 9/4 9.869604401089358 1.224606353822377e-16+2i)) #t) (test (practically-equal? 'expt (map (lambda (n) (expt n r)) nums) '(181.0193359837562 1.837117307087384 5.568327996831708 0.6435942529055828+1.553773974030037i)) #t) (test (map floor rnums) '(32 1 3)) (test (map ceiling rnums) '(32 2 4)) (test (map truncate rnums) '(32 1 3)) (test (map round rnums) '(32 2 3)) (test (integer->char (mock-number (char->integer #\a))) #\a) (test (practically-equal? 'exact->inexact (map exact->inexact rnums) '(32.0 1.5 3.141592653589793)) #t) (unless (provided? 'pure-s7) (test (integer-length i) 6)) (test (integer-decode-float x) (if with-bignums '(267257146016241686964920093290467695825 -126 1) '(7074237752028440 -51 1))) (test (map number? nums) '(#t #t #t #t)) (test (map integer? nums) '(#t #f #f #f)) (test (map real? nums) '(#t #t #t #f)) (test (map complex? nums) '(#t #t #t #t)) (test (map rational? nums) '(#t #t #f #f)) (unless pure-s7 (let-temporarily (((*s7* 'default-rationalize-error) 1e-12)) (test (map inexact->exact rnums) '(32 3/2 4272943/1360120))) (test (map exact? nums) '(#t #t #f #f)) (test (map inexact? nums) '(#f #f #t #t))) (test (ash 1 i) 4294967296) (test (ash i -3) 4) (test (logbit? i 1) #f) (test (logbit? 1 i) #f) (if with-bignums (test (map number->string nums) '("32" "3/2" "3.141592653589793238462643383279502884195E0" "1.0+1.0i")) (test (map number->string nums) '("32" "3/2" "3.141592653589793" "1.0+1.0i"))) (test (every? number? (map random nums)) #t) (test (quotient i r) 21) (test (remainder i r) 1/2) (test (modulo i r) 1/2) (test (lognot i) -33) (test (logior i 2) 34) (test (logior 1 i 2 3) (logior 1 32 2 3)) (test (logior 1 7 i 62) (logior 1 7 32 62)) (test (logior (mock-number 1) (mock-number 8) 2 4 16 (mock-number 32)) 63) (test (logxor (mock-number 1) (mock-number 7) 2 4 16 (mock-number 32)) (logxor 1 7 2 4 16 32)) (test (logand 63 15 31 127) (logand 63 (mock-number 15) (mock-number 31) 127)) (test (+ (mock-number 4/3) (values)) 'error) (test (+ (mock-number 4/3) (values) 1) 'error) (num-test (apply + nums) 37.6415926535898+1i) (num-test (apply - nums) 26.35840734641021-1i) (num-test (apply * nums) 150.7964473723101+150.7964473723101i) (num-test (apply / nums) 3.3953054526271-3.3953054526271i) (num-test (apply max rnums) 32) (num-test (apply min rnums) 3/2) (num-test (min 65 i) 32) (test (apply < rnums) #f) (test (apply > rnums) #f) (test (apply <= rnums) #f) (test (apply >= rnums) #f) (test (< 1 3 i 47) #t) (test (> 5/2 r 1/2 (/ i 100)) #t) (test (<= 1.0 2.0 3.0 x) #t) (test (>= 101.231 i 4 x 5/2 r) #t) (test (> x z) 'error) (test (> i 0) #t) (test (< 0 i) #t) (test (>= x 0.0) #t) (test (<= 0.0 x) #t) (test (apply = nums) #f) (test (= i 32) #t) (test (= 33 i) #f) (test (= r 1/2) #f) (test (lcm i 3/2) (lcm i r)) (test (lcm 3/2 i) (lcm r i)) (test (lcm 33 2 i) (lcm 2 i 33)) (test (lcm 33 x) 'error) (test (apply lcm nums) 'error) (test (lcm i 0 x) 'error) (test (lcm 9 0 r) 0) (test (gcd i 3/2) (gcd i r)) (test (gcd i 3/2) (gcd 32 3/2)) (test (gcd 3/2 i) (gcd r i)) (test (gcd 33 2 i) (gcd 2 i 33)) (test (gcd 33 x) 'error) (test (apply gcd nums) 'error) (test (gcd i 0 x) 'error) (test (gcd 9 0 r) 3/2) (unless with-bignums (test (<= +nan.0 (mock-number 1)) #f)) (test (<= 1 (mock-number 1)) #t) (test (<= 1 (mock-number 1+i)) 'error) (test (vector-ref #(0 1) (mock-number 0)) 0) (test (vector-ref #(0 1) (mock-number 0+i)) 'error) (test (format #f "~D" ((*mock-number* 'mock-number) 123)) "123") (test (format #f "~F" ((*mock-number* 'mock-number) 1.23)) (format #f "~F" 1.23)) (test (format #f "~G" ((*mock-number* 'mock-number) 1.23)) (format #f "~G" 1.23)) ; (test (format #f "~A" ((*mock-number* 'mock-number) 1.23)) (format #f "~A" 1.23)) ; (test (format #f "~A" r) "3/2") (test (format #f "~S" r) "3/2") (let ((index (mock-number 2)) (v #(0 1 2 3 4)) (s "01234") (p (list 0 1 2 3 4))) (test (string-ref s index) #\2) (test (list-ref p index) 2) (test (vector-ref v index) 2) (test (s index) #\2) (test (p index) 2) (test (v index) 2) (test (subvector #(0 1 2 3) (mock-number 1) 4 '(3)) #(1 2 3)) (unless pure-s7 (test (vector->list #(0 1 2 3 4) (mock-number 1) (mock-number 3)) '(1 2)) (test (vector->list #(0 1 2 3 4) index) '(2 3 4)) (test (vector->list #(0 1 2 3 4) index index) ()) (test (string->list "01234" index) '(#\2 #\3 #\4)) (test (string->list "01234" 0 index) '(#\0 #\1))) (test (list-tail p index) '(2 3 4)) (test (substring "01234" index) "234") (test (substring "01234" 0 index) "01") (test (substring "01234" index (mock-number 3)) "2") (test (let ((dest (make-string 3))) (copy "01234" dest index) dest) "234") (test (let ((dest (make-string 2))) (copy "01234" dest 0 index) dest) "01") (unless pure-s7 (test (let ((str "01234")) (string-fill! str #\a index) str) "01aaa")) (unless pure-s7 (test (let ((vec #(0 1 2 3 4))) (vector-fill! vec 5 (mock-number 0) (mock-number 3)) vec) #(5 5 5 3 4))) (test (let ((vec #2d((0 1 2) (3 4 5)))) (vector-ref vec (mock-number 1) index)) 5) ) (let () (define mock-number (*mock-number* 'mock-number)) (define (f) (with-let (mock-number 4/3) value)) (define (g) (f)) (test (g) 4/3) (test (with-let (mock-number 4/3) (random-state? (byte-vector))) #f)) (test (let ((vec ((*mock-vector* 'mock-vector) 10 11 12))) (vec ((*mock-number* 'mock-number) 1))) 11) (test (let () (define (func) (copy ((*mock-string* 'mock-string) #\h #\o #\h #\o) #i(1 2))) (func)) #i(104 111)) (let () (define-constant fv #(1 2 3)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) (vector-ref fv (mock-number 0))))) (test (func) 1)) (test-wi (object->string (vector (let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>) ((*mock-hash-table* 'mock-hash-table) 'b 2)) :readable) "(let ((<3> (vector #f #f)) (<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<3> 0) <1>) (set! (<3> 1) (openlet (sublet *mock-hash-table* :value (hash-table 'b 2) :mock-type 'mock-hash-table?))) (set! (<2> 0) <1>) <3>)") (test-wi (object->string (vector (let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>) ((*mock-pair* 'mock-pair) 1 2)) :readable) "(let ((<3> (vector #f #f)) (<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<3> 0) <1>) (set! (<3> 1) (openlet (sublet *mock-pair* :value (list 1 2) :mock-type 'mock-pair?))) (set! (<2> 0) <1>) <3>)") (test (vector? (make-vector i)) #t) (test (string? (make-string i)) #t) (test (hash-table? (make-hash-table i)) #t) (test (pair? (make-list i)) #t) (define (p1-check . args) (if (> (magnitude (- (apply * args) 0.25+0.25i)) 1e-15) (format #t "~A: (* ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply * args))) (if (not (= (apply + args) 3+i)) (format #t "~A: (+ ~{~A~^ ~}) -> ~A?~%" (port-line-number) args (apply + args))) (if (not (= (apply - args) (- (car args) (apply + (cdr args))))) (format #t "~A: ~A != ~A? [- args: ~S]~%" (port-line-number) (apply - args) (- (car args) (apply + (cdr args))) args)) (if (not (= (apply / args) (/ (car args) (apply * (cdr args))))) (format #t "~A: ~A != ~A? [/ args: ~S]~%" (port-line-number) (apply / args) (/ (car args) (apply * (cdr args))) args))) (for-each (lambda (lst) (for-each-permutation p1-check lst)) (list (list 1 1/2 0.5 1+i) (list (mock-number 1) 1/2 0.5 1+i) (list 1 (mock-number 1/2) 0.5 1+i) (list 1 1/2 (mock-number 0.5) 1+i) (list 1 1/2 0.5 (mock-number 1+i)) (list (mock-number 1) (mock-number 1/2) (mock-number 0.5) (mock-number 1+i)))) (test (catch #t (lambda () (+ (openlet (outlet (mock-number 1-i))) 1)) (lambda (type info) type)) 'wrong-type-arg) ; not stack overflow ))) (let () (define mock-number (*mock-number* 'mock-number)) (test (let () (define (func) (* (mock-number 4/3) -1)) (define (hi) (func) (func)) (hi) (hi)) -4/3) (test (let () (define (func) (* (mock-number 1-i) 0)) (define (hi) (func) (func)) (hi) (hi)) 0.0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (byte-vector-ref #u(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (int-vector-ref #i(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (float-vector-ref #r(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0.0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (complex-vector-ref #c(0+i 1+i) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0.0+i) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (vector-ref #(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (string-ref "abc" (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) #\a) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (list-ref '(0 1) (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (byte-vector-set! #u(0 1) (mock-number 0) 0)))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (byte-vector-set! #u(0 1) 0 (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (int-vector-set! #i(0 1) (mock-number 0) 0)))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (int-vector-set! #i(0 1) 0 (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (float-vector-set! #r(0 1) (mock-number 0) 0.0)))) (define (hi) (func) (func)) (hi) (hi)) 0.0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (float-vector-set! #r(0 1) 0 (mock-number 0.0))))) (define (hi) (func) (func)) (hi) (hi)) 0.0) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (complex-vector-set! #c(0 1) (mock-number 0) 0.0+i)))) (define (hi) (func) (func)) (hi) (hi)) 0.0+i) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (complex-vector-set! #c(0 1) 0 (mock-number 0.0+i))))) (define (hi) (func) (func)) (hi) (hi)) 0.0+i) (test (equivalent? (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (vector-set! #(0 1) 0 (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) (mock-number 0)) #t) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (vector-set! #(0 1) (mock-number 0) 0)))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (let ((str "abs")) (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (string-set! str (mock-number 0) #\d)))) (define (hi) (func) (func)) (hi) (hi)) #\d) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (list-set! '(0 1) (mock-number 0) 0)))) (define (hi) (func) (func)) (hi) (hi)) 0) (test (equivalent? (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (list-set! '(0 1) 0 (mock-number 0))))) (define (hi) (func) (func)) (hi) (hi)) (mock-number 0)) #t) (test (with-let (mock-number 0) (append)) ()) (test (with-let (mock-number 2.0) (integer? #)) #f) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (logxor ((*mock-number* 'mock-number) 4/3)))) (f)) 'error) (test (let () (_do4_ (logxor (mock-number 4/3)))) 'error) (test (let () (define (func) (_do4_ (logior (mock-number 4/3) 1))) (define (hi) (func) (func)) (hi) (hi)) 'error) (test (let () (define (func) (lcm (mock-number 4/3))) (define (hi) (func) (func)) (hi) (hi)) 4/3) ) (let () (let ((lst '(1 2 3))) (list-set! lst ((inlet 'i 2) 'i) 32) (test lst '(1 2 32))) (let ((lst '((1 2 3)))) (list-set! lst 0 ((inlet 'i 2) 'i) 32) (test lst '((1 2 32)))) (let ((lst '((1 2 3)))) (list-set! lst ((inlet 'i 0) 'i) ((inlet 'i 2) 'i) 32) (test lst '((1 2 32)))) (let ((i0 ((*mock-number* 'mock-number) 0)) (i1 ((*mock-number* 'mock-number) 1)) (i2 ((*mock-number* 'mock-number) 2)) (lst '((0 1 2) (3 4 5)))) (list-set! lst i0 i1 32) (test lst '((0 32 2) (3 4 5))))) (let ((mock-pair (*mock-pair* 'mock-pair)) (mock-pair? (*mock-pair* 'mock-pair?))) (let ((lst (mock-pair 1 2 3))) (test (pair? lst) #t) (test (mock-pair? lst) #t) (test ((outlet (mock-pair 1 2)) 'value) #) (test (equivalent? (list 1 2 3) lst) #t) (test (equivalent? lst (mock-pair 1 2 3)) #t) ;(test (integer? (pair-line-number lst)) #t) (unless pure-s7 (test (list->string (mock-pair #\a #\b #\c)) "abc")) (test (object->string lst) "(1 2 3)") (test (list? lst) #t) (test (null? lst) #f) (test (car lst) 1) (test (cdr lst) '(2 3)) (test (length lst) 3) (test (arity lst) (cons 1 1)) (test (reverse lst) '(3 2 1)) (unless pure-s7 (test (list->vector lst) #(1 2 3))) (test (map values lst) '(1 2 3)) (test (memq 2 lst) '(2 3)) (test (memv 3 lst) '(3)) (test (member 1 lst) '(1 2 3)) (test (list-tail lst 1) '(2 3)) (test (cadr lst) 2) (test (caddr lst) 3) (test (cddr lst) '(3)) (test (cdddr lst) ()) (test (list-ref lst 1) 2) (set-car! lst 4) (test (car lst) 4) (list-set! lst 2 32) (test (caddr lst) 32) (set-cdr! lst ()) (test (length lst) 1) (set! lst (apply mock-pair '((a . 1) (b . 2) (c . 3)))) (test (assq 'a lst) '(a . 1)) (test (assv 'b lst) '(b . 2)) (test (assoc 'c lst) '(c . 3)) (fill! lst 1) (test (car lst) 1) (set! lst (mock-pair 1 2 3)) (reverse! lst) (test (copy lst) '(3 2 1)) (set! lst (apply mock-pair (sort! lst <))) (test (copy lst) '(1 2 3)) (set! (lst 0) 4) (test (lst 0) 4) (test (list-tail lst 0) '(4 2 3)) (for-each (lambda (x) (if (not (integer? x)) (format *stderr* ";for-each mock-pair: ~A~%" x))) (mock-pair 1 2 3)) (test (subvector #(0 1 2 3) 0 2 (mock-pair 2)) #(0 1)) (test (caar (apply mock-pair '((a) b c d e f g))) 'a) (test (cadr (apply mock-pair '(a b c d e f g))) 'b) (test (cdar (apply mock-pair '((a b) c d e f g))) '(b)) (test (cddr (apply mock-pair '(a b c d e f g))) '(c d e f g)) (test (caaar (apply mock-pair '(((a)) b c d e f g))) 'a) (test (caadr (apply mock-pair '(a (b) c d e f g))) 'b) (test (cadar (apply mock-pair '((a b) c d e f g))) 'b) (test (caddr (apply mock-pair '(a b c d e f g))) 'c) (test (cdaar (apply mock-pair '(((a b)) c d e f g))) '(b)) (test (cdadr (apply mock-pair '(a (b c) d e f g))) '(c)) (test (cddar (apply mock-pair '((a b c) d e f g))) '(c)) (test (cdddr (apply mock-pair '(a b c d e f g))) '(d e f g)) (test (caaaar (apply mock-pair '((((a))) b c d e f g))) 'a) (test (caaadr (apply mock-pair '(a ((b)) c d e f g))) 'b) (test (caadar (apply mock-pair '((a (b)) c d e f g))) 'b) (test (caaddr (apply mock-pair '(a b (c) d e f g))) 'c) (test (cadaar (apply mock-pair '(((a b)) c d e f g))) 'b) (test (cadadr (apply mock-pair '(a (b c) d e f g))) 'c) (test (caddar (apply mock-pair '((a b c) d e f g))) 'c) (test (cadddr (apply mock-pair '(a b c d e f g))) 'd) (test (cdaaar (apply mock-pair '((((a b))) c d e f g))) '(b)) (test (cdaadr (apply mock-pair '(a ((b c)) d e f g))) '(c)) (test (cdadar (apply mock-pair '((a (b c)) d e f g))) '(c)) (test (cdaddr (apply mock-pair '(a b (c d) e f g))) '(d)) (test (cddaar (apply mock-pair '(((a b c)) d e f g))) '(c)) (test (cddadr (apply mock-pair '(a (b c d) e f g))) '(d)) (test (cdddar (apply mock-pair '((a b c d) e f g))) '(d)) (test (cddddr (apply mock-pair '(a b c d e f g))) '(e f g)) (test (cyclic-sequences (mock-pair 1 2 3)) ()) (test (let ((y (mock-pair (make-circular-list 3)))) (let ((x (cyclic-sequences y))) (length x))) 1) (test (subsequence ((*mock-pair* 'mock-pair) 1 2 3 4) 2) '(3 4)) )) (let ((mock-pair (*mock-pair* 'mock-pair))) (let ((L1 (mock-pair 1)) ; make a list of mock-pairs, mock-pair copies its arglist as a normal list (L2 (mock-pair 2)) (L3 (mock-pair 3))) (set-cdr! L1 L2) (set-cdr! L2 L3) (test (length L1) 3) (test (equivalent? (map sin L1) (map (lambda (x) (sin x)) L1)) #t) (test (let loop ((p L1) (sum 0)) (if (null? p) sum (loop (cdr p) (+ sum (car p))))) 6) (test (+ (car L1) (cadr L1) (caddr L1)) 6))) (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append lst '(4 5 6))) '(1 2 3 4 5 6)) ; why were these commented out? (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append '(4 5 6) lst ())) '(4 5 6 1 2 3)) (test (let ((lst ((*mock-pair* 'mock-pair) 1 2 3))) (append '(4 5 6) lst)) '(4 5 6 1 2 3)) (test (sort! 'begin ((*mock-pair* 'mock-pair) 1 2)) 'error) (let ((immutable-list-class (sublet (*mock-pair* 'mock-pair-class) 'object->string (lambda (obj . args) (apply #_object->string (obj 'value) args)) 'let-set-fallback (lambda (obj i val) (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1)))) (list-set! (obj 'value) i val)) 'list-set! (lambda (obj i val) (set! (obj 'value) (append (copy (obj 'value) (make-list (+ i 1))) (list-tail (obj 'value) (+ i 1)))) (list-set! (obj 'value) i val)) 'set-car! (lambda (obj val) (set! (obj 'value) (cons val (cdr (obj 'value))))) 'set-cdr! (lambda (obj val) (set! (obj 'value) (cons (car (obj 'value)) val))) 'fill! (lambda (obj val) (set! (obj 'value) (fill! (copy (obj 'value)) val))) 'reverse! (lambda (obj) (set! (obj 'value) (reverse (obj 'value)))) 'sort! (lambda (obj func) (set! (obj 'value) (sort! (copy (obj 'value)) func)))))) (define (immutable-list lst) (openlet (sublet immutable-list-class 'value lst 'mock-type 'mock-pair?))) (let ((L1 (immutable-list (list 1 2 3 4 5)))) (let ((L2 (cdr L1)) (L3 (cons 0 (L1 'value)))) (list-set! L1 0 32) (test (L1 'value) '(32 2 3 4 5)) (test L2 '(2 3 4 5)) (test L3 '(0 1 2 3 4 5)) (set! (L1 2) 32) (test (L1 'value) '(32 2 32 4 5)) (test L2 '(2 3 4 5)) (test L3 '(0 1 2 3 4 5)) (set-cdr! L1 3) (test (L1 'value) '(32 . 3)) (test L2 '(2 3 4 5)) (set! L1 (immutable-list (list 1 2 3 4 5))) (set! L2 (cddr L1)) (set! L3 (cons 0 (L1 'value))) (sort! L1 >) (test (L1 'value) '(5 4 3 2 1)) (test L2 '(3 4 5)) (test L3 '(0 1 2 3 4 5)) (reverse! L1) (test (L1 'value) '(1 2 3 4 5)) (test L2 '(3 4 5)) (test (object->string L1) "(1 2 3 4 5)") ))) (let ((mock-symbol (*mock-symbol* 'mock-symbol)) (mock-symbol? (*mock-symbol* 'mock-symbol?))) (let ((sym (mock-symbol 'a))) (test (symbol? sym) #t) (test (mock-symbol? sym) #t) (test (equivalent? sym 'a) #t) (test (fill! sym #\a) 'error) (test (reverse! sym #\a) 'error) (test (keyword? sym) #f) (test (gensym? sym) #f) (test (symbol->string sym) "a") (let ((a 32)) (test (let ((a 32)) (symbol->value sym (curlet))) 32) (test (symbol->dynamic-value sym) 32) (test (defined? sym) #t) (test (symbol->keyword sym) :a) (test (provided? sym) #f))) (let ((sym (mock-symbol :a))) (test (keyword? sym) #t) (test (keyword->symbol sym) 'a)) ;(let () (define* (f1 a b) (+ a b)) (test (f1 (mock-symbol :a) 3 :b 2) 5)) -- changed my mind again 20-Jan-19 (test (with-let (mock-symbol 'c) (float-vector? (provide 'pizza))) #f) (test (with-let (mock-symbol 'c) (provide 'pizza)) 'pizza) (test (let () (define (func) (with-let (mock-symbol 'c) (provide 'pizza))) (func)) 'pizza) (test (let () (define (func) (with-let (mock-symbol 'c) (float-vector? (provide 'pizza)))) (func)) #f) ) (let ((mock-port (*mock-port* 'mock-port)) (mock-port? (*mock-port* 'mock-port?))) (let ((ip (open-input-string "0123456789")) (op (open-output-string))) (let ((mip (mock-port ip)) (mop (mock-port op))) (test (mock-port? mip) #t) (test (mock-port? ip) #f) (test (mock-port? mop) #t) (test (input-port? mip) #t) (test (output-port? mip) #f) (test (input-port? mop) #f) (test (output-port? mop) #t) (if (not pure-s7) (test (char-ready? mip) #t)) (test (char-ready? mop) 'error) (test (port-closed? mip) #f) (test (port-closed? mop) #f) ; (test (port-line-number mip) 0) ; ?? (test (port-filename mip) "") (test (read-char mip) #\0) (test (read-byte mip) (char->integer #\1)) (test (peek-char mip) #\2) (test (read-string 3 mip) "234") (test (read-line mip) "56789") (close-input-port mip) (test (port-closed? mip) #t) (test (port-closed? ip) #t) (write-char #\a mop) (test (get-output-string mop) "a") (write-byte (char->integer #\b) mop) (test (get-output-string mop) "ab") (write-string "cde" mop) (test (get-output-string mop) "abcde") (display #\f mop) (write 'g mop) (test (get-output-string mop) "abcdefg") (format mop "~C~C" #\h #\i) (test (get-output-string mop) "abcdefghi") (test (flush-output-port mop) op) (close-output-port mop) (test (port-closed? mop) #t) (test (port-closed? op) #t) (set! mip (mock-port (open-input-string "(+ 1 2)"))) (test (eval (read mip)) 3) (close-input-port mip) )) (test (with-let (mock-port (open-input-string "asdf")) (append (block) (block))) (block)) (when full-s7test (let ((imfi (mock-port (open-input-string "asdf")))) ; pair_to_port GC problem in fx_c_opaaq (define (func) (object->string (make-list (*s7* 'rootlet-size) imfi))) (do ((i 0 (+ i 1))) ((= i 10)) (func)))) (test (catch #t (lambda () (with-let (mock-port (open-input-string "asdf")) (append "hi" (block)))) (lambda (type info) (apply format #f info))) "block-append first argument, \"hi\", is a string but should be a block")) (let () (define mock-hash-table (*mock-hash-table* 'mock-hash-table)) (define mock-pair (*mock-pair* 'mock-pair)) (define mock-vector (*mock-vector* 'mock-vector)) (define mock-string (*mock-string* 'mock-string)) (define mock-char (*mock-char* 'mock-char)) (define mock-number (*mock-number* 'mock-number)) (define mock-symbol (*mock-symbol* 'mock-symbol)) (define mock-port (*mock-port* 'mock-port)) (define mock-c-pointer (*mock-c-pointer* 'mock-c-pointer)) (define mock-random-state (*mock-random-state* 'mock-random-state)) (test (copy (mock-pair '(2 3 4)) cond (mock-vector 1 2 3 4)) 'error) (test (subvector (vector #f) (mock-vector 1 2 3 4)) 'error) (test (subvector (vector #f) (mock-pair '(1 2 3 4))) 'error) (test (list-tail (vector 1 '(3)) (mock-pair '(2 3 4))) 'error) (test (list-tail '(3) (mock-pair '(2 3 4))) 'error) (test (list-tail (+) (mock-pair '(2 3 4))) 'error) (test (make-string 10001 (mock-number 0)) 'error) (test (copy (mock-string #\h #\o #\h #\o) 0/0+i (mock-hash-table 'b 2)) 'error) (test (copy (string (integer->char 255)) (list ()) (mock-vector 1 2 3 4)) 'error) (test (apply '(()) (mock-pair '(2 3 4)) (expt 2 32) `((1))) 'error) (test (list-set! `(x . 1) (mock-pair '(2 3 4)) #f) 'error) (test (object->string "asdf" #f (mock-number 80)) "asdf") (test (write-char (integer->char 123) (mock-char #\b)) 'error) (test (write-char (mock-char #\c) (mock-char #\d)) 'error) (test (string (mock-char #\a) #\b (mock-char #\c)) "abc") (test (format #f "symbol: ~S" (mock-symbol 'a)) "symbol: a") (test (format (mock-symbol 'b) "symbol: ~S" (mock-symbol 'a)) 'error) (test (format #f (mock-symbol 'b) (mock-symbol 'a)) 'error) (test (write-byte (mock-port *stdout*)) 'error) (test (call-with-output-string (lambda (p) (write-byte (mock-number 123) (mock-port p)))) (string (integer->char 123))) (unless pure-s7 (test (let ((str "123")) (string-fill! str (mock-string #\a))) 'error) (test (let ((str "123")) (string-fill! str #\b (mock-string #\a))) 'error)) (test (with-let (mock-number 2.0) (make-hash-table)) (make-hash-table)) (test (make-hash-table (mock-number 2) (mock-number 8)) 'error) (test (let () (define (func) (let ((x #f)) (catch 'oops (lambda () (values (display (cons x x) (mock-port (open-output-string))))) (lambda args (format *stderr* "~A~%" args))))) (define (hi) (func) (func)) (hi) (hi)) '(#f . #f)) (test (with-let (mock-port (open-output-string)) (newline) #f) #f) (test (let ((x #f) (i 0)) (begin (append (vector-fill! #i() (mock-vector 1 2 3 4))))) 'error) (test (iterator? (let () (define (func) (make-iterator (mock-string #\h #\o #\h #\o) `((1)))) (define (hi) (func) (func)) (hi) (hi))) #t) (test (gensym? (with-let (mock-string #\h #\o #\h #\o) (gensym))) #t) (test (append #i() (mock-vector 1 2 3)) #i(1 2 3)) (test (let () (define (func) (let ((x #f) (i 0)) (begin (append (int-vector) (mock-vector 1 2 3 4))))) (define (hi) (func) (func)) (hi) (hi)) #i(1 2 3 4)) (test (let () (define (func) (let ((x #f) (i 0)) (begin (append (vector) (mock-pair '(2 3 4)))))) (define (hi) (func) (func)) (hi) (hi)) #((2 3 4))) (test (let () (define (func) (append (make-vector '(2 3) 0) (mock-vector 1 2 3 4))) (define (hi) (func) (func)) (hi) (hi)) #(0 0 0 0 0 0 1 2 3 4)) (test (sort! (list) (mock-pair '(2 3 4))) 'error) (test (let () (define (func) (let ((x #f)) (write (cons x x) (mock-port (open-output-string))))) (define (hi) (func) (func)) (hi) (hi)) '(#f . #f)) (test (with-let (mock-hash-table 'b 2) (object->string `((set! x (+ x 1)) (* x 2)))) "((set! x (+ x 1)) (* x 2))") (test (with-let (mock-hash-table 'b 2) `(+ ,a1 ,b)) '(+ #f 2)) ; let-ref-fallback for 'a1 (undefined), hash-table-ref -> #f for undefined (test (with-let (mock-hash-table 'b 2) (set! ((curlet) b) 3)) 3) (test (with-let (mock-hash-table 'b 2) (set! b 3)) 3) (test (let ((mh (mock-hash-table 'b 2))) (with-let mh (set! b 3)) (mh 'b)) 3) (test (with-let (mock-hash-table 'b 2) (copy '(15 26))) '(15 26)) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf 3)))) (f) (f)) #t) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf pi)))) (f) (f)) #t) (test (let () (define (f2) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf (* 2 3))))) (f2) (f2)) #t) (test (let () (define (f3) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf (let () 3))))) (f3) (f3)) #t) (test (let () (define (f4) (do ((i 0 (+ i 1))) ((= i 2)) (with-let (mock-hash-table 'basf 2) (set! basf (* 3 basf))))) (f4) (f4)) #t) (test (let? (append () (mock-vector 2 3 4))) #t) (test (let? (let () (define (f) (append () (mock-vector 2 3 4))) (f))) #t) (test (let? (append (mock-vector 1 2 3))) #t) (test (let? (append (mock-vector))) #t) ; a mock-vector with #() as 'value (test (with-let (*mock-vector* 'mock-vector-class) (append)) ()) ; redundant (test (with-let (*mock-vector* 'mock-vector-class) (vector-append)) #()) ;; ? is this inconsistent with: (test (append (mock-vector 1 2) (mock-vector 3 4 5)) #(1 2 3 4 5)) (test (append (mock-vector 1 2) (vector 3 4 5)) #(1 2 3 4 5)) (test (let? (append () (mock-pair 2 3 4))) #t) (test (let? (let () (define (f) (append () (mock-pair 2 3 4))) (f))) #t) (test (let? (append (mock-pair 1 2 3))) #t) (test (let? (append (mock-pair))) #t) ; a mock-pair with #() as 'value (test (with-let (*mock-pair* 'mock-pair-class) (append)) ()) (test (append (mock-pair 1 2) (mock-pair 3 4 5)) '(1 2 3 4 5)) (test (append (mock-pair 1 2) (list 3 4 5)) '(1 2 3 4 5)) (test (let? (append () (mock-string "234"))) #t) (test (let? (let () (define (f) (append () (mock-string "234"))) (f))) #t) (test (let? (append (mock-string "234"))) #t) (test (let? (append (mock-string ""))) #t) (test (with-let (*mock-string* 'mock-string-class) (append)) ()) ; (append) (test (append (mock-string "1") (mock-string "234")) "1234") (test (append (mock-string "1") (string #\2 #\3 #\4)) "1234") (let ((H ((*mock-hash-table* 'make-hash-table) 8 eq? (cons symbol? integer?)))) (test (hash-table-key-typer H) symbol?) (test (hash-table-value-typer H) integer?) (test (set! (H 'a) 123) 123) (test (H 'a) 123) (test (set! (H 'b) #\a) 'error)) (let ((imfo (immutable! (mock-port (open-output-string))))) (test (with-let imfo (integer? (append))) #f) (test (pair? (append '(1 2 3) imfo)) #t)) (test (subvector #(123 223) 0 0 (sublet (mock-pair '(2 3 4)) (mock-random-state 1234))) 'error) (let ((_df_ (mock-pair '((2 3 4))))) (define (_fnc5_ x) (not (pair? x))) (test (_fnc5_ _df_) (let () (define (func) (_fnc5_ _df_)) (define (hi) (func)) (hi)))) (test (with-let (mock-pair 0 1) (object->string 123)) "123") (test (with-let (mock-number 0) (object->string 123)) "123") (test (with-let (mock-string #\0 #\1) (object->string 123)) "123") (test (let () (define (func) (#_call-with-input-string (mock-string "asdf") (lambda (x) (read-char x)))) (func)) #\a) (test (with-let (mock-char #\1) (object->string 123)) "123") (test (with-let (mock-vector 0 1) (object->string 123)) "123") (test (with-let (mock-symbol 'a) (object->string 123)) "123") (test (with-let (mock-port (open-input-string "123")) (object->string 123)) "123") (test (with-let (mock-c-pointer 0) (object->string 123)) "123") (unless with-bignums (test (int-vector? ((*mock-vector* 'make-mock-vector) 3 1 integer?)) #t)) ; bignum=int but not int-vector element (test (hash-table? ((*mock-hash-table* 'make-mock-hash-table) 8 eq? (cons symbol? integer?))) #t) (test (string-fill! (symbol->string 'x) (sublet (mock-number 0) (immutable! (mock-random-state 123456)))) 'error) (test (sqrt (openlet (with-let (mock-number 2.0) (lambda (y) (+ x y))))) 'error) (test (with-let (mock-vector 1) (vector-length '(1))) 'error) (let ((V ((*mock-vector* 'make-mock-vector) 8 'a symbol?))) (test (vector-typer V) symbol?) (test (set! (V 0) 'b) 'b) (test (V 0) 'b) (test (set! (V 1) 123) 'error)) ;vector-set! third argument 123, is an integer, but the vector's element type checker, symbol?, rejects it (unless with-bignums (let ((mn (sublet (mock-number 3) :mock-number mock-number))) (test (with-let mn (abs (openlet (inlet 'abs (lambda (val) 0))))) 0) (test (with-let mn (abs -1)) 1) (test (with-let mn (abs (mock-number -1))) 1) (test (with-let mn (abs (openlet (inlet 'length (lambda (obj) 0))))) 'error) (test (with-let mn (+ (mock-number -1) 3 (openlet (inlet '+ (lambda args (+ (car args) 4)))))) 6) (test (with-let mn (+ 3 (mock-number -1) (openlet (inlet '+ (lambda args (+ (car args) 4)))))) 6) (test (with-let mn (+ (openlet (inlet '+ (lambda args (apply + 4 (cdr args))))) 3 (mock-number -1))) 6))) (test (with-output-to-string (lambda () (display (openlet (with-let (mock-c-pointer 0) (lambda () 1)))) (write (openlet (with-let (mock-c-pointer 0) (lambda () 1)))) (display (object->string (openlet (with-let (mock-c-pointer 0) (lambda () 1))))) (format () "~A" (openlet (with-let (mock-c-pointer 0) (lambda () 1)))))) "####") (test (with-output-to-string (lambda () (display (openlet (with-let (mock-number 0) (lambda () 1)))) (write (openlet (with-let (mock-number 0) (lambda () 1)))) (display (object->string (openlet (with-let (mock-number 0) (lambda () 1))))) (format () "~A" (openlet (with-let (mock-number 0) (lambda () 1)))))) "####") (let ((imfi (immutable! (mock-port (open-input-string "asdf"))))) (test (type-of (display imfi #f)) (type-of (let () (define (func) (display imfi #f)) (define (hi) (func) (func)) (hi) (hi))))) (when with-bignums (test (+ 2 (mock-number (bignum "1"))) (bignum "3")) (test (bignum (mock-string #\1)) (bignum "1"))) (test (complex-vector (mock-number 1.0+i)) #c(1.0+i)) (test (complex-vector 0.0 (mock-number 1.0+i)) #c(0.0 1.0+i)) (test (complex-vector 0.0 (mock-number 1.0+i) 2.0) #c(0.0 1.0+i 2.0)) (test (complex-vector (mock-number 1.0) 2.0+i (mock-number 3.0+i)) #c(1.0 2.0+i 3.0+i)) (test (float-vector (mock-number 1.0)) #r(1.0)) (test (float-vector 0.0 (mock-number 1.0)) #r(0.0 1.0)) (test (float-vector 0.0 (mock-number 1.0) 2.0) #r(0.0 1.0 2.0)) (test (float-vector (mock-number 1.0) 2.0 (mock-number 3.0)) #r(1.0 2.0 3.0)) (test (float-vector (mock-number 1+i)) 'error) (test (int-vector (mock-number 1)) #i(1)) (test (int-vector 0 (mock-number 1)) #i(0 1)) (test (int-vector 0 (mock-number 1) 2) #i(0 1 2)) (test (int-vector (mock-number 1) 2 (mock-number 3)) #i(1 2 3)) (test (int-vector (mock-number 2/3)) 'error) (test (byte-vector (mock-number 1)) #u(1)) (test (byte-vector 0 (mock-number 1)) #u(0 1)) (test (byte-vector 0 (mock-number 1) 2) #u(0 1 2)) (test (byte-vector (mock-number 1) 2 (mock-number 3)) #u(1 2 3)) (test (byte-vector (mock-number -123)) 'error) (test (byte-vector (mock-number 1234)) 'error) ; (test (object->string (openlet (c-pointer 2 #(1) (mock-char #\b))) :readable) "(c-pointer 2 (vector 1) #\\b)") (test (atan (openlet (sublet (mock-c-pointer 1 'integer? ((*mock-number* 'mock-number) 2.0))))) 'error) (test (let ((x #f)) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (set! x (denominator (mock-number 2/3))))) (f) x) 3) (test (tree-memq (mock-symbol 'a) (list 'b (list (mock-symbol 'a)))) #f) (test (let ((sym (mock-symbol 'a))) (tree-memq sym (list 'b (list sym)))) #t) (test (let ((sym (mock-symbol 'a))) (tree-memq sym (list 'b (list 'a)))) #f) ; ?? (test (let ((mp (mock-pair 1 2 3))) (reverse! mp) (mp 'value)) '(3 2 1)) (test (format #f "~D" (mock-number 17)) "17") (test (format #f "~X" (mock-number 17)) "11") (test (format #f "~B" (mock-number 17)) "10001") (test (format #f "~O" (mock-number 17)) "21") (test (format #f "~A" (mock-number 17)) "17") (test (format #f "~S" (mock-number 17)) "17") (test (format #f "~W" (mock-number 17)) "(openlet (immutable! (sublet *mock-number* :value 17 :mock-type 'mock-number?)))") (test (format #f "~F" (mock-number 1.5)) "1.500000") (test (format #f "~G" (mock-number 1.5)) "1.5") (test (format #f "~E" (mock-number 1.5)) "1.500000e+00") (test (format #f "~C" (mock-char #\a)) "a") (let ((r (mock-number 1.23))) (test (format #f "~F" r) "1.230000") (test (format #f "~G" r) "1.23") (test (format #f "~A" r) "1.23") (test (format #f "~S" r) "1.23") (test (format #f "~F ~F" r r) "1.230000 1.230000")) (test (format #f (mock-string "~A ~A") 1 2) "1 2") (test (format #f (mock-string "~A ~A") 1 (mock-string "2")) "1 2") (test (format #f "~S" (mock-number 3/2)) "3/2") (test (format #f "~W" (mock-number 3/2)) "(openlet (immutable! (sublet *mock-number* :value 3/2 :mock-type 'mock-number?)))") (test (format #f "~A" (mock-string #\a #\b #\c)) "abc") (test (format #f "~A" (mock-pair 1 2 3)) "(1 2 3)") (test (format #f "~A" (mock-char #\a)) "a") (test (format #f "~A" (mock-symbol 'asdf)) "asdf") (test (format #f "~A" (mock-hash-table 'a 1)) "(hash-table 'a 1)") (test (format #f "~A" (mock-vector 1 2 3)) "#(1 2 3)") (test (pair? (member (format #f "~A" (mock-c-pointer 0)) '("#" "#") string=?)) #t) (test (format #f "~A" (mock-port (open-input-string "1234"))) "#") (test (format #f "~A ~F" (mock-string #\1 #\2) (mock-number 12)) "12 12") (test (let () (define (f) (format #f "~A" (mock-number 1))) (f)) "1") (test (with-let (mock-symbol 'c) (setter (lambda* ((a 1) (b 2)) (+ a b)))) #f) (test (object->string (sublet (mock-symbol 'c))) "c") (test (copy (sublet (mock-hash-table))) (hash-table)) (test (copy (sublet (mock-vector 1 2))) #(1 2)) (test (write-char (sublet (mock-port (open-output-string)))) 'error) (test (display 3 (sublet (mock-number 1-i))) 'error) (test (display (lambda () 1) (sublet (mock-number 1-i))) 'error) (test (format (sublet (mock-symbol 'c)) (mock-number 4/3)) 'error) (test (subvector (sublet (mock-number 2.0)) `((1) . x)) 'error) (test (abs (openlet (c-pointer 0 #f (mock-number 4/3)))) 'error) (test (format #f "~S" (openlet (with-let (mock-hash-table 'b 2) (lambda () 0)))) "#") (test (with-output-to-string (lambda () (display (openlet (c-pointer 1 2 (mock-number 1234) ()))))) "#") (test (with-output-to-string (lambda () (display (openlet (c-pointer 1 2 (mock-random-state 1234) ()))))) "#") ;; these are aimed at the gmp version (num-test (- 1.0 (mock-number 2.0) (mock-number -3.0)) 2.0) (num-test (- (mock-number 1.0)) -1.0) (num-test (let () (define (func) (- 1/2 (mock-number 3/4) 5/4)) (define (hi) (func)) (hi) (hi)) -3/2) (num-test (lcm -3/4 (mock-number 4/3)) 12) (num-test (lcm (mock-number 12) (mock-number 6) (mock-number 9)) 36) (num-test (let () (define (func) (lcm -3/4 (mock-number 4/3))) (define (hi) (func) (func)) (hi) (hi)) 12) (num-test (min 1 (mock-number -2) 3) -2) (num-test (max 1 (mock-number -2) 3) 3) (test (< 1 (mock-number -2) 3) #f) (test (> 1 (mock-number -2) 3) #f) (test (<= 1 (mock-number -2) 3) #f) (test (>= 1 (mock-number -2) 3) #f) (num-test (+ 1.0 (mock-number 2.0) (mock-number -3.0)) 0.0) (num-test (* 1.0 (mock-number 2.0) (mock-number -3.0)) -6.0) (num-test (/ 1.0 (mock-number 2.0) (mock-number -2.0)) -0.25) (num-test (let () (define (func) (min 1 (mock-number -2) 3)) (define (hi) (func) (func)) (hi) (hi)) -2) (test (let () (define (func) (> 1 (mock-number -2) 3)) (define (hi) (func) (func)) (hi) (hi)) #f) (num-test (let () (define (func) (+ 1.0 (mock-number 2.0) (mock-number -3.0))) (define (hi) (func) (func)) (hi) (hi)) 0.0) (test (logior 1 (mock-number 2) 3) 3) (test (logxor 1 (mock-number 2) 3) 0) (test (logand 1 (mock-number 2) 3) 0) (test (let () (define (f) (logand 1 (mock-number 2) 3)) (define (g) (f)) (g) (g)) 0) (test (let () (define (f) (logior 1 (mock-number 0))) (f)) 1) (test (= 1 (mock-number 1)) #t) (test (= 1 (mock-number -2) 3) #f) ;; make sure this doesn't cause infinite recursion (test (string? (object->string (vector (mock-pair '(2 3 4)) (let ((<1> #f) (<2> (list #f #f #f))) (set! <1> (c-pointer 1 <2> #f)) (set! (<2> 2) <1>) <1>) (mock-hash-table 'b 2)) :readable)) #t) (test (string? (object->string (list (mock-vector 1 2 3 4) (mock-hash-table 'b 2) (let ((<1> (hash-table))) (set! (<1> 'a) <1>) <1>)) :readable)) #t) (test (with-output-to-string (lambda () (display (openlet (with-let (mock-string #\h #\o #\h #\o) (define-macro (_m1_ a) `(+ ,a 1))))))) "_m1_") ;; test that op_if_is_type_s|opsq include method check (test (hash-table? (mock-hash-table 'b 2)) #t) (test (hash-table->alist (mock-hash-table 'b 2)) '((b . 2))) (test (map values (mock-hash-table 'b 2)) '((b . 2))) (test ((lambda () (map values (mock-hash-table 'b 2)))) '((b . 2))) (test ((lambda (a) (map values a)) (mock-hash-table 'b 2)) '((b . 2))) (test ((lambda (a) (if (hash-table? a) (map values a))) (mock-hash-table 'b 2)) '((b . 2))) (test (let () (define (f a) (if (hash-table? a) (map values a))) (f (mock-hash-table 'b 2))) '((b . 2))) (test (let () (define (f a) (if (hash-table? a) (map values a))) (define (g) (f (mock-hash-table 'b 2))) (g)) '((b . 2))) (test (let () (define hash-table->alist (lambda (table) (if (hash-table? table) (map values table) (error 'wrong-type-arg "hash-table->alist argument, ~A, is not a hash-table" table)))) (hash-table->alist (mock-hash-table 'b 2)) (hash-table->alist (mock-hash-table 'b 2))) '((b . 2))) (test ((lambda () (hash-table->alist (mock-hash-table 'b 2)))) '((b . 2))) (test (let () (define (func) (with-let (mock-hash-table) (undefined-function))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (with-let (mock-hash-table) (undefined-function 0))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (with-let (mock-hash-table) (let ((x 1)) (undefined-function x)))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (with-let (mock-hash-table) (let ((x 1)) (undefined-function (+ x 1))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (clamp #f (vector (inlet :a 1 :b 2 :c 3) #f #f) (mock-hash-table 'b 2))) (define (hi) (func)) (hi)) 'error) (test (getenv (outlet (mock-string #\h #\o #\h #\o))) 'error) (test (sort! (list 1 2) (mock-vector 1 2 3)) 'error) (test (let () (let ((p (mock-pair '(1 2 3)))) (call-with-exit (lambda (x) (x (khar p)))))) '(1 2 3)) ; depends on khar before mockery (test (sort! or (mock-pair '(2 3 4))) 'error)) ;; owbug (when full-s7test (let () (load "write.scm") (define mock-number (*mock-number* 'mock-number)) (define-constant bigrat 1/2) (define-constant bigcmp 1+2i) (define x #f) (define (free2) (x i)) (define (checked-eval code) (and (< (length code) 100) (null? (cyclic-sequences code)) (eval code))) (define (f) (catch #t (lambda () (let ((x #f) (i 0)) (let () (let-temporarily ((x 1234)) (call/cc (lambda (goto) (goto 1))) (pp (weak-hash-table `(+ x 1) (substring "0123" 2) (string #\c #\null #\b) (subvector #i2d((1 2) (3 4)) 0 4 '(4)) (begin (make-hook) (begin (ow!) #f) 1/2 (checked-eval `(+ 1 2))))))))) (lambda args #f))) (define (f1) (catch #t (lambda () (let ((x #f) (i 0)) (let () (let-temporarily ((x 1234)) (call/cc (lambda (goto) (goto 1))) (begin (ash 1 43) (begin (ow!) #f) (subvector (vector 1 2 3 4 5 6) 0 6 '(2 3)) (substring "0123" 2) #x123.123 (make-iterator (list 11 22 33))) (empty? (make-vector (make-list 10 2)) (make-vector '(2 3) boolean?) #\A))))) (lambda args #f))) (define (f2) (catch #t (lambda () (let ((x #f) (i 0)) (let () (let-temporarily ((x 1234)) (call/cc (lambda (goto) (goto 1))) (c-object? 1) (lambda sym-args sym-args) #i2d((101 201) (3 4)) (begin (ow!) #f) bigrat (make-float-vector '(128 3) pi) (expt 2 32) (mock-number 1+i) `(+ ,a ,@b) bigcmp (char-whitespace?))))) (lambda args #f))) (define (f3) (catch #t (lambda () (let ((x #f) (i 0)) (let () (let-temporarily ((x 1234)) (call/cc (lambda (goto) (goto 1))) (with-baffle (begin (ow!) #f) "ra" (string-position #xfeed 'ho :a (let-temporarily ((x #(1)) (i 0)) (free2)) pi #r() (let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>) (openlet (inlet 'zero? (lambda (x) (if (number? x) (= x 0.0) (error 'wrong-type-arg "not a number"))))))))))) (lambda args #f))) (define (g) (do ((i 0 (+ i 1))) ((= i 1000)) (if (> (random 10) 5) (f)) (if (> (random 10) 5) (f1)) (if (> (random 10) 5) (f2)) (if (> (random 10) 5) (f3)))) (g)))) ; mockery.scm ;(let () (define (f1) (with-let (inlet '+ (lambda args (apply * args))) (+ 1 2 3 4))) (test (with-let (inlet '+ (lambda args (apply * args))) (+ 1 2 3 4)) (f1))) ;as elsewhere stated, this is documented -- not sure it needs to be fixed (set! (*s7* 'print-length) 123123) (when (and (not with-bignums) (not pure-s7)) (let () (require stuff.scm mockery.scm) (define (write-func1 port name expr c method) (format port "(define (~A x) ~S)~%" name expr) (format port "(let ((val1 (~A ~S))~%" name c) (format port " (val2 (let ((x ~S)) ~S)))~%" c expr) (format port " (let ((val3 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x)))))))~%" name c method method) (format port " (if (or (not (equivalent? val1 val2))~%") (format port " (not (equivalent? val2 val3)))~%") (format port " (format *stderr* \"~A: opt ~~A, unopt ~~A, env ~~A~~%\" val1 val2 val3))))~%~%" name)) (define* (write-func2 port name expr c1 c2 method method2) (format port "(define (~A x y) ~S)~%" name expr) (format port "(let ((val1 (~A ~S ~S))~%" name c1 c2) (format port " (val2 (let ((x ~S) (y ~S)) ~S)))~%" c1 c2 expr) (format port " (let ((val3 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x))))~%" name c1 method method) (format port " (make-object 'y ~S '~A (make-method ~A (lambda (e) (e 'y)))))))~%" c2 (or method2 method) (or method2 method)) (format port " (let ((val4 (~A ~S (make-object 'y ~S '~A (make-method ~A (lambda (e) (e 'y)))))))~%" name c1 c2 (or method2 method) (or method2 method)) (format port " (let ((val5 (~A (make-object 'x ~S '~A (make-method ~A (lambda (e) (e 'x)))) ~S)))~%" name c1 method method c2) (format port " (if (or (not (equivalent? val1 val2))~%") (format port " (not (equivalent? val2 val3))~%") (format port " (not (equivalent? val3 val4))~%") (format port " (not (equivalent? val4 val5)))~%") (format port " (format *stderr* \"~A: opt ~~A, unopt ~~A, exy ~~A, ecy ~~A, exc ~~A~~%\" val1 val2 val3 val4 val5))))))~%~%" name)) (call-with-output-file "t923.scm" (lambda (p) (format p "(require stuff.scm)~%~%") (format p "(let-temporarily (((*s7* 'debug) 0)) (define (make-object . args) (openlet (apply inlet args))))~%") (format p "(define (make-method f accessor) (lambda args (if (null? args) (f) (if (let? (car args)) (apply f (accessor (car args)) (cdr args)) (if (or (null? (cdr args)) (not (let? (cadr args)))) (apply f (map (lambda (arg) (if (openlet? arg) (coverlet arg) arg)) args)) (apply f (car args) (accessor (cadr args)) (cddr args)))))))") (format p "(let ()~%") (write-func1 p "+_1s" '(+ 1 x) 3 '+) (write-func1 p "+_s1" '(+ x 1) 3 '+) (write-func1 p "+_s12" '(+ (+ x) 1) 3 '+) (write-func1 p "+_sf" '(+ x 2.0) 3 '+) (write-func1 p "+_fs" '(+ 2.0 x) 3 '+) (write-func2 p "+_xy" '(+ x y) 3 4 '+) (write-func2 p "+_xy1" '(+ 5 x y) 3 4 '+) (write-func2 p "+_xy2" '(+ 5 3 x 2 y) 3 4 '+) (write-func1 p "-_s1" '(- x 1) 3 '-) (write-func1 p "-_s1" '(- x 6) 3 '-) (write-func1 p "-_s1" '(- (- x) 1) 3 '-) (write-func1 p "-_1s" '(- 1 x) 3 '-) (write-func1 p "-_sf" '(- x 2.0) 3 '-) (write-func1 p "-_fs" '(- 2.0 x) 3 '-) (write-func2 p "-_xy" '(- x y) 3 4 '-) (write-func1 p "*_s" '(* x) 3 '*) (write-func1 p "*_2s" '(* 2 x) 3 '*) (write-func1 p "*_s2" '(* x 2) 3 '*) (write-func1 p "*_sf" '(* x 2.0) 3 '*) (write-func1 p "*_fs" '(* 2.0 x) 3 '*) (write-func1 p "*_xx" '(* x x) 3 '*) (write-func1 p "*_xnk" '(+ (* x 2) 3) 3 '*) (write-func1 p "-_fss" '(- 2.0 (* x x)) 3 '*) (write-func2 p "*_xy" '(* x y) 3 4 '*) (write-func2 p "*1xy" '(* (- 1.0 x) y) 3.0 4 '- '*) (write-func2 p "r2cos" '(* -2.0 x (cos y)) 3.0 1.8 '* 'cos) (write-func1 p "fsf" '(+ 3.5 (* x 4.5)) 5.0 '*) (write-func1 p "/_s" '(/ x) 3 '/) (write-func1 p "/_1s" '(/ 1 x) 3 '/) (write-func1 p "/_1.0s" '(/ 1.0 x) 3 '/) (write-func1 p "/_2s" '(/ 2 x) 3 '/) (write-func1 p "/_s2" '(/ x 2) 3 '/) (write-func1 p "/_sf" '(/ x 2.0) 3 '/) (write-func1 p "/_fs" '(/ 2.0 x) 3 '/) (write-func2 p "/_xy" '(/ x y) 3 4 '/) (write-func2 p "s_cos_s" '(* x (cos y)) 3.1 1.8 '* 'cos) (write-func2 p "s_sin_s" '(* x (sin y)) 3.1 1.8 '* 'sin) (write-func1 p "min_2f" '(min x 1.0) 3.1 'min) (write-func1 p "max_2f" '(max 1.0 x) 3.1 'max) (write-func1 p "min_2f1" '(min x 1.0) 3.1 'min) (write-func1 p "max_2f1" '(max 1.0 x) 3.1 'max) (write-func1 p "modsi0" '(zero? (modulo x 3)) 5 'modulo) (write-func1 p "neglen" '(negative? (length x)) #(0 1) 'length) (write-func1 p "eqzlen" '(= (length x) 0) #() 'length) (write-func1 p "zlen" '(zero? (length x)) #() 'length) (write-func1 p "=x" '(= x 1) 1 '=) (write-func1 p "=x" '(>= x 1) 1 '>=) (write-func1 p ">x" '(> x 1) 1 '>) (write-func1 p "=len" '(= (length x) 6) #(0 1 2 3 4 5) 'length) (write-func1 p "len" '(> (length x) 6) #(0 1 2 3 4 5) 'length) (write-func1 p "<=len" '(<= (length x) 6) #(0 1 2 3 4 5 ) 'length) (write-func1 p "<=len" '(<= (length x) 6) #(0 1 2 3 4 5) 'length) (write-func1 p ">=len" '(>= (length x) 6) #(0 1 2 3 4 5) 'length) (for-each ; ints (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_si") `(,f1 x) -3 f1)) (list 'real-part 'imag-part 'numerator 'denominator 'even? 'odd? 'zero? 'positive? 'negative? 'infinite? 'nan? 'magnitude 'angle 'rationalize 'abs 'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt 'floor 'ceiling 'truncate 'round 'inexact->exact 'exact->inexact 'integer-length 'logior 'logxor 'logand 'lognot 'number? 'integer? 'real? 'complex? 'rational? 'exact? 'inexact? 'number->string)) (for-each ; reals (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_sf") `(,f1 x) 3.14 f1)) (list 'real-part 'imag-part 'zero? 'positive? 'negative? 'infinite? 'nan? 'magnitude 'angle 'rationalize 'abs 'exp 'log 'sin 'cos 'tan 'asin 'acos 'atan 'sinh 'cosh 'tanh 'asinh 'acosh 'atanh 'sqrt 'floor 'ceiling 'truncate 'round 'inexact->exact 'exact->inexact 'integer-decode-float 'number? 'integer? 'real? 'complex? 'rational? 'exact? 'inexact? 'number->string)) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_si") `(,f1 x 3) 4 f1)) (list 'log 'logior 'logxor 'logand 'modulo 'remainder 'quotient 'max 'min 'lcm 'gcd 'expt 'ash)) (for-each (lambda (f1) (write-func2 p (string-append (symbol->string f1) "_xy") `(,f1 x y) 3 4 f1)) (list 'complex 'expt 'lcm 'gcd 'max 'min 'quotient 'remainder 'modulo '= '< '> '<= '>= 'ash 'logbit?)) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_x0") `(,f1 x 0) 3 f1)) (list 'complex 'expt 'lcm 'gcd 'max 'min '= '< '> '<= '>= 'ash 'logbit?)) (for-each (lambda (f1) (write-func2 p (string-append (symbol->string f1) "_xy") `(,f1 x y) 3.14 4.2 f1)) (list 'complex 'expt 'max 'min 'quotient 'remainder 'modulo '= '< '> '<= '>=)) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_c") `(,f1 x) #\a f1)) (list 'char-upcase 'char-downcase 'char->integer 'char-upper-case? 'char-lower-case? 'char-alphabetic? 'char-numeric? 'char-whitespace? 'char?)) (for-each (lambda (f2) (write-func2 p (string-append (symbol->string f2) "_xy") `(,f2 x y) #\a #\space f2)) (list 'char=? 'char? 'char<=? 'char>=? 'string)) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_xc") `(,f1 x #\b) #\a f1)) (list 'char=? 'char? 'char<=? 'char>=?)) (write-func1 p "intchar" '(integer->char x) 92 'integer->char) (write-func2 p "charpos" '(char-position x y) #\a "dsafa" 'char-position 'char-position) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_c") `(,f1 x) "asd" f1)) (list 'string? 'string-downcase 'string-upcase 'string->list 'string-length 'string-copy)) (for-each (lambda (f2) (write-func2 p (string-append (symbol->string f2) "_xy") `(,f2 x y) "Aasd" "basd" f2)) (list 'string=? 'string? 'string<=? 'string>=? 'string-ci=? 'string-ci? 'string-ci<=? 'string-ci>=? 'string-append)) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_xc") `(,f1 x "asbda") "asda" f1)) (list 'string=? 'string? 'string<=? 'string>=? 'string-ci=? 'string-ci? 'string-ci<=? 'string-ci>=?)) (write-func1 p "lst0" '(list-ref x 0) '(list 0 1 3) 'list-ref) (write-func1 p "lst1" '(list-set! x 0 1) '(list 0 1 3) 'list-set!) (write-func1 p "vct0" '(vector-ref x 0) '(vector 0 1 3 4 5 6 7 8) 'vector-ref) (write-func1 p "vct1" '(vector-ref x 1) '(vector 0 1 3 4 5 6 7 8) 'vector-ref) (write-func1 p "vct2" '(vector-ref x 2) '(vector 0 1 3 4 5 6 7 8) 'vector-ref) (write-func1 p "vct3" '(vector-ref x 3) '(vector 0 1 3 4 5 6 7 8) 'vector-ref) (write-func1 p "vct4" '(vector-ref x 4) '(vector 0 1 3 4 5 6 7 8) 'vector-ref) (write-func1 p "arit" '(aritable? x 1) abs 'aritable?) (write-func1 p "arty" '(arity x) abs 'arity) (write-func1 p "bool" '(boolean? x) #f 'boolean?) (write-func1 p "cc" '(continuation? x) #f 'continuation?) (write-func1 p "eof" '(eof-object? x) # 'eof-object?) (write-func1 p "gen" '(gensym? x) ''a 'gensym?) (write-func1 p "df" '(defined? x) ''format 'defined?) (write-func1 p "key" '(keyword? x) ':a 'keyword?) (write-func1 p "keysym" '(keyword->symbol x) ':a 'keyword->symbol) (write-func1 p "intchr" '(integer->char x) 95 'integer->char) ;(write-func1 p "gens" '(gensym x) "asdf" 'gensym) -- can't be the same (this is like calling random) ;(write-func1 p "evl" '(eval x) ''(+ 1 2) 'eval) -- env evals to itself (write-func1 p "evlstr" '(eval-string x) "(+ 1 2)" 'eval-string) (write-func1 p "rev" '(reverse x) #(0 1 2) 'reverse) (write-func1 p "symb" `(symbol x) "asdf" 'symbol) (write-func1 p "mb" '(member 1 x) '(list 0 1 2) 'member) (write-func1 p "mq" '(memq 1 x) '(list 0 1 2) 'memq) (write-func1 p "mv" '(memv 1 x) '(list 0 1 2) 'memv) (write-func1 p "ac" '(assoc 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assoc) (write-func1 p "aq" '(assq 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assq) (write-func1 p "av" '(assv 1 x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assv) (write-func1 p "srt" '(sort! x <) #(0 1 2) 'sort!) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) abs f1)) (list 'documentation 'funclet 'setter 'procedure-source 'dilambda?)) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) ''abs f1)) (list 'symbol->dynamic-value 'symbol->keyword 'symbol->string 'symbol->value 'symbol?)) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) #(0 1 2) f1)) (list 'vector->list 'vector-dimensions 'vector-length 'vector?)) (write-func1 p "vs" '(vector-set! x 0 1) (vector 0 1) 'vector-set!) (write-func1 p "vf" '(vector-fill! x 0) (vector 0 1) 'vector-fill!) ;(write-func2 p "va" '(vector-append x y) (vector 0 1) (vector 2 3) 'vector-append 'vector-append) (write-func1 p "cwof" '(call-with-output-file x (lambda (p) (display 12 p))) "tmp1.r5rs" 'call-with-output-file) (write-func1 p "cwif" '(call-with-input-file x (lambda (p) (read p))) "tmp1.r5rs" 'call-with-input-file) (write-func1 p "cwis" '(call-with-input-string x (lambda (p) (read p))) "123" 'call-with-input-string) (write-func1 p "wof" '(with-output-to-file x (lambda () (display 12))) "tmp1.r5rs" 'with-output-to-file) (write-func1 p "wif" '(with-input-from-file x (lambda () (read))) "tmp1.r5rs" 'with-input-from-file) (write-func1 p "wis" '(with-input-from-string x (lambda () (read))) "123" 'with-input-from-string) (write-func1 p "fvr" '(float-vector-ref x 0) '(float-vector 0 1) 'float-vector-ref) (write-func1 p "fvs" '(float-vector-set! x 0 1.0) '(float-vector 0 1) 'float-vector-set!) ; g_vct_set_three clm2xen.c 9507 (write-func1 p "fvq" '(float-vector? x) '(float-vector 0 1) 'float-vector?) (for-each (lambda (f1) (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) '(hash-table 'a 1 'b 2) f1)) (list 'hash-table-entries 'hash-table?)) (write-func1 p "htr" '(hash-table-ref x 'a) '(hash-table 'a 1 'b 2) 'hash-table-ref) (write-func1 p "hts" '(hash-table-set! x 'a 1) '(hash-table 'a 1 'b 2) 'hash-table-set!) (write-func1 p "lstail" '(list-tail x 2) '(list 0 1 2 3) 'list-tail) (write-func1 p "op1" '(let ((p (open-input-file x))) (close-input-port p)) "tmp1.r5rs" 'open-input-file) (write-func1 p "op1" '(let ((p (open-input-string x))) (close-input-port p)) "tmp1.r5rs" 'open-input-string) ; (write-func1 p "mapx" '(map abs x) #(-1 -2 -3) 'map) ; (write-func1 p "forx" '(let ((sum 0)) (for-each (lambda (n) (set! sum (+ sum n))) x) sum) #(1 2 3) 'for-each) (write-func1 p "strfil" '(string-fill! x #\a) '(make-string 3) 'string-fill!) ; (write-func1 p "strfil" '(string-fill! (make-string 3) x) #\a 'string-fill!) (write-func1 p "lststr" '(list->string x) '(list #\a #\b) 'list->string) (write-func1 p "substr" '(substring x 1) "asdf" 'substring) (write-func2 p "makstr" `(make-string x y) 3 #\a 'make-string) (write-func1 p "n?" '(null? x) '(list) 'null?) (write-func1 p "nl?" '(null? x) '(list 1) 'null?) (write-func1 p "npa" '(not (pair? (car x))) '(list 1 2) 'car) (write-func1 p "npa1" '(not (pair? (car x))) '(list (list 1 2)) 'car) (write-func1 p "ft" '(format #f x) "test" 'format) (write-func1 p "sca" '(set-car! x 1) '(list 1 2) 'set-car!) (write-func1 p "scd" '(set-cdr! x 1) '(list 1 2) 'set-cdr!) (write-func1 p "nnd" '(not (null? (cdr x))) '(list 1) 'cdr) (write-func1 p "nnd1" '(not (null? (cdr x))) '(list 1 2) 'cdr) ; (write-func2 p "strref" `(string-ref x y) "asdf" 1 'string-ref) ; (write-func2 p "strset" `(string-set! x y #\a) "asdf" 1 'string-set!) (write-func1 p "objstr" `(object->string x) 12 'object->string) (write-func1 p "newstr" `(call-with-output-string (lambda (p) (newline x))) #f 'newline) (write-func1 p "ftn" '(format #f x) "test~%" 'format) ;(write-func1 p "stk" '(stacktrace x) 2 'stacktrace) (write-func1 p "symstr" '(symbol->string x) ''a 'symbol->string) (write-func1 p "mrns" '(random-state x) 123 'random-state) (write-func1 p "mrnx" '(random-state 123 x) 123 'random-state) (write-func1 p "a1y" '(assoc (+ 0 1) x) '(list (cons 0 1) (cons 1 2) (cons 2 3)) 'assoc) (write-func1 p "mba" '(member 'a x) '(list 0 'a 2) 'member) (write-func1 p ">xf" '(> x 2.0) 3.0 '>) (write-func1 p "=rx" '(= 3/2 x) 2/3 '=) (write-func1 p "-*x" '(- (* x 2.0) 3.0) 4.0 '*) (write-func1 p "-_rs" '(- 2/3 x) 3 '-) (write-func1 p "-_rf" '(- 12 x) 3 '-) (write-func1 p "-_cs" '(- 1+i x) 3 '-) (write-func1 p "+_rs" '(+ 2/3 x) 3 '+) (write-func1 p "+_cs" '(+ 1+i x) 3 '+) (write-func1 p "*_rs" '(* 2/3 x) 3 '*) (write-func1 p "*_cs" '(* 1+i x) 3 '*) (write-func1 p "+_si" '(+ x 12) 3 '+) (for-each (lambda (f1 lst) (write-func1 p (string-append (symbol->string f1) "_x") `(,f1 x) lst f1)) (list 'car 'cdr 'caar 'cadr 'cdar 'cddr 'caaar 'caadr 'cadar 'caddr 'cdaar 'cdadr 'cddar 'cdddr 'caaaar 'caaadr 'caadar 'caaddr 'cadaar 'cadadr 'caddar 'cadddr 'cdaaar 'cdaadr 'cdadar 'cdaddr 'cddaar 'cddadr 'cdddar 'cddddr ) (list ''(a) ''(a b) ''((a) b c) ''(a b c) ''((a . aa) b c) ''(a b . c) ''(((a)) b c) ''(a (b) c) ''((a aa) b c) ''(a b c) ''(((a . aa)) b c) ''(a (b . bb) c) ''((a aa . aaa) b c) ''(a b c . d) ''((((a))) b c) ''(a ((b)) c) ''((a (aa)) b c) ''(a b (c)) ''(((a aa)) b c) ''(a (b bb) c) ''((a aa aaa) b c) ''(a b c d) ''((((a . aa))) b c) ''(a ((b . bb)) c) ''((a (aa . aaa)) b c) ''(a b (c . cc)) ''(((a aa . aaa)) b c) ''(a (b bb . bbb) c) ''((a aa aaa . aaaa) b c) ''(a b c d . e))) (write-func1 p "np" '(not (pair? x)) '(list 1) 'pair?) (write-func1 p "nn" '(not (null? x)) () 'null?) (write-func1 p "ns" '(not (symbol? x)) '(quote q) 'symbol?) (write-func1 p "nx" '(not (number? x)) 3 'number?) (write-func1 p "nr" '(not (real? x)) 3 'real?) (write-func1 p "nm" '(not (rational? x)) 3 'rational?) (write-func1 p "ni" '(not (integer? x)) 3 'integer?) (write-func1 p "nb" '(not (boolean? x)) #f 'boolean?) (write-func1 p "ny" '(not (string? x)) "a" 'string?) (write-func1 p "nc" '(not (char? x)) #\a 'char?) (write-func1 p "ne" '(not (eof-object? x)) # 'eof-object?) (write-func1 p "nl" '(not (list? x)) '(list 1) 'list?) (write-func1 p "nl1" '(not (proper-list? x)) '(cons 1 2) 'proper-list?) (write-func1 p "scar" '(set! (car x) 2) '(list 0 1) 'set-car!) (format p ")~%") )) (load "t923.scm" (curlet)))) (let () (define (call-with-input-vector v proc) (let ((i -1)) (proc (openlet (inlet 'read (lambda (p) (v (set! i (+ i 1)))) 'read-byte (lambda (p) (v (set! i (+ i 1)))) 'read-char (lambda (p) (v (set! i (+ i 1)))) 'read-line (lambda (p) (v (set! i (+ i 1)))) 'close-input-port (lambda (p) p) 'read-string (lambda (p) (v (set! i (+ i 1))))))))) (define (call-with-output-vector proc) (let* ((size 1) (v (make-vector size #f)) (i 0) (write-to-vector (lambda (obj p) (when (= i size) ; make the vector bigger to accommodate the output (set! v (copy v (make-vector (set! size (* size 2)) #f)))) (set! (v i) obj) (set! i (+ i 1)) #))) ; that's what write/display return! (proc (openlet (inlet 'write (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p)) 'display (lambda* (obj p) ((if (not (let? p)) display write-to-vector) obj p)) 'format (lambda (p . args) (if (not (let? p)) (apply format p args) (write (apply format #f args) p))) 'write-byte (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p)) 'write-char (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p)) 'close-output-port (lambda (p) p) 'flush-output-port (lambda (p) p) 'write-string (lambda* (obj p) ((if (not (let? p)) write write-to-vector) obj p))))) (subvector v 0 i))) (let ((lst ())) (call-with-input-vector (vector 1 2 3 4 5) (lambda (p) (set! lst (cons (read p) lst)) (set! lst (cons (read-byte p) lst)) (set! lst (cons (read-char p) lst)) (set! lst (cons (read-line p) lst)) (set! lst (cons (read-string p) lst)) (close-input-port p))) (test lst '(5 4 3 2 1))) (test (call-with-output-vector (lambda (p) (write 2 p) (display 4 p) (format p "~C" #\a) (write-byte 8 p) (write-char #\a p) (write-string "a" p) (flush-output-port p) (close-output-port p))) #(2 4 "a" 8 #\a "a"))) (let () (let-temporarily (((*s7* 'debug) 0)) (define (open-output-log name) ;; return a soft output port that does not hold its output file open (define (logit name str) (let ((p (open-output-file name "a"))) (display str p) (close-output-port p))) (openlet (inlet :name name :format (lambda (p str . args) (logit (p 'name) (apply format #f str args))) :write (lambda (obj p) (logit (p 'name) (object->string obj #t))) :display (lambda (obj p) (logit (p 'name) (object->string obj #f))) :write-string (lambda (str p) (logit (p 'name) str)) :write-char (lambda (ch p) (logit (p 'name) (string ch))) :newline (lambda (p) (logit (p 'name) (string #\newline))) :close-output-port (lambda (p) #f) :flush-output-port (lambda (p) #f)))) (if (file-exists? "s7-test.log") (delete-file "s7-test.log")) (let ((elog (open-output-log "s7-test.log"))) (format elog "this is a test~%") (format elog "all done!~%")) (let ((p (open-input-file "s7-test.log"))) (test (read-line p) "this is a test") (test (read-line p) "all done!") (test (eof-object? (read-line p)) #t) (close-input-port p))) ) ;;; *s7* -------- (define-constant *s7*-length 63) (test (let? *s7*) #t) (test (outlet *s7*) (rootlet)) (test (defined? 'heap-size *s7*) #t) (test (defined? '_x_ *s7*) #f) (let ((hpsize (*s7* 'heap-size))) (test (let-ref *s7* 'heap-size) hpsize) (test (with-let *s7* heap-size) hpsize) (test ((sublet *s7* 'a 1) 'heap-size) hpsize) (test (eval-string "heap-size" *s7*) hpsize) (test (symbol->value 'heap-size *s7*) hpsize)) (test (length *s7*) *s7*-length) (test (equal? *s7* *s7*) #t) (test (type-of *s7*) 'let?) (test (fill! *s7* #f) 'error) (test (set! *s7* 3) 'error) (test (let-temporarily ((*s7* 3)) 1) 'error) (test (define *s7* 3) 'error) (let ((old-pl (*s7* 'print-length))) (let-temporarily (((*s7* 'print-length) 32)) (unless (provided? 'snd) ;; print-length is a top-level function in Snd, so (with-let *s7* print-length) sees Snd's print-length ;; if *s7* were a real let, this would not happen (test (eval-string "print-length" *s7*) 32) (test (with-let *s7* print-length) 32) (test (with-let (sublet *s7*) print-length) 32)) (test (let ((s7 *s7*)) (s7 'print-length)) 32) (test (let-set! *s7* 'print-length 8) 8) (test (let-ref *s7* 'print-length) 8) (test (with-let *s7* (+ print-length 1)) 9) (test (with-let *s7* (let ((print-length (+ print-length 1))) print-length)) (+ (*s7* 'print-length) 1)) (test ((sublet *s7*) 'print-length) 8) (when full-s7test (test ((inlet *s7*) 'print-length) 8) ; this calls each *s7* field, including memory-usage! (test (with-let (inlet *s7*) print-length) 8))) (test (*s7* 'print-length) old-pl) (test (coverlet *s7*) 'error) (test (openlet *s7*) *s7*) (test (*s7* 'print-length) old-pl)) (test (object->string *s7*) "*s7*") (test (object->string *s7* :readable) "*s7*") (test (catch #t (lambda () (cutlet *s7* 'print-length)) (lambda (type info) (apply format #f info))) "can't cutlet *s7* (it is immutable)") (test (catch #t (lambda () (varlet *s7* 'asdf 3)) (lambda (type info) (apply format #f info))) "can't (varlet *s7* asdf 3), *s7* is immutable") (test (help *s7*) "*s7* is a let that gives access to s7's internal state: e.g. (*s7* 'print-length)") (let ((iter (make-iterator *s7*))) (test (iterator? iter) #t) (test (eq? (iterator-sequence iter) *s7*) #t) (let ((val (iter))) (test (eq? (car val) 'accept-all-keyword-arguments) #t) (test (boolean? (cdr val)) #t) (set! val (iter)) (test (eq? (car val) 'autoloading?) #t) (test (boolean? (cdr val)) #t))) (let ((iter (make-iterator *s7* (cons #f #f)))) (test (eq? (iterator-sequence iter) *s7*) #t) (let ((val (iter))) (test (eq? (car val) 'accept-all-keyword-arguments) #t) (test (boolean? (cdr val)) #t) (set! val (iter)) (test (eq? (car val) 'autoloading?) #t) (test (boolean? (cdr val)) #t))) (test (length (object->let *s7*)) (+ *s7*-length 6)) (test (with-let *s7* (define asdf 321)) 'error) (test (let () (define print-length 111) (with-let *s7* print-length)) (*s7* 'print-length)) (test ((object->let (make-iterator *s7*)) 'sequence) *s7*) (when full-s7test (test (length (let->list *s7*)) *s7*-length) (test (length (map values *s7*)) *s7*-length)) (test (copy (inlet 'a 1) *s7*) 'error) (test (vector? (copy *s7* (make-vector 4))) #t) (test (load "reactive.scm" *s7*) 'error) (test (set! (setter *s7*) #f) 'error) (test (set! (outlet *s7*) (curlet)) 'error) (test (integer? (*s7* 'stack-top)) #t) (test (integer? (*s7* 'stack-size)) #t) (test (integer? (*s7* 'max-stack-size)) #t) (test (integer? (*s7* 'max-heap-size)) #t) (test (integer? (*s7* 'max-port-data-size)) #t) (test (integer? (*s7* 'output-port-data-size)) #t) (test (integer? (*s7* 'rootlet-size)) #t) (test (integer? (*s7* 'heap-size)) #t) (test (integer? (*s7* 'free-heap-size)) #t) (test (integer? (*s7* 'gc-freed)) #t) (test (integer? (*s7* 'gc-total-freed)) #t) (test (pair? (*s7* 'gc-info)) #t) (test (positive? (car (*s7* 'gc-info))) #t) (test (positive? (cadr (*s7* 'gc-info))) #t) (set! (*s7* 'gc-info) #f) ; same as (set! (*s7* 'gc-info) '(0 0)) (test (car (*s7* 'gc-info)) 0) (test (cadr (*s7* 'gc-info)) 0) (test (set! (*s7* 'gc-info) ()) 'error) (test (set! (*s7* 'gc-info) '(0 0)) #f) (let ((ticks/second (caddr (*s7* 'gc-info)))) (test (set! (*s7* 'gc-info) '(0 0 -100)) #f) ; make sure third is ignored (test (caddr (*s7* 'gc-info)) ticks/second)) (test (integer? (*s7* 'gc-temps-size)) #t) (test (real? (*s7* 'gc-resize-heap-fraction)) #t) (test (real? (*s7* 'gc-resize-heap-by-4-fraction)) #t) (test (real? (*s7* 'cpu-time)) #t) (test (integer? (*s7* 'max-string-length)) #t) (test (integer? (*s7* 'max-format-length)) #t) (test (integer? (*s7* 'max-list-length)) #t) (test (integer? (*s7* 'max-vector-length)) #t) (test (integer? (*s7* 'max-vector-dimensions)) #t) (test (integer? (*s7* 'default-hash-table-length)) #t) (test (integer? (*s7* 'initial-string-port-length)) #t) (test (real? (*s7* 'equivalent-float-epsilon)) #t) (test (real? (*s7* 'hash-table-float-epsilon)) #t) (test (integer? (*s7* 'float-format-precision)) #t) (test (random-state? (*s7* 'default-random-state)) #t) (test (integer? (*s7* 'debug)) #t) (test (*s7* 'symbol-quote?) #f) (test (*s7* 'symbol-printer) #f) (test (*s7* 'stacktrace-defaults) '(3 45 80 45 #t)) (test (set! (*s7* 'stacktrace-defaults) pi) 'error) (test (set! (*s7* 'stacktrace-defaults) '(30)) 'error) (test (set! (*s7* 'stacktrace-defaults) '(30 50 80 50 #f pi)) 'error) (test (set! (*s7* 'stacktrace-defaults) '(3.0 45 80 45 #f)) 'error) (test (set! (*s7* 'stacktrace-defaults) '(3 45.0 80 45 #f)) 'error) (test (set! (*s7* 'stacktrace-defaults) '(3 45 80.0 45 #f)) 'error) (test (set! (*s7* 'stacktrace-defaults) '(3 45 80 45.0 #f)) 'error) (test (set! (*s7* 'stacktrace-defaults) '(3 45 80 45 12)) 'error) (let ((L (*s7* 'stacktrace-defaults))) (set-car! L 1+i) ; make sure (*s7* 'stacktrace-defaults) returns a copy of the list (test (integer? (car (*s7* 'stacktrace-defaults))) #t)) (catch #t (lambda () (set! (*s7* 'stacktrace-defaults) '(100 #() 1 2 3))) (lambda (type info) (test (apply format #f info) "(set! (*s7* 'stacktrace-defaults) '(100 #() 1 2 3)): the second list element #() is a vector but should be an integer (cols-for-data)"))) (test (set! (*s7* 'autoloading?) "asdf") 'error) (test (let ((hist (*s7* 'history))) (or (not hist) (pair? hist))) #t) (test (let ((size (*s7* 'history-size))) (or (not size) (integer? size))) #t) (test (boolean? (*s7* 'undefined-identifier-warnings)) #t) (test (boolean? (*s7* 'undefined-constant-warnings)) #t) (test (boolean? (*s7* 'accept-all-keyword-arguments)) #t) (test (boolean? (*s7* 'muffle-warnings?)) #t) (test (integer? (*s7* ':print-length)) #t) (test (integer? (*s7* :print-length)) #t) (test (eqv? (*s7* 'print-length) (*s7* :print-length)) #t) (test (boolean? (*s7* 'openlets)) #t) (test (string? (*s7* 'version)) #t) (test (set! (*s7* 'version) "hi") 'error) (test (integer? (*s7* 'major-version)) #t) (test (set! (*s7* 'major-version) 32) 'error) (test (integer? (*s7* 'minor-version)) #t) (test (set! (*s7* 'minor-version) 32) 'error) (test (or (not (*s7* 'profile-prefix)) (symbol? (*s7* 'profile-prefix))) #t) (let-temporarily (((*s7* 'profile-prefix) 'my-name)) (test (*s7* 'profile-prefix) 'my-name) (set! (*s7* 'profile-prefix) #f) (test (*s7* 'profile-prefix) #f)) (let ((__s7__ *s7*)) (test (__s7__ 'heap-size) (*s7* 'heap-size))) (test (let () (define (func) (with-let *s7* letrec*)) (func) (func)) letrec*) ; fx_with_let_s bug (test (let () (define (f) (with-let (inlet 'x #) x)) (f) (f)) #) (test (let ((I (inlet 'x #))) (define (f) (with-let I x)) (f) (f)) #) (let-temporarily (((*s7* 'safety) -1)) (test (*s7* 'safety) -1)) (when (provided? 'history) (test (boolean? (*s7* 'history-enabled)) #t) (let-temporarily (((*s7* 'history-enabled) #t)) (test (*s7* 'history-enabled) #t))) (let () (catch 'one (lambda () (catch 'two (lambda () (catch 'three (lambda () (let ((cs (*s7* 'catches))) (test (or (equal? cs '(three two one)) (equal? cs '(three two one string-read-error #t #t))) #t))) (lambda a a))) (lambda a a))) (lambda a a))) (test (vector? (*s7* 'gc-protected-objects)) #t) (test (list? (*s7* 'file-names)) #t) (test (list? (*s7* 'filenames)) #t) (test (boolean? (*s7* 'gc-stats)) #f) (test (real? (*s7* 'default-rationalize-error)) #t) (test (set! (*s7* 'max-format-arg) 12) 'error) (test (cutlet *s7* 'let-ref-fallback) 'error) (test (varlet *s7* 'let-ref-fallback 123) 'error) (test (cutlet *s7* 'let-set-fallback) 'error) (test (varlet *s7* 'let-set-fallback 123) 'error) (test (let-set! *s7* 'let-ref-fallback #t) 'error) (test (varlet *s7* 'asdf 321) 'error) (test (let-set! *s7* 'a 1) 'error) (test (reverse! *s7*) 'error) (test (fill! *s7* #f) 'error) (test (copy (inlet 'let-ref-fallback #f) *s7*) 'error) (test (copy '((let-set-fallback . 32)) *s7*) 'error) (test (let ((e (let () (define-constant a 1) (curlet)))) (let-set! e 'a 2) e) 'error) (test (let ((e (let () (define-constant a 1) (curlet)))) (set! (e 'a) 2) e) 'error) (test (let ((e (let () (define-constant a 1) (curlet)))) (with-let e (set! a 2)) e) 'error) (test (fill! (let ((a 1)) (set! (setter 'a) integer?) (curlet)) #f) 'error) (test (let-set! (let ((a 1)) (set! (setter 'a) integer?) (curlet)) 'a #f) 'error) (test (let ((a 1)) (set! (setter 'a) integer?) (let ((a #f)) a)) #f) (test (let () (define-constant a 3) (let ((a #f)) a)) 'error) (test (let ((e (let () (define-constant a 1) (curlet)))) (fill! e 2) e) 'error) (test (copy '((a . #f)) (let ((a 1)) (set! (setter 'a) integer?) (curlet))) 'error) (test (defined? 'print-length *s7*) #t) (test (defined? :print-length *s7*) #t) (test (defined? 'asdf *s7*) #f) (test (defined? :asdf *s7*) #f) ; maybe inconsistent (test (setter current-input-port) set-current-input-port) (set! (setter current-input-port) #f) (test (setter current-input-port) #f) (set! (setter current-input-port) set-current-input-port) (let-temporarily (((*s7* 'default-hash-table-length) 31) ((*s7* 'hash-table-float-epsilon) 1e-4) ((*s7* 'equivalent-float-epsilon) .1) ((*s7* 'gc-stats) #f) ((*s7* 'max-stack-size) 8192) ((*s7* 'safety) 1) ((*s7* 'default-rationalize-error) .1)) (let ((ht (make-hash-table))) (test (length ht) 32)) (let ((ht (hash-table 'a 1))) (test (length ht) 32)) (let ((ht (hash-table :a 1))) (test (length ht) 32)) (let ((ht (make-hash-table))) (set! (ht 3.0) 'x) (set! (ht 3.00005) 'y) (test (ht 3.00001) #f)) (test (equivalent? 1.0 1.01) #t) (test (rationalize 3.14159) 16/5)) (let ((ht (make-hash-table))) (test (length ht) (*s7* 'default-hash-table-length))) (let ((ht (make-hash-table))) (set! (ht 3.0) 'x) (set! (ht 3.05) 'y) (test (ht 3.01) #f)) (test (equivalent? 1.0 1.01) #f) (test (rationalize 3.14159) 314159/100000) (let-temporarily (((*s7* 'float-format-precision) 123123123)) (test (*s7* 'float-format-precision) 128)) (let ((lim (*s7* 'float-format-precision))) (test (set! (*s7* 'float-format-precision) -123) 'error) (test (*s7* 'float-format-precision) lim)) ;;; (*s7* 'make-function) (test (*s7* 'make-function) #f) (for-each (lambda (arg) (test (set! (*s7* 'make-function) arg) 'error)) (list 1 #t 1+i "asdf" (list 1 2) (lambda () 1) #\a 'a #(a) #_abs #_/ # # #)) (set! (*s7* 'make-function) #f) ;;; (*s7* 'make-function) (let () (set! (*s7* 'make-function) (lambda (args code) `((+ 1 ,@code)))) (define (f1 a) a) (unless (= (f1 2) 3) (format *stderr* "(*s7* 'make-function): (f1 2) is ~S~%" (f1 2))) (unless (equal? (procedure-source f1) '(lambda (a) (+ 1 a))) (format *stderr* "(*s7* 'make-function): f1 source is ~S~%" (procedure-source f1))) (define (f2 a) (+ a 2)) (unless (= (f2 3) 6) (format *stderr* "(*s7* 'make-function): (f2 3) is ~S~%" (f2 3))) (unless (equal? (procedure-source f2) '(lambda (a) (+ 1 (+ a 2)))) (format *stderr* "(*s7* 'make-function): f2 source is ~S~%" (procedure-source f2))) (define* (f3 a (b 3)) (+ a b)) (unless (= (f3 4) 8) (format *stderr* "(*s7* 'make-function): (f3 4) is ~S~%" (f3 4))) (set! (*s7* 'make-function) #f) (define (f4 a) (+ a 1)) (test (f4 1) 2) (test (procedure-source f4) '(lambda (a) (+ a 1))) (set! (*s7* 'make-function) (lambda (pars code) `((let ((sig (symbol->value '+signature+ (curlet)))) ; can be # (let-temporarily (((*s7* 'make-function) #f)) ; don't instrument make-function-search or the for-each lambda below (define (make-function-search checker par arg) (if (procedure? checker) (unless (checker arg) (error 'wrong-type-arg "~S should be ~S, but it is ~S~%" par checker arg)) (let search ((types checker)) (unless (pair? types) (error 'wrong-type-arg "~S should be one of ~S, but it is ~S~%" par checker arg)) (unless ((car types) arg) (search (cdr types)))))) (when (pair? sig) (let ((orig-pars ',pars) (orig-sig (cdr sig))) (when (pair? orig-pars) ; (lambda (a ...)...) (let ((sg (cdr sig))) (do ((p orig-pars (cdr p))) ((null? p)) (let ((par (car p))) (unless (keyword? par) (if (pair? par) (set! par (car par))) ; if a pair, it's a lambda* parameter with a default value (make-function-search (car sg) par (symbol->value par)) (if (pair? (cdr sg)) (set! sg (cdr sg))) (when (or (symbol? (cdr p)) (and (pair? (cdr p)) (eq? (cadr p) :rest))) (set! orig-pars (if (symbol? (cdr p)) (cdr p) (caddr p))) (set! orig-sig sg) (set! p (list :rest)))))))) (when (and (symbol? orig-pars) ; (lambda args ...) or (lambda (a . b) etc (pair? orig-sig)) ; we have (rest) arg types (let ((par-args (symbol->value orig-pars))) (let ((full-arg-sig (make-list (length par-args)))) (let fill-arg ((arg full-arg-sig) (sg orig-sig)) (set-car! arg (car sg)) (when (pair? (cdr arg)) (fill-arg (cdr arg) (cdr sg)))) (for-each (lambda (argtype arg) (make-function-search argtype orig-pars arg)) full-arg-sig par-args)))))) (let ((result (list (begin ,@code)))) ; list to catch possible multiple values (when (pair? sig) (if (null? (cdr result)) ; no values (make-function-search (car sig) 'result (car result)) (unless (eq? values (car sig)) (error 'wrong-type-arg "result ~S represents multiple-values, but (car +signature+) is ~S~%" result (car sig))))) (if (null? (cdr result)) (car result) (apply values result)))))))) ; pass multiple-values on up the call chain (define f5 (let ((+signature+ (list integer? integer?))) (lambda (a) a))) (test (f5 1) 1) (test (catch #t (lambda () (f5 3.1)) (lambda (type info) (apply format #f info))) "a should be integer?, but it is 3.1\n") (define f6 (lambda (a) a)) (test (f6 1) 1) (define f7 (lambda (a) (set! a (+ a 1)) (* a 2))) (test (f7 1) 4) (let ((+signature+ (list (list integer? not) (list integer? (let-temporarily (((*s7* 'make-function) #f)) (lambda (x) (= x 1/2))))))) (define f8 (lambda (a) (and (< 0 a 2) (* a 2)))) (test (f8 1) 2) ; these confuse t101-10 et al because they introduce functions -- don't do sigs this way! (test (f8 1/2) 1) (test (f8 2) #f) (let-temporarily (((*s7* 'make-function) #f)) ; don't add checks to catch lambda's below (caused by ambiguous placement of +signature+ above (test (catch #t (lambda () (f8 1.5)) (lambda (type info) (apply format #f info))) "a should be one of (integer? #), but it is 1.5\n"))) (define f9 (let ((+signature+ (list (list integer? not) integer?))) (lambda (a) (log a)))) (test (catch #t (lambda () (f9 2)) (lambda (type info) (apply format #f info))) "result should be one of (integer? not), but it is 0.6931471805599453\n") (define f10 (let ((+signature+ (list values integer? float?))) (lambda* (a (b 1)) (+ a b)))) (test (catch #t (lambda () (f10 1)) (lambda (type info) (apply format #f info))) "b should be float?, but it is 1\n") (test (f10 1 2.5) 3.5) (define f11 (let ((+signature+ (let ((L (list integer?))) (set-cdr! L L)))) (lambda args (apply + args)))) (test (f11 1 2 3) 6) (test (catch #t (lambda () (f11 1 2.5 3)) (lambda (type info) (apply format #f info))) "args should be integer?, but it is 2.5\n") (define f12 (let ((+signature+ (let ((L (list pair? integer? string?))) (set-cdr! (cddr L) (cddr L)) L))) (lambda* (a :rest b) (list a b)))) (test (f12 1 "a" "b") '(1 ("a" "b"))) (test (catch #t (lambda () (f12 1 "a" 123)) (lambda (type info) (apply format #f info))) "b should be string?, but it is 123\n") (test (catch #t (lambda () (f12 1 123)) (lambda (type info) (apply format #f info))) "b should be string?, but it is 123\n") (define f13 (let ((+signature+ (list values integer?))) (lambda (a) (values a a)))) (test (list (f13 1)) '(1 1)) (test (catch #t (lambda () (list (f13 1.5))) (lambda (type info) (apply format #f info))) "a should be integer?, but it is 1.5\n") (define f14 (let ((+signature+ (list integer? integer?))) (lambda (a) (values a a)))) (test (catch #t (lambda () (list (f14 1))) (lambda (type info) (apply format #f info))) "result (1 1) represents multiple-values, but (car +signature+) is integer?\n") (define f15 (let ((+signature+ (list integer? integer? integer?))) (lambda* (a (b 1) :allow-other-keys) (+ a b)))) (test (f15 2) 3) (test (f15 :c 4 :a 2) 3) (define f16 (let ((+signature+ (let ((L (list pair? symbol? integer?))) (set-cdr! (cddr L) (cdr L)) L))) (lambda args (copy args)))) (test (f16 'a 1 'b 2 'c 3) '(a 1 b 2 c 3)) (test (catch #t (lambda () (f16 'a 1 2)) (lambda (type info) (apply format #f info))) "args should be symbol?, but it is 2\n") (define f17 (let ((+signature+ (let ((L (list pair? string? symbol? integer?))) (set-cdr! (cdddr L) (cddr L)) L))) (lambda args (cdr args)))) (test (f17 "asdf" 'a 1 'b 2 'c 3) '(a 1 b 2 c 3)) (test (catch #t (lambda () (f17 "asdf" 'a 1 2)) (lambda (type info) (apply format #f info))) "args should be symbol?, but it is 2\n") (define f18 (let ((+signature+ (let ((L (list pair? string? unspecified? symbol? integer?))) (set-cdr! (cddddr L) (cdddr L)) L))) (lambda args (cddr args)))) (test (f18 "asdf" # 'a 1 'b 2 'c 3) '(a 1 b 2 c 3)) (test (catch #t (lambda () (f18 "asdf" # 'a 1 2)) (lambda (type info) (apply format #f info))) "args should be symbol?, but it is 2\n") (set! (*s7* 'make-function) #f)) ;; max-vector-length (let-temporarily (((*s7* 'max-vector-length) 123)) (test (make-vector 256) 'error) (test (make-complex-vector 256) 'error) (test (make-float-vector 256) 'error) (test (make-int-vector 256) 'error) (test (make-byte-vector 256) 'error) (test (make-hash-table 256) 'error) (test (make-weak-hash-table 256) 'error) (test (symbol-table) 'error)) (let-temporarily (((*s7* 'max-vector-length) 3)) (test (vector 1 2 3 4) 'error) (test (complex-vector 1-i 2 3-i 4) 'error) (test (float-vector 1 2 3 4) 'error) (test (int-vector 1 2 3 4) 'error) (test (byte-vector 1 2 3 4) 'error) (test (string->byte-vector "12345") 'error) (test (eval-string "#(1 2 3 4)") 'error) (test (eval-string "#r(1 2 3 4)") 'error) (test (eval-string "#i(1 2 3 4)") 'error) (test (eval-string "#u(1 2 3 4)") 'error) (test (list->vector '(1 2 3 4 5)) 'error) (test (hash-table 'a 1 'b 2 'c 3 'd 4) 'error) (test (weak-hash-table 'a 1 'b 2 'c 3 'd 4) 'error) (test (append (vector 1 2) (vector 3 4)) 'error) (test (vector-append (vector 1 2) (vector 3 4)) 'error)) ;; max-vector-dimensions (let-temporarily (((*s7* 'max-vector-dimensions) 1)) (test (make-vector '(2 3)) 'error) (test (make-float-vector '(2 3)) 'error) (test (make-int-vector '(2 3)) 'error) (test (subvector (vector 1 2 3 4) 0 4 '(2 2)) 'error)) ;; max-format-length (when (= (*s7* 'debug) 0) (let-temporarily (((*s7* 'max-format-length) 12)) (test (format #f "~NC" 256 #\a) 'error))) ;; max-string-length (let-temporarily (((*s7* 'max-string-length) 12)) (test (append (make-string 9 #\a) (make-string 9 #\b)) 'error) (test (string-append (make-string 9 #\a) (make-string 9 #\b)) 'error) (test (let ((port (open-output-string))) (display "aaaaaaaaa" port) (display "bbbbbb" port) (get-output-string port)) 'error) (test (make-string 24 #\a) 'error) (test (call-with-input-file "s7test.scm" (lambda (port) (read-string 20 port))) 'error) (test (call-with-output-string (lambda (p) (display "aaaaaaaa" p) (display "bbbbbbbbb" p))) 'error) (test (byte-vector->string #u(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)) 'error) (test (symbol->string (symbol "aaaaaaaaa" "bbbbbbbbb")) 'error) (test (string #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a #\a) 'error) (test (list->string '(#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e)) 'error) (let ((str "0123456789")) (test (string-append str str str) 'error)) (test (make-string 256) 'error)) (let-temporarily (((*s7* 'max-string-length) 3)) (test (port-filename) 'error)) ;; max-list-length (let-temporarily (((*s7* 'max-list-length) 1)) (test (make-list 256) 'error)) (unless pure-s7 (let-temporarily (((*s7* 'max-list-length) 3)) (test (vector->list #(a b c d)) 'error) (test (string->list "abcdef") 'error))) #| ;;; these could be checked for max-*, but are tricky or dubious etc (let-temporarily (((*s7* 'max-string-length) 3)) (number->string pi) (object->string pi) "asdfghj") ; complicated and hard to test (let-temporarily (((*s7* 'max-string-length) 12)) (format #f "~W" (vector pi)) (format #f "~NC" 80 #\-) (stacktrace) (call-with-input-file "s7test.scm" (lambda (port) (read-line port))) ; complicated (documentation 'abs) (help 'abs) (system "ls tools" #t) ; s7.c 36742 (*s7* 'version)) (let-temporarily (((*s7* 'max-vector-length) 3)) (*s7* 'gc-protected-objects) ; s7.c 93115, copied before len known (append (hash-table 'a 1 'b 2) (hash-table 'c 3 'd 4)))) ; s7.c 50065, but it's in a loop (let-temporarily (((*s7* 'max-list-length) 3)) (map (lambda (a) (values a a)) "12") (let->list (inlet 'a 1 'b 2 'c 3 'd 4)) ; s7.c ca 9980, but len not always easily available '(a b c d) (list 1 2 3 4) ; just copies args (list-values 1 2 3 4) (append '(1 2) '(3 4)) (map (lambda (a) (values a a)) '(1 2)) (map (lambda (a) (values a a)) #(1 2 3 4)) (directory->list "tools") ; s7.c 36801, but kinda dumb (*s7* 'stacktrace-defaults) ; 5 (*s7* 'file-names) ; 4 in t651 ;; also c-types, file-names, stack-entries and history ;; cyclic-sequences? procedure-source? signature? read? cons!?! ;; (*function* 'arglist)? ;; *features* ) |# (test (*s7* 14) 'error) (test (*s7* (list 1)) 'error) (test (set! (*s7* 14) 1) 'error) (when full-s7test (test (string? (with-output-to-string (lambda () (let-temporarily (((*s7* 'safety) -1)) (*s7* 'memory-usage))))) #t)) (test (set! (*s7* 'hash-table-float-epsilon) 10) 10) (test (set! (*s7* 'hash-table-float-epsilon) 1/10000) 1/10000) (test (set! (*s7* 'hash-table-float-epsilon) -.1) 'error) (test (set! (*s7* 'equivalent-float-epsilon) -.1) 'error) (test (set! (*s7* 'default-rationalize-error) -.1) 'error) (test (set! (*s7* 'bignum-precision) -10) 'error) (test (set! (*s7* 'bignum-precision) .1) 'error) (when full-s7test (test (pair? (append '(1) *s7* ())) #t) (test (string? (format #f "~W" (inlet *s7*))) #t)) (when (provided? 'number-separator) (let-temporarily (((*s7* 'number-separator) #\null)) (test (*s7* 'number-separator) #\null) (test (eval-string "12,321") 'error) ; unbound variable (set! (*s7* 'number-separator) #\,) (test (eval-string "12,321") 12321) (test (eval-string "12,321.5") 12321.5) (test (eval-string "12,321+inf.0i") 12321+inf.0i) (test (eval-string "1,23,456,7890") 1234567890) (set! (*s7* 'number-separator) #\_) (test (eval-string "_123") 'error) (test (eval-string "1_2_3") 123) (test (eval-string "#x16_2") #x162) (test (eval-string "123_") 'error) (test (eval-string "1__2") 'error) (test (eval-string "1+_3i") 'error) (test (eval-string "1/_2") 'error) (test (eval-string "1_2+i") 12.0+1.0i) (test (eval-string "1+1_2i") 1.0+12.0i) (test (eval-string "12_3/3_4") 123/34) (test (string->number "a_b_c@1" 16) #xabc@1) (test (string->number "a_b_c@1" 12) #f) (test (string->number "1_2@1" 2) #f) (test (string->number "1_1@1" 2) 6.0) (num-test (eval-string "1.0@2_3") 1.0e23) (num-test (eval-string "1.0e2_3") 1.0e23)) (let-temporarily (((*s7* 'number-separator) #\a)) (test (eval-string "a1") 'error) ; unbound variable a1 (test (eval-string "1a") 'error) ; unbound variable 1a (test (eval-string "1a1") 11) (test (eval-string "1a+i") 'error) ; unbound variable 1a+i (test (eval-string "1a1/2a2") 1/2)) (let-temporarily (((*s7* 'number-separator) #\')) (test (eval-string "10'10'10") 101010)) (test (set! (*s7* 'number-separator) #\.) 'error) (test (set! (*s7* 'number-separator) #\e) 'error) (test (set! (*s7* 'number-separator) #\E) 'error) (test (set! (*s7* 'number-separator) #\@) 'error)) (let ((v ())) (let ((val1 (object->string (do ((i 1 (+ i 1))) ((= i 4) v) (set! v (cons (sin i) v)))))) (set! v ()) (let ((val2 (let-temporarily (((*s7* 'float-format-precision) 3)) (object->string (do ((i 1 (+ i 1))) ((= i 4) v) (set! v (cons (sin i) v))))))) (test val1 "(0.1411200080598672 0.9092974268256817 0.8414709848078965)") (test val2 "(0.141 0.909 0.841)") (test (<= (length val1) (length val2)) #f)))) (for-each (lambda (field) (for-each (lambda (arg) (test (set! (*s7* field) arg) 'error)) (list "hi" (integer->char 65) (list 1 2) #t (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0) 3.14 3/4 1.0+1.0i #\f (lambda (a) (+ a 1)) # #))) '(print-length safety cpu-time heap-size free-heap-size gc-freed gc-total-freed max-string-length max-list-length max-vector-length max-vector-dimensions default-hash-table-length initial-string-port-length gc-protected-objects file-names rootlet-size c-types stack-top stack-size stacktrace-defaults max-stack-size catches exits float-format-precision bignum-precision)) (for-each (lambda (field) (let ((old-val (*s7* field))) (test (set! (*s7* field) -12) 'error) (test (set! (*s7* field) 0) 'error) (set! (*s7* field) old-val))) '(max-string-length max-list-length max-vector-length max-vector-dimensions bignum-precision default-hash-table-length initial-string-port-length max-stack-size)) (for-each (lambda (field) (let ((old-val (*s7* field))) (test (set! (*s7* field) -12) 'error) (set! (*s7* field) old-val))) '(print-length float-format-precision)) (for-each (lambda (field) (for-each (lambda (arg) (test (set! (*s7* field) arg) 'error)) (list "hi" (integer->char 65) (list 1 2) #t (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 1.0+1.0i #\f (lambda (a) (+ a 1)) # #))) '(default-rationalize-error default-random-state equivalent-float-epsilon hash-table-float-epsilon)) (for-each (lambda (field) (for-each (lambda (arg) (test (set! (*s7* field) arg) 'error)) (list "hi" (integer->char 65) (list 1 2) (make-vector 3) abs _ht_ _undef_ _null_ _c_obj_ quasiquote macroexpand 3/4 3.14 1.0+1.0i #\f (lambda (a) (+ a 1)) # #))) '(undefined-identifier-warnings undefined-constant-warnings gc-stats accept-all-keyword-arguments muffle-warnings?)) (test (set! (*s7* 123) 0) 'error) (test (set! (*s7* #(123)) 0) 'error) (test (let () (define (f) (set! (*s7* #(123)) 0)) (f) (f)) 'error) (test (let () (define (f) (set! (*s7* #(123)) 0)) (catch #t f (lambda args #f)) (f)) 'error) (let-temporarily (((*s7* :print-length) 123)) (test (*s7* :print-length) 123) (set! (*s7* :print-length) 321) (test (*s7* :print-length) 321)) (test (set! #_abs 32) 'error) (test (define (#_abs a) (= a 1)) 'error) (test #|a|#|b|#|c|# 'error) ; unbound variable |b|#|c|# (test (catch #t (lambda () (let-temporarily (((*s7* 'undefined-identifier-warnings) #t) ((*s7* 'autoloading?) #f)) (define (func) (+ 1 (asdf123 3))) (define (hi) (func)) (hi))) (lambda (type info) type)) 'unbound-variable) (gc #t) (let () (define (f) (let-temporarily (((*s7* 'safety) 1)) (format #f "~A" (quasiquote quote)))) (f)) ; check unheap bug (s7_is_valid) (let () (define (s7-field-test) (for-each (lambda (arg) (catch #t (lambda () (let-temporarily (((*s7* 'accept-all-keyword-arguments) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'autoloading?) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'bignum-precision) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'c-types) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'catches) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'cpu-time) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'debug) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'default-hash-table-length) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'default-random-state) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'default-rationalize-error) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'equivalent-float-epsilon) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'expansions?) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'file-names) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'float-format-precision) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'free-heap-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'gc-freed) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'gc-info) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'gc-protected-objects) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'gc-resize-heap-by-4-fraction) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'gc-resize-heap-fraction) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'gc-stats) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'gc-temps-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'gc-total-freed) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'hash-table-float-epsilon) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'heap-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'history) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'history-enabled) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'history-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'initial-string-port-length) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'major-version) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'minor-version) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'max-format-length) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'max-heap-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'max-list-length) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'max-port-data-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'max-stack-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'max-string-length) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'max-vector-dimensions) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'max-vector-length) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'memory-usage) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'most-negative-fixnum) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'most-positive-fixnum) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'muffle-warnings?) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'openlets) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'output-port-data-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'print-length) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'profile) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'profile-info) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'profile-prefix) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'rootlet-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'safety) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'stack) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'stack-size) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'stack-top) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'stacktrace-defaults) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'symbol-printer) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'symbol-quote?) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'undefined-constant-warnings) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'undefined-identifier-warnings) arg)) #f)) (lambda (type info) #f)) (catch #t (lambda () (let-temporarily (((*s7* 'version) arg)) #f)) (lambda (type info) #f))) (vector #f #t () #\a # # # 1 2/3 1.0 1+i (list 0) 'a set! "11" #(1+i 2+i) #i(312 1234) #r(1.5 2.5) #u(1 2) #2i((1 2) (3 4)) (hash-table 'a 1 'b 2) (inlet 'a 1 'b 2) (c-pointer 0) (random-state 1234) (lambda () 1) (lambda* ((a 21)) (+ a 1)) (macro (a) `(+ ,a 1)) (macro* ((a 32)) `(+ ,a 1)) quasiquote (bacro (a) `(+ ,a 1)) (bacro* ((a 32)) `(+ ,a 1)) (open-output-string) (open-input-string "1234") abs + make-hash-table map port-line-number (call/cc (lambda (c) c)) (call-with-exit (lambda (c) c)) (make-iterator '(1 2 3))))) (s7-field-test)) (when full-s7test (let ((mem (*s7* 'memory-usage))) (test (pair? (mem 'approximate-s7-size)) #t) (test (let? (mem 'free-lists)) #t) (test (mem 'asdf) #)) (test (*s7* :asdf) #)) (for-each (lambda (f) (catch #t (lambda () (set! (*s7* f) 123) (format *stderr* "oops: set! (*s7* '~S) did not fail!~%" f)) (lambda (t i) (unless (eq? t 'immutable-error) (format *stderr* "~S: ~S ~S~%" f t i))))) '(catches cpu-time c-types file-names free-heap-size gc-freed gc-total-freed gc-protected-objects memory-usage most-negative-fixnum most-positive-fixnum rootlet-size stack stack-size stack-top version major-version minor-version)) (let ((s7g (dilambda (lambda () (*s7* 'gc-freed)) (lambda (val) (set! (*s7* 'gc-freed) val))))) (catch #t (lambda () (let-temporarily (((s7g) 123)) (display 'oops *stderr*))) (lambda (type info) (unless (string=? (apply format #f info) "can't set (*s7* 'gc-freed)") (format *stderr* "set s7g: ~A~%" (apply format #f info)))))) (let () (define (func) (hash-table (copy (*s7* 'gc-protected-objects) '((x))) (values 2 3) 0)) ; the "copy" is not needed, I think (see sl_protected_objects) (test (func) (hash-table '(#f) 2 3 0))) ; the #f can be () (tests7 etc) (let () ; check op_let_temp_s7_direct and unwinders (define (f1) (let-temporarily (((*s7* 'openlets) #f)) (*s7* 'openlets))) (test (*s7* 'openlets) #t) (test (f1) #f) (test (*s7* 'openlets) #t) (test (f1) #f) (test (*s7* 'openlets) #t) (define (f2) (call-with-exit (lambda (return) (let-temporarily (((*s7* 'openlets) #f)) (return (*s7* 'openlets)))))) (test (*s7* 'openlets) #t) (test (f2) #f) (test (*s7* 'openlets) #t) (test (f2) #f) (test (*s7* 'openlets) #t) (define (f3) (call/cc (lambda (return) (let-temporarily (((*s7* 'openlets) #f)) (return (*s7* 'openlets)))))) (test (*s7* 'openlets) #t) (test (f3) #f) (test (*s7* 'openlets) #t) (test (f3) #f) (test (*s7* 'openlets) #t)) (test (let () (define* (v3 x y) (values x y)) (define (func) (list (let-temporarily (((*s7* 'openlets) #f)) (v3)))) (func) (func)) (list #f #f)) ; unwinder mv check (test (*s7* 'symbol-quote?) #f) ;;; -------------------------------------------------------------------------------- (test (s7-init-and-free) #f) ;;; -------------------------------------------------------------------------------- ;; it's documented that this kind of stuff may be optimized out, so these can do anything ;(test (let ((x (abs -1)) (sba abs)) (set! abs odd?) (let ((y (abs 1))) (set! abs sba) (list x y abs))) (list 1 #t abs)) ;(test (let () (define (hi z) (abs z)) (let ((x (hi -1)) (sba abs)) (set! abs odd?) (let ((y (hi 1))) (set! abs sba) (list x y)))) (list 1 #t)) ;(test (let () (define (hi z) (abs z)) (let ((x (hi -1)) (sba abs)) (set! abs (lambda (a b) (+ a b))) (let ((y (hi 1))) (set! abs sba) (list x y)))) 'error) ;(set! abs #_abs) ;(test (let () (define (hi) (let ((cond 3)) (set! cond 4) cond)) (hi)) 4) ;(test (let ((old+ +) (j 0)) (do ((i 0 (+ i 1))) ((or (< i -3) (> i 3))) (set! + -) (set! j (old+ j i))) (set! + old+) j) -6) (let () (define (freef) (local-func 0)) (test (freef) 'error) (define (local-func x) (+ x 1)) (test (freef) 1) (set! local-func (lambda (x y) (+ x y))) (test (freef) 'error) (set! local-func (lambda (x) (+ x 2))) (test (freef) 2) (set! local-func 2) (test (freef) 'error)) (let () (define (freeg) (+ local-var 1)) (define (freeh) (set! local-var 2)) (test (freeg) 'error) (test (freeh) 'error) (define local-var 1) (test (freeg) 2) (test (freeh) 2)) (let () ; new_s7_optimize (define (f1) (do ((i 0 (+ i 1))) ((= i 10)) (if (< i 0) (format *stderr* "oops~%")))) (f1) ; opt_dotimes create/store (f1) ; opt_dotimes restore (define (f2 seq item start end) (do ((i start (+ i 1))) ((= i end)) (set! (seq i) item))) (f2 (list 1 2 3) 4 0 3) ; opt_dotimes create/store (f2 (vector 1 2 3) 4 0 3) ; opt_dotimes fallback (define (f3) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 10)) (if (not (= i j)) (format *stderr* "oops~%")))) (f3) ; dox_ex create/store (f3) ; dox_ex restore (define (f4) (let ((v (make-vector 10))) (do ((i 0 (+ i 1))) ((= i 10)) (vector-set! v i i)))) (f4) ; simple_do_ex create/store (f4) ; simple_do_ex restore (define (f5 x) (let ((y 0)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 10)) (set! y (+ i x))))) (f5 0) (f5 2) (f5 1/2) ; dox_ex fallback (f5 pi)) ;;; bizarre optimizer checks (test (let () (define (func x) (if (pair? (cdr /)) 3)) (define (hi) (func (integer->char 255))) (catch #t (lambda () (hi) (func (integer->char 255))) (lambda arg #f))) #f) (test (catch #t (lambda () (define (func x) (cond (case `((1)) (if x y) =>))) (define (hi) (func ())) (hi)) (lambda args 'error)) 'error) (let () (define (func x) (case x ((#t) (- (cdaadr))) (('(((x 1) 2) 3)) (cadddr or (list (list 1 2)) (<= (sort!)))) (else (cond (case / #() let* 0+1/0i (list (list 1)) (lambda* / (caadar (read-byte // (assv))))))))) (define (hi) (func 1+0/0i)) (hi) (func 1+0/0i)) (test (let () (define (f1 a b) (list a b)) (define (f2) (when #f (define f2_c 2)) (f1 f2_c #f)) (f2)) 'error) (test (let () (define (f1 a b) (list a b)) (define (f3) (if #f (define f3_c 2)) (f1 f3_c f3_c)) (f3)) 'error) (test (let () (define (f4 a b) (catch #t (lambda () a) (lambda args (display (ow!))))) (define (f5) (when #f (define f5_c 50)) (f4 f5_c (lambda () 1))) (f5)) 'error) (test (let () (define (f6) (and #f (define f7_c 50)) (+ f7_c ((lambda () 1)))) (f6)) 'error) (test (let () (define (func x) (call-with-exit (lambda ((i 0 (+ i 1))) #f))) (define (hi) (func begin)) (hi) (func begin)) 'error) (test (let () (define (func x) (if (cond (cddr => (lambda))) (cddddr `(((+ x 1)))))) (define (hi) (func '((x 1) (y) . 2))) (hi) (func '((x 1) (y) . 2))) 'error) (test (let () (define (func x) (if (memq / (quote . "")) (assv '()))) (define (hi) (func x y z)) (hi) (func x y z)) 'error) (test (let () (define (func x) (cond (case / (set! _settee_ (caadr))))) (define (hi) (func 0/0+0/0i)) (hi) (func 0/0+0/0i)) 'error) (test (let () (define (func x) (object->string (list (funclet /)))) (define (hi) (func abs)) (hi)) "((rootlet))") (test (let () (define (func x) (cdadar (not (eq? / '())))) (define (hi) (func '((())))) (hi)) 'error) (test (let () (define (func x) (append (inlet 'integer? (lambda (f) #f)) (hash-table `((+ x 1)) '(((x 1) 2) 3)))) (define (hi) (func 1)) (hi)) 'error) (test (let () (define (func x) (float-vector? (<= / (let-ref 1+0/0i 0)))) (define (hi) (func 0/0+i)) (hi)) 'error) (test (let () (set! else #(0 0)) (define (func x) (car (boolean? (char=? (else ()) (= i 2))))) (define (hi) (func '(()))) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logior // (+)))) (define (hi) (func 0+1/0i)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-ref /(asinh (logand))))) (define (hi) (func 0+1/0i)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logxor /(lognot (gcd))))) (define (hi) (func (list (list 1 2)))) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-set! / 1 2))) (define (hi) (func 1.5)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (quote . /))) (define (hi) (func (integer->char 255))) (hi)) 'error) (test (let () (define (func x) (cond ((if if . :readable) #f))) (define (hi) (func begin)) (hi)) 'error) (test (let () (define (func x) (if (not . /) x)) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (set! (with-let / begin `(+ ,a ,b ,@c) #) #f)) (define (hi) (func #f)) (hi)) 'error) (test (procedure? (let () (define (func) (cond (case 'x (lambda / x)))) (func))) #t) (test (procedure? (let () (define (func x) (cond (case / (lambda* abs /)) (else #f))) (define (hi) (func #f)) (hi))) #t) (test (let () (define (func x) (let () (define _x_ (lambda* . let*)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (set! (with-let . ()) #f)) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (call/cc (lambda (_x_) (acosh (unlet))))) (define (hi) (func #f)) (hi)) 'error) (test (procedure? (let () (define (func x) (cond (case '((x 1) y . 2) 1/0+i :readable (lambda / macroexpand `(x 1))) (else #f))) (define (hi) (func #f)) (hi))) #t) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (member :rest (cons 1 2) /))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-numeric? (make-vector 3) 1.5 `((+ x 1)) ))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (procedure? //))) (define (hi) (func #f)) (hi)) 'error) ;(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-numeric? (char-ready? )))) (define (hi) (func #f)) (hi)) 'error) ;#t if opt (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (iterator-at-end? /))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-ref /(flush-output-port )))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (let () (set! ((dilambda / (let ((x 3)) (lambda (y) (+ x y))) )) 3))) (define (hi) (func #f)) (hi)) 6) ;! (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (unlet /(immutable? )))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (catch #f (vector-ref #(1 2) 0 1.0+1.0i) (vector-ref #(1 2) 0 1.0+1.0i))) (define (hi) (func #f)) (hi)) 'error) (test ((vector abs log) 0 -1) 1) ; weird... (test (vector-ref (vector abs log) 0 -1) 1) ;'error (test (let () (define (func x) (cond (lambda (if x y) 0 1.0+1.0i (string>=? / `((+ x 1)) x y z (integer->char 255))) (else #f))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (format `((x)) (list 1) cons else (read (string-append /))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (<= -1 (round /)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (byte-vector-ref (make-string 3) 0))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-cichar 255))))) (define (hi) (func #f)) (hi)) #t) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (string>? (null? i) (object->let /)) (string>? (null? i) (object->let /)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (letrec . #t))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) :readable `((x . 1)) (provide (quote /)))) (define (hi) (func #f)) (hi)) 1) (test (let () (define (func x) (iterator-sequence (string-ci<=? (do ((i 0 (+ i 1))) ((= i 1) i) (when (+ i 1) `(+ x 1) (list 1) (- i 1)))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (continuation? (do ((i 0 (+ i 1))) ((= i 1) i) (unless (+ i 1) quasiquote )))) (define (hi) (func #f)) (hi)) #f) (test (let () (define (func x) (error `(x 1) (null? i) (list 1 2) (lambda . /))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (case / (if x y) #2d((1 2) (3 4)) (x => y)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (char>=? (inlet 'a 1) (hook-functions (output-port?))) (vector? (letrec))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (letrec // . letrec)) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (for-each quasiquote (object->let /))) (define (hi) (func #f)) (hi)) #) (test (let () (define (func x) (provided? (eval-string (do ((i 0 (+ i 1))) ((= i 1) i) (case))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (cond (denominator 1 . 2))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (when denominator 1 . 2)) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (case 0 ((0) 1 . 2))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (case denominator ((0) 1) (else 1 . 2))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (cond (denominator . 2))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (when denominator . 2)) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (case 0 ((0) . 2))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (case denominator ((0) 1) (else . 2))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (string? (object->string (hash-table (list-values (object->let /)))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (sort! / (lambda (zero? i) (zero? i)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (string>? (string) (read-line)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! cons '() macroexpand))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-set! cons -1 ()))) (f)) 'error) (test (let () (define (func x) (call-with-values quasiquote macroexpand )) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (modulo (expt 2 32) (make-iterator (list 1 2 3))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (< (read-char (cond (boolean? lambda* (lambda (a) (values a (+ a 1))) `(+ ,a ,b) 0+0/0i))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (exact->inexact (cond (continuation? lambda (lambda (a) (values a (+ a 1))) (values "ho") `(x) `(+ ,a ,b))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) 0 (cond (quote (define _definee_ 0))))) (define (hi) (func #f)) (hi)) 1) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) 0 (cond '(define _definee_ 0)))) (define (hi) (func #f)) (hi)) 1) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (let* ()))) (define (hi) (func #f)) (hi)) 'error) ; not 0! (test (let () (define (func x) (input-port? (c-pointer (values 1 2) begin))) (define (hi) (func #f)) (hi)) #f) ; not 'error (test (let () (define (func x) (member letrec '#())) (define (hi) (func #f)) (hi)) 'error) ; not #f (test (let () (define (func abs) (abs 1)) (define (hi) (func '(1 2 3))) (hi)) 2) (test (let () (define (hi) ((lambda (abs) (abs 1)) '(1 2 3))) (hi)) 2) (test (let () (define (func x) ((lambda (values) (values "ho")) '((x 1) 2))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (multiple-value-bind (values) '((x 1) 2) (values "ho"))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (multiple-value-bind (list) macroexpand '((1 2) (3 4)) (length (list)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (multiple-value-bind (hash-table) (integer->char 255) (pair? (hash-table? (let* () 0+1/0i (hash-table)))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (multiple-value-bind (list) -1 `((1) . x) #() (make-iterator (list 1 2 3)) (random-state 1234) 1234)) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-numeric? most-negative-fixnum))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-alphabetic? (list)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-whitespace? (make-hash-table)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (vector->list (values 1 2) #(1 2))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (truncate (/ (values 1 2) 0))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (fill! (values 1 2) `(+ x 1))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (not (zero? :readable))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (exact->inexact 1.0+123.0i))) (define (hi) (func #f)) (hi)) 1) (test (let () (define (func x) (inlet 'if 3)) (define (hi) (func #f)) (hi)) (inlet 'if 3)) (test ((let () (define (func x) (inlet ':allow-other-keys 3)) (define (hi) (func #f)) (hi)) 'allow-other-keys) 3) (test (let () (define (func x) (vector (setter car) (quote (null? i) #r2d((.1 .2) (.3 .4))))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (c-pointer? begin (member let-temporarily (values 1 2)))) (define (hi) (func #f)) (hi)) 'error) (test (let () (define (func x) (integer? (assoc (values) '((x 1) (y) . 2) cons))) (define (hi) (func #f)) (hi)) #f) (test (let () (define-macro (_mac_ x) `(+ ,x 1)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) 1) (_mac_ +inf.0 . #x123.123))) (define (hi) (func #f)) (hi))) 'error) (test (let () (define (func x) (reverse! (write-string (symbol->string :allow-other-keys) #f))) (define (hi) (func #f)) (hi)) "syek-rehto-wolla:") ; copied we hope (test (symbol->string :allow-other-keys) ":allow-other-keys") (test (let () (define (func x) (with-let (openlet (inlet 'abs (lambda (x) (- x)))) '(- 1) (abs 1+1i))) (define (hi) (func #f)) (hi)) -1-i) (test (let ((x #f)) (define (func) (member "c" '(x) (lambda (a b) (call/cc (lambda (return) (return #f)))))) (define (hi) (func)) (hi)) #f) (test (let ((x #f)) (define (func) (assoc "c" '((x . 1)) (lambda (a b) (call/cc (lambda (return) (return #t)))))) (define (hi) (func)) (hi)) '(x . 1)) (let ((imp '(0 1))) (define (func) (list (hash-table-ref imp imp) #u(0 1) #r())) (define (hi) (func)) (test (hi) 'error)) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (fill! (curlet) (list-values letrec cond)))) (define (hi) (func)) (hi)) 'error) (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (eval-string (object->string (curlet)))))) (define (hi) (func)) (test (hi) (inlet 'i 0))) (test (let () (define (func) (hash-table-entries (string-ref (iterator-sequence (symbol? x)) #i2d((101 201) (3 4))))) (func)) 'error) (test (let () (define (_fnc3_ x) (* x 2.0)) (define (f) (_fnc3_ (inlet :a (hash-table 'b 1)))) (f)) 'error) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (let-temporarily ((i 0 (+ i 1))) #i(1) 1)))) (define (hi) (func)) (hi)) 'error) (unless with-bignums (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (log 1 (abs x))))) (define (hi) (func)) (hi)) 0)) (test (let () (define (f) (with-input-from-string '(+ x 1) (cdaar))) (f)) 'error) (let ((v (make-vector '(2 2)))) (test (member 1 (list 3 2) (lambda (a b) (immutable? (list v -1/2 (+ 1 2))))) #f)) ; list_3_direct (test (let () (define (func) (let ((x #f)) (if (car (list 1)) (string=? let (abs))))) (func) (func)) 'error) (test (> (length (object->string (unlet))) 7) #t) ; (inlet 'else :else) probably (test (let ((+ *)) (define (f x) (+ x 1)) (object->string f :readable)) "(let ((+ #_*)) (lambda (x) (+ x 1)))") ; can also be - (test (let () (define (func) (let ((+ *)) (+ (begin (real-part (random 0+i))) 'value "") (string->symbol (case)))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (let ((+ *)) (+ (begin (real-part (random 0+i)) 0) 'value "") (string->symbol (case)))) (define (hi) (func)) (hi)) 'error) (test (let ((_f_ (lambda () (>= (cond (immutable! "asdf") (immutable! (hash-table 'a 1))) (caadar(caadr)))))) (_f_) (_f_)) 'error) (test (let () (define (!f!) (let ((!x! (map (lambda (!a!) (dynamic-wind + + +)) '(0)))) (car !x!))) (!f!)) 0) (test (let () (define (!f!) (let ((!x! (map (lambda (!a!) (dynamic-wind lcm gcd *)) '(0)))) (car !x!))) (!f!)) 0) (test (let () (define (func) (cdddr (c-pointer (bignum 1) (vector) (vector 1) (vector 2)) (adjoin (list 1) (list 1 2)))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (let ((+ *)) (let ((cons list)) (cons #o123 +documentation+ 0-i)))) (func) (func)) 'error) (test (let () (define (func) (let ((+ *)) (+ (bignum 1234.1234) 100 .0-) (string-ci=? (ash (open-input-string (documentation)))))) (func) (func)) 'error) (test (let () (define (func) (let ((+ *)) (let ((cons list)) (+ 100 0+. #r2d((.1 .2) (.3 .4)))))) (func) (func)) 'error) (test (let () (define (f) (let ((+ *)) (with-let (curlet) (#_integer? (+))))) (f)) #t) (test (let () (define (func) (let ((x #f) (i 0)) (case x (else (string->number))))) (func)) 'error) (test (let () (define (func) (apply + (string-ref ((if (> 3 2) abs log) 1) 0))) (func)) 'error) (test (let () (define (func) (apply char? (list (string-ref ((if (> 3 2) string string) #\a) 0)))) (func)) #t) (test (let () (define (func) (list (values (string-ref ___lst 0 ) cond (help) (string-upcase 1001 (make-vector 3 :rest keyword?) when (list))))) (func)) 'error) (when with-block (let () (define (fibf n) (if (< n 2.0) n (+ (fibf (- n 1.0)) (fibf (- n 2.0))))) (define (clamp minimum x maximum) (min maximum (max x minimum))) (define (func) (clamp (fibf 8.0) 0 (tree-count 0 (vector-dimensions (block))))) (define (hi) (func)) (test (hi) 1)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (for-each (lambda s s) (object->let (block)))))) (define (hi) (func)) (hi)) #)) (test (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (call-with-output-string x))))) (define (hi) (func)) (hi)) 'error) (test (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (with-output-to-string x))))) (define (hi) (func)) (hi)) 'error) (test (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (with-output-to-file "/dev/null" x))))) (define (hi) (func)) (hi)) 'error) (unless (or pure-s7 immutable-unquote) (test (let ((x #f)) (define (func) (let () (vector (quasiquote (fill! (with-baffle (unquote))))))) (define (hi) (func)) (hi)) 'error)) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (indexable?)))) (define (hi) (func)) (hi)) 'error) (test (let () (let-temporarily () (define x 2)) (+ x 1)) 3) (test (let ((y 1)) (let-temporarily ((y 3)) (define x y)) (+ x y)) 4) (test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ x 1))) (define (hi) (func)) (hi)) 'error) (test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ 2 x 1))) (define (hi) (func)) (hi)) 'error) (test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ 3 2 x 1))) (define (hi) (func)) (hi)) 'error) (test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (abs x))) (define (hi) (func)) (hi)) 'error) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (with-let (inlet 'a 1) (setter x))))) (define (hi) (func)) (hi)) 'error) (test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (with-let (inlet 'b 1) (+ b 1)) (+ x 1))) (define (hi) (func)) (hi)) 'error) (test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (+ x 1)))) (define (hi) (func)) (hi)) 2) (test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (with-let (inlet 'b 1) (+ b 1)) (+ x 1)))) (define (hi) (func)) (hi)) 2) (test (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (with-let (inlet 'b 1) (+ b 1)))) (+ x 1)) (define (hi) (func)) (hi)) 0) (test (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (atanh (with-let (inlet 'integer? (lambda (f) #f)) (+ x 1)))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (call-with-exit (lambda (_x_) 1 . 2))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (list (quote 1 abs) (quote 1))) (define (hi) (func)) (hi)) 'error) (test (with-let (inlet) (let () (signature abs) . if)) 'error) (test (with-let (inlet) (let* () (signature abs) . if)) 'error) (test (with-let (inlet) (letrec () (signature abs) . if)) 'error) (test (let-temporarily ((__var__ 1)) (signature abs) . if) 'error) (test (with-let (inlet 'i 0) 1 cons . 2) 'error) ;;; opt3 as lambda arglen (test (dynamic-wind (lambda () (open-input-string (format #f "~W" (car (list (the (lambda args args) #i(1)) (or)))))) (lambda () #f) (lambda () #f)) 'error) (test (call-with-exit (lambda (goto) (goto (with-input-from-string (lambda (a) (values a (+ a 1))) 2) (cadar (unless))))) 'error) (test (let () (define (f) (let ((_x_ (+ _x_ 1.0))) 1)) (f)) 'error) (test (let () (define (f) (define _x_ (let-ref (cdr _x_) 'a))) (f)) 'error) (test (let () (define (f) (define _x_ (define _x_ 1))) (f)) 1) (test (let () (define (f y) (define _x_ (* y (cos _x_))) 1) (f 1)) 'error) (test (let () (define (f y) (define _x_ (* _x_ y)) 1) (f 1)) 'error) (test (let () (define (f) (define _x_ (+ _x_ 123)) 1) (f)) 'error) (test (let () (define (f) (define _x_ (+ _x_ 1)) 1) (f)) 'error) (test (let () (define (f) (define _x_ (+ 1 _x_)) 1) (f)) 'error) (test (let () (define (f) (define _x_ (* .1 _x_)) 1) (f)) 'error) (test (let () (define (f) (define _x_ (+ .1 _x_)) 1) (f)) 'error) (test (let () (define (f) (define _x_ (+ _x_ .1)) 1) (f)) 'error) (test (let () (define (func) (clamp 1 (values 1 2 3 4 5 6) 2)) (func)) 'error) (test (let () (define (func) (clamp 1 (values 1 2) 2)) (func)) 'error) (test (let () (define (clf a b c d e f g) (+ a b c d e f g)) (define (func) (clf 1 (values 1 2) 2)) (func)) 'error) (test (let () (define (clf a b c d e f g) (+ a b c d e f g)) (define (func) (clf 1 (values 1 2 3 4) 2)) (func)) 'error) (test (let () (define (clf a b c d e f g) (+ a b c d e f g)) (define (func) (clf 1 (values 1 2 3 4 5) 2)) (func)) 18) (test (let () (define (f) (let-ref (cdr cond) 291.071044921875)) (f) (f)) 'error) (test (let () (define (f) (let-ref (cdr cond) :asdf)) (f) (f)) 'error) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (set!))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (list 1) (byte-vector 0 1 2))))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (c-pointer 1234) #i(1))))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (let _let_ #x123.123))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (immutable! (float-vector 0 1 2)) #_cons)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (let-temporarily ((x 1234)) (+ x 1)) _undef_))))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (list 1 2) and)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (string #\c #\b) '((1 (2)) (((3) 4))))))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if 1 (* 2 x 3.0 4))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (let _let_ #x123.123))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (hash-table-set! (immutable! (hash-table 'a 1)) 'x 3)))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (cond (set! __var__ . #x123)))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (not :readable #i()) (vector))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (truncate (min +nan.0 123)))))) (define (hi) (func)) (hi)) 'error) (test (eval-string "(let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (cond-expand (x => y) (values 1 2) #\\newline `(+ ,a ,b)))))") 'error) (test (let ((s (list (list 1 2)))) (define (func) (eq? (caar s) `(1))) (define (hi) (func)) (hi)) #f) (test (let () (define (func) (list + (assoc (setter car) '((111 . 2222) (3 . 4))))) (func)) (list + #f)) ; op_c_s_op_opsq_cq (when with-block (test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (if (= (immutable! (block 0.0 1.0 2.0)) (make-iterator #(10 20))) (integer? (setter kar))))) (f)) 'error)) ; opt2 fx overwrite complaint (test (let () (define (func) (do ((x 0.0 (+ x 0.1)) (i 0 (+ i 1))) ((>= x .1) (with-baffle (byte-vector #\backspace (+ x 1) 1 "STR1" (list ())))))) (define (hi) (func)) (hi)) 'error) (let () (define (_d5_ . args) (let ((__var__ #f)) (let doer ((_i_ 0)) (if (= _i_ 1) __var__ (begin (set! __var__ (values (define b1 2))) (doer (+ _i_ 1))))))) (test (_d5_ 1) 2)) (test (multiple-value-bind lambda #f (call-with-exit (lambda (return) (return 1)))) 'error) (unless (or pure-s7 immutable-unquote) (test (let ((x #f) (i 0)) (if (not x) (begin (quasiquote (type-of `((x)) "" #r2d((.1 .2) (.3 .4)) unquote))))) 'error) (test (let () (define (func) (let ((x #f) (i 0)) (let () (values (zero? (quasiquote (unquote . #x123.123))))))) (define (hi) (func)) (hi)) 'error)) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (fill! (immutable! (list 0 1 2)) (call/cc (lambda (return) (return 1 2)))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (member 1 '(2 3) (lambda (a b) (do ((i 0 (+ i 1))) ((= i 1) 1) (/ (random 1)))))) (define (hi) (func)) (hi)) 'error) (define-expansion (_do1_ . args) `(with-output-to-string (lambda () (do ((i 0 (+ i 1))) ((= i 1)) ,@(map (lambda (x) `(display ,x)) args))))) (test (let () (define (func) (let ((x #f) (i 0)) (let () (_do1_ (make-vector (do ())) (make-byte-vector (hash-table-ref)))))) (define (hi) (func)) (hi)) 'error) (test (string? (_do1_ (map cons (let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>) "aa"))) #t) (test (_do1_ (for-each cons (let ((<1> #f) (<2> (vector #f))) (set! <1> (make-iterator <2>)) (set! (<2> 0) <1>) <1>) "aa")) "#") ;;; ^ these are regression tests for an over-eager free_cell use (let () (let ((x 1)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (clamp 0 x 10)))) (define (hi) (func)) (hi)) (test (let ((x 1)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) 1) (clamp 0 (make-iterator (list 1)) 0))) (define (hi) (func)) (hi)) 'error)) (when with-block (test (let () (define (func x) (syntax? (values -1 (copy (block) (vector))))) (define (hi) (func #f)) (display (hi)) (newline)) 'error)) (test (dynamic-wind (lambda () (int-vector (cons x x) (call/cc (call-with-exit (lambda (goto) goto))))) (lambda () #f) (lambda () #f)) 'error) (when (defined? 's7-optimize) (test (s7-optimize '((cdadr (cddddr (symbol->string (min '((x 1 . 2) . 3) # '((x 1) . 2))))))) #) ; # is s7-optimize's error value (test (s7-optimize '((set! (cyclic-sequences . 0+0/0i) #f))) #) (test (s7-optimize (list (catch #t (lambda () (with-input-from-string "(if (not) (cadddr (rational?)))" read)) (lambda args args)))) #) (test ((s7-optimize '((inlet 'if 3))) 'if) 'error) ) ;;; null sc->args in unbound_variable: (test (let () (define (func) (inexact->exact (letrec ((x 1234) (y 1/2)) +documentation+ (list)))) (define (hi) (func) (func)) (hi) (hi)) 'error) (test (let () (define (func) (char-alphabetic? (letrec ((x 1234) (y 1/2)) (_definee_ x) 0+i (exact->inexact)))) (define (hi) (func) (func)) (hi) (hi)) 'error) ;;; same as above but change location of test (let () (define (func x) (object->string (list (funclet /)))) (define (hi) (func abs)) (test (hi) "((rootlet))")) (let () (define (func x) (cdadar (not (eq? / '())))) (define (hi) (func '((())))) (test (hi) 'error)) (let () (define (func x) (append (inlet 'integer? (lambda (f) #f)) (hash-table `((+ x 1)) '(((x 1) 2) 3)))) (define (hi) (func 1)) (test (hi) 'error)) (let () (define (func x) (float-vector? (<= / (let-ref 1+0/0i 0)))) (define (hi) (func 0/0+i)) (test (hi) 'error)) (let () (set! else #(0 0)) (define (func x) (car (boolean? (char=? (else ()) (= i 2))))) (define (hi) (func '(()))) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logior // (+)))) (define (hi) (func 0+1/0i)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-ref /(asinh (logand))))) (define (hi) (func 0+1/0i)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (logxor /(lognot (gcd))))) (define (hi) (func (list (list 1 2)))) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (int-vector-set! / 1 2))) (define (hi) (func 1.5)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (quote . /))) (define (hi) (func (integer->char 255))) (test (hi) 'error)) (let () (define (func x) (cond ((if if . :readable) #f))) (define (hi) (func begin)) (test (hi) 'error)) (let () (define (func x) (if (not . /) x)) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (set! (with-let / begin `(+ ,a ,b ,@c) #) #f)) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (let () (define _x_ (lambda* . let*)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (set! (with-let . ()) #f)) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (call/cc (lambda (_x_) (acosh (unlet))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (member :rest (cons 1 2) /))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-numeric? (make-vector 3) 1.5 `((+ x 1)) ))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (procedure? //))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (iterator-at-end? /))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-ref /(flush-output-port )))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (let () (set! ((dilambda / (let ((x 3)) (lambda (y) (+ x y))) )) 3))) (define (hi) (func #f)) (test (hi) 6)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (unlet /(immutable? )))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (catch #f (vector-ref #(1 2) 0 1.0+1.0i) (vector-ref #(1 2) 0 1.0+1.0i))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (cond (lambda (if x y) 0 1.0+1.0i (string>=? / `((+ x 1)) x y z (integer->char 255))) (else #f))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (format `((x)) (list 1) cons else (read (string-append /))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (<= -1 (round /)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (byte-vector-ref (make-string 3) 0))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (char-cichar 255))))) (define (hi) (func #f)) (test (hi) #t)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (string>? (null? i) (object->let /)) (string>? (null? i) (object->let /)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (letrec . #t))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) :readable `((x . 1)) (provide (quote /)))) (define (hi) (func #f)) (test (hi) 1)) (let () (define (func x) (iterator-sequence (string-ci<=? (do ((i 0 (+ i 1))) ((= i 1) i) (when (+ i 1) `(+ x 1) (list 1) (- i 1)))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (continuation? (do ((i 0 (+ i 1))) ((= i 1) i) (unless (+ i 1) quasiquote )))) (define (hi) (func #f)) (test (hi) #f)) (let () (define (func x) (error `(x 1) (null? i) (list 1 2) (lambda . /))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (case / (if x y) #2d((1 2) (3 4)) (x => y)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (char>=? (inlet 'a 1) (hook-functions (output-port?))) (vector? (letrec))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (letrec // . letrec)) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (for-each quasiquote (object->let /))) (define (hi) (func #f)) (test (hi) #)) (let () (define (func x) (provided? (eval-string (do ((i 0 (+ i 1))) ((= i 1) i) (case))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (cond (denominator 1 . 2))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (when denominator 1 . 2)) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (case 0 ((0) 1 . 2))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (case denominator ((0) 1) (else 1 . 2))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (cond (denominator . 2))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (when denominator . 2)) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (case 0 ((0) . 2))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (case denominator ((0) 1) (else . 2))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (string? (object->string (hash-table (list-values (object->let /)))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (sort! / (lambda (zero? i) (zero? i)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (string>? (string) (read-line)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 3)) (let-set! cons '() macroexpand))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (call-with-values quasiquote macroexpand )) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (modulo (expt 2 32) (make-iterator (list 1 2 3))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (< (read-char (cond (boolean? lambda* (lambda (a) (values a (+ a 1))) `(+ ,a ,b) 0+0/0i))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (exact->inexact (cond (continuation? lambda (lambda (a) (values a (+ a 1))) (values "ho") `(x) `(+ ,a ,b))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) 0 (cond (quote (define _definee_ 0))))) (define (hi) (func #f)) (test (hi) 1)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) 0 (cond '(define _definee_ 0)))) (define (hi) (func #f)) (test (hi) 1)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (let* ()))) (define (hi) (func #f)) (test (hi) 'error)) ; not 0! (let () (define (func x) (input-port? (c-pointer (values 1 2) begin))) (define (hi) (func #f)) (test (hi) #f)) (let () (define (func x) (member letrec '#())) (define (hi) (func #f)) (test (hi) 'error)) ; not #f (let () (define (func abs) (abs 1)) (define (hi) (func '(1 2 3))) (test (hi) 2)) (let () (define (hi) ((lambda (abs) (abs 1)) '(1 2 3))) (test (hi) 2)) (let () (define (func x) ((lambda (values) (values "ho")) '((x 1) 2))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (multiple-value-bind (values) '((x 1) 2) (values "ho"))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (multiple-value-bind (list) macroexpand '((1 2) (3 4)) (length (list)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (multiple-value-bind (hash-table) (integer->char 255) (pair? (hash-table? (let* () 0+1/0i (hash-table)))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (multiple-value-bind (list) -1 `((1) . x) #() (make-iterator (list 1 2 3)) (random-state 1234) 1234)) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-numeric? most-negative-fixnum))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-alphabetic? (list)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (char-whitespace? (make-hash-table)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (vector->list (values 1 2) #(1 2))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (truncate (/ (values 1 2) 0))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (fill! (values 1 2) `(+ x 1))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (not (zero? :readable))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) (exact->inexact 1.0+123.0i))) (define (hi) (func #f)) (test (hi) 1)) (let () (define (func x) (inlet 'if 3)) (define (hi) (func #f)) (test (hi) (inlet 'if 3))) (test (inlet 'if 3) (inlet 'if 3)) (test (apply (lambda (g) (inlet :if 32)) (list 2)) (inlet 'if 32)) (test (apply (lambda (g) (inlet ':if 32)) (list 2)) (inlet 'if 32)) (test (inlet :if `((x))) (inlet 'if '((x)))) (let () (define (func x) (vector (setter car) (quote (null? i) #r2d((.1 .2) (.3 .4))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (c-pointer? begin (member let-temporarily (values 1 2)))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func x) (integer? (assoc (values) '((x 1) (y) . 2) cons))) (define (hi) (func #f)) (test (hi) #f)) (let () (define-macro (_mac_ x) `(+ ,x 1)) (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) 1) (_mac_ +inf.0 . #x123.123))) (define (hi) (func #f)) (test (hi) 'error)) 'error) (let () (define (func x) (reverse! (write-string (symbol->string :allow-other-keys) #f))) (define (hi) (func #f)) (test (hi) "syek-rehto-wolla:")) (let () (define (func x) (with-let (openlet (inlet 'abs (lambda (x) (- x)))) '(- 1) (abs 1+1i))) (define (hi) (func #f)) (test (hi) -1-i)) (let ((x #f)) (define (func) (member "c" '(x) (lambda (a b) (call/cc (lambda (return) (return #f)))))) (define (hi) (func)) (test (hi) #f)) (let ((x #f)) (define (func) (assoc "c" '((x . 1)) (lambda (a b) (call/cc (lambda (return) (return #t)))))) (define (hi) (func)) (test (hi) '(x . 1))) (let ((imp '(0 1))) (define (func) (list (hash-table-ref imp imp) #u(0 1) #r())) (define (hi) (func)) (test (hi) 'error)) (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (let-temporarily ((i 0 (+ i 1))) #i(1) 1)))) (define (hi) (func)) (test (hi) 'error)) (when with-block (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (for-each (lambda s s) (object->let (block)))))) (define (hi) (func)) (test (hi) #))) (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (call-with-output-string x))))) (define (hi) (func)) (test (hi) 'error)) (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (with-output-to-string x))))) (define (hi) (func)) (test (hi) 'error)) (let ((x #f)) (define (func) (call-with-exit (lambda (x) (char-ci>? (with-output-to-file "/dev/null" x))))) (define (hi) (func)) (test (hi) 'error)) (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (indexable?)))) (define (hi) (func)) (test (hi) 'error)) (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ x 1))) (define (hi) (func)) (test (hi) 'error)) (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ 2 x 1))) (define (hi) (func)) (test (hi) 'error)) (let ((x -1)) (define (func) (with-let (inlet 'a 1) (+ 3 2 x 1))) (define (hi) (func)) (test (hi) 'error)) (let ((x -1)) (define (func) (with-let (inlet 'a 1) (abs x))) (define (hi) (func)) (test (hi) 'error)) (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (with-let (inlet 'a 1) (setter x))))) (define (hi) (func)) (test (hi) 'error)) (let ((x -1)) (define (func) (with-let (inlet 'a 1) (with-let (inlet 'b 1) (+ b 1)) (+ x 1))) (define (hi) (func)) (test (hi) 'error)) (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (+ x 1)))) (define (hi) (func)) (test (hi) 2)) (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (with-let (inlet 'b 1) (+ b 1)) (+ x 1)))) (define (hi) (func)) (test (hi) 2)) (let ((x -1)) (define (func) (with-let (inlet 'a 1) (let ((x 1)) (with-let (inlet 'b 1) (+ b 1)))) (+ x 1)) (define (hi) (func)) (test (hi) 0)) (let ((x #f)) (define (func) (do ((i 0 (+ i 1))) ((= i 1) x) (set! x (atanh (with-let (inlet 'integer? (lambda (f) #f)) (+ x 1)))))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (call-with-exit (lambda (_x_) 1 . 2))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (list (quote 1 abs) (quote 1))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (set!))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (list 1) (byte-vector 0 1 2))))) (define (hi) (func)) (test (hi) #t)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (c-pointer 1234) #i(1))))) (define (hi) (func)) (test (hi) #t)) (let () (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (let _let_ #x123.123))))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (immutable! (float-vector 0 1 2)) #_cons)))) (define (hi) (func)) (test (hi) #t)) (let () (define (func) (let ((x #f)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (let-temporarily ((x 1234)) (+ x 1)) _undef_))))) (define (hi) (func)) (test (hi) #t)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (list 1 2) and)))) (define (hi) (func)) (test (hi) #t)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (string #\c #\b) '((1 (2)) (((3) 4))))))) (define (hi) (func)) (test (hi) #t)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if 1 (* 2 x 3.0 4))))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (let _let_ #x123.123))))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (hash-table-set! (immutable! (hash-table 'a 1)) 'x 3)))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (cond (set! __var__ . #x123)))))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (if (not :readable #i()) (vector))))) (define (hi) (func)) (test (hi) 'error)) (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (truncate (min +nan.0 123)))))) (define (hi) (func)) (test (hi) 'error)) (unless with-bignums (test (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (let ((j 0)) (truncate (exp #x123.123)))))) (define (hi) (func)) (hi)) 'error) (let () (define (func) (let ((x #f) (i 0)) (do ((i 0 (+ i 1))) ((= i 1)) (let ((j 0)) (truncate (exp #x123.123)))))) (define (hi) (func)) (test (hi) 'error)) (let ((__var__ 1)) ; int matters (test (member 1 (list 3 2) (lambda (a b) (immutable? (set! __var__ pi)))) '(3 2)) (test (member 1 (list 3 2) (lambda (a b) (immutable? (set! __var__ pi)))) '(3 2)))) ; will fail if immutable not passed through by opt_set_p_d(p)_f(s) (test (let ((a 3) (b 2)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (logand (ash 1 b) a) (random 1) 123 123)))) (define (hi) (func)) (hi)) #t) (test (let ((a 3) (b 2)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ 123 (logand (ash 1 b) a) (random 1) 123)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (floor a) (random 1) 1 1)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (floor a) (round pi) 1 1 1)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) 1 1 1 1)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) (round pi) (round pi) 1)))) (define (hi) (func)) (hi)) #t) (test (let ((x 1.0)) (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ 1.0 x x x)))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) 1 (round pi) (round pi))))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (do ((j 0 (+ j 1))) ((= j 1)) (+ (round pi) (round pi) (round pi) (round pi))))) (define (hi) (func)) (hi)) #t) (test (let () (define (func) (_do1_ (char-position #\delete ims -123))) (define (hi) (func)) (hi)) 'error) (let () ; from Kjetil Matheussen, op_closure*_fx can occur if 0 args, but it goes to op_unknown_fx which needs to check for that case (define* (func1 (a1 -1)) ((lambda () 50))) (define (func2) (set! *last-func* func2)) (define *last-func* func1) ((lambda () (func2) (*last-func*)))) (let () (define (f1 in) (let loop () (let ((c (read-char in))) (cond ((eof-object? c) 'done) ((char=? c #\newline) 'done) (else (loop)))))) (test (call-with-input-string "01234" f1) 'done) (define (f2) (let ((c (read-char))) (cond ((eof-object? c) 'done) ((char=? c #\newline) 'done) (else (f2))))) (test (with-input-from-string "01234" f2) 'done)) (when with-block (test (let () (define (func) (do () ((not false) (tree-memq (values #\c 3 1.2) (vector-dimensions (block)))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (do ((x 0) (i 0 (+ i 1))) ((= i 1) x) (set! x (tree-count ((lambda (a) (values a (+ a 1))) 2) (vector-dimensions (block)))))) (define (hi) (func)) (hi)) 'error) (test (let () (define (func) (append (values "" (block)) (list :go))) (define (hi) (func)) (hi)) 'error) ; plist clobbered (test (let ((b (block 1 2 3))) (define (func) (call-with-exit (lambda (x) (x (unspecified? (c-pointer-weak1 b)))))) (func)) 'error)) (test (let () (define (func x i) (float-vector-set! x i (catch #t (lambda () (float-vector-ref x i)) (lambda args 'error)))) (define (hi) (func #r(1 2 3) 3)) (hi)) 'error) (test (let () (define (func) (undefined? (list-ref (list #f (make-iterator (list #f))) 1 ()))) (define (hi) (func)) (hi)) 'error) ; safe_c_opaaaq sc->code != code bug (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (if (eq? # (values)) (outlet "")))) (define (hi) (func)) (hi)) 'error) ; s7_is_eq b_pp_f (test (let ((__var__ -1.0)) (define (func) (do ((_i_ 0 (+ _i_ 1))) ((= _i_ 1) __var__) (set! __var__ -123))) (define (hi) (func) (func)) (hi) (hi)) -123) (test (let ((vvv (let ((v (make-vector '(2 2)))) (set! (v 0 0) "asd") (set! (v 0 1) #r(4 5 6)) (set! (v 1 0) '(1 2 3)) (set! (v 1 1) 32) v))) (define (f) (do ((i 0 (+ i 1))) ((= i 1)) (vector-set! vvv (abs x) `(x 1) '(15 26 . 36)))) (f)) 'error) (test (let () (define (func) (_do4_ (float-vector-ref #r2d((.1 .2) (.3 .4)) __var2__))) (define (hi) (func) (func)) (hi) (hi)) 'error) (test (let () (define (f) (c-pointer pi pi (values 1 2))) (f)) 'error) (num-test (let () (define (f) (+ pi pi (values 1 2))) (f)) (+ 3 (* 2 pi))) (when with-block ; block copy is technically unsafe (test (let () (define (f) (let-ref (char-ci>? (copy (block) #u()) (string #\c #\null #\b) (make-vector 3 'a symbol?)))) (f)) 'error)) (let () (define (f1) (>= +signature+ pi pi 0)) (define (f2) (float-vector-ref let-temporarily +signature+ pi #\e)) (define (f3) (* when case => #r2d((0.1 0.2) (0.3 0.4)))) (test (f1)'error) (test (f2)'error) (test (f3)'error)) (test (c-pointer-weak1 "asdf") 'error) (test (char>? #\a #f) 'error) (test (int-vector-set! '(a) 1 0) 'error) (test (vector-length 0) 'error) (test (= 1 ()) 'error) (test (string=? "asdf" 1) 'error) (test (hash-table-entries ()) 'error) (test (append #(0) pi) 'error) (test (> 0 '(1)) 'error) (test (string>? "asdf" '(1)) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (hash-table-entries x))) (f ())) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (numerator x))) (f "asdf")) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (denominator x))) (f "asdf")) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (c-pointer-weak1 x))) (f "asdf")) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (c-pointer-weak2 x))) (f "asdf")) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (car x))) (f (hash-table))) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (number->string x))) (f #f)) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (number->string 12 x))) (f 10000)) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (string->number x))) (f 123)) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (symbol->string x))) (f ())) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (iterate x))) (f ())) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (round x))) (f ())) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (cdr x))) (f :a)) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (cadr x))) (f :a)) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (cdar x))) (f :a)) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (caddr x))) (f :a)) 'error) (test (let () (define (f x) (do ((i 0 (+ i 1))) ((= i 1)) (/ 1 x))) (f 0)) 'error) (test (char=? #\a ()) 'error) (test (let () (define (f a b) (member a b)) (f 0 123.0)) 'error) (test (byte-vector-ref (random 1) (expt 2 32) '(+ x 1)) 'error) (test (memq 0 2) 'error) (test (let () (define (f x) (int-vector-ref x 0)) (f (c-pointer 1))) 'error) (test (let () (define (f x) (float-vector-ref x 0)) (f (c-pointer 1))) 'error) (test (let () (define (f x) (int-vector-ref #(0) x)) (f (c-pointer 1))) 'error) (test (- 1 #f) 'error) (test (port-position (values)) 'error) (test (= 1 "asdf") 'error) (test (else (list ())) 'error) (test (+ 1 (openlet (inlet 'a 1))) 'error) (test (byte-vector-ref (openlet (inlet 'a 1)) 0) 'error) (test (vector-set! (vector 1) () 1) 'error) (test (sort! #(1 2 3) cons) 'error) (test (* 3 (make-iterator '(1 2))) 'error) (unless with-bignums (test (random-state 123 1+i) 'error)) (test (apply abs "asdf") 'error) ;;; this is from snd-test, but hits an interesting fx_tree problem (let () (define integrate-envelope (let ((+documentation+ "(integrate-envelope env) -> area under env")) (lambda (env1) (let integrate-envelope-1 ((e env1) (sum 0.0000)) (if (or (null? e) (null? (cddr e))) sum (integrate-envelope-1 (cddr e) (+ sum (* (+ (cadr e) (cadddr e)) 0.5 (- (caddr e) (car e)))))))))) (if (not (equal? (integrate-envelope '(0 0 1 1)) 0.5)) (format *stderr* "integrate-envelope: ~A?" (integrate-envelope '(0 0 1 1))))) (test (let () (define (f a b) (+ (* (- b a) b) a)) (f 2 5)) 17) ; c_op_opssq_sq_s (let ((v (make-float-vector '(2 2) 1.0)) ; fx_c_aa_indirect (temp 0.0)) (define (f rl wr wi j) (set! temp (+ (* wr (float-vector-ref rl 1 j)) (* wi (float-vector-ref rl 0 j))))) (f v 1.0 2.0 1) (num-test (f v 1.0 2.0 1) 3.0)) (let () ; fx_s0_cdr (define (lookup key table) ; i.e. assq! (let loop ((x table)) (if (null? x) ; (and (pair? x) ... #f (let ((pair (car x))) (if (eq? (car pair) key) pair (loop (cdr x))))))) (test (lookup 'a '((b 1) (a 2))) '(a 2))) (let () ; (copy func) after func use -- clearing all opts is a problem, here OP_IF -> OP_IF_IS_TYPE needs to be reset (define h->a (let ((+documentation+ "(h->a table) returns the contents of table as an association list:\n\ (h->a (hash-table 'a 1)) -> '((a . 1))")) (lambda (table) (if (hash-table? table) (map values table) (error 'wrong-type-arg "h->a argument, ~A, is not a hash-table" table))))) (define (func) (h->a (hash-table 'a 1))) (func) (define (func1) (call-with-output-file "/dev/null" (copy h->a))) (test (func1) 'error)) ;;; clumsy test, but will hang in older s7's (define global_fi (let ((+documentation+ "docs")) (lambda (par_f lst) (do ((p lst (cdr p))) ((or (not (pair? p)) (par_f (car p))) (and (pair? p) (car p))))))) (define (par_f) (let ((items (list 1 (list 2 3 4)))) (global_fi (lambda (x) (not (or (symbol? x) (memq x '(#f #t () # # #))))) (cadr items)))) (par_f) (par_f) (let () ; from radium, opt2_sym overwrite (define (quantitize-note start end q max-length type) (define new-start (quantitize start q)) (define new-end (quantitize end q)) (if (>= new-start new-end) (set! new-end (quantitize new-end q)))) (define (roundup A) (floor (+ A 0.5))) (define (quantitize Place Q) (* (roundup (/ Place Q)) Q)) (quantitize-note 7 8 2 4194175/65534 2) (quantitize-note 7 8 2 4194175/65534 2)) ;;; check cond=>opt result (let () (define (f) (cond ((= 1 2) => (lambda (s) s)))) (test (f) #) (test (f) #)) ;;; some clm optimizer stuff (let () (define (fdo1) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (do ((j 0 (+ j 1))) ((= j 3)) (set! sum (+ sum j)))))) (let ((sum (fdo1))) (if (not (= sum 30)) (format *stderr* "fdo1: ~A~%" sum))) (define (fdo2) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (do ((j 0 (+ j 1))) ((= j 3)) (set! sum (+ sum i j)))))) (let ((sum (fdo2))) (if (not (= sum 165)) (format *stderr* "fdo2: ~A~%" sum))) (define (fdo3) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (do ((j 0 (+ j 1))) ((= j 3)) (do ((k 0 (+ k 1))) ((= k 2)) (set! sum (+ sum 1))))))) (let ((sum (fdo3))) (if (not (= sum 60)) (format *stderr* "fdo3: ~A~%" sum))) (define (fdo4) (do ((i 0 (+ i 1))) ((= i 10) i) (do ((j 0 (+ j 1))) ((= j 3))))) (let ((sum (fdo4))) (if (not (= sum 10)) (format *stderr* "fdo4: ~A~%" sum))) (define (fdo5) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (do ((j 0 (+ j 1))) ((= j 3)) (set! sum (+ sum j)) (set! sum (+ sum i)))))) (let ((sum (fdo5))) (if (not (= sum 165)) (format *stderr* "fdo5: ~A~%" sum))) (define (fdo6) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 3)) (if (zero? sum) (do ((j 0 (+ j 1))) ((= j 3)) (set! sum (+ sum j))))) sum)) (let ((sum (fdo6))) (if (not (= sum 3)) (format *stderr* "fdo6: ~A~%" sum))) (define (f1) (let ((x 0)) (do ((i 0 (+ i 1/2))) ((= i 3) x) (set! x (+ x i))))) (f1) (define (fdo7) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 3) sum) (if (zero? sum) (do ((j 0 (+ j 1))) ((= j 3)) (set! sum (+ sum j))))))) (let ((sum (fdo7))) (if (not (= sum 3)) (format *stderr* "fdo7: ~A~%" sum))) (define (fdo8) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 3) (set! sum (+ sum 1)) (* sum 2)) (if (zero? sum) (do ((j 0 (+ j 1))) ((= j 3)) (set! sum (+ sum j))))))) (let ((sum (fdo8))) (if (not (= sum 8)) (format *stderr* "fdo8: ~A~%" sum))) (define (fdo9) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 3) sum) (do () ((> (* sum 3) i)) (set! sum (+ sum 1)))))) (let ((sum (fdo9))) (if (not (= sum 1)) (format *stderr* "fdo9: ~A~%" sum))) (define (fdo10) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 3) sum) (do ((k 1)) ((> sum 3)) (set! sum (+ sum k)))))) (let ((sum (fdo10))) (if (not (= sum 4)) (format *stderr* "fdo10: ~A~%" sum))) (define (fdo11) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 3) sum) (do ((k 1 (+ k 1)) (j 2 (+ j 2))) ((> k 3)) (set! sum (+ sum k j)))))) (let ((sum (fdo11))) (if (not (= sum 54)) (format *stderr* "fdo11: ~A~%" sum))) (define (fdo12) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 3) sum) (do ((k 1 (+ k 1)) (j 2 (+ j k))) ((> k 3)) (set! sum (+ sum k j)))))) (let ((sum (fdo12))) (if (not (= sum 48)) (format *stderr* "fdo12: ~A~%" sum))) (define size 100) (define (ft1) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i 10) sum) (do ((k 0 (+ k 1))) ((= k size)) (set! sum (+ sum 1)))))) (let ((sum (ft1))) (if (not (= sum (* size 10))) (format *stderr* "ft1: ~A~%" sum))) (define (fcond1) (let ((res 0)) (do ((i 0 (+ i 1))) ((= i 1)) (cond ((zero? i) (set! res (+ i 21))) (else (set! res -1)))) res)) (let ((res (fcond1))) (if (not (= res 21)) (format *stderr* "fcond1: ~A~%" res))) (define (fcond2) (let ((res 0)) (do ((i 0 (+ i 1))) ((= i 1)) (cond ((negative? i) (set! res (+ i 21))) (else (set! res -1)))) res)) (let ((res (fcond2))) (if (not (= res -1)) (format *stderr* "fcond2: ~A~%" res))) (define (fcond3) (let ((res 0)) (do ((i 0 (+ i 1))) ((= i 1)) (cond ((negative? i) (set! res (+ i 21))) ((> i 4) (set! res 100)))) res)) (let ((res (fcond3))) (if (not (zero? res)) (format *stderr* "fcond3: ~A~%" res))) ) ;;; -------------------------------------------------------------------------------- ;;; libm (unless (provided? 'windows) (let () (require libm.scm) (when (and (defined? '*libm*) (procedure? (*libm* 'remquo))) ; ignore ancient versions of libm (with-let (sublet *libm*) ;; __DBL_DENORM_MIN__ comes from gcc ;; these tests come from the autotester (I also tried those in glibc 2-17 math/libm-test.inc) ;; just representative values -- maybe catch more possibilities? (unless (provided? 'solaris) (num-test __DBL_DENORM_MIN__ 4.9406564584125e-324) (num-test __DBL_MAX__ 1.7976931348623e+308) (num-test __DBL_MIN__ 2.2250738585072e-308) (num-test __DBL_EPSILON__ 2.2204460492503e-16) (num-test __DBL_MIN_10_EXP__ -307) (num-test __DBL_MAX_10_EXP__ 308) (num-test __DBL_DIG__ 15) (num-test __DBL_MANT_DIG__ 53) (num-test __DBL_MIN_EXP__ -1021) (num-test __DBL_MAX_EXP__ 1024) (reader-cond ((not (provided? 'openbsd)) (num-test __SIZEOF_DOUBLE__ 8))) (reader-cond ((not (provided? 'openbsd)) (num-test __SIZEOF_LONG_LONG__ 8))) (num-test __LONG_LONG_MAX__ 9223372036854775807)) (reader-cond ((provided? 'linux) (num-test FP_NAN 0) (num-test FP_INFINITE 1) (num-test FP_ZERO 2) (num-test FP_SUBNORMAL 3) (num-test FP_NORMAL 4)) ((provided? 'freebsd) (num-test FP_NAN 2) (num-test FP_INFINITE 1) (num-test FP_ZERO 16) (num-test FP_SUBNORMAL 8) (num-test FP_NORMAL 4)) ((provided? 'osx) (num-test FP_NAN 1) (num-test FP_INFINITE 2) (num-test FP_ZERO 3) (num-test FP_SUBNORMAL 5) (num-test FP_NORMAL 4))) (num-test M_E (exp 1.0)) (num-test M_LOG2E (/ (log 2))) (num-test M_LOG10E (/ (log 10))) (num-test M_LN2 (log 2)) (num-test M_LN10 (log 10)) (num-test M_PI pi) (num-test M_PI_2 (/ pi 2)) (num-test M_PI_4 (/ pi 4)) (num-test M_1_PI (/ pi)) (num-test M_2_PI (/ 2 pi)) (num-test M_2_SQRTPI (/ 2 (sqrt pi))) (num-test M_SQRT2 (sqrt 2)) (num-test M_SQRT1_2 (/ (sqrt 2))) (num-test (j0 -1) 0.76519768655797) (num-test (j0 0) 1.0) (num-test (j0 1) 0.76519768655797) (num-test (j0 1.5) 0.51182767173592) (num-test (j0 -1234567.5) -0.00056797538542782) (num-test (j0 32.75) 0.11922756341796) (num-test (j0 3) -0.26005195490193) (num-test (j0 +inf.0) 0.0) (test (nan? (j0 +nan.0)) #t) (test (catch #t (lambda () (j0 #\a)) (lambda (t i) (apply format #f i))) "(*libm* 'j0) argument, #\\a, is a character but should be a real") (num-test (j1 -42) 0.045993888221887) (num-test (j1 -1) -0.44005058574493) (num-test (j1 0) 0.0) (num-test (j1 3/4) 0.34924360217486) (num-test (j1 -63) 0.057696680293944) (num-test (j1 +inf.0) 0.0) (test (nan? (j1 +nan.0)) #t) (num-test (j1 32.75) 0.074086803054576) (num-test (j1 1.5) 0.5579365079101) (test (nan? (erf +nan.0)) #t) (num-test (erf -1) -0.84270079294971) (num-test (erf 0) 0.0) (num-test (erf 1.5) 0.96610514647531) (num-test (erf 3/4) 0.71115563365352) (num-test (erf -63) -1.0) (num-test (erf 3.1415926535898) 0.99999112385363) (num-test (erf +inf.0) 1.0) (num-test (erfc +inf.0) 0.0) (test (nan? (erfc +nan.0)) #t) (num-test (erfc 1234567.6) 0.0) (num-test (erfc 1.5) 0.033894853524689) (num-test (erfc -1.5) 1.9661051464753) (num-test (erfc 3.0) 2.2090496998585e-05) (num-test (lgamma +inf.0) +inf.0) (test (nan? (lgamma +nan.0)) #t) (num-test (lgamma 1.5) -0.12078223763525) (num-test (lgamma 3/4) 0.2032809514313) (num-test (lgamma 32.75) 80.688603510529) (num-test (lgamma -1.5) 0.86004701537648) (num-test (fabs -1) 1.0) (num-test (fabs 0) 0.0) (num-test (fabs +inf.0) +inf.0) (test (nan? (fabs +nan.0)) #t) (num-test (fabs 1234567.6) 1234567.6) (num-test (fabs -1234567.6) 1234567.6) (num-test (fabs -1.5) 1.5) (num-test (ceil -1) -1.0) (num-test (ceil 0) 0.0) (num-test (ceil +inf.0) +inf.0) (test (nan? (ceil +nan.0)) #t) (num-test (ceil 1234567.6) 1234568.0) (num-test (ceil -1234567.6) -1234567.0) (num-test (ceil 1234567.5) 1234568.0) (num-test (ceil -1234567.5) -1234567.0) (num-test (ceil 32.75) 33.0) (unless (provided? 'netbsd) (num-test (nearbyint 1.5) 2.0) (num-test (nearbyint 3/4) 1.0) (num-test (nearbyint -63) -63.0) (num-test (nearbyint +inf.0) +inf.0) (test (nan? (nearbyint +nan.0)) #t) (num-test (nearbyint 1234567.6) 1234568.0) (num-test (nearbyint 1234567.5) 1234568.0) (num-test (nearbyint -1234567.5) -1234568.0) (num-test (nearbyint 1/9223372036854775807) 0.0)) (num-test (rint +inf.0) +inf.0) (test (nan? (rint +nan.0)) #t) (num-test (rint 1234567.6) 1234568.0) (num-test (rint -1234567.6) -1234568.0) (num-test (rint 1234567.5) 1234568.0) (num-test (rint -1234567.5) -1234568.0) (num-test (rint 32.75) 33.0) (num-test (rint 1.5) 2.0) (num-test (llrint 3.1415926535898) 3) (num-test (llrint 1.5707963267949) 2) (num-test (llrint 1234567.6) 1234568) (num-test (llrint -1234567.6) -1234568) (num-test (llrint 1234567.5) 1234568) (num-test (llrint -1234567.5) -1234568) (num-test (llrint 32.75) 33) (num-test (llround 1.5) 2) (num-test (llround 3/4) 1) (num-test (llround 1234567.6) 1234568) (num-test (llround -1234567.6) -1234568) (num-test (llround 1234567.5) 1234568) (num-test (llround -1234567.5) -1234568) (num-test (llround 32.75) 33) (num-test (trunc 1.5707963267949) 1.0) (num-test (trunc +inf.0) +inf.0) (test (nan? (trunc +nan.0)) #t) (num-test (trunc 1234567.6) 1234567.0) (num-test (trunc -1234567.6) -1234567.0) (num-test (trunc 1234567.5) 1234567.0) (num-test (trunc -1234567.5) -1234567.0) (num-test (trunc 32.75) 32.0) (num-test (trunc 1.5) 1.0) (num-test (trunc -1.5) -1.0) (test (nan? (fmod +nan.0 -42.0)) #t) (num-test (fmod 3.1415926535898 3) 0.14159265358979) (num-test (fmod 32.75 -1.5) 1.25) (num-test (fmod 32.75 1.5) 1.25) (num-test (ldexp -1 6) -64.0) (num-test (ldexp 0 6) 0.0) (num-test (ldexp 6 6) 384.0) (num-test (ldexp 3.0 1) 6.0) (num-test (ldexp 6 0) 6.0) (num-test (ldexp +inf.0 -1) +inf.0) (test (nan? (ldexp +nan.0 -1)) #t) (num-test (scalbn 1.5 3) 12.0) (num-test (scalbn 3.0 6) 192.0) (num-test (scalbn 1.5 1) 3.0) (num-test (scalbn 6 -1) 3.0) (unless (provided? 'netbsd) (num-test (scalbln +inf.0 -42) +inf.0) (test (nan? (scalbln +nan.0 -42)) #t) (num-test (scalbln 3.0 3) 24.0) (num-test (scalbln 0 -42) 0.0) (num-test (scalbln -1.5 6) -96.0) (num-test (scalbln 3.0 6) 192.0) (num-test (scalbln 1 -1) 0.5) (num-test (scalbln 1.5 -1) 0.75)) (num-test (exp2 -1) 0.5) (num-test (exp2 0) 1.0) (num-test (exp2 1.5) 2.8284271247462) (num-test (exp2 3/4) 1.6817928305074) (num-test (exp2 6) 64.0) (num-test (exp2 +inf.0) +inf.0) (test (nan? (exp2 +nan.0)) #t) (num-test (expm1 +inf.0) +inf.0) (test (nan? (expm1 +nan.0)) #t) (num-test (expm1 -1) -0.63212055882856) (num-test (expm1 0) 0.0) (num-test (expm1 1) 1.718281828459) (num-test (expm1 1.5) 3.4816890703381) (num-test (expm1 3/4) 1.1170000166127) (num-test (expm1 -63) -1.0) (num-test (log10 +inf.0) +inf.0) (test (nan? (log10 +nan.0)) #t) (num-test (log10 32.75) 1.5152113043278) (num-test (log10 1.5) 0.17609125905568) (num-test (log10 1) 0.0) (num-test (log10 1234567.6) 6.0915148751535) (num-test (log1p +inf.0) +inf.0) (if (provided? 'linux) (test (nan? (log1p +nan.0)) #t)) (num-test (log1p 1234567.6) 14.02623215528) (num-test (log1p 0.0) 0.0) (num-test (log1p 1) 0.69314718055995) (num-test (log1p 1.5) 0.91629073187416) (num-test (log1p 3/4) 0.55961578793542) (num-test (log2 +inf.0) +inf.0) (test (nan? (log2 +nan.0)) #t) (num-test (log2 1234567.6) 20.235574404197) (num-test (log2 1) 0.0) (num-test (log2 32.75) 5.0334230015375) (num-test (log2 1.5) 0.58496250072116) (num-test (ilogb 3.1415926535898) 1) (num-test (ilogb 1.5707963267949) 0) (num-test (ilogb +inf.0) 2147483647) (num-test (ilogb +nan.0) (if (or (provided? 'freebsd) (provided? 'solaris)) 2147483647 -2147483648)) (num-test (ilogb 1234567.6) 20) (num-test (ilogb -1234567.6) 20) (num-test (ilogb 1) 0) (num-test (ilogb 3.0) 1) (num-test (cbrt +inf.0) +inf.0) (test (nan? (cbrt +nan.0)) #t) (num-test (cbrt 1234567.6) 107.27658956435) (num-test (cbrt -1) -1.0) (num-test (cbrt 0) 0.0) (num-test (cbrt 1) 1.0) (num-test (cbrt 1.5) 1.1447142425533) (num-test (cbrt 3.0) 1.4422495703074) (num-test (hypot 0 -42.0) 42.0) (num-test (hypot 1 3) 3.1622776601684) (num-test (hypot 1.5 3) 3.3541019662497) (num-test (hypot 3/4 3) 3.0923292192132) (num-test (hypot +inf.0 -1.5) +inf.0) (test (nan? (hypot +nan.0 -1.5)) #t) (num-test (hypot 1.5 32.75) 32.784333148625) (unless (provided? 'netbsd) (num-test (fma 3.0 3 -42.0) -33.0) (num-test (fma 6 -42 -42.0) -294.0) (num-test (fma 1.5 -42 -42.0) -105.0) (num-test (fma -1.5 -42 -42.0) 21.0) (num-test (fma 3.0 -42 -42.0) -168.0) (num-test (fma +inf.0 1.5 -42.0) +inf.0)) (test (nan? (pow +nan.0 -42.0)) #t) (num-test (pow 1 3) 1.0) (num-test (pow 1.5 3) 3.375) (num-test (pow 3/4 3) 0.421875) (num-test (pow -63 3) -250047.0) (num-test (pow 6 3) 216.0) (num-test (pow 0.0 3.0) 0.0) (num-test (fdim 1.5 -42) 43.5) (num-test (fdim -1.5 -42) 40.5) (num-test (fdim 3.0 -42) 45.0) (num-test (fdim 0 -42.0) 42.0) (test (nan? (fdim 0.0 +nan.0)) #t) (num-test (fdim 1 6) 0.0) (num-test (fdim 32.75 6) 26.75) (num-test (tgamma 1.5) 0.88622692545276) (num-test (tgamma 3/4) 1.2254167024652) (num-test (tgamma 3.1415926535898) 2.28803779534) (num-test (tgamma 1.5707963267949) 0.89056089038154) (num-test (tgamma +inf.0) +inf.0) (test (nan? (tgamma +nan.0)) #t) (num-test (tgamma -1.5) 2.3632718012074) (num-test (tgamma 3.0) 2.0) (num-test (copysign -1.5 3) 1.5) (num-test (copysign 3/4 -42.0) -0.75) (num-test (copysign +inf.0 3.0) +inf.0) (test (nan? (copysign +nan.0 3.0)) #t) (num-test (copysign 1.5 3.0) 1.5) (num-test (copysign -1.5 3.0) 1.5) (num-test (nextafter 1 -42) 1.0) (num-test (nextafter 1.5 -42) 1.5) (num-test (nextafter 3/4 -42) 0.75) (test (nan? (nextafter +nan.0 -1.5)) #t) (num-test (nextafter 0 -1.5) -4.9406564584125e-324) (num-test (nexttoward 0 -42) -4.9406564584125e-324) (num-test (nexttoward 1.5 3) 1.5) (unless (provided? 'solaris) (num-test (isfinite +inf.0) 0) (num-test (isfinite +nan.0) 0) (num-test (isfinite 1234567.6) 1) (num-test (isfinite -1234567.6) 1) (num-test (isfinite 9223372036854775807) 1) (num-test (isinf +inf.0) 1) (num-test (isinf +nan.0) 0) (num-test (isinf 1234567.6) 0) (num-test (isinf -9223372036854775807) 0) (num-test (isinf -1) 0) (num-test (isinf 0) 0) (num-test (isnan +inf.0) 0) (num-test (isnan +nan.0) 1) (num-test (isnan 1234567.6) 0) (num-test (isnormal +inf.0) 0) (num-test (isnormal +nan.0) 0) (num-test (isnormal 1234567.6) 1) (num-test (isnormal 0) 0) (num-test (isnormal 1.0e-307) 1) (num-test (isnormal 1.0e-308) 0) (num-test (isnormal 1.0e-310) 0) (num-test (isnormal 1.0e-321) 0) (when (defined? 'signbit) (num-test (signbit 1.5) 0) (num-test (signbit 0) 0) (num-test (signbit +inf.0) 0) (num-test (signbit +nan.0) 0))) (num-test (floor 1.5) 1.0) (num-test (floor 3/4) 0.0) (num-test (floor -63) -63.0) (num-test (floor +inf.0) +inf.0) (test (nan? (floor +nan.0)) #t) (num-test (floor 1234567.6) 1234567.0) (num-test (floor -1234567.6) -1234568.0) (num-test (floor 1234567.5) 1234567.0) (num-test (floor -1234567.5) -1234568.0) (num-test (floor 32.75) 32.0) (num-test (floor -1.5) -2.0) (num-test (round +inf.0) +inf.0) (test (nan? (round +nan.0)) #t) (num-test (round 1234567.6) 1234568.0) (num-test (round -1234567.6) -1234568.0) (num-test (round 1234567.5) 1234568.0) (num-test (round -1234567.5) -1234568.0) (num-test (round 32.75) 33.0) (num-test (round 1.5) 2.0) (num-test (round -1.5) -2.0) (test (nan? (remainder +nan.0 -42)) #t) (num-test (remainder 1234567.6 -42) 19.600000000093) (num-test (remainder -63 3.0) 0.0) (num-test (remainder 32.75 3.0) -0.25) (test (nan? (remainder 3.0 +nan.0)) #t) (num-test (remainder -1.5 3/4) 0.0) (num-test (exp 1.5707963267949) 4.8104773809654) (num-test (exp +inf.0) +inf.0) (test (nan? (exp +nan.0)) #t) (num-test (exp -1) 0.36787944117144) (num-test (exp 1.5) 4.4816890703381) (num-test (exp 3/4) 2.1170000166127) (num-test (log 6) 1.7917594692281) (num-test (log 3.1415926535898) 1.1447298858494) (num-test (log 1.5707963267949) 0.45158270528945) (num-test (log +inf.0) +inf.0) (test (nan? (log +nan.0)) #t) (num-test (log 1234567.6) 14.02623134528) (num-test (log 32.75) 3.4889029620813) (num-test (log 1.5) 0.40546510810816) (num-test (sqrt 0.0) 0.0) (num-test (sqrt 1) 1.0) (num-test (sqrt 1.5) 1.2247448713916) (num-test (sqrt 3/4) 0.86602540378444) (num-test (sqrt 6) 2.4494897427832) (num-test (sqrt 3.1415926535898) 1.7724538509055) (num-test (sqrt 1.5707963267949) 1.2533141373155) (num-test (sqrt +inf.0) +inf.0) (test (nan? (sqrt +nan.0)) #t) (num-test (sqrt 1234567.6) 1111.1109755555) (num-test (cos 0.0) 1.0) (num-test (cos 1) 0.54030230586814) (num-test (cos 1.5) 0.070737201667703) (num-test (cos 3/4) 0.73168886887382) (num-test (cos -63) 0.98589658158255) (num-test (cos 6) 0.96017028665037) (num-test (cos 3.1415926535898) -1.0) (num-test (cos 1.5707963267949) 6.1232339957368e-17) (test (nan? (cos +nan.0)) #t) (num-test (cos 1234567.6) -0.97435594756269) (num-test (sin 0.0) 0.0) (num-test (sin 1) 0.8414709848079) (num-test (sin 1.5) 0.99749498660405) (num-test (sin 3/4) 0.68163876002333) (num-test (sin -63) -0.16735570030281) (num-test (sin 6) -0.27941549819893) (num-test (sin 3.1415926535898) 1.2246467991474e-16) (num-test (sin 1.5707963267949) 1.0) (test (nan? (sin +nan.0)) #t) (num-test (sin 1234567.6) -0.22501219400117) (num-test (tan 0.0) 0.0) (num-test (tan 1) 1.5574077246549) (num-test (tan 1.5) 14.101419947172) (num-test (tan 3/4) 0.93159645994407) (num-test (tan -63) -0.16974975208269) (num-test (tan 6) -0.29100619138475) (num-test (tan 3.1415926535898) -1.2246467991474e-16) (test (nan? (tan +nan.0)) #t) (num-test (tan 1234567.6) 0.23093428491305) (num-test (sinh 0.0) 0.0) (num-test (sinh 1) 1.1752011936438) (num-test (sinh 1.5) 2.1292794550948) (num-test (sinh 3/4) 0.82231673193583) (num-test (sinh -63) -1.1468915797348e+27) (num-test (sinh 6) 201.71315737028) (num-test (sinh 3.1415926535898) 11.548739357258) (num-test (sinh 1.5707963267949) 2.3012989023073) (num-test (sinh +inf.0) +inf.0) (test (nan? (sinh +nan.0)) #t) (num-test (sinh 1234567.6) +inf.0) (num-test (tanh 0.0) 0.0) (num-test (tanh 1) 0.76159415595576) (num-test (tanh 1.5) 0.90514825364487) (num-test (tanh 3/4) 0.63514895238729) (num-test (tanh -63) -1.0) (num-test (tanh 6) 0.9999877116508) (num-test (tanh 3.1415926535898) 0.99627207622075) (num-test (tanh 1.5707963267949) 0.91715233566727) (num-test (tanh +inf.0) 1.0) (test (nan? (tanh +nan.0)) #t) (num-test (tanh 1234567.6) 1.0) (num-test (acos 1) 0.0) (num-test (acos 3/4) 0.72273424781342) (test (nan? (acos 1.5707963267949)) #t) (num-test (acos -1) 3.1415926535898) (num-test (acos 0) 1.5707963267949) (num-test (asin 0.0) 0.0) (num-test (asin 1) 1.5707963267949) (test (nan? (asin +inf.0)) #t) (test (nan? (asin +nan.0)) #t) (num-test (asin 3/4) 0.84806207898148) (num-test (atan 0.0) 0.0) (num-test (atan 1) 0.78539816339745) (num-test (atan 1.5) 0.98279372324733) (num-test (atan 3/4) 0.64350110879328) (num-test (atan -63) -1.5549246438031) (num-test (atan 6) 1.4056476493803) (num-test (atan 3.1415926535898) 1.2626272556789) (num-test (atan 1.5707963267949) 1.0038848218539) (num-test (atan +inf.0) 1.5707963267949) (test (nan? (atan +nan.0)) #t) (num-test (atan 1234567.6) 1.5707955167947) (test (nan? (atan2 +nan.0 3.0)) #t) (num-test (atan2 -1 3) -0.32175055439664) (num-test (atan2 -1 32.75) -0.030524866917203) (num-test (atan2 0.0 3) 0.0) (num-test (atan2 1 3) 0.32175055439664) (num-test (atan2 1.5 3) 0.46364760900081) (num-test (atan2 3/4 3) 0.24497866312686) (num-test (atan2 -63 3) -1.5232132235179) (num-test (acosh 1) 0.0) (num-test (acosh 1.5) 0.96242365011921) (num-test (acosh 6) 2.4778887302885) (num-test (acosh 3.1415926535898) 1.8115262724609) (num-test (acosh 1.5707963267949) 1.0232274785476) (num-test (acosh +inf.0) +inf.0) (test (nan? (acosh +nan.0)) #t) (num-test (acosh 1234567.6) 14.71937852584) (num-test (asinh 0.0) 0.0) (num-test (asinh 1) 0.88137358701954) (num-test (asinh 1.5) 1.1947632172871) (num-test (asinh 3/4) 0.69314718055995) (num-test (asinh -63) -4.8363448891593) (num-test (asinh 6) 2.4917798526449) (num-test (asinh 3.1415926535898) 1.8622957433108) (num-test (asinh 1.5707963267949) 1.2334031175112) (num-test (asinh +inf.0) +inf.0) (test (nan? (asinh +nan.0)) #t) (num-test (asinh 1234567.6) 14.71937852584) (num-test (atanh 0.0) 0.0) (num-test (atanh 3/4) 0.97295507452766) (test (nan? (atanh +nan.0)) #t) (when full-s7test (define (magtest) (do ((i 0 (+ i 1)) (max-diff 1.0e-13)) ((= i 100)) (let ((diff (- (magnitude (complex (exp i) (exp i))) (hypot (exp i) (exp i))))) (when (> (abs diff) max-diff) (set! max-diff (abs diff)) (format *stderr* "s7/libm: ~S ~S -> ~S~%" i (exp i) diff))))) (magtest)) (equivalent? (remquo -42.0 -42.0) '(0.0 1)) (equivalent? (remquo 1234567.5 3) '(1.5 2)) (equivalent? (remquo 3.1415926535898 3) '(0.14159265358979 1)) (equivalent? (remquo -63 3.0) '(0.0 -5)) (equivalent? (remquo 1 -1.5) '(-0.5 -1)) (equivalent? (remquo 3/4 1.5) '(0.75 0)) (equivalent? (frexp 0.0) '(0.0 0)) (equivalent? (frexp 1) '(0.5 1)) (equivalent? (frexp 1.5) '(0.75 1)) (equivalent? (frexp 3/4) '(0.75 0)) (equivalent? (frexp -63) '(-0.984375 6)) (equivalent? (frexp 6) '(0.75 3)) (equivalent? (frexp 3.1415926535898) '(0.78539816339745 2)) (equivalent? (frexp 1.5707963267949) '(0.78539816339745 1)) (equivalent? (frexp +inf.0) '(+inf.0 0)) (equivalent? (frexp +nan.0) '(+nan.0 0)) (equivalent? (frexp 1234567.6) '(0.58868770599365 21)) (test (catch #t (lambda () (modf #\a)) (lambda (t i) (apply format #f i))) "(*libm* 'modf) argument, #\\a, is a character but should be a real") (equivalent? (modf 0.0) '(0.0 0.0)) (equivalent? (modf 1) '(0.0 1.0)) (equivalent? (modf 1.5) '(0.5 1.0)) (equivalent? (modf 3/4) '(0.75 0.0)) (equivalent? (modf -63) '(0.0 -63.0)) (equivalent? (modf 6) '(0.0 6.0)) (equivalent? (modf 3.1415926535898) '(0.14159265358979 3.0)) (equivalent? (modf 1.5707963267949) '(0.5707963267949 1.0)) (equivalent? (modf +inf.0) '(0.0 +inf.0)) (equivalent? (modf +nan.0) '(+nan.0 +nan.0)) (equivalent? (modf 1234567.6) '(0.60000000009313 1234567.0)))))) ;; now check for leaks (test (defined? 'remquo) #f) (test (defined? 'M_LN2) #f) (num-test (sin 1+i) 1.298457581415977+0.6349639147847361i) (test (integer? (round 123.3)) #t) ;;; -------------------------------------------------------------------------------- ;;; libc (unless (provided? 'windows) (let () (require libc.scm) (when (and (defined? '*libc*) (procedure? (*libc* 'passwd.pw_name))) (with-let (sublet *libc*) ;(let-temporarily (((*s7* 'print-length) 3)) (test (funclet memcpy) *libc*)) ; confused by t101? (test (let ((buf (make-string 20 #\null))) (strcat buf "All ") (strcat buf "for ") (strcat buf "one.") (substring buf 0 12)) "All for one.") (test (strcmp "a" "b") -1) (test (strcmp "a" "a") 0) (test (strncmp "1234" "1235" 3) 0) (test (strcpy (make-string 3) "123") "123") (test (strlen "123") 3) (test (strchr "12345" (char->integer #\3)) "345") (test (strspn "12345" "123") 3) (test (isalpha (char->integer #\.)) 0) (test (zero? (isdigit (char->integer #\2))) #f) (test (integer->char (toupper (char->integer #\a))) #\A) (test (let ((buf (malloc 3))) (memset buf 90 3) (let ((result (c-pointer->string buf 3))) (free buf) result)) "ZZZ") (define get-environment-variable getenv) (define get-environment-variables getenvs) (define* (set-environment-variable x v (overwrite #t)) (setenv x v (if overwrite 1 0))) (define delete-environment-variable unsetenv) (define (file-exists? file) (= (access file F_OK) 0)) (define delete-file unlink) ;; system can be used as is (define* (ls dir-name (port *stderr*)) (let ((dir (opendir dir-name))) (do ((p (read_dir dir) (read_dir dir))) ((= (length p) 0)) (format port "~A " p)) (closedir dir))) (define (directory->list dir-name) (let ((lst ()) (dir (opendir dir-name))) (do ((p (read_dir dir) (read_dir dir))) ((= (length p) 0)) (if (not (member p '("." ".."))) (set! lst (cons p lst)))) ; read_dir in libc.scm returns dpos->d_name (closedir dir) lst)) (define (memory-rusage) (let ((v (rusage.make))) (getrusage RUSAGE_SELF v) (let ((mem (rusage.ru_maxrss v))) (free v) (* 1024 mem)))) (define (os-type) (car (uname))) (define (cpu-architecture) (cadr (uname))) (define (machine-name) (caddr (uname))) (define (os-version) (string-append (list-ref (uname) 3) " " (list-ref (uname) 4))) (define (implementation-name) "s7") (define (implementation-version) (substring (*s7* 'version) 3 7)) (reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris))) (define (word-size) __WORDSIZE))) (reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris))) (define (little-endian?) (= __BYTE_ORDER __LITTLE_ENDIAN)))) (define (daytime) (let ((timestr (make-string 64)) (p #f)) (let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z" (localtime (set! p (time.make (time (c-pointer 0 'time_t*)))))))) (time.free p) (substring timestr 0 len)))) (define (write-date file) (let ((buf (stat.make))) (let ((res (and (stat file buf) (stat.st_mtime buf)))) (stat.free buf) res))) (define (file-write-date->string file) (let ((timestr (make-string 64)) (p #f)) (let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z" (localtime (set! p (time.make (write-date file))))))) (time.free p) (substring timestr 0 len)))) (define (copy-file in-file out-file) (with-let (sublet *libc* (inlet 'in-file in-file 'out-file out-file)) (let ((infd (open in-file O_RDONLY 0))) (if (= infd -1) (error 'io-error "can't find ~S~%" in-file) (let ((outfd (creat out-file #o666))) (if (= outfd -1) (begin (close infd) (error 'io-error "can't open ~S~%" out-file)) (let* ((BUF_SIZE 1024) (buf (malloc BUF_SIZE))) (do ((num (read infd buf BUF_SIZE) (read infd buf BUF_SIZE))) ((or (<= num 0) (not (= (write outfd buf num) num))))) (close outfd) (close infd) (free buf) out-file))))))) (define (tty-direct) ; run in a non-GUI repl (with-let (sublet *libc*) (call-with-exit (lambda (quit) (let ((saved (termios.make)) (fn (fileno stdin))) (define (tty_reset fd) (tcsetattr fd TCSAFLUSH saved)) (define (sigcatch no) (tty_reset fn) (quit)) (if (or (equal? (signal SIGINT sigcatch) SIG_ERR) (equal? (signal SIGQUIT sigcatch) SIG_ERR) (equal? (signal SIGTERM sigcatch) SIG_ERR) (negative? (tcgetattr fn saved))) (quit)) (let ((buf (termios.make)) (c (string #\null #\null))) (let ((cc (string->c-pointer c))) (tcgetattr fn buf) (termios.set_c_lflag buf (logand (termios.c_lflag buf) (lognot (logior ECHO ICANON)))) (termios.set_c_cc buf VMIN 1) (termios.set_c_cc buf VTIME 0) (if (negative? (tcsetattr fn TCSAFLUSH buf)) (quit)) (do ((i (read fn cc 1) (read fn cc 1))) ((not (= i 1)) (tty_reset fn) (quit)) (format *stderr* "got ~C~%" (c 0)))))))))) ;; to write a directory files + file size: (test (string? (with-output-to-string (lambda () (ftw (append "/home/" username "/sf1") (lambda (a b c) (format () "~A ~A~%" a ((*libc* 'stat.st_size) b)) 0) 10)))) #t) (define (directory? file) (let ((buf (stat.make))) (let ((result (and (stat file buf) (S_ISDIR (stat.st_mode buf))))) (free buf) result))) (define* (home-directory name) (if (not name) (getenv "HOME") (passwd.pw_dir (getpwnam name)))) (define (file-length file) (let ((buf (stat.make))) (stat file buf) (let ((result (stat.st_size buf))) (free buf) result))) (define (fgrep func wildfile) (for-each (lambda (file) (call-with-input-file file (lambda (port) (do ((str (read-line port) (read-line port)) (line 1 (+ line 1))) ((eof-object? str)) (when (func str) (format *stderr* "~S[~D]: ~S~%" file line str)))))) (let ((g (glob.make))) (glob wildfile 0 g) (let ((res (glob.gl_pathv g))) (globfree g) res)))) ;; (fgrep (lambda (str) (string-position "legendre" str)) "lib*.scm") (define (system-limits) (list 'arg-max (sysconf _SC_ARG_MAX) 'login-max (sysconf _SC_LOGIN_NAME_MAX) 'open-max (sysconf _SC_OPEN_MAX) 'groups-max (sysconf _SC_NGROUPS_MAX) 'page-size (sysconf _SC_PAGESIZE))) (define (open-file filename) (catch 'io-error (lambda () (open-input-file filename)) (lambda (type info) (let ((new-filename #f) (err ((*libc* 'errno)))) (list type filename ((*libc* 'strerror) err)))))) (test (open-file "!asdf!") (list 'io-error "!asdf!" "No such file or directory")) (test (string? (getcwd (make-string 1024 #\space) 1024)) #t) (test (string? (get-environment-variable "HOME")) #t) (test (integer? (random)) #t) (test ((localeconv) 'decimal_point) ".") (test (string? (getlogin)) #t) (test (integer? (getpid)) #t) (test (integer? _POSIX_VERSION) #t) (if (provided? 'linux) (test (>= __GLIBC__ 2) #t)) ;(test (c-null? (c-pointer 0)) #t) (test (fnmatch "*.c" "s7.c" FNM_PATHNAME) 0) (test (string? (realpath "s7.c" (string))) #t) ; second arg is simply ignored (test (string? (realpath "s7.c" #f)) #t) (let ((log (getlogin))) ; this is null in an emacs shell! (when (and (string? log) (> (string-length log) 0)) (test (passwd.pw_name (getpwnam (getlogin))) (getlogin)) (test (string? (passwd.pw_shell (getpwnam (getlogin)))) #t))) (reader-cond ((not (provided? 'openbsd)) (test (string? (let ((w (wordexp.make))) (wordexp "~/cl/snd-gdraw" w 0) (let ((res (car (wordexp.we_wordv w)))) (wordfree w) (wordexp.free w) res))) #t))) (test (pair? (system-limits)) #t) (test (> (file-length "s7test.scm") 4000000) #t) (test (string? (home-directory)) #t) (test (directory? (home-directory)) #t) (test (string? (file-write-date->string "s7test.scm")) #t) (if (provided? 'linux) (test (string? (car (command-line))) #t)) (test (string? (daytime)) #t) (reader-cond ((and (not (provided? 'openbsd)) (not (provided? 'solaris))) (test (not (member (word-size) '(32 64))) #f))) (reader-cond ((provided? 'linux) (test (os-type) "Linux")) ((provided? 'osx) (test (os-type) "Darwin")) ((provided? 'freebsd) (test (os-type) "FreeBSD")) ((provided? 'netbsd) (test (os-type) "NetBSD")) ((provided? 'openbsd) (test (os-type) "OpenBSD")) ((provided? 'solaris) (test (os-type) "SunOS")) (#t (test (os-type) "Unknown"))) (test (integer? (memory-rusage)) #t) (test (file-exists? "s7test.scm") #t) (test (atoi "123") 123) (test (llabs -1234) 1234) (test (strtod "1.5") 1.5) (test CLOCKS_PER_SEC (if (provided? 'openbsd) 100 1000000)) (test (*libc* 'INT8_MIN) -128) (test (not (member (group.gr_name (getgrnam "wheel")) '("" "wheel"))) #f) (test (not (member (group.gr_name (getgrgid 0)) '("root" "wheel"))) #f) (test (not (memv (group.gr_gid (getgrnam "root")) '(0 -1))) #f) (test (let ((g (glob.make))) (glob "s7t*.scm" 0 g) (let ((res (glob.gl_pathv g))) (globfree g) (free g) res)) '("s7test.scm")) (test (fegetround) 0) (test (let* ((p (fenv_t.make)) (result (fegetenv p))) (free p) result) 0) (test (let ((file (fopen "s7test.scm" "r"))) (let ((c (getc file))) (fclose file) (integer->char c))) #\;) )))) (if (defined? '*libc*) (format *stderr* "*libc* is defined~%")) (if (equal? (arity random) '(0 . 0)) (format *stderr* "libc random is global~%")) ;;; -------------------------------------------------------------------------------- ;;; libgsl (when (or (provided? 'linux) (provided? 'osx)) (let () (require libgsl.scm) (when (and (defined? '*libgsl*) (procedure? (*libgsl* 'gsl_vector_equal))) (with-let (sublet *libgsl*) (define (eigenvalues M) (with-let (sublet *libgsl* (inlet 'M M)) (let* ((len (sqrt (length M))) (gm (gsl_matrix_alloc len len)) (m (float-vector->gsl_matrix M gm)) (evl (gsl_vector_complex_alloc len)) (evc (gsl_matrix_complex_alloc len len)) (w (gsl_eigen_nonsymmv_alloc len))) (gsl_eigen_nonsymmv m evl evc w) (gsl_eigen_nonsymmv_free w) (gsl_eigen_nonsymmv_sort evl evc GSL_EIGEN_SORT_ABS_DESC) (let ((vals (make-vector len))) (do ((i 0 (+ i 1))) ((= i len)) (set! (vals i) (gsl_vector_complex_get evl i))) (gsl_matrix_free gm) (gsl_vector_complex_free evl) (gsl_matrix_complex_free evc) vals)))) (test (eigenvalues (float-vector 3 1 1 3)) #(4.0 2.0)) (test (eigenvalues (float-vector 1 2 4 3)) #(5.0 -1.0)) (num-test GSL_CONST_CGS_LIGHT_YEAR 9.460536207070001e+17) (num-test (GSL_SIGN -123) -1) (test (GSL_IS_ODD 4) #f) (test (integer? GSL_SF_FACT_NMAX) #t) (num-test (gsl_sf_airy_Ai -500.0 GSL_MODE_DEFAULT) 0.07259012010418163) (num-test (gsl_sf_airy_Bi -500.0 GSL_MODE_DEFAULT) -0.0946885701328829) (num-test (gsl_sf_airy_Ai_scaled -5.0 GSL_MODE_DEFAULT) 0.3507610090241141) (num-test (gsl_sf_airy_Bi_scaled -5.0 GSL_MODE_DEFAULT) -0.1383691349016009) (num-test (gsl_sf_airy_Ai_deriv -5.0 GSL_MODE_DEFAULT) 0.3271928185544435) (num-test (gsl_sf_airy_Bi_deriv -5.0 GSL_MODE_DEFAULT) 0.778411773001899) (num-test (gsl_sf_airy_Ai_deriv_scaled -5.0 GSL_MODE_DEFAULT) 0.3271928185544435) (num-test (gsl_sf_airy_Bi_deriv_scaled -5.0 GSL_MODE_DEFAULT) 0.778411773001899) (num-test (gsl_sf_airy_zero_Ai_deriv 2) -3.248197582179837) (num-test (gsl_sf_airy_zero_Bi_deriv 2) -4.073155089071828) (num-test (gsl_sf_bessel_J0 1.0) 0.7651976865579666) (num-test (let ((sfr (gsl_sf_result.make))) (gsl_sf_bessel_J0_e 1.0 sfr) (let ((result (gsl_sf_result.val sfr))) (free sfr) result)) 0.7651976865579666) (num-test (let ((sfr (gsl_sf_result.make))) (gsl_sf_bessel_J0_e 1.0 sfr) (let ((result (gsl_sf_result.err sfr))) (free sfr) result)) 6.72613016567227e-16) (num-test (gsl_sf_bessel_J0 .1) 0.9975015620660401) (num-test (gsl_sf_bessel_J1 .1) 0.049937526036242) (num-test (gsl_sf_bessel_Jn 45 900.0) 0.02562434700634277) (num-test (gsl_sf_bessel_Y0 .1) -1.534238651350367) (num-test (gsl_sf_bessel_Y1 .1) -6.458951094702027) (num-test (gsl_sf_bessel_Yn 4 .1) -305832.2979335312) (num-test (gsl_sf_bessel_I0_scaled .1) 0.9071009257823011) (num-test (gsl_sf_bessel_I1_scaled .1) 0.04529844680880932) (num-test (gsl_sf_bessel_In_scaled 4 .1) 2.35752586200546e-07) (num-test (gsl_sf_bessel_I0 .1) 1.002501562934096) (num-test (gsl_sf_bessel_I1 .1) 0.05006252604709269) (num-test (gsl_sf_bessel_In 4 .1) 2.605469021299657e-07) (num-test (gsl_sf_bessel_K0_scaled .1) 2.682326102262894) (num-test (gsl_sf_bessel_K1_scaled .1) 10.8901826830497) (num-test (gsl_sf_bessel_Kn_scaled 4 .1) 530040.2483725621) (num-test (gsl_sf_bessel_K0 .1) 2.427069024702016) (num-test (gsl_sf_bessel_K1 .1) 9.853844780870606) (num-test (gsl_sf_bessel_Kn 4 .1) 479600.2497925678) (num-test (gsl_sf_bessel_j0 1.0) 0.8414709848078965) (num-test (gsl_sf_bessel_j1 1.0) 0.3011686789397567) (num-test (gsl_sf_bessel_j2 1.0) 0.06203505201137386) (num-test (gsl_sf_bessel_jl 5 1.0) 9.256115861125814e-05) (num-test (gsl_sf_bessel_zero_J0 1) 2.404825557695771) (num-test (gsl_sf_bessel_zero_Jnu 5 5) 22.21779994656127) (num-test (gsl_sf_hydrogenicR_1 3 2) 0.02575994825614847) (num-test (gsl_sf_dilog -3.0) -1.939375420766708) (let ((s1 (gsl_sf_result.make)) (s2 (gsl_sf_result.make))) (gsl_sf_complex_dilog_e 0.99999 (/ pi 2) s1 s2) (num-test (gsl_sf_result.val s1) -0.2056132926277968) (num-test (gsl_sf_result.val s2) 0.9159577401813151) (free s1) (free s2)) (let ((s1 (gsl_sf_result.make)) (s2 (gsl_sf_result.make))) (gsl_sf_complex_spence_xy_e 0.5 0.0 s1 s2) (num-test (gsl_sf_result.val s1) 0.5822405264650126) (num-test (gsl_sf_result.val s2) 0.0) (free s1) (free s2)) (num-test (gsl_sf_lngamma -0.1) 2.368961332728787) (num-test (gsl_sf_gamma 9.0) 40320.0) (num-test (gsl_sf_gammastar 9.0) 1.009298426421819) (num-test (gsl_sf_gammainv -1.0) 0.0) (let ((s1 (gsl_sf_result.make)) (s2 (gsl_sf_result.make))) (gsl_sf_lngamma_complex_e 5.0 2.0 s1 s2) (num-test (gsl_sf_result.val s1) 2.748701756133804) (num-test (gsl_sf_result.val s2) 3.073843410049702) (free s1) (free s2)) (num-test (gsl_sf_taylorcoeff 10 5) 2.691144455467373) (num-test (gsl_sf_choose 7 3) 35.0) (num-test (gsl_sf_poch 7 3) 504.0000000000001) (num-test (gsl_sf_gamma_inc_P 1.0 10.0) 0.9999546000702381) (num-test (gsl_sf_lnbeta 0.1 1.0) 2.302585092994044) (num-test (gsl_sf_beta 100.1 -1.2) 1203.895236907804) (num-test (gsl_sf_hyperg_0F1 1 0.5) 1.56608292975635) (num-test (gsl_sf_hyperg_1F1 1 1.5 1) 2.030078469278705) (num-test (gsl_sf_hyperg_U_int 100 100 1) 0.009998990209084679) (num-test (gsl_sf_hyperg_2F1 1 1 1 0.5) 2.0) (num-test (gsl_sf_legendre_P1 -0.5) -0.5) (num-test (gsl_sf_legendre_sphPlm 10 0 -0.5) -0.2433270236930014) (num-test (gsl_sf_legendre_Q0 -0.5) -0.5493061443340549) (num-test (gsl_sf_clausen (+ (* 2 pi) (/ pi 3))) 1.014941606409653) (num-test (gsl_sf_coupling_3j 0 1 1 0 1 -1) 0.7071067811865476) (num-test (gsl_sf_dawson 0.5) 0.4244363835020223) (num-test (gsl_sf_multiply -3 2) -6.0) (num-test (gsl_sf_ellint_E (/ pi 2) 0.5 GSL_MODE_DEFAULT) 1.467462209339427) (num-test (gsl_sf_erfc -10) 2.0) (num-test (gsl_sf_exp_mult 10 -2) -44052.93158961344) (num-test (gsl_sf_expm1 -.001) -0.0009995001666250082) (num-test (gsl_sf_Shi -1) -1.057250875375728) (num-test (gsl_sf_fermi_dirac_0 -1) 0.3132616875182229) (num-test (gsl_sf_gegenpoly_1 1.0 1.0) 2.0) (let ((p (float-vector 1.0 -2.0 1.0)) (res (vector 0.0 0.0))) (gsl_poly_complex_solve (wrap-double* p) 3 res) (test res #(1.0 1.0))) (let ((p (float-vector 1 -1 1 -1 1 -1 1 -1 1 -1 1))) (num-test (gsl_poly_eval (wrap-double* p) 11 1.0) 1.0)) (let ((p (float-vector 2.1 -1.34 0.76 0.45))) (num-test (gsl_poly_complex_eval (wrap-double* p) 4 0.49+0.95i) 0.3959142999999998-0.6433305000000001i)) (let ((res (float-vector 0.0 0.0))) (let ((err (gsl_poly_solve_quadratic 4.0 -20.0 26.0 (wrap-double* res)))) (test err 0))) (let ((res (float-vector 0.0 0.0))) (let ((err (gsl_poly_solve_quadratic 4.0 -20.0 21.0 (wrap-double* res)))) (test res (float-vector 1.5 3.5)))) (let ((res (float-vector 0.0 0.0 0.0))) (let ((err (gsl_poly_solve_cubic -51 867 -4913 (wrap-double* res)))) (test res (float-vector 17.0 17.0 17.0)))) (let ((res (vector 0.0 0.0))) (let ((err (gsl_poly_complex_solve_quadratic 4.0 -20.0 26.0 res))) (test res #(2.5-0.5i 2.5+0.5i)))) (let ((res (vector 0.0 0.0 0.0))) ; workspace handling is internal (let ((err (gsl_poly_complex_solve_cubic -51 867 -4913 res))) (test res #(17.0 17.0 17.0)))) (num-test (gsl_hypot3 1.0 1.0 1.0) (sqrt 3)) (num-test (gsl_hypot 1.0 1.0) (sqrt 2)) (test (nan? (gsl_nan)) #t) (test (infinite? (gsl_posinf)) #t) (test (gsl_frexp 2.0) '(0.5 2)) (num-test (gsl_pow_2 4) 16.0) (num-test (gsl_cdf_ugaussian_P 0.0) 0.5) (num-test (gsl_cdf_ugaussian_P 0.5) 0.691462461274013) (num-test (gsl_cdf_ugaussian_Q 0.5) 0.3085375387259869) (num-test (gsl_cdf_ugaussian_Pinv 0.5) 0.0) (num-test (gsl_cdf_ugaussian_Qinv 0.5) 0.0) (num-test (gsl_cdf_exponential_P 0.1 0.7) 0.1331221002498184) (num-test (gsl_cdf_exponential_Q 0.1 0.7) 0.8668778997501816) (num-test (gsl_cdf_exponential_Pinv 0.13 0.7) 0.09748344713345537) (num-test (gsl_cdf_exponential_Qinv 0.86 0.7) 0.1055760228142086) (num-test (gsl_cdf_exppow_P -0.1 0.7 1.8) 0.4205349082867516) (num-test (gsl_cdf_exppow_Q -0.1 0.7 1.8) 0.5794650917132484) (num-test (gsl_cdf_tdist_P 0.0 1.0) 0.5) (num-test (gsl_cdf_tdist_Q 0.0 1.0) 0.5) (num-test (gsl_cdf_fdist_P 0.0 1.0 1.3) 0.0) (num-test (gsl_cdf_fdist_Q 0.0 1.0 1.3) 1.0) (num-test (gsl_cdf_fdist_Pinv 0.0 1.0 1.3) 0.0) (num-test (gsl_cdf_fdist_Qinv 1.0 1.0 1.3) 0.0) (num-test (gsl_cdf_gamma_P 0 1 1) 0.0) (num-test (gsl_cdf_gamma_Q 0 1 1) 1.0) (num-test (gsl_cdf_chisq_P 0 13) 0.0) (num-test (gsl_cdf_chisq_Q 0 13) 1.0) (num-test (gsl_cdf_beta_P 0 1.2 1.3) 0.0) (num-test (gsl_cdf_beta_Q 0 1.2 1.3) 1.0) (when full-s7test ;; this is *very* slow! (let ((d (gsl_dht_new 128 1.0 1.0)) (f_in (make-float-vector 128 0.0)) (f_out (make-float-vector 128 0.0))) (do ((i 0 (+ i 1))) ((= i 128)) (let ((x (gsl_dht_x_sample d i))) (set! (f_in i) (* x (- 1.0 (* x x)))))) (gsl_dht_apply d (wrap-double* f_in) (wrap-double* f_out)) (let ((res (list (f_out 0) (f_out 5)))) (gsl_dht_free d) (num-test (res 0) 0.05727421417071144) (num-test (res 1) -0.0001908501261051786)))) (num-test (gsl_stats_mean (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 2.5) (num-test (gsl_stats_skew (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 0.0) (num-test (gsl_stats_max (wrap-double* (float-vector 1.0 2.0 3.0 4.0)) 1 4) 4.0) (let ((rng (gsl_rng_alloc gsl_rng_default))) (test (real? (gsl_ran_exponential rng 1.0)) #t) (gsl_rng_free rng)) (num-test (gsl_complex_log 1+i) (log 1+i)) (num-test (gsl_complex_abs 1+i) (magnitude 1+i)) (num-test (gsl_complex_sin 1+i) (sin 1+i)) (let ((gs (gsl_cheb_alloc 40))) (gsl_cheb_init gs (lambda (x) x) -1.0 1.0) (num-test (gsl_cheb_eval gs -1.0) -1.0) (num-test (gsl_cheb_eval gs 0.0) 0.0) (num-test (gsl_cheb_eval gs 1.0) 1.0) (gsl_cheb_free gs)) (let ((x (float-vector 0.0)) (y (float-vector 0.0))) (gsl_deriv_central (lambda (x) (expt x 1.5)) 2.0 1e-8 (wrap-double* x) (wrap-double* y)) (num-test (x 0) (* 1.5 (sqrt 2))) (gsl_deriv_forward (lambda (x) (expt x 1.5)) 0.0 1e-8 (wrap-double* x) (wrap-double* y)) (test (< (x 0) 1e-5) #t)) (let ((f (float-vector -1 3 0 4 2 6))) (gsl_sort (wrap-double* f) 1 6) (test f (float-vector -1 0 2 3 4 6))) (let ((g1 (gsl_vector_alloc 3)) (g2 (gsl_vector_alloc 3)) (f1 (make-float-vector 3))) (gsl_vector_add (float-vector->gsl_vector (float-vector 0 1 2) g1) (float-vector->gsl_vector (float-vector 3 4 5) g2)) (gsl_vector->float-vector g1 f1) (gsl_vector_free g1) (gsl_vector_free g2) (test f1 (float-vector 3 5 7))) (let ((g1 (gsl_vector_complex_alloc 3)) (g2 (gsl_vector_complex_alloc 3)) (f1 (make-complex-vector 3))) (gsl_vector_complex_add (complex-vector->gsl_vector_complex (complex-vector 0+i 1-i 2+2i) g1) (complex-vector->gsl_vector_complex (complex-vector 3-i 4+0i 5-i) g2)) (gsl_vector_complex->complex-vector g1 f1) (gsl_vector_complex_free g1) (gsl_vector_complex_free g2) (test f1 (complex-vector 3 5-i 7+i))) (let ((g1 (gsl_vector_complex_alloc 3)) (g2 (gsl_vector_complex_alloc 3)) (f1 #f)) (gsl_vector_complex_add (complex-vector->gsl_vector_complex (complex-vector 0+i 1-i 2+2i) g1) (complex-vector->gsl_vector_complex (complex-vector 3-i 4+0i 5-i) g2)) (set! f1 (gsl_vector_complex->complex-vector-wrapper g1)) ; f1 accesses g1->data directly (test f1 (complex-vector 3 5-i 7+i)) (gsl_vector_complex_free g1) (gsl_vector_complex_free g2)) (let ((f (make-float-vector '(3 3)))) (let ((g (gsl_matrix_alloc 3 3))) (gsl_matrix_set_identity g) (do ((i 0 (+ i 1))) ((= i 3) (gsl_matrix_free g)) (do ((j 0 (+ j 1))) ((= j 3)) (set! (f i j) (gsl_matrix_get g i j))))) (test (equivalent? f #2d((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))) #t)) (let ((f (make-vector '(3 3)))) (let ((g (gsl_matrix_complex_alloc 3 3))) (gsl_matrix_complex_set_identity g) (gsl_matrix_complex_scale g 1+i) (do ((i 0 (+ i 1))) ((= i 3) (gsl_matrix_complex_free g)) (do ((j 0 (+ j 1))) ((= j 3)) (set! (f i j) (gsl_matrix_complex_get g i j))))) (test (equivalent? f #2d((1+i 0.0 0.0) (0.0 1+i 0.0) (0.0 0.0 1+i))) #t)) (let ((Y (float-vector 0.554)) (A (float-vector -0.047)) (X (float-vector 0.672))) (cblas_dgemv 101 111 1 1 -0.3 (wrap-double* A) 1 (wrap-double* X) -1 -1 (wrap-double* Y) -1) (num-test (Y 0) -0.5445248)) (let ((Y (float-vector 0.348 0.07)) (A (float-vector 0.932 -0.724)) (X (float-vector 0.334 -0.317)) (alpha (float-vector 0 .1)) (beta (float-vector 1 0))) (cblas_zgemv 101 111 1 1 (wrap-double* alpha) (wrap-double* A) 1 (wrap-double* X) -1 (wrap-double* beta) (wrap-double* Y) -1) (num-test (Y 0) 0.401726) (num-test (Y 1) 0.078178)) (test (let ((f (float-vector 0 1 2 3 4))) (gsl_interp_bsearch (wrap-double* f) 1.5 0 4)) 1) (let ((x (make-float-vector 10)) (y (make-float-vector 10))) (do ((i 0 (+ i 1))) ((= i 10)) (set! (x i) (+ i (* 0.5 (sin i)))) (set! (y i) (+ i (cos (* i i))))) (let ((acc (gsl_interp_accel_alloc)) (spline (gsl_spline_alloc gsl_interp_cspline 10))) (gsl_spline_init spline (wrap-double* x) (wrap-double* y) 10) (let ((res (gsl_spline_eval spline (x 5) acc))) (gsl_spline_free spline) (gsl_interp_accel_free acc) (num-test res 5.991202811863474)))) (let ((c (gsl_combination_alloc 6 3)) (data #2d((0 1 2) (0 1 3) (0 1 4) (0 1 5) (0 2 3) (0 2 4) (0 2 5) (0 3 4) (0 3 5) (0 4 5) (1 2 3) (1 2 4) (1 2 5) (1 3 4) (1 3 5) (1 4 5) (2 3 4) (2 3 5) (2 4 5) (3 4 5))) (iv (make-int-vector 3 0))) (gsl_combination_init_first c) (do ((i 0 (+ i 1))) ((= i 20)) ((*libgsl* 'gsl_combination->int-vector) c iv) (if (not (equivalent? iv (data i))) (format *stderr* ";gsl_combination: ~A ~A~%" iv (data i))) (gsl_combination_next c)) (gsl_combination_free c)) (let ((p (gsl_permutation_alloc 3)) (data (make-int-vector 18 0))) (gsl_permutation_init p) (do ((pp GSL_SUCCESS (gsl_permutation_next p)) (i 0 (+ i 3))) ((not (= pp GSL_SUCCESS))) (set! (data i) (gsl_permutation_get p 0)) (set! (data (+ i 1)) (gsl_permutation_get p 1)) (set! (data (+ i 2)) (gsl_permutation_get p 2))) (gsl_permutation_free p) (test (equivalent? data #(0 1 2 0 2 1 1 0 2 1 2 0 2 0 1 2 1 0)) #t)) (let ((N 50)) (let ((t (make-float-vector N 0.0))) (do ((i 0 (+ i 1))) ((= i N)) (set! (t i) (/ 1.0 (* (+ i 1) (+ i 1))))) (let ((zeta_2 (/ (* pi pi) 6.0))) (let ((accel (float-vector 0.0)) (err (float-vector 0.0)) (w (gsl_sum_levin_u_alloc N))) (gsl_sum_levin_u_accel (wrap-double* t) N w (wrap-double* accel) (wrap-double* err)) (num-test zeta_2 (accel 0)) (gsl_sum_levin_u_free w))))) (let ((data (float-vector 0 0 1 0 1 1 0 -1)) ; complex data as rl+im coming and going (output (make-float-vector 8 0.0))) (gsl_dft_complex_forward (wrap-double* data) 1 4 (wrap-double* output)) ;; = -1 in snd terminology: (cfft! (vector 0 1 1+i 0-i) 4 -1): #(2.0 0-2i 0+2i -2.0) (test (equivalent? output (float-vector 2.0 0.0 0.0 -2.0 0.0 2.0 -2.0 0.0)) #t)) (let ((data (float-vector 0 0 1 0 1 1 0 -1))) ; complex data as rl+im coming and going (gsl_fft_complex_radix2_forward (wrap-double* data) 1 4) (test (equivalent? data (float-vector 2.0 0.0 0.0 -2.0 0.0 2.0 -2.0 0.0)) #t)) (let ((data (make-float-vector 256)) (w (gsl_wavelet_alloc gsl_wavelet_daubechies 4)) (work (gsl_wavelet_workspace_alloc 256))) (do ((i 0 (+ i 1))) ((= i 256)) (set! (data i) (sin (* i (/ pi 128))))) (gsl_wavelet_transform_forward w (wrap-double* data) 1 256 work) (gsl_wavelet_transform_inverse w (wrap-double* data) 1 256 work) (gsl_wavelet_free w) (gsl_wavelet_workspace_free work) data) (let ((h (gsl_histogram_alloc 10)) (data (make-int-vector 10))) (gsl_histogram_set_ranges_uniform h 0.0 1.0) (do ((i 0 (+ i 1))) ((= i 50)) (gsl_histogram_increment h (random 1.0))) (do ((i 0 (+ i 1))) ((= i 10)) (set! (data i) (round (gsl_histogram_get h i)))) (gsl_histogram_free h) data) (let ((a_data (float-vector 0.18 0.60 0.57 0.96 0.41 0.24 0.99 0.58 0.14 0.30 0.97 0.66 0.51 0.13 0.19 0.85)) (b_data (float-vector 1 2 3 4))) (let ((m (gsl_matrix_alloc 4 4)) (b (gsl_vector_alloc 4))) (let ((x (gsl_vector_alloc 4)) (p (gsl_permutation_alloc 4))) (do ((i 0 (+ i 1))) ((= i 4)) (do ((j 0 (+ j 1))) ((= j 4)) (gsl_matrix_set m i j (a_data (+ j (* i 4)))))) (do ((i 0 (+ i 1))) ((= i 4)) (gsl_vector_set b i (b_data i))) (gsl_linalg_LU_decomp m p) ; int-by-ref is internal (gsl_linalg_LU_solve m p b x) (do ((i 0 (+ i 1))) ((= i 4)) (set! (b_data i) (gsl_vector_get x i))) (gsl_permutation_free p) (gsl_vector_free x) (gsl_vector_free b) (gsl_matrix_free m) b_data))) (when (>= gsl-version 1.16) (let () (define (dofit T X y c cov) (let ((work (gsl_multifit_robust_alloc T (car (gsl_matrix_size X)) (cdr (gsl_matrix_size X))))) (let ((s (gsl_multifit_robust X y c cov work))) (gsl_multifit_robust_free work) s))) (let* ((n 30) (p 2) (a 1.45) (b 3.88) (X (gsl_matrix_alloc n p)) (x (gsl_vector_alloc n)) (y (gsl_vector_alloc n)) (c (gsl_vector_alloc p)) (c_ols (gsl_vector_alloc p)) (cov (gsl_matrix_alloc p p)) (gv (gsl_vector_alloc p)) (r (gsl_rng_alloc gsl_rng_default))) (do ((i 0 (+ i 1))) ((= i (- n 3))) (let* ((dx (/ 10.0 (- n 1.0))) (ei (gsl_rng_uniform r)) (xi (+ -5.0 (* i dx))) (yi (+ b (* a xi)))) (gsl_vector_set x i xi) (gsl_vector_set y i (+ yi ei)))) (gsl_vector_set x (- n 3) 4.7) (gsl_vector_set y (- n 3) -8.3) (gsl_vector_set x (- n 2) 3.5) (gsl_vector_set y (- n 2) -6.7) (gsl_vector_set x (- n 1) 4.1) (gsl_vector_set y (- n 1) -6.0) (do ((i 0 (+ i 1))) ((= i n)) (let ((xi (gsl_vector_get x i))) (gsl_matrix_set X i 0 1.0) (gsl_matrix_set X i 1 xi))) (dofit gsl_multifit_robust_ols X y c_ols cov) (dofit gsl_multifit_robust_bisquare X y c cov) (do ((i 0 (+ i 1))) ((= i n)) (let ((xi (gsl_vector_get x i)) (yi (gsl_vector_get y i)) (y_ols (float-vector 0.0)) (y_rob (float-vector 0.0)) (y_err (float-vector 0.0))) (gsl_vector_set gv 0 (gsl_matrix_get X i 0)) (gsl_vector_set gv 1 (gsl_matrix_get X i 1)) (gsl_multifit_robust_est gv c cov (wrap-double* y_rob) (wrap-double* y_err)) (gsl_multifit_robust_est gv c_ols cov (wrap-double* y_ols) (wrap-double* y_err)))) (gsl_matrix_free X) (gsl_matrix_free cov) (gsl_vector_free c_ols) (gsl_vector_free x) (gsl_vector_free y) (gsl_vector_free c) (gsl_vector_free gv) (gsl_rng_free r)))) (let () (gsl_rng_env_setup) (let* ((T gsl_rng_default) (r (gsl_rng_alloc T)) (x 0) (y 0) (dx (float-vector 0.0)) (dy (float-vector 0.0))) (do ((i 0 (+ i 1))) ((= i 10)) (gsl_ran_dir_2d r (wrap-double* dx) (wrap-double* dy)) (set! x (+ x (dx 0))) (set! y (+ y (dy 0)))) (gsl_rng_free r))) (let ((f_size 2) (T gsl_multimin_fminimizer_nmsimplex)) (define (simple-abs x) (let ((u (gsl_vector_get x 0)) (v (gsl_vector_get x 1))) (let ((a (- u 1)) (b (- v 2))) (+ (abs a) (abs b))))) (let ((x (gsl_vector_alloc f_size)) (step_size (gsl_vector_alloc f_size)) (s (gsl_multimin_fminimizer_alloc T 2))) (gsl_vector_set x 0 1.0) (gsl_vector_set x 1 2.0) (gsl_vector_set step_size 0 1) (gsl_vector_set step_size 1 1) (gsl_multimin_fminimizer_set s simple-abs x step_size) (do ((i 0 (+ i 1))) ((= i 10)) (gsl_multimin_fminimizer_iterate s)) (let ((result (abs (gsl_multimin_fminimizer_fval s)))) (gsl_multimin_fminimizer_free s) (gsl_vector_free x) (gsl_vector_free step_size) (num-test result 0.0)))) (let ((n 4) (x (float-vector 1970 1980 1990 2000)) (y (float-vector 12 11 14 13)) (w (float-vector 0.1 0.2 0.3 0.4)) (c0 (float-vector 0.0)) (c1 (float-vector 0.0)) (cov00 (float-vector 0.0)) (cov01 (float-vector 0.0)) (cov11 (float-vector 0.0)) (chisq (float-vector 0.0))) (gsl_fit_wlinear (wrap-double* x) 1 (wrap-double* w) 1 (wrap-double* y) 1 n (wrap-double* c0) (wrap-double* c1) (wrap-double* cov00) (wrap-double* cov01) (wrap-double* cov11) (wrap-double* chisq)) (num-test (+ (c0 0) (c1 0)) -106.54)) (let ((c (gsl_multiset_calloc 4 2))) (test (list (gsl_multiset_n c) (gsl_multiset_k c)) '(4 2)) (gsl_multiset_free c)) (let ((x (gsl_vector_alloc 2)) (factor 1.0) (T gsl_multiroot_fsolver_dnewton)) (define (rosenb x f) (let ((x0 (gsl_vector_get x 0)) (x1 (gsl_vector_get x 1))) (let ((y0 (- 1 x0)) (y1 (* 10 (- x1 (* x0 x0))))) (gsl_vector_set f 0 y0) (gsl_vector_set f 1 y1) GSL_SUCCESS))) (gsl_vector_set x 0 -1.2) (gsl_vector_set x 1 1.0) (let ((s (gsl_multiroot_fsolver_alloc T 2))) (gsl_multiroot_fsolver_set s rosenb x) (do ((i 0 (+ i 1))) ((= i 10)) (gsl_multiroot_fsolver_iterate s)) (let ((residual (abs (gsl_vector_get (gsl_multiroot_fsolver_f s) 0)))) (gsl_multiroot_fsolver_free s) (gsl_vector_free x) (test residual 0.0)))) (when full-s7test (define (magtest) (do ((i 0 (+ i 1)) (max-diff 1.0e-13)) ((= i 100)) (let ((diff (- (magnitude (complex (exp i) (exp i))) (gsl_complex_abs (complex (exp i) (exp i)))))) (when (> (abs diff) max-diff) (set! max-diff (abs diff)) (format *stderr* "s7/gsl: ~S ~S -> ~S~%" i (exp i) diff))))) (magtest)) )))) #| ;;; test of local autoload from johnm (no good way to test this here -- maybe set up a dummy library?): (autoload 'gsl_integration_qags "libgsl.scm") (autoload 'gsl_integration_workspace_alloc "libgsl.scm") (autoload 'gsl_integration_workspace_free "libgsl.scm") (autoload 'double* "libgsl.scm") (define (integrate f) (let ((workspace (gsl_integration_workspace_alloc 1000))) (gsl_integration_workspace_free workspace))) (define (f x) (/ (log x) (sqrt x))) (test (integrate f) #) (test (integrate f) #) ; this call is not redundant |# (test (defined? 'CLOCKS_PER_SEC (rootlet)) #f) ; autoloader can cause endless confusion here! ;;; -------------------------------------------------------------------------------- ;;; libgdbm (when (and (provided? 'linux) (provided? 'system-extras) (or (file-exists? "/usr/local/lib/libgdbm.a") (file-exists? "/usr/lib/x86_64-linux-gnu/libgdbm.a"))) (let () (require libgdbm.scm) (when (and (defined? '*libgdbm*) (procedure? (*libgdbm* 'gdbm_store))) (with-let (sublet *libgdbm*) (let ((gfile (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664 (lambda (str) (format *stderr* "str: ~S~%" str))))) (gdbm_store gfile "1" "1234" GDBM_REPLACE) (gdbm_fetch gfile "1") (gdbm_close gfile)) (define *db* (openlet (inlet :file (gdbm_open "test.gdbm" 1024 GDBM_NEWDB #o664 (lambda (str) (format *stderr* "gdbm error: ~S~%" str))) :let-ref-fallback (lambda (obj sym) (with-input-from-string (gdbm_fetch (obj 'file) (symbol->string sym)) (lambda () (eval (read))))) :let-set-fallback (lambda (obj sym val) (gdbm_store (obj 'file) (symbol->string sym) (object->string val :readable) GDBM_REPLACE) val) :make-iterator (lambda (obj) (let ((key #f) (length (lambda (obj) (expt 2 20)))) (#_make-iterator (openlet (let ((+iterator+ #t)) (lambda () (if key (set! key (gdbm_nextkey (obj 'file) (cdr key))) (set! key (gdbm_firstkey (obj 'file)))) (if (pair? key) (cons (string->symbol (car key)) (with-input-from-string (gdbm_fetch (obj 'file) (car key)) (lambda () (eval (read))))) key)))))))))) (set! (*db* 'str) "123") ; add a variable named 'str with the value "123" (test (*db* 'str) "123") (set! (*db* 'int) 432) (test (*db* 'int) 432) (test (with-let *db* (+ int (length str))) 435) (test (let ((lst (map values *db*))) (or (equal? lst '((str . "123") (int . 432))) (equal? lst '((int . 432) (str . "123"))))) #t) (gdbm_close (*db* 'file)))))) ;;; -------------------------------------------------------------------------------- ;;; libutf8proc (now moved to utf8-tests.scm) (when (and full-s7test (provided? 'system-extras) (not (provided? 'osx)) (file-exists? "utf8-tests.scm")) (load "utf8-tests.scm")) ;;; -------------------------------------------------------------------------------- (test (procedure? (symbol->value-anywhere 'getchar)) #t) (test (integer? (symbol->value-anywhere 'GSL_SUCCESS)) #t) (test (integer? (symbol->value-anywhere 'most-positive-fixnum)) #t) (test (let? (cdr (assoc "libc.scm" *libraries*))) #t) ;;; regex (let () (require libc.scm) (test (with-let (sublet *libc*) (define rg (regex.make)) (regcomp rg "a.b" 0) (let ((res (regexec rg "acb" 0 0))) ; 0 = match (regfree rg) (regex.free rg) res)) 0) (unless (provided? 'osx) (test (with-let (sublet *libc*) (define rg (regex.make)) (let ((res (regcomp rg "colou\\?r" 0))) (if (not (zero? res)) (error 'regex-error "~S: ~S~%" "colou\\?r" (regerror res rg))) (set! res (regexec rg "The color green" 1 0)) (if (and (integer? res) (not (zero? res))) (error 'regex-error "~S: ~S~%" "colou\\?r" (regerror res rg))) (regfree rg) (regex.free rg) res)) #i(4 9)) (test (with-let (sublet *libc*) (define rg (regex.make)) (let ((res (regcomp rg "\\(ba\\(na\\)*s \\|nefer\\(ti\\)* \\)*" 0))) (if (not (zero? res)) (error 'regex-error "~S~%" (regerror res rg))) (set! res (regexec rg "bananas nefertiti" 3 0)) (if (and (integer? res) (not (zero? res))) (error 'regex-error "~S~%" (regerror res rg))) (regfree rg) (regex.free rg) res)) #i(0 8 0 8 4 6))) (test (procedure? (*libc* 'memcpy)) #t) (test ((rootlet) 'memcpy) #) (test (with-let (rootlet) memcpy) 'error) (test (procedure? (with-let *libc* memcpy)) #t)) ;;; -------------------------------- case.scm -------------------------------- (let () (require case.scm) (define (scase x) (case* x ((a b) 'a-or-b) ((1 2/3 3.0) => (lambda (a) (* a 2))) ((pi) 1 123) (("string1" "string2")) ((#) 'symbol!) (((+ x #)) 'got-list) ((#(1 x 3)) 'got-vector) (((+ #<>)) 'empty) (((* # #)) 'got-label) (((#<> # #)) 'repeated) (((# #)) 'two) (((# #)) 'pair) ((#(# #)) 'vector) ((#(# #<...> #)) 'vectsn) ((#(#<...> #)) 'vectstart) ((#(# # #<...>)) 'vectstr) (else 'oops))) (test (scase 3.0) 6.0) (test (scase 'pi) 123) (test (scase "string1") "string1") (test (scase "string3") 'oops) (test (scase 'a) 'a-or-b) (test (scase 'abc) 'symbol!) (test (scase #()) 'oops) (test (scase '(+ x z)) 'got-list) (test (scase #(1 x 3)) 'got-vector) (test (scase '(+ x 3)) 'oops) (test (scase '(+ x)) 'empty) (test (scase '(* z z)) 'got-label) (test (scase '(* z x)) 'oops) (test (scase '(+ (abs x) (abs x))) 'repeated) (test (scase '(+ (abs x) (abs y))) 'oops) (test (scase '(a b)) 'two) (test (scase '(1 1)) 'pair) (test (scase '(1 1 2)) 'oops) (test (scase #(1 1)) 'vector) (test (scase #(a b c 3)) 'vectsn) (test (scase #(1 b 2)) 'vectstart) (test (scase #("asdf" #\space +nan.0 #)) 'vectstr) (test (scase #(a 3)) 'vectsn) (test (scase #(1)) 'vectstart) (test (scase #("asdf" #\space)) 'vectstr) (test (scase #("asdf")) 'oops) (define (scase5 x) (case* x (((# #<...> #)) 'ok))) (test (scase5 '(a)) #) (let ((local-func (lambda (key) (eqv? key 1)))) (define (scase1 x) (case* x ((2 3 a) 'oops) ((#) 'yup))) (test (scase1 2) 'oops) (test (scase1 32) #) (test (scase1 1) 'yup)) (define scase2 (let ((local-func (lambda (key) (eqv? key 1)))) (lambda (x) (case* x ((2 3 a) 'oops) ((#) 'yup))))) (test (scase2 2) 'oops) (test (scase2 32) #) (test (scase2 1) 'yup) (define (scase3 x) (let ((local-func (lambda (key) (eqv? key 1)))) (case* x ((2 3 a) 'oops) ((#) 'yup)))) (test (scase3 2) 'oops) (test (scase3 32) #) (test (scase3 1) 'yup) (define (scase4 x) (let ((local-func (lambda (key) (eqv? key 1)))) (case* x ((2 3 a) 'oops) ((# #<...> #)) 'both-symbol) (((# #<...>)) 'car-symbol) (((#<...> # #)) 'two-symbols) (((#<...> #)) 'end-symbol) (else #f))) (test (ecase '(a b 1)) 'car-symbol) (test (ecase '(1 2 c)) 'end-symbol) (test (ecase '(a 1 2 3 c)) 'both-symbol) (test (ecase '(1 2 3 b c)) 'two-symbols) (define (scase6 x) (case* x (((# # #<...>)) 'ok) (else 'oops))) (test (scase6 '(a a)) 'ok) (define (scase7 x) (case* x (((#<...> # #)) 'ok) (else 'oops))) (test (scase7 '(a a)) 'ok) (define (scase8 x) (case* x (((# #<...> #)) 'ok) (else 'oops))) (test (scase8 '(a a)) 'ok) (define (scase10 x) (case* x ((#) 1) (else 'oops))) (test (scase10 1) 'oops) (define (scase11 x) (case* x ((#<...>) 1) (else 'oops))) (test (scase11 1) 'oops) (define (scase12 x) (case* x (((# #)) 1) (else 'oops))) (test (catch #t (lambda () (scase12 '(1 2))) (lambda (type info) type)) 'unbound-variable) (define (scase13 x) (case* x ((#<>) 'ok) ; matches anything! as does # (else 'oops))) (test (scase13 '(a a)) 'ok) (test (scase13 1+i) 'ok) (test (scase13 #(1 2 3)) 'ok) (define (scase14 x) (case* x (((# #)) 1) (else 'oops))) (test (catch #t (lambda () (scase14 '(1 1))) (lambda (type info) type)) 'syntax-error) ; duplicate identifier currently uses this error type (define uniquify (let () (define (uniq-1 lst new-lst) (case* lst ((()) (reverse new-lst)) (((#<>)) (reverse (cons (car lst) new-lst))) (((# # #<...>)) (uniq-1 (cdr lst) new-lst)) (else (uniq-1 (cdr lst) (cons (car lst) new-lst))))) (lambda (lst) (uniq-1 lst ())))) (test (uniquify '(a a b b b b a a c c)) '(a b a c)) (test (uniquify '((+ a 1) (+ a 1) (* b 2) (* b 2) c a a)) '((+ a 1) (* b 2) c a)) (test (uniquify '(a b b c)) '(a b c)) (test (uniquify '(a)) '(a)) (test (uniquify ()) ()) (let ((x '(+ 2 3))) (test (case* x (((+ #<> #<>)) (apply + (cdr x))) (else (error 'out-of-range "unimplemented"))) 5)) (test (case* '(a b a) (((# #)) #)) '(a b)) (test (case* '(a) (((# #)) #)) ()) (test (case* '(a b) (((# #)) #)) '(a)) (test (case* '(a b a) (((# #)) #)) '(b a)) (test (case* '(a) (((# #)) #)) ()) (test (case* '(a b) (((# #)) #)) '(b)) (test (case* '(a b a) (((# # #)) #)) '(b)) (test (case* '(a a) (((# # #)) #)) ()) (test (case* '(a b c a) (((# # #)) #)) '(b c)) (test (case* #(a b a) ((#(# #)) #)) '(a b)) (test (case* #(a) ((#(# #)) #)) ()) (test (case* #(a b) ((#(# #)) #)) '(a)) (test (case* #(a b a) ((#(# #)) #)) '(b a)) (test (case* #(a) ((#(# #)) #)) ()) (test (case* #(a b) ((#(# #)) #)) '(b)) (test (case* #(a b a) ((#(# # #)) #)) '(b)) (test (case* #(a a) ((#(# # #)) #)) ()) (test (case* #(a b c a) ((#(# # #)) #)) '(b c)) (define (palindrome? x) ; x can be a list or a vector (case* x ((() (#<>) #() #(#<>)) #t) (((# # #) #(# # #)) (palindrome? #)) (else #f))) (test (palindrome? '(a b a)) #t) (test (palindrome? '(a b c a)) #f) (test (palindrome? '(a b c b a)) #t) (test (palindrome? '(a)) #t) (test (palindrome? ()) #t) (test (palindrome? #(a b a)) #t) (test (palindrome? #(a b c a)) #f) (test (palindrome? #(a b c b a)) #t) (test (palindrome? #(a)) #t) (test (palindrome? #()) #t) (define (scase15 x) (case* x (((+ # #)) (* 2 #)) (((# #)) (list # #)) (else 'oops))) (test (scase15 '(1 2)) '(2 1)) (test (scase15 '(+ 1 1)) 2) (test (scase15 '(+ (* 2 3) (* 2 3))) 12) (define (scase16 x) (case* x (((+ (* # 2) 3)) 0) (else 1))) (test (scase16 '(+ (* y 2) 3)) 0) (test (scase16 '(+ (* y 1) 3)) 1) (define (scase17 x) (let ((a1 3)) (case* x (((+ # (* # 2))) (+ # (* # 2))) (else 'oops)))) (test (scase17 '(+ a1 (* 5 2))) 11) (let ((a1 3)) (define (scase18 x) (case* x (((+ # (* # 2))) (quote (+ # (* # 2)))) (else 'oops))) (test (eval (scase18 '(+ a1 (* 5 2)))) 11)) (define (scase19 x) (case* x (((# . #)) 'ok) (else #f))) (test (scase19 (cons 1 'a)) 'ok) (test (scase19 (list 1 'a)) #f) (define (scase20 x) (case* x ((#(+ (* # 2) 3)) 0) (else 1))) (test (scase20 #(+ (* y 2) 3)) 0) (test (scase20 #(+ (* y 1) 3)) 1) (define (scase21 x) (let ((pair2? (lambda (p) (= (length p) 2)))) (case* x (((+ # 3)) #t) (else #f)))) (test (scase21 '(+ (abs x) 3)) #t) (test (scase21 '(+ (* 2 x) 3)) #f) (define (scase22 x) (letrec ((symbols? (lambda (x) (or (null? x) (and (pair? x) (symbol? (car x)) (symbols? (cdr x))))))) (case* x ((#) #t) (else #f)))) (test (scase22 '(+ a b c)) #t) (test (scase22 '(+ a b 3))#f) (define (scase23 x) (let ((numeric-op? (lambda (x) (let ((func (symbol->value x))) (and (signature func) (memq (car (signature func)) '(number? complex? real? float? rational? integer? byte?))))))) (case* x (((# #) (# # #)) #t) (else #f)))) (test (scase23 '(+ 1 2)) #t) (test (scase23 '(floor 32.1)) #t) (test (scase23 '(abs)) #f) (define (case-reverse x) ; maybe the least efficient reverse ever (case* x (((#<>) ()) x) (((# #)) (append (case-reverse #) (list (quote #)))))) (test (case-reverse '(a b c)) '(c b a)) (test (case-reverse '(a b)) '(b a)) (define (scase24 x) (case* x (((+ #)) (+ (apply values #))) (else 'oops))) (test (scase24 '(+ 1 2 3)) 6) (test (let ((a 1) (b 2) (c 3)) (scase24 `(+ ,a ,b ,c))) 6) (define (scase25 x) (case* x (((# # (+ #))) (append # #)) (else #f))) (test (scase25 '(a b c d (+ 1 2))) '(b c d 1 2)) (define (scase26 x) (case* x (((if (not #) (begin #))) (cons 'unless (cons '# #))) (((if (not #) #)) (cons 'unless (list '# '#))) (((if # (begin #))) (cons 'when (cons '# #))) (((if # #)) (cons 'when (list '# '#))))) (test (scase26 '(if (not (> i 3)) (display i))) '(unless (> i 3) (display i))) (test (scase26 '(if (not (> i 3)) (begin (display i) (newline)))) '(unless (> i 3) (display i) (newline))) (test (scase26 '(if (> i 3) (display i))) '(when (> i 3) (display i))) (test (scase26 '(if (> i 3) (begin (display i) (newline)))) '(when (> i 3) (display i) (newline))) (define (scase27 x) (let ((efunc? (lambda (x) (and (pair? x) (number? (car x)))))) (case* x (((#)) #t) (else #f)))) (test (scase27 '(1 2 3)) #t) (test (scase27 '(a 2 3)) #f) (test (scase27 '(3)) #t) (test (scase27 ()) #f) (define (scase29 x) (let ((match? ((funclet 'case*) 'case*-match?))) (let ((multiplier? (lambda (x) (or (match? x '(* 1 #)) (match? x '(* 2 #)))))) (case* x (((+ # # #)) #t) (else #f))))) (test (scase29 '(+ 1 (* 1 2) 3)) #t) (test (scase29 '(+ 1 (* 3 2) 3)) #f) (define (scase30 x) (let ((match? ((funclet 'case*) 'case*-match?))) (match? x '(+ # 1)))) (test (scase30 '(+ a 1)) #t) (test (scase30 '(+ 1 1)) #f) (define* (scase31 x (e (curlet))) (let ((match? ((funclet 'case*) 'case*-match?)) (labels ((funclet 'case*) 'case*-labels))) (and (match? x '(# # (+ #))) (append (cadr (labels 'ellip1)) (cadr (labels 'ellip2)))))) (test (scase31 '(a b c d (+ 1 2))) '(b c d 1 2)) (define (scase32 x) (let ((match? ((funclet 'case*) 'case*-match?)) (labels ((funclet 'case*) 'case*-labels))) (if (match? x '(if # (begin #))) (cons 'when (cons (labels 'test) (cadr (labels 'body))))))) (test (scase32 '(if (> i 3) (begin (display i) (newline)))) '(when (> i 3) (display i) (newline))) (test (scase32 '(if 32/15 (begin (display i) (newline)))) '(when 32/15 (display i) (newline))) (test (let ((match? ((funclet 'case*) 'case*-match?))) (match? (make-list 256 1) (let ((<1> (list #f))) (set-cdr! <1> <1>) (let (( (list #f #f))) (set-cdr! (cdr ) <1>) )))) 'error) ; cyclic pattern (define (scase33 x) (case* x ((#<"a.b">) #t) (else #f))) (test (scase33 "a1b") #t) (test (scase33 "abc") #f) (test (scase33 "a123b") #f) (test (scase33 'a1b) #f) (define (scase34 x) (case* x ((#) #) (else #f))) (test (scase34 "a1b") "a1b") (define (scase35 x) (let ((quotes? (lambda (x) (char-position #\" x)))) (case* x ((#<"^dog">) 'dog0) ((#<"gray\|grey">) 'graey) ; basic regex so it needs \ ((#<"h\(a\|e\)y">) 'haey) ((#<"p[ae]y">) 'paey) ((#<"b[aeiou]bble">) 'bxbble) ((#<"z\{3,6\}">) 'zzz) ((#<"\d">) 'digit) ((#<"<>">) 'brackets) ((#) 'quotes) ((#<"[^i*&2@]">) 'not-i) (else #f)))) (test (scase35 "dog") 'dog0) (test (scase35 "i7+") 'not-i) (unless (provided? 'osx) (test (scase35 "gray") 'graey) (test (scase35 "hay") 'haey)) (test (scase35 "pay") 'paey) (test (scase35 "bubble") 'bxbble) (test (scase35 "ab0d") 'digit) (test (scase35 "+-<>-+") 'brackets) (test (scase35 "zzzz") 'zzz) (test (scase35 (string #\a #\")) 'quotes) (define (scase36 x) (case* x (((equal? # #)) #t) (else #f))) (test (scase36 '(equal? "a1b" "a1b")) #t) (test (scase36 '(equal? "a1b" "a2b")) #f) (define match-lambda (let* ((match? ((funclet 'case*) 'case*-match?)) (labels ((funclet 'case*) 'case*-labels)) (match-lambda-helper (lambda (arg) (cond ((null? arg) ()) ((match? arg '(+ # (+ #))) (apply + (labels 'a) (cadr (labels 'b)))) ((match? arg '(+ #<> #<>)) (apply + (cdr arg))) (else #f))))) (macro (arg) `(((funclet 'match-lambda) 'match-lambda-helper) ',arg)))) (test (match-lambda ()) ()) (test (match-lambda (+ 1 2)) 3) (test (match-lambda (+ 1 (+ 2 3))) 6) (define match+ (let* ((match? ((funclet 'case*) 'case*-match?)) (labels ((funclet 'case*) 'case*-labels))) (macro (arg) (cond ((null? arg) ()) ((match? arg '(+ # (+ #))) `(+ ,(labels 'a) ,@(cadr (labels 'b)))) ((match? arg '(+ #<> #<>)) `(+ ,@(cdr arg))) (else #f))))) (test (match+ ()) ()) (test (match+ (+ 1 2)) 3) (test (match+ (+ 1 (+ 2 3))) 6) (define (scase37 x) (case* x ((#) 'undef) ((#) 'unspec) ((#<...>) 'ellipsis) (((# 3)) '(label3 #)) ((#) '(alabel #)) (else #f))) (test (scase37 #) 'undef) (test (scase37 #) 'unspec) (test (scase37 #) '(alabel #)) (test (scase37 #) '(alabel #)) (test (scase37 #<...>) 'ellipsis) (test (scase37 '(# 3)) '(label3 #)) (test (scase37 '(#<> 3)) '(label3 #<>)) (define (hlt x) (case* (with-input-from-string (object->string x) read) (((hash-table 'a #)) 'hash-table) (((inlet 'a #)) 'inlet) (else #f))) (test (hlt (inlet 'a 1)) 'inlet) (test (hlt (hash-table 'a 1)) 'hash-table) (test (case* 32 ((1 2) 3)) #) (test (case* 32 ((a 32))) 32) (test (case* 32 ((1 32) => (lambda (x) (+ x 1)))) 33) (define (fcase1 x) (case* x ((#) "0") ((#) (case* x ((1) "1") ((#) "-") ((#) "+") (else "oops"))) (else "?"))) (test (fcase1 0) "0") (test (fcase1 1) "1") (test (fcase1 2) "+") (test (fcase1 -1) "-") (test (fcase1 1+i) "?") (define fcase2 (let () (define (is-zero x) (zero? x)) (define (is-integer x) (case* x ((1) "1") ((#) "-") ((#) "+") (else "oops"))) (lambda (x) (case* x ((#) "0") ((#) (is-integer x)) (else "?"))))) (test (fcase2 0) "0") (test (fcase2 1) "1") (test (fcase2 2) "+") (test (fcase2 -1) "-") (test (fcase2 1+i) "?") ) ;;; -------------------------------------------------------------------------------- (set! (*s7* 'print-length) 1024) (define need-lint-line-numbers #f) ;(let () (require lint.scm) (set! *report-repeated-code-fragments* #f) (set! *report-combinable-lets* #t) (set! *report-splittable-lets* #t) (set! (setter /) #f) ; clear stuff from above (define lint-test (letrec ((no-lines (lambda (s) (let* ((pos (string-position "(line " s)) (epos (and pos (string-position "): " s (+ pos 1))))) ; might be "):" unrelated to (line...)! (if (and pos epos) (no-lines (string-append (substring s 0 (- pos 1)) (substring s (+ epos 1)))) ; sometimes there are two "(line ...)" intrusions s))))) (lambda (str1 str2) ;(format *stderr* "str1: ~A~%" str1) (let ((result (call-with-output-string (lambda (op) (call-with-input-string str1 (lambda (ip) (lint ip op))))))) (unless (string-wi=? result str2) (set! result (no-lines result)) (unless (string-wi=? result str2) (format *stderr* ";~D (lint ~S) ->~% ~S~% ~S~%~%" (port-line-number) str1 str2 result))))))) (lint-test "(+ 1 2)" " +: perhaps (+ 1 2) -> 3") (lint-test "(+ 1 (+ 2 3))" " +: perhaps (+ 1 (+ 2 3)) -> 6") (lint-test "(+ 1 (+ x 3))" " +: perhaps (+ 1 (+ x 3)) -> (+ 4 x)") (lint-test "(+ x)" " +: perhaps (+ x) -> x") (lint-test "(+ (+ (+ x 2) 3) 4)" " +: perhaps (+ (+ (+ x 2) 3) 4) -> (+ 9 x)") (lint-test "(+ 1 2 x -3)" " +: perhaps (+ 1 2 x -3) -> x") (lint-test "(+ 1/2 -1/2)" " +: perhaps (+ 1/2 -1/2) -> 0") (lint-test "(+ 1/3 2/3)" " +: perhaps (+ 1/3 2/3) -> 1") (lint-test "(+ (log x) (log 3))" " +: perhaps (+ (log x) (log 3)) -> (log (* x 3))") (lint-test "(+ x 0 (+ 0 0))" " +: perhaps (+ x 0 (+ 0 0)) -> x") (lint-test "(+ x #(a))" " +: in (+ x #(a)), +'s second argument should be a number, but #(a) is a vector?") (lint-test "(+ x 2.0 -2)" " +: perhaps (+ x 2.0 -2) -> (inexact (* x 1))") (lint-test "(+ x (+ y z) (+ a b))" " +: perhaps (+ x (+ y z) (+ a b)) -> (+ x y z a b)") (lint-test "(+ (- x) y)" " +: perhaps (+ (- x) y) -> (- y x)") (lint-test "(+ x (- y))" " +: perhaps (+ x (- y)) -> (- x y)") (lint-test "(+ x (+ y 2) (+ z 3))" " +: perhaps (+ x (+ y 2) (+ z 3)) -> (+ 5 x y z)") (lint-test "(+ 1 (* 2 (+ x)) (+ y z))" " +: perhaps (+ 1 (* 2 (+ x)) (+ y z)) -> (+ 1 (* 2 x) y z)") (lint-test "(+ x (- y) (- a b) w)" " +: perhaps (+ x (- y) (- a b) w) -> (- (+ w a x) y b)") (lint-test "(+ x (- 1))" " +: perhaps (+ x (- 1)) -> (- x 1)") (lint-test "(+ -1 x)" " +: perhaps (+ -1 x) -> (- x 1)") (lint-test "(+ x -1)" " +: perhaps (+ x -1) -> (- x 1)") (lint-test "(+ (/ a b) (/ c b))" " +: perhaps (+ (/ a b) (/ c b)) -> (/ (+ a c) b)") (lint-test "(+ (/ a b d) (/ c b d))" " +: perhaps (+ (/ a b d) (/ c b d)) -> (/ (+ a c) b d)") (lint-test "(+ (* a b) (* c a))" " +: perhaps (+ (* a b) (* c a)) -> (* a (+ b c))") (lint-test "(+ x (- (+ y z) w))" " +: perhaps (+ x (- (+ y z) w)) -> (- (+ z y x) w)") (lint-test "(+ (- (+ y z) w v) x)" " +: perhaps (+ (- (+ y z) w v) x) -> (- (+ x y z) w v)") (lint-test "(+ (- (+ a b) c d e) (- (+ y z) w v))" " +: perhaps (+ (- (+ a b) c d e) (- (+ y z) w v)) -> (- (+ y z a b) c d e w v)") (lint-test "(+ x (- (+ y z) w) v)" " +: perhaps (+ x (- (+ y z) w) v) -> (- (+ v z y x) w)") (lint-test "(+ (- x) (- y))" " +: perhaps (+ (- x) (- y)) -> (- (+ x y))") (lint-test "(+ (- x) (- y) (- z))" " +: perhaps (+ (- x) (- y) (- z)) -> (- (+ x y z))") (lint-test "(+ (- x) (- y z))" " +: perhaps (+ (- x) (- y z)) -> (- y x z)") (lint-test "(+ (- x) (- x z))" " +: perhaps (+ (- x) (- x z)) -> (- z)") (lint-test "(+ (- x z) (- y))" " +: perhaps (+ (- x z) (- y)) -> (- x z y)") (lint-test "(+ (- y z) (- y))" " +: perhaps (+ (- y z) (- y)) -> (- z)") (lint-test "(+ (- x 1) 1000)" " +: perhaps (+ (- x 1) 1000) -> (+ x 999)") (lint-test "(+ (- 1 x) 1000)" " +: perhaps (+ (- 1 x) 1000) -> (- 1001 x)") (lint-test "(+ (- x y 1) 2 z)" " +: perhaps (+ (- x y 1) 2 z) -> (- (+ x z 1) y)") (lint-test "(+ (- x 1) (- 1 x) 2)" " +: perhaps (+ (- x 1) (- 1 x) 2) -> 2") (lint-test "(+ (- x 1) x)" "") (lint-test "(+ (- x 1) (- 1 x))" " +: perhaps (+ (- x 1) (- 1 x)) -> 0") (lint-test "(+ (- x y z) (- z y x))" " +: perhaps (+ (- x y z) (- z y x)) -> (- (+ y y))") (lint-test "(+ (- 0 x y) x y z)" " +: perhaps (+ (- 0 x y) x y z) -> z") (lint-test "(+ (- 1 x y) x y z)" " +: perhaps (+ (- 1 x y) x y z) -> (+ z 1)") (lint-test "(+ -1 (- x y))" " +: perhaps (+ -1 (- x y)) -> (- x y 1)") (lint-test "(+ (- x) -1)" " +: perhaps (+ (- x) -1) -> (- -1 x)") (lint-test "(+ (- -1 x) (- y -1))" " +: perhaps (+ (- -1 x) (- y -1)) -> (- y x)") (lint-test "(+ (- -1 x) (- -1 y))" " +: perhaps (+ (- -1 x) (- -1 y)) -> (- -2 x y)") (lint-test "(+ (- x 2) (- 1 y 3 4))" " +: perhaps (+ (- x 2) (- 1 y 3 4)) -> (- x y 8)") (lint-test "(+ (- x (random y)) (random y))" "") (lint-test "(+ (- x (abs y)) (abs y))" " +: perhaps (+ (- x (abs y)) (abs y)) -> x") (lint-test "(+ (* a b) (* b c))" " +: perhaps (+ (* a b) (* b c)) -> (* b (+ a c))") (lint-test "(+ (* a b b) (* b c))" " +: perhaps (+ (* a b b) (* b c)) -> (* b (+ (* a b) c))") (lint-test "(+ (* a b c) (* b c))" " +: perhaps (+ (* a b c) (* b c)) -> (* b c (+ a 1))") (lint-test "(+ (* a b) (* a b c d))" " +: perhaps (+ (* a b) (* a b c d)) -> (* a b (+ 1 (* c d)))") (lint-test "(+ (* a b) (* c d))" "") (lint-test "(+ (* a b) (* a b))" " +: perhaps (+ (* a b) (* a b)) -> (* a b 2)") (lint-test "(+ (* x 2) 3 (* 4 x x))" " +: perhaps (+ (* x 2) 3 (* 4 x x)) -> (+ 3 (* x (+ 2 (* x 4))))") (lint-test "(+ -1 (* x -2) 3 (* 4 x x x))" " +: perhaps (+ -1 (* x -2) 3 (* 4 x x x)) -> (+ 2 (* x (+ -2 (* x (* x 4)))))") (lint-test "(+ (* x 65536) (* x 256) x)" " +: perhaps (+ (* x 65536) (* x 256) x) -> (* x 65793)") (lint-test "(+ x x x x)" " +: perhaps (+ x x x x) -> (* x 4)") (lint-test "(+ n (if (= 0 m) 0 1))" " +: perhaps (+ n (if (= 0 m) 0 1)) -> (if (= 0 m) n (+ n 1))") (lint-test "(if (= m 0) n (+ n 1))" "") (lint-test "(+ n (if x 0 y))" " +: perhaps (+ n (if x 0 y)) -> (if x n (+ n y))") (lint-test "(+ n (if x y 0))" " +: perhaps (+ n (if x y 0)) -> (if x (+ n y) n)") (lint-test "(+ (if x 0 y) n)" " +: perhaps (+ (if x 0 y) n) -> (if x n (+ y n))") (lint-test "(+ (if x y 0) n)" " +: perhaps (+ (if x y 0) n) -> (if x (+ y n) n)") (lint-test "(+ x (if y #() 0))" " +: in (+ x (if y #() 0)), +'s second argument should be a number, but #() is a vector? +: perhaps (+ x (if y #() 0)) -> (if y (+ x #()) x)") (lint-test "(+ 1 (if x 0 #()))" " +: in (+ 1 (if x 0 #())), +'s second argument should be a number, but #() is a vector? +: perhaps (+ 1 (if x 0 #())) -> (if x 1 (+ 1 #()))") (lint-test "(+ 1 (if x #() 0))" " +: in (+ 1 (if x #() 0)), +'s second argument should be a number, but #() is a vector? +: perhaps (+ 1 (if x #() 0)) -> (if x (+ 1 #()) 1)") (lint-test "(+ n (make-rectangular 0.0 0.0))" " +: perhaps (+ n (make-rectangular 0.0 0.0)) -> (+ n 0.0)") (lint-test "(+ (log a) (log b))" " +: perhaps (+ (log a) (log b)) -> (log (* a b))") (lint-test "(* 2 3)" " *: perhaps (* 2 3) -> 6") (lint-test "(* 2 (+))" " *: perhaps (* 2 (+)) -> 0") (lint-test "(* (* 2 3) 4)" " *: perhaps (* (* 2 3) 4) -> 24") (lint-test "(* (* x 3) 4)" " *: perhaps (* (* x 3) 4) -> (* 12 x)") (lint-test "(* x)" " *: perhaps (* x) -> x") (lint-test "(* x (*))" " *: perhaps (* x (*)) -> x") (lint-test "(* 2 x 3 y 1/6)" " *: perhaps (* 2 x 3 y 1/6) -> (* x y)") (lint-test "(* x -1)" " *: perhaps (* x -1) -> (- x)") (lint-test "(* -1 x y)" " *: perhaps (* -1 x y) -> (- (* x y))") (lint-test "(* x 1 1 1)" " *: perhaps (* x 1 1 1) -> x") (lint-test "(* x 1 1.0 1)" " *: perhaps (* x 1 1.0 1) -> (* x 1.0)") (lint-test "(* x y 2 0)" " *: perhaps (* x y 2 0) -> 0") (lint-test "(* -1 x -1 -1)" " *: perhaps (* -1 x -1 -1) -> (- x)") (lint-test "(* x (* y z) a)" " *: perhaps (* x (* y z) a) -> (* x y z a)") (lint-test "(* (- x) (- y))" " *: perhaps (* (- x) (- y)) -> (* x y)") (lint-test "(* 2.0 (inexact x))" " *: perhaps (* 2.0 (inexact x)) -> (* 2.0 x)") (lint-test "(* (inexact x) 2.0)" " *: perhaps (* (inexact x) 2.0) -> (* x 2.0)") (lint-test "(* (exp a) (exp b))" " *: perhaps (* (exp a) (exp b)) -> (exp (+ a b))") (lint-test "(* (expt x z) (expt y z))" " *: perhaps (* (expt x z) (expt y z)) -> (expt (* x y) z)") (lint-test "(* (expt x z) (expt x y))" " *: perhaps (* (expt x z) (expt x y)) -> (expt x (+ z y))") (lint-test "(* 2.0 (random 1.0))" " *: perhaps (* 2.0 (random 1.0)) -> (random 2.0)") (lint-test "(* (gcd a b) (lcm a b))" " *: perhaps (* (gcd a b) (lcm a b)) -> (abs (* a b))") (lint-test "(* (/ x) (/ y z))" " *: perhaps (* (/ x) (/ y z)) -> (/ y x z)") (lint-test "(* (/ x) (/ x z))" " *: perhaps (* (/ x) (/ x z)) -> (/ z)") (lint-test "(* (/ x z) (/ y))" " *: perhaps (* (/ x z) (/ y)) -> (/ x z y)") (lint-test "(* (/ y z) (/ y))" " *: perhaps (* (/ y z) (/ y)) -> (/ z)") (lint-test "(* (/ x z) (/ y w v))" " *: perhaps (* (/ x z) (/ y w v)) -> (/ (* x y) z w v)") (lint-test "(* (/ x y) y)" " *: perhaps (* (/ x y) y) -> x") (lint-test "(* (/ x y) (/ y x))" " *: perhaps (* (/ x y) (/ y x)) -> 1") (lint-test "(* (/ x 2) 2)" " *: perhaps (* (/ x 2) 2) -> x") (lint-test "(* (/ 2 x) 3/4)" " *: perhaps (* (/ 2 x) 3/4) -> (/ 3/2 x)") (lint-test "(* (/ x) (/ y))" " *: perhaps (* (/ x) (/ y)) -> (/ 1 x y)") (lint-test "(* (/ x y) z (/ y x))" " *: perhaps (* (/ x y) z (/ y x)) -> z") (lint-test "(* (/ x y z) z (/ y x))" " *: perhaps (* (/ x y z) z (/ y x)) -> 1") (lint-test "(* (/ x a) z (/ y x))" " *: perhaps (* (/ x a) z (/ y x)) -> (/ (* z y) a)") (lint-test "(* n (if x 0 1))" " *: perhaps (* n (if x 0 1)) -> (if x 0 (* n 1))") (lint-test "(* n (if x y 1))" " *: perhaps (* n (if x y 1)) -> (if x (* n y) n)") (lint-test "(* n (if x y 0))" " *: perhaps (* n (if x y 0)) -> (if x (* n y) 0)") (lint-test "(* n (if x 0 y))" " *: perhaps (* n (if x 0 y)) -> (if x 0 (* n y))") (lint-test "(* n (if x 1 y))" " *: perhaps (* n (if x 1 y)) -> (if x n (* n y))") (lint-test "(* (if x 0 y) n)" " *: perhaps (* (if x 0 y) n) -> (if x 0 (* y n))") (lint-test "(* (if x y 0) n)" " *: perhaps (* (if x y 0) n) -> (if x (* y n) 0)") (lint-test "(* (if x 1 y) n)" " *: perhaps (* (if x 1 y) n) -> (if x n (* y n))") (lint-test "(* (if x y 1) n)" " *: perhaps (* (if x y 1) n) -> (if x (* y n) n)") (lint-test "(* (if x w y) n)" "") (lint-test "(* x (if y 0 z) w)" " *: perhaps (* x (if y 0 z) w) -> (if y 0 (* z x w))") (lint-test "(* (if y z 0) x w)" " *: perhaps (* (if y z 0) x w) -> (if y (* z x w) 0)") (lint-test "(* (sqrt x) (sqrt y))" " *: perhaps (* (sqrt x) (sqrt y)) -> (sqrt (* x y))") (lint-test "(* a (/ 1 b))" " *: perhaps (* a (/ 1 b)) -> (/ a b)") (lint-test "(* (/ 1 a) a)" " *: perhaps (* (/ 1 a) a) -> 1") (lint-test "(* a (/ 1 a))" " *: perhaps (* a (/ 1 a)) -> 1") (lint-test "(* a (/ a))" " *: perhaps (* a (/ a)) -> 1") (lint-test "(* (/ a) a)" " *: perhaps (* (/ a) a) -> 1") (lint-test "(* a (/ b))" " *: perhaps (* a (/ b)) -> (/ a b)") (lint-test "(- 1 2)" " -: perhaps (- 1 2) -> -1") (lint-test "(- 1 (- 1 2))" " -: perhaps (- 1 (- 1 2)) -> 2") (lint-test "(- x (- 2 0))" " -: perhaps (- x (- 2 0)) -> (- x 2)") (lint-test "(- (- x))" " -: perhaps (- (- x)) -> x") (lint-test "(- 0 x)" " -: perhaps (- 0 x) -> (- x)") (lint-test "(- x 0)" " -: perhaps (- x 0) -> x") (lint-test "(- (- y x))" " -: perhaps (- (- y x)) -> (- x y)") (lint-test "(- 3/2 1/2)" " -: perhaps (- 3/2 1/2) -> 1") (lint-test "(- (- x y) z)" " -: perhaps (- (- x y) z) -> (- x y z)") (lint-test "(- x 0 (+ 3 2))" " -: perhaps (- x 0 (+ 3 2)) -> (- x 5)") (lint-test "(- 5 x (+ 3 2))" " -: perhaps (- 5 x (+ 3 2)) -> (- x)") (lint-test "(- x 0 0 0)" " -: perhaps (- x 0 0 0) -> x") (lint-test "(- 0 0 0 x)" " -: perhaps (- 0 0 0 x) -> (- x)") (lint-test "(- 0.0 x)" "") (lint-test "(- x (+ 0 x))" " -: perhaps (- x (+ 0 x)) -> 0") (lint-test "(- (abs x) (abs x) y)" " -: perhaps (- (abs x) (abs x) y) -> (- y)") (lint-test "(- (abs x) (abs x) (abs x) y)" " -: perhaps (- (abs x) (abs x) (abs x) y) -> (- (+ (abs x) y))") (lint-test "(- (- x) y)" " -: perhaps (- (- x) y) -> (- (+ x y))") (lint-test "(- x (truncate x))" " -: perhaps (- x (truncate x)) -> (remainder x 1)") (lint-test "(- x (+ y z))" " -: perhaps (- x (+ y z)) -> (- x y z)") (lint-test "(- x (- y))" " -: perhaps (- x (- y)) -> (+ x y)") (lint-test "(- x x)" " -: this looks odd: (- x x) -: perhaps (- x x) -> 0") (lint-test "(- (- x y) z w)" " -: perhaps (- (- x y) z w) -> (- x y z w)") (lint-test "(- (- x y) (+ z w))" " -: perhaps (- (- x y) (+ z w)) -> (- x y z w)") (lint-test "(- x -1)" "") ;lengths match (lint-test "(- x (if y 0 z))" " -: perhaps (- x (if y 0 z)) -> (if y x (- x z))") (lint-test "(- x (if y z 0))" " -: perhaps (- x (if y z 0)) -> (if y (- x z) x)") (lint-test "(- (floor (- x)))" " -: perhaps (- (floor (- x))) -> (ceiling x)") (lint-test "(- (floor (- (+ x y))))" " -: perhaps (- (floor (- (+ x y)))) -> (ceiling (+ x y))") (lint-test "(- (- x) 1)" "") ; lengths match (lint-test "(- (log a) (log b))" " -: perhaps (- (log a) (log b)) -> (log (/ a b))") (lint-test "(- (* b a) (* c a))" " -: perhaps (- (* b a) (* c a)) -> (* a (- b c))") (lint-test "(- (* a b) (* c a))" " -: perhaps (- (* a b) (* c a)) -> (* a (- b c))") (lint-test "(- (* b a) (* a c))" " -: perhaps (- (* b a) (* a c)) -> (* a (- b c))") (lint-test "(- (* a b) (* a c))" " -: perhaps (- (* a b) (* a c)) -> (* a (- b c))") (lint-test "(- (/ a b) (/ c b))" " -: perhaps (- (/ a b) (/ c b)) -> (/ (- a c) b)") (lint-test "(- (random x) 1 (random x))" "") (lint-test "(- (+ x y) (+ y x))" " -: perhaps (- (+ x y) (+ y x)) -> 0") (lint-test "(- (+ x 1) (+ y x))" " -: perhaps (- (+ x 1) (+ y x)) -> (- 1 y)") (lint-test "(- x (+ y x 1))" " -: perhaps (- x (+ y x 1)) -> (- (+ y 1))") (lint-test "(- 0 0 x)" " -: perhaps (- 0 0 x) -> (- x)") (lint-test "(- 0 0 x y)" " -: perhaps (- 0 0 x y) -> (- (+ x y))") (lint-test "(- (+ x 1) (- x y) 1)" " -: perhaps (- (+ x 1) (- x y) 1) -> y") (lint-test "(- (+ x z) (- x y) 0)" " -: perhaps (- (+ x z) (- x y) 0) -> (+ z y)") (lint-test "(- (+ x 1) (- x y) 2)" " -: perhaps (- (+ x 1) (- x y) 2) -> (- y 1)") (lint-test "(- (+ x 1) (- x y) -2)" " -: perhaps (- (+ x 1) (- x y) -2) -> (+ y 3)") (lint-test "(- (+ x z 2) x y 1)" " -: perhaps (- (+ x z 2) x y 1) -> (- (+ z 1) y)") (lint-test "(- (+ x z) x y 1)" " -: perhaps (- (+ x z) x y 1) -> (- z y 1)") (lint-test "(- (+ x z w) x y 1)" " -: perhaps (- (+ x z w) x y 1) -> (- (+ w z) y 1)") (lint-test "(- (+ x z) x y)" " -: perhaps (- (+ x z) x y) -> (- z y)") (lint-test "(- (+ x z w) x y)" " -: perhaps (- (+ x z w) x y) -> (- (+ w z) y)") (unless with-bignums (lint-test "(- -9223372036854775808)" "- argument, -9223372036854775808, is out of range (most-negative-fixnum can't be negated) -: perhaps (- -9223372036854775808) -> +nan.0") (lint-test "(- (*s7* 'most-negative-fixnum))" "- argument, -9223372036854775808, is out of range (most-negative-fixnum can't be negated) -: perhaps (- (*s7* 'most-negative-fixnum)) -> +nan.0")) (lint-test "(/ 2 3)" " /: perhaps (/ 2 3) -> 2/3") (lint-test "(/ 1 x)" " /: perhaps (/ 1 x) -> (/ x)") (lint-test "(/ 2)" " /: perhaps (/ 2) -> 1/2") (lint-test "(/ 0 2 x)" " /: perhaps (/ 0 2 x) -> 0") (lint-test "(/ 0 x)" " /: perhaps (/ 0 x) -> 0") (lint-test "(/ x (- x))" " /: perhaps (/ x (- x)) -> -1") (lint-test "(/ (/ x))" " /: perhaps (/ (/ x)) -> x") (lint-test "(/ (log x) (log 2))" " /: perhaps (/ (log x) (log 2)) -> (log x 2)") (lint-test "(/ (log x) (log y))" " /: perhaps (/ (log x) (log y)) -> (log x y)") (lint-test "(/ x (/ y))" " /: perhaps (/ x (/ y)) -> (* x y)") (lint-test "(/ x (/ 1 y z))" " /: perhaps (/ x (/ 1 y z)) -> (* x y z)") (lint-test "(/ x 1 1 1)" " /: perhaps (/ x 1 1 1) -> x") (lint-test "(/ x a (* b 1 c) d)" " /: perhaps (/ x a (* b 1 c) d) -> (/ x a b c d)") (lint-test "(/ 0 a (* b 1 c) d)" " /: perhaps (/ 0 a (* b 1 c) d) -> 0") (lint-test "(/ x x)" " /: this looks odd: (/ x x) /: perhaps (/ x x) -> 1") (lint-test "(/ 0)" " /: attempt to invert zero: (/ 0)") (lint-test "(/ x y 2 0)" " /: attempt to divide by 0: (/ x y 2 0)") (lint-test "(/ (/ 1 a) (/ b c d))" " /: perhaps (/ (/ 1 a) (/ b c d)) -> (/ (* c d) (* a b))") (lint-test "(/ (/ a) (/ b))" " /: perhaps (/ (/ a) (/ b)) -> (/ b a)") (lint-test "(/ (/ a b c) (/ d e f))" " /: perhaps (/ (/ a b c) (/ d e f)) -> (/ (* a e f) (* b c d))") (lint-test "(/ (/ a b) c)" " /: perhaps (/ (/ a b) c) -> (/ a b c)") (lint-test "(/ a b a)" " /: perhaps (/ a b a) -> (/ b)") (lint-test "(/ a b a c)" " /: perhaps (/ a b a c) -> (/ 1 b c)") (lint-test "(/ a (* b a))" " /: perhaps (/ a (* b a)) -> (/ b)") (lint-test "(/ a (* b a c))" " /: perhaps (/ a (* b a c)) -> (/ 1 b c)") (lint-test "(/ 2.0 (inexact x))" " /: perhaps (/ 2.0 (inexact x)) -> (/ 2.0 x)") (lint-test "(/ (inexact x) 2.0)" " /: perhaps (/ (inexact x) 2.0) -> (/ x 2.0)") (lint-test "(/ (- x) (- y))" " /: perhaps (/ (- x) (- y)) -> (/ x y)") (lint-test "(/ x (/ y z))" " /: perhaps (/ x (/ y z)) -> (/ (* x z) y)") (lint-test "(/ 3 (/ -3 x))" " /: perhaps (/ 3 (/ -3 x)) -> (- x)") (lint-test "(/ 2/3 (/ 3/2 x))" " /: perhaps (/ 2/3 (/ 3/2 x)) -> (* 4/9 x)") (lint-test "(/ x (* y z))" "") (lint-test "(/ x (/ y))" " /: perhaps (/ x (/ y)) -> (* x y)") (lint-test "(/ (* x y) (* z y))" " /: perhaps (/ (* x y) (* z y)) -> (/ x z)") (lint-test "(/ (* 12 (log x)) (log 2))" " /: perhaps (/ (* 12 (log x)) (log 2)) -> (* 12 (log x 2))") (lint-test "(/ (* x y) (log 2))" "") (lint-test "(/ (expt x y))" " /: perhaps (/ (expt x y)) -> (expt x (- y))") (lint-test "(/ (expt 10 6))" " /: perhaps (/ (expt 10 6)) -> (expt 10 (- 6))") (lint-test "(/ (exp x))" " /: perhaps (/ (exp x)) -> (exp (- x))") (lint-test "(/ x (sqrt x))" " /: perhaps (/ x (sqrt x)) -> (sqrt x)") (lint-test "(/ (sqrt x) x)" " /: perhaps (/ (sqrt x) x) -> (/ (sqrt x))") (lint-test "(/ (sqrt x) (sqrt y))" " /: perhaps (/ (sqrt x) (sqrt y)) -> (sqrt (/ x y))") (lint-test "(/ (/ x))" " /: perhaps (/ (/ x)) -> x") (lint-test "(/ (/ 1 x))" " /: perhaps (/ (/ 1 x)) -> x") (lint-test "(/ (/ 1 x y))" " /: perhaps (/ (/ 1 x y)) -> (* x y)") (lint-test "(/ (/ z x))" " /: perhaps (/ (/ z x)) -> (/ x z)") (lint-test "(/ (/ z x y))" " /: perhaps (/ (/ z x y)) -> (/ (* x y) z)") (lint-test "(/ 1 (/ 1 x y))" " /: perhaps (/ 1 (/ 1 x y)) -> (* x y)") (lint-test "(/ x y (length z))" " /: (length z) will cause division by 0 if z is empty") (lint-test "(/ (length x))" " /: (length x) will cause division by 0 if x is empty") (lint-test "(/ (length x) z)" "") (lint-test "(/ (- (* a a) (* b b)) (- a b))" " /: perhaps (/ (- (* a a) (* b b)) (- a b)) -> (+ a b)") (lint-test "(/ (- (* a a) (* b b)) (+ a b))" " /: perhaps (/ (- (* a a) (* b b)) (+ a b)) -> (- a b)") (lint-test "(/ (expt a b) (expt a c))" " /: perhaps (/ (expt a b) (expt a c)) -> (expt a (- b c))") (lint-test "(/ (exp a) (exp b))" " /: perhaps (/ (exp a) (exp b)) -> (exp (- a b))") (lint-test "(/ (exact->inexact x) 10)" " /: perhaps (/ (exact->inexact x) 10) -> (/ x 10.0)") (lint-test "(+ (exact->inexact x) 10)" " +: perhaps (+ (exact->inexact x) 10) -> (+ x 10.0)") (lint-test "(+ 10 (exact->inexact x))" " +: perhaps (+ 10 (exact->inexact x)) -> (+ 10.0 x)") (lint-test "(* (exact->inexact x) 10)" " *: perhaps (* (exact->inexact x) 10) -> (* x 10.0)") (lint-test "(* (exact->inexact x) 10 10.0)" " *: perhaps (* (exact->inexact x) 10 10.0) -> (* x 10 10.0)") (lint-test "(* 10 (exact->inexact x) 10.0)" " *: perhaps (* 10 (exact->inexact x) 10.0) -> (* 10 x 10.0)") (lint-test "(* 10.0 (exact->inexact x) 10.0)" " *: perhaps (* 10.0 (exact->inexact x) 10.0) -> (* 10.0 x 10.0)") (lint-test "(exact->inexact (/ x 32))" " exact->inexact: perhaps (exact->inexact (/ x 32)) -> (/ x 32.0)") (lint-test "(exact->inexact (real-part x))" "") ; if complex? (lint-test "(exact->inexact (random 10))" "") ; this can't be changed to (random 10.0) (lint-test "(exact->inexact 1.234)" " exact->inexact: perhaps (exact->inexact 1.234) -> 1.234") (lint-test "(exact->inexact (float-vector-ref x 0))" " exact->inexact: perhaps (exact->inexact (float-vector-ref x 0)) -> (float-vector-ref x 0)") (lint-test "(exact->inexact (* 1.234 w))" " exact->inexact: perhaps (exact->inexact (* 1.234 w)) -> (* 1.234 w)") (lint-test "(inexact (+ 1.0 x))" " inexact: perhaps (inexact (+ 1.0 x)) -> (+ 1.0 x)") (lint-test "(inexact (random 10))" "") (lint-test "(inexact? (random 10))" "") ; this should be #f (lint-test "(inexact? 1.0)" " inexact?: perhaps (inexact? 1.0) -> #t") (lint-test "(inexact->exact (numerator x))" " inexact->exact: perhaps (inexact->exact (numerator x)) -> (numerator x)") (lint-test "(inexact->exact (random 10))" " inexact->exact: perhaps (inexact->exact (random 10)) -> (random 10)") (lint-test "(inexact->exact (floor x))" " inexact->exact: perhaps (inexact->exact (floor x)) -> (floor x)") (lint-test "(inexact->exact 1.5)" " inexact->exact: perhaps (inexact->exact 1.5) -> 3/2") (lint-test "(inexact->exact 2/3)" " inexact->exact: perhaps (inexact->exact 2/3) -> 2/3") (lint-test "(inexact->exact 2)" " inexact->exact: perhaps (inexact->exact 2) -> 2") (lint-test "(inexact->exact (int-vector-ref x 0))" " inexact->exact: perhaps (inexact->exact (int-vector-ref x 0)) -> (int-vector-ref x 0)") (lint-test "(inexact->exact (floor 23))" " inexact->exact: perhaps (inexact->exact (floor 23)) -> 23") (lint-test "(exact (round x))" " exact: perhaps (exact (round x)) -> (round x)") (lint-test "(exact? 1.0)" " exact?: perhaps (exact? 1.0) -> #f") (lint-test "(sin (asin x))" " sin: perhaps (sin (asin x)) -> x") (lint-test "(sin 0)" " sin: perhaps (sin 0) -> 0") (lint-test "(sin pi)" " sin: perhaps (sin pi) -> 0.0") (lint-test "(cos 0)" " cos: perhaps (cos 0) -> 1") (lint-test "(cos (acos (+ x 1)))" " cos: perhaps (cos (acos (+ x 1))) -> (+ x 1)") (lint-test "(cos (* pi 1))" " cos: perhaps (cos (* pi 1)) -> -1.0") (lint-test "(cos (- (* x y)))" " cos: perhaps (cos (- (* x y))) -> (cos (* x y))") (lint-test "(exp (* (+ x y) (log (+ y 1))))" " exp: perhaps (exp (* (+ x y) (log (+ y 1)))) -> (expt (+ y 1) (+ x y))") (lint-test "(exp (* (log x) a))" " exp: perhaps (exp (* (log x) a)) -> (expt x a)") (lint-test "(exp (log (* x y)))" " exp: perhaps (exp (log (* x y))) -> (* x y)") (lint-test "(acosh (cosh 0))" " acosh: perhaps (acosh (cosh 0)) -> (acosh 1)") (lint-test "(exp (log 1))" " exp: perhaps (exp (log 1)) -> 1") (lint-test "(exp 0.0)" " exp: perhaps (exp 0.0) -> 1.0") (lint-test "(exp (+ (* 0.5 (log hi)) (* 0.5 (log lo))))" " exp: perhaps (exp (+ (* 0.5 (log hi)) (* 0.5 (log lo)))) -> (expt (* hi lo) 0.5)") (lint-test "(sin x 0.0)" " sin: sin has too many arguments: (sin x 0.0)") (lint-test "(sin)" " sin: sin needs 1 argument: (sin)") (lint-test "(/ (sin x) (cos x))" " /: perhaps (/ (sin x) (cos x)) -> (tan x)") (lint-test "(log 1)" " log: perhaps (log 1) -> 0") (lint-test "(log (exp 0))" " log: perhaps (log (exp 0)) -> 0") (lint-test "(log (exp (* x y)))" " log: perhaps (log (exp (* x y))) -> (* x y)") (lint-test "(log (* x 1) (- x 0))" " log: perhaps (log (* x 1) (- x 0)) -> 1.0") (lint-test "(log 2 2)" " log: perhaps (log 2 2) -> 1") (lint-test "(log pi pi)" " log: perhaps (log pi pi) -> 1.0") (lint-test "(log (* x pi) (* x pi))" " log: perhaps (log (* x pi) (* x pi)) -> 1.0") (lint-test "(log (* x pi))" "") (lint-test "(log (sqrt x))" " log: perhaps (log (sqrt x)) -> (* 1/2 (log x))") (lint-test "(log (expt x y))" " log: perhaps (log (expt x y)) -> (* y (log x))") (lint-test "(log (expt x y) z)" " log: perhaps (log (expt x y) z) -> (* y (log x z))") (lint-test "(log (/ 1 a))" " log: perhaps (log (/ 1 a)) -> (- (log a))") (lint-test "(log (/ a))" " log: perhaps (log (/ a)) -> (- (log a))") (lint-test "(sqrt 4)" " sqrt: perhaps (sqrt 4) -> 2") (unless with-bignums (lint-test "(sqrt 3)" "")) (lint-test "(sqrt 4.0)" "") (lint-test "(sqrt (* (+ x 1) (+ x 1)))" "") ; tricky case, x might be -2 for example (lint-test "(sqrt)" " sqrt: sqrt needs 1 argument: (sqrt)") (lint-test "(sqrt (- x 0))" " sqrt: perhaps (sqrt (- x 0)) -> (sqrt x)") (lint-test "(sqrt (exp x))" " sqrt: perhaps (sqrt (exp x)) -> (exp (/ x 2))") (lint-test "(complex (- x 0) 2)" " complex: perhaps (complex (- x 0) 2) -> (complex x 2)") (lint-test "(floor 3.4)" " floor: perhaps (floor 3.4) -> 3") (lint-test "(round 3.4+i)" " round: in (round 3.4+1.0i), round's argument should be real, but 3.4+1.0i is complex?") (lint-test "(ceiling (floor 2.1))" " ceiling: perhaps (ceiling (floor 2.1)) -> 2") (lint-test "(ceiling (floor x))" " ceiling: perhaps (ceiling (floor x)) -> (floor x)") (lint-test "(truncate 2/3)" " truncate: perhaps (truncate 2/3) -> 0") (lint-test "(truncate (/ 2 3))" " truncate: perhaps (truncate (/ 2 3)) -> 0") (lint-test "(truncate (/ 12 (* 2 3)))" " truncate: perhaps (truncate (/ 12 (* 2 3))) -> 2") (lint-test "(truncate (* 2.0 (inexact->exact (log 3))))" " truncate: perhaps (truncate (* 2.0 (inexact->exact (log 3)))) -> (truncate (* 2.0 (log 3)))") (lint-test "(truncate (inexact->exact (log 3)))" " truncate: perhaps (truncate (inexact->exact (log 3))) -> (truncate (log 3))") (lint-test "(round (random 10))" " round: perhaps (round (random 10)) -> (random 10)") (lint-test "(floor (random 10.0))" " floor: perhaps (floor (random 10.0)) -> (random 10)") (lint-test "(abs (magnitude 1+i))" " abs: perhaps (abs (magnitude 1.0+1.0i)) -> (magnitude 1.0+1.0i)") (lint-test "(magnitude 2/3)" " magnitude: perhaps use abs here: (magnitude 2/3) magnitude: perhaps (magnitude 2/3) -> 2/3") (lint-test "(abs (- (* 2 x)))" " abs: perhaps (abs (- (* 2 x))) -> (abs (* 2 x))") (lint-test "(abs (* (+ x 1) 1))" " abs: perhaps (abs (* (+ x 1) 1)) -> (abs (+ x 1))") (lint-test "(magnitude (real-part z))" " magnitude: perhaps use abs here: (magnitude (real-part z))") (lint-test "(abs (denominator x))" " abs: perhaps (abs (denominator x)) -> (denominator x)") (lint-test "(abs (modulo x 2))" " abs: perhaps (abs (modulo x 2)) -> (modulo x 2)") (lint-test "(abs () ())" " abs: abs has too many arguments: (abs () ()) abs: in (abs () ()), abs's first argument should be real, but () is null?") (unless with-bignums (lint-test "(abs -9223372036854775808)" "abs argument, (-9223372036854775808), is out of range (result is too large) abs: perhaps (abs -9223372036854775808) -> +nan.0")) (lint-test "(abs (abs x))" " abs: perhaps (abs (abs x)) -> (abs x)") (lint-test "(real-part 3.0)" " real-part: perhaps (real-part 3.0) -> 3.0") (lint-test "(imag-part 3.0)" " imag-part: perhaps (imag-part 3.0) -> 0.0") (lint-test "(real-part (abs x))" " real-part: perhaps (real-part (abs x)) -> (abs x)") (lint-test "(imag-part (abs x))" " imag-part: perhaps (imag-part (abs x)) -> 0.0") (lint-test "(imag-part (sin x))" "") (lint-test "(real-part 1+i)" "") (lint-test "(imag-part x)" "") (lint-test "(real-part x)" "") (lint-test "(imag-part (vector-ref x i))" "") (lint-test "(imag-part (x i))" "") (lint-test "(string? (number->string x))" " string?: number->string always returns a string, so (string? (number->string x)) -> #t") (lint-test "(number? (string->number x))" " number?: string->number returns either #f or a number, so (number? (string->number x)) -> (string->number x)") (lint-test "(numerator 1/3)" " numerator: perhaps (numerator 1/3) -> 1") (lint-test "(numerator 3)" " numerator: perhaps (numerator 3) -> 3") (lint-test "(numerator (floor x))" " numerator: perhaps (numerator (floor x)) -> (floor x)") (lint-test "(denominator (floor x))" " denominator: perhaps (denominator (floor x)) -> 1") (lint-test "(denominator 3)" " denominator: perhaps (denominator 3) -> 1") (lint-test "(denominator (round (+ x 1)))" " denominator: perhaps (denominator (round (+ x 1))) -> 1") (lint-test "(numerator (round (+ x 1)))" " numerator: perhaps (numerator (round (+ x 1))) -> (round (+ x 1))") (lint-test "(> (numerator x) 0)" " >: perhaps (> (numerator x) 0) -> (> x 0)") (lint-test "(negative? (numerator x))" " negative?: perhaps (negative? (numerator x)) -> (negative? x)") (lint-test "(random 0)" " random: perhaps (random 0) -> 0") (lint-test "(random 0.0)" " random: perhaps (random 0.0) -> 0.0") (lint-test "(random x)" "") (lint-test "(random 1)" " random: perhaps (random 1) -> 0") (lint-test "(random -1)" " random: perhaps (random -1) -> 0") (lint-test "(random 0 y)" "") (lint-test "(lognot 1)" " lognot: perhaps (lognot 1) -> -2") (lint-test "(lognot 1/2)" " lognot: in (lognot 1/2), lognot's argument should be an integer, but 1/2 is rational?") (if with-bignums (lint-test "(ash 2 64)" " ash: perhaps (ash 2 64) -> 36893488147419103232") (lint-test "(ash 2 64)" "")) (lint-test "(ash 1 7)" " ash: perhaps (ash 1 7) -> 128") (lint-test "(ash x 0)" " ash: perhaps (ash x 0) -> x") (lint-test "(quotient (remainder x y) y)" " quotient: perhaps (quotient (remainder x y) y) -> 0") (lint-test "(positive? (remainder x 2))" "") (lint-test "(zero? (remainder x 2))" " zero?: perhaps (assuming x is an integer) (zero? (remainder x 2)) -> (even? x)") (lint-test "(negative? (remainder x 3))" "") (lint-test "(negative? (modulo x 4))" " negative?: perhaps (negative? (modulo x 4)) -> #f") (lint-test "(positive? (modulo x -4))" " positive?: perhaps (positive? (modulo x -4)) -> #f") (lint-test "(positive? (modulo x 4))" " positive?: perhaps (positive? (modulo x 4)) -> #t") (lint-test "(negative? (modulo x -4))" " negative?: perhaps (negative? (modulo x -4)) -> #t") (lint-test "(ash 0 x)" " ash: perhaps (ash 0 x) -> 0") (lint-test "(modulo (abs x) y)" " modulo: perhaps (modulo (abs x) y) -> (modulo x y)") (lint-test "(complex 1.0 0)" " complex: perhaps (complex 1.0 0) -> 1.0") (lint-test "(expt 0 x)" " expt: perhaps (expt 0 x) -> 0") (lint-test "(expt x 0)" " expt: perhaps (expt x 0) -> 1") (lint-test "(expt (* 2 x) 1)" " expt: perhaps (expt (* 2 x) 1) -> (* 2 x)") (lint-test "(expt (* 2 x) -1)" " expt: perhaps (expt (* 2 x) -1) -> (/ (* 2 x))") (lint-test "(expt 2 3)" " expt: perhaps (expt 2 3) -> 8") (lint-test "(expt 1/2 -2)" " expt: perhaps (expt 1/2 -2) -> 4") (lint-test "(expt 2 1/2)" "") (lint-test "(expt 1.0 1.0)" "") (lint-test "(expt 0 0)" " expt: perhaps (expt 0 0) -> 1") (lint-test "(expt (expt x y) z)" " expt: perhaps (expt (expt x y) z) -> (expt x (* y z))") (lint-test "(expt (exp a) b)" " expt: perhaps (expt (exp a) b) -> (exp (* a b))") (lint-test "(angle -1)" " angle: perhaps (angle -1) -> pi") (lint-test "(angle 0.0)" " angle: perhaps (angle 0.0) -> 0.0") (lint-test "(angle pi)" " angle: perhaps (angle pi) -> 0.0") (lint-test "(atan x 0.0)" "") (lint-test "(atan (/ x y))" " atan: perhaps (atan (/ x y)) -> (atan x y)") (lint-test "(logior x (logior y z))" " logior: perhaps (logior x (logior y z)) -> (logior x y z)") (lint-test "(logior x 3 7 3 1 x)" " logior: perhaps (logior x 3 7 3 1 x) -> (logior 7 x)") (lint-test "(logior x)" " logior: perhaps (logior x) -> x") (lint-test "(logior x -1 2 y)" " logior: perhaps (logior x -1 2 y) -> -1") (lint-test "(logior 6 2)" " logior: perhaps (logior 6 2) -> 6") (lint-test "(logior)" " logior: perhaps (logior) -> 0") (lint-test "(logior x 0 y)" " logior: perhaps (logior x 0 y) -> (logior x y)") (lint-test "(logand x 3 7 3 1 x)" " logand: perhaps (logand x 3 7 3 1 x) -> (logand 1 x)") (lint-test "(logand 3 91 2)" " logand: perhaps (logand 3 91 2) -> 2") (lint-test "(logand)" " logand: perhaps (logand) -> -1") (lint-test "(logand (* x 3))" " logand: perhaps (logand (* x 3)) -> (* x 3)") (lint-test "(logand (* x 3) 0 y)" " logand: perhaps (logand (* x 3) 0 y) -> 0") (lint-test "(logand -1 x -1 y)" " logand: perhaps (logand -1 x -1 y) -> (logand x y)") (lint-test "(logand x (logand y 1))" " logand: perhaps (logand x (logand y 1)) -> (logand x y 1)") (lint-test "(logand x (logand y 0))" " logand: perhaps (logand x (logand y 0)) -> 0") (lint-test "(logxor x y x z)" "") (lint-test "(logxor 2 4 1)" " logxor: perhaps (logxor 2 4 1) -> 7") (lint-test "(logxor x)" " logxor: perhaps (logxor x) -> x") (lint-test "(logxor x x)" " logxor: perhaps (logxor x x) -> 0") (lint-test "(integer-length 1)" " integer-length: perhaps (integer-length 1) -> 1") (lint-test "(gcd x (gcd x y))" " gcd: perhaps (gcd x (gcd x y)) -> (gcd x y)") (lint-test "(lcm x (lcm x y))" " lcm: perhaps (lcm x (lcm x y)) -> (lcm x y)") (lint-test "(gcd x x)" " gcd: perhaps (gcd x x) -> (abs x)") (lint-test "(gcd)" " gcd: perhaps (gcd) -> 0") (lint-test "(lcm)" " lcm: perhaps (lcm) -> 1") (lint-test "(gcd x y 1 3)" " gcd: perhaps (gcd x y 1 3) -> 1") (lint-test "(lcm x y 0 3)" " lcm: perhaps (lcm x y 0 3) -> 0") (lint-test "(gcd 12 18)" " gcd: perhaps (gcd 12 18) -> 6") (lint-test "(gcd x 0)" " gcd: perhaps (gcd x 0) -> (abs x)") (lint-test "(lcm 12 18)" " lcm: perhaps (lcm 12 18) -> 36") (lint-test "(lcm x)" " lcm: perhaps (lcm x) -> (abs x)") (lint-test "(lcm x x x)" " lcm: perhaps (lcm x x x) -> (abs x)") (lint-test "(if (negative? (gcd x y)) a b)" " if: perhaps (negative? (gcd x y)) -> #f if: perhaps (if (negative? (gcd x y)) a b) -> b") (lint-test "(gcd (random x) (random x))" "") (lint-test "(max x)" " max: perhaps (max x) -> x") (lint-test "(max 3 4 5)" " max: perhaps (max 3 4 5) -> 5") (lint-test "(max 3 x 4 5)" " max: perhaps (max 3 x 4 5) -> (max 5 x)") (lint-test "(max 3.0 x 4/5 5)" " max: perhaps (max 3.0 x 4/5 5) -> (max 5 x)") (lint-test "(min 3.0 x 4/5 5)" " min: perhaps (min 3.0 x 4/5 5) -> (min 4/5 x)") (lint-test "(max 3.0 x x 5)" " max: it looks odd to have repeated arguments in (max 3.0 x x 5) max: perhaps (max 3.0 x x 5) -> (max 5 x)") (lint-test "(max 3 (max 4 x) y)" " max: perhaps (max 3 (max 4 x) y) -> (max 4 x y)") (lint-test "(max 4 (min 3 x) y)" " max: perhaps (max 4 (min 3 x) y) -> (max 4 y)") (lint-test "(min 4 (max 3 x) y)" "") (lint-test "(min (max x 3) 4 y)" "") (lint-test "(min 3 (max 4 x) y)" " min: perhaps (min 3 (max 4 x) y) -> (min 3 y)") (lint-test "(max (min x 3) (min x 3))" " max: this looks odd: (max (min x 3) (min x 3)) max: perhaps (max (min x 3) (min x 3)) -> (min x 3)") (lint-test "(min x (max y x))" " min: perhaps (min x (max y x)) -> x") (lint-test "(max (min y x) x)" " max: perhaps (max (min y x) x) -> x") (lint-test "(max 3 (min x 3))" " max: perhaps (max 3 (min x 3)) -> 3") (lint-test "(min x (max y z (+ 21 x) x (* y z)))" " min: perhaps (min x (max y z (+ 21 x) x (* y z))) -> x") (lint-test "(max 0 (string-length x))" " max: perhaps (max 0 (string-length x)) -> (string-length x)") (lint-test "(max (string-length x) -1 y)" " max: perhaps (max (string-length x) -1 y) -> (max (string-length x) y)") (lint-test "(equal? x y z)" " equal?: equal? has too many arguments: (equal? x y z)") (lint-test "(= 1 y 2)" " =: this comparison can't be true: (= 1 y 2)") (lint-test "(= x 1.5)" " =: = can be troublesome with floats: (= x 1.5)") (lint-test "(= x 0.0)" "") (lint-test "(= x 1.0 x)" " =: it looks odd to have repeated arguments in (= x 1.0 x)") (lint-test "(= x x)" " =: this looks odd: (= x x), perhaps use (not (nan? x))") (lint-test "(= (- x y) 0)" " =: perhaps (= (- x y) 0) -> (= x y)") (lint-test "(= 0.0 (- x y))" " =: perhaps (= 0.0 (- x y)) -> (= x y)") (lint-test "(= (- (abs x) 2) 0)" " =: perhaps (= (- (abs x) 2) 0) -> (= (abs x) 2)") (lint-test "(= (length x) 0)" " =: perhaps (assuming x is a list), (= (length x) 0) -> (null? x)") (lint-test "(= (length x) 1)" " =: perhaps (assuming x is a list), (= (length x) 1) -> (and (pair? x) (null? (cdr x)))") (lint-test "(> (- fltdur 50868) 256)" " >: perhaps (> (- fltdur 50868) 256) -> (> fltdur 51124)") (lint-test "(= (- fltdur 50868) 256)" " =: perhaps (= (- fltdur 50868) 256) -> (= fltdur 51124)") (lint-test "(= (- fltdur 50868) 0)" " =: perhaps (= (- fltdur 50868) 0) -> (= fltdur 50868)") (lint-test "(< 256 (- fltdur 50868))" " <: perhaps (< 256 (- fltdur 50868)) -> (> fltdur 51124)") (lint-test "(= 256 (- fltdur 50868))" " =: perhaps (= 256 (- fltdur 50868)) -> (= fltdur 51124)") (lint-test "(> (+ fltdur 50868) 256)" " >: perhaps (> (+ fltdur 50868) 256) -> (> fltdur -50612)") (lint-test "(= (+ fltdur 50868) 256)" " =: perhaps (= (+ fltdur 50868) 256) -> (= fltdur -50612)") (lint-test "(= (+ fltdur 50868) 0)" " =: perhaps (= (+ fltdur 50868) 0) -> (= fltdur -50868)") (lint-test "(< 256 (+ fltdur 50868))" " <: perhaps (< 256 (+ fltdur 50868)) -> (> fltdur -50612)") (lint-test "(= 256 (+ fltdur 50868))" " =: perhaps (= 256 (+ fltdur 50868)) -> (= fltdur -50612)") (lint-test "(zero? (- x))" " zero?: perhaps (zero? (- x)) -> (zero? x)") (lint-test "(zero? (- x y))" " zero?: perhaps (zero? (- x y)) -> (= x y)") (lint-test "(zero? (- x y z))" " zero?: perhaps (zero? (- x y z)) -> (= x (+ y z))") (lint-test "(zero? (abs x))" " zero?: perhaps (zero? (abs x)) -> (zero? x)") (lint-test "(zero? (imag-part x))" " zero?: perhaps (zero? (imag-part x)) -> (real? x)") (lint-test "(positive? (- x))" " positive?: perhaps (positive? (- x)) -> (negative? x)") (lint-test "(positive? (- x y))" " positive?: perhaps (positive? (- x y)) -> (> x y)") (lint-test "(positive? (- x y z))" " positive?: perhaps (positive? (- x y z)) -> (> x (+ y z))") (lint-test "(negative? (- x))" " negative?: perhaps (negative? (- x)) -> (positive? x)") (lint-test "(negative? (- x y))" " negative?: perhaps (negative? (- x y)) -> (< x y)") (lint-test "(negative? (- x y z))" " negative?: perhaps (negative? (- x y z)) -> (< x (+ y z))") (lint-test "(negative? (string-length s))" " negative?: string-length can't be negative: (negative? (string-length s))") (lint-test "(not (positive? (- n 2)))" " not: perhaps (positive? (- n 2)) -> (> n 2)") (lint-test "(+ 1 +i)" " +: +i is not a number") (lint-test "(let ((|ABS| abs)) |ABS|)" " let: | is not a special character, so |ABS| is not the symbol ABS let: perhaps (let ((|ABS| abs)) |ABS|) -> abs") (lint-test "(char? '#\\a)" " char?: perhaps (char? '#\\a) -> #t char?: (char? '#\\a) is always #t char?: quote is not needed here: '#\\a") (lint-test "(string? '\"a\")" " string?: perhaps (string? '\"a\") -> #t string?: (string? '\"a\") is always #t string?: quote is not needed here: '\"a\"") (lint-test "(memq 1.0 x)" " memq: (memq 1.0 x): perhaps memq -> memv") (lint-test "(assq \"test\" x)" " assq: (assq \"test\" x): perhaps assq -> assoc") (lint-test "(assq (cons 1 2) x)" " assq: (assq (cons 1 2) x): perhaps assq -> assoc") (lint-test "(assv #(a) x)" " assv: (assv #(a) x): perhaps assv -> assoc") (lint-test "(member 'a x (lambda (a b c) (eq? a b)))" " member: member equality function (optional third arg) should take two arguments") (lint-test "(member 'a x (lambda (a b) (eq? a (car b))))" " member: member might perhaps be assq") (lint-test "(member y x (lambda (a b) (equal? a (car b))))" " member: member might perhaps be assoc") (lint-test "(member 1 x (lambda (a b) (> a b)))" " member: perhaps (lambda (a b) (> a b)) -> >") (lint-test "(member 1 x (lambda (a b) (> b a)))" " member: perhaps (lambda (a b) (> b a)) -> <") (lint-test "(member (abs x) lt (lambda (a b) (< b 2)))" " member: a is ignored, so perhaps (member #f ...)") (lint-test "(member 1 x abs)" " member: abs is a questionable member function") (lint-test "(member x (list \"asdf\"))" " member: perhaps (member x (list \"asdf\")) -> (string=? x \"asdf\") member: perhaps (list \"asdf\") -> '(\"asdf\")") (lint-test "(member x (list \"asd\" \"abc\" \"asd\"))" " member: duplicated entry \"asd\" in (list \"asd\" \"abc\" \"asd\") member: perhaps (list \"asd\" \"abc\" \"asd\") -> '(\"asd\" \"abc\" \"asd\")") (lint-test "(memq x '(1))" " memq: perhaps (memq x '(1)) -> (= x 1)") (lint-test "(memq x '(begin))" " memq: perhaps (memq x '(begin)) -> (eq? x 'begin)") (lint-test "(memq x (list 'car))" " memq: perhaps (memq x (list 'car)) -> (eq? x 'car) memq: perhaps (list 'car) -> '(car)") (lint-test "(memq x '(a 'b c))" " memq: stray quote? (memq x '(a 'b c)) memq: memq should be member in (memq x '(a 'b c)) memq: pointless list member: 'b in (memq x '(a 'b c))") (lint-test "(memq x '(a ,b c))" (if (or pure-s7 immutable-unquote) " memq: memq should be member in (memq x '(a ,b c)) memq: pointless list member: ,b in (memq x '(a ,b c))" " memq: memq should be member in (memq x '(a (unquote b) c)) memq: stray comma? (memq x '(a (unquote b) c))")) (lint-test "(memq x '(a (+ 1 2) 3))" "memq: memq should be member in (memq x '(a (+ 1 2) 3)) memq: pointless list member: (+ 1 2) in (memq x '(a (+ 1 2) 3))") (lint-test "(memq x '(a #(a)))" " memq: memq should be member in (memq x '(a #(a))) memq: pointless list member: #(a) in (memq x '(a #(a)))") (lint-test "(memv x '(#f #\\c a 1 () :a))" "") (lint-test "(memq x '(a b a c))" " memq: duplicated entry a in '(a b a c)") (lint-test "(assq x '((a . 1)))" "") (lint-test "(member x (list \"a\" \"b\"))" " member: perhaps (list \"a\" \"b\") -> '(\"a\" \"b\")") (lint-test "(memq x (list 'a 'b 'x))" " memq: perhaps (list 'a 'b 'x) -> '(a b x)") (lint-test "(memq x (map car y))" " memq: perhaps use assoc: (memq x (map car y)) -> (assq x y)") (lint-test "(memq #t (map null? items))" " memq: perhaps (memq #t (map null? items)) -> (memq () items)") (lint-test "(memq #t (map cadr items))" " memq: perhaps avoid 'map: (memq #t (map cadr items)) -> (member #t items (lambda (a b) (cadr b)))") (lint-test "(memq #t (map b items))" " memq: perhaps avoid 'map: (memq #t (map b items)) -> (member #t items (lambda (a c) (b c)))") (lint-test "(member x (map floor items))" " member: perhaps avoid 'map: (member x (map floor items)) -> (member x items (lambda (a b) (equal? a (floor b))))") (lint-test "(member x (map b items))" " member: perhaps avoid 'map: (member x (map b items)) -> (member x items (lambda (a c) (equal? a (b c))))") (lint-test "(member x (cons y z))" " member: perhaps avoid 'cons: (member x (cons y z)) -> (or (equal? x y) (member x z))") (lint-test "(member x (append (list x) y))" " member: perhaps (member x (append (list x) y)) -> (or (equal? x x) (member x y)) member: perhaps (append (list x) y) -> (cons x y)") (lint-test "(memq (string->symbol x) (map string->symbol y))" " memq: perhaps (memq (string->symbol x) (map string->symbol y)) -> (member x y string=?)") (lint-test "(memv #\\= (string->list x))" " memv: perhaps (memv #\\= (string->list x)) -> (char-position #\\= x)") (lint-test "(memv #\\= (string->list x start end))" " memv: perhaps (memv #\\= (string->list x start end)) -> (char-position #\\= x start end)") (lint-test "(memv (string-ref s 0) (string->list x))" " memv: perhaps (memv (string-ref s 0) (string->list x)) -> (char-position (string-ref s 0) x)") (lint-test "(memv (string-ref x 0) '(+ *))" " memv: memv could be memq in (memv (string-ref x 0) '(+ *)) memv: perhaps (memv (string-ref x 0) '(+ *)) -> #f") (lint-test "(memv (string-ref x 0) '(#\\+ -))" " memv: perhaps (memv (string-ref x 0) '(#\\+ -)) -> (memv (string-ref x 0) '(#\\+))") (lint-test "(memq expr '(#t #f))" " memq: perhaps (memq expr '(#t #f)) -> (boolean? expr)") (lint-test "(member (denominator k/n) '(1 2 3 4 6))" " member: (member (denominator k/n) '(1 2 3 4 6)): perhaps member -> memv member: member could be memv in (member (denominator k/n) '(1 2 3 4 6))") (lint-test "(member x '(1 0))" " member: member could be memv in (member x '(1 0))") (lint-test "(memq (strname 0) '(#\\{ #\\[ #\\())" " memq: memq should be memv in (memq (strname 0) '(#\\{ #\\[ #\\())") (lint-test "(member (car op) '(x y z))" " member: member could be memq in (member (car op) '(x y z))") (lint-test "(memv (car op) '(x y z))" " memv: memv could be memq in (memv (car op) '(x y z))") (lint-test "(member (car tail) '(:x :y :z))" " member: member could be memq in (member (car tail) '(:x :y :z))") (lint-test "(member x (list 1 0))" " member: member could be memv in (member x (list 1 0)) member: perhaps (list 1 0) -> '(1 0)") (lint-test "(memq (strname 0) (list #\\{ #\\[ #\\())" " memq: memq should be memv in (memq (strname 0) (list #\\{ #\\[ #\\()) memq: perhaps (list #\\{ #\\[ #\\() -> '(#\\{ #\\[ #\\()") (lint-test "(member (car op) (list x y z))" "") (lint-test "(member (car op) (list \"a\" (f x)))" "") (lint-test "(member (car op) (list \"a\" #(1)))" " member: perhaps (list \"a\" #(1)) -> '(\"a\" #(1)) member: #(1) could be #i(1)") (lint-test "(member (car op) '(\"a\" #()))" "") (lint-test "(memq (car op) '(\"a\" #()))" " memq: memq should be member in (memq (car op) '(\"a\" #())) memq: pointless list member: \"a\" in (memq (car op) '(\"a\" #()))") (lint-test "(member (car op) '(#f ()))" " member: member could be memq in (member (car op) '(#f ()))") (lint-test "(assq c '((#\\b . 2) (#\\o . 8) (#\\d . 10)))" " assq: assq should be assv in (assq c '((#\\b . 2) (#\\o . 8) (#\\d . 10)))") (lint-test "(assq (string-ref name 0) bad-var-names)" "") ; this is ok in s7 (lint-test "(assoc order '((1 . 1.0) (2 . 1.3)) =)" "") (lint-test "(assoc order '((1 . 1.0) (2 . 1.3)))" " assoc: assoc could be assv in (assoc order '((1 . 1.0) (2 . 1.3)))") (lint-test "(assq order '((1 . 1.0) (2 . 1.3)))" " assq: assq should be assv in (assq order '((1 . 1.0) (2 . 1.3)))") (lint-test "(assq c (list '(#\\b . 2) '(#\\o . 8) '(#\\d . 10)))" " assq: assq should be assv in (assq c (list '(#\\b . 2) '(#\\o . 8) '(#\\d . 10))) assq: perhaps (list '(#\\b . 2) '(#\\o . 8) '(#\\d . 10)) -> '((#\\b . 2) (#\\o . 8) (#\\d . 10))") (lint-test "(assoc order (list '(1 . 1.0) '(2 . 1.3)))" " assoc: assoc could be assv in (assoc order (list '(1 . 1.0) '(2 . 1.3))) assoc: perhaps (list '(1 . 1.0) '(2 . 1.3)) -> '((1 . 1.0) (2 . 1.3))") (lint-test "(assoc x y string-position)" "") ; 'not in car sig (lint-test "(assv order (list '(a . 1.0) '(b . 1.3)))" " assv: assv should be assoc in (assv order (list '(a . 1.0) '(b . 1.3))) assv: perhaps (list '(a . 1.0) '(b . 1.3)) -> '((a . 1.0) (b . 1.3))") (lint-test "(member (car (string->list S)) (string->list x))" " member: perhaps (member (car (string->list S)) (string->list x)) -> (char-position (car (string->list S)) x) member: perhaps (car (string->list S)) -> (string-ref S 0)") (lint-test "(memq x '(a # # #))" "") (lint-test "(member x '(a # # #))" " member: member could be memq in (member x '(a # # #))") (lint-test "(memq x '(a # #t #))" "") (lint-test "(member x '(a # #t #))" " member: member could be memq in (member x '(a # #t #))") (lint-test "(if #f x y)" " if: if test is never true: (if #f x y) if: perhaps (if #f x y) -> y") (lint-test "(if #t #f)" " if: if test is never false: (if #t #f) if: perhaps (if #t #f) -> #f") (lint-test "(if x #f #t)" " if: perhaps (if x #f #t) -> (not x)") (lint-test "(if x #t #t)" " if: if is not needed here: (if x #t #t) -> #t") (lint-test "(if x #f #f)" " if: if is not needed here: (if x #f #f) -> #f") (lint-test "(if x (+ y 1) (+ y 1))" " if: if is not needed here: (if x (+ y 1) (+ y 1)) -> (+ y 1)") (lint-test "(if #f #f)" " if: perhaps (if #f #f) -> #") (lint-test "(if #f x)" " if: if test is never true: (if #f x) if: perhaps (if #f x) -> #") (lint-test "(if #t x y)" " if: if test is never false: (if #t x y) if: perhaps (if #t x y) -> x") (lint-test "(if x #t #f)" " if: perhaps (if x #t #f) -> x") (lint-test "(if x y #f)" " if: perhaps (if x y #f) -> (and x y)") (lint-test "(if x y #t)" " if: perhaps (if x y #t) -> (or (not x) y)") (lint-test "(if x #f y)" " if: perhaps (if x #f y) -> (and (not x) y)") (lint-test "(if x #t y)" " if: perhaps (if x #t y) -> (or x y)") (lint-test "(if (not x) y #t)" " if: perhaps (if (not x) y #t) -> (or x y)") (lint-test "(if (not x) #f y)" " if: perhaps (if (not x) #f y) -> (and x y)") (lint-test "(if x x y)" " if: perhaps (if x x y) -> (or x y)") (lint-test "(if (not x) y x)" " if: perhaps (if (not x) y x) -> (or x y)") (lint-test "(if (< 1 2) x y)" " if: perhaps (< 1 2) -> #t if: perhaps (if (< 1 2) x y) -> x") (lint-test "(if (and x z) y #f)" " if: perhaps (if (and x z) y #f) -> (and x z y)") (lint-test "(if (and x z) (and y w) #f)" " if: perhaps (if (and x z) (and y w) #f) -> (and x z y w)") (lint-test "(if (or x z) #t y)" " if: perhaps (if (or x z) #t y) -> (or x z y)") (lint-test "(if (or x z) #t (or y w))" " if: perhaps (if (or x z) #t (or y w)) -> (or x z y w)") (lint-test "(if (not (or x z)) y #t)" " if: perhaps (if (not (or x z)) y #t) -> (or x z y)") (lint-test "(if (not (and x z)) #f y)" " if: perhaps (if (not (and x z)) #f y) -> (and x z y)") (lint-test "(if (cons 1 2) x y)" " if: if test is never false: (if (cons 1 2) x y)") (lint-test "(if (getenv x) x w)" "") ; changed 6-May-22 (lint-test "(if y)" " if: if has too few clauses: (if y)") (lint-test "(if y z a b)" " if: if has too many clauses: (if y z a b)") (lint-test "(if x y (if z y))" " if: perhaps (if x y (if z y)) -> (if (or x z) y)") (lint-test "(if x y (if x y))" " if: perhaps (if x y (if x y)) -> (if x y) if: weird repetition! perhaps (if x y (if x y)) -> (if x y)") (lint-test "(if x (if x y))" " if: perhaps (if x (if x y)) -> (if x y)") (lint-test "(if x (set! y #t) (set! y #f))" " if: perhaps (if x (set! y #t) (set! y #f)) -> (set! y x)") (lint-test "(if x (f 1 2 1) (f 1 2 2))" " if: perhaps (if x (f 1 2 1) (f 1 2 2)) -> (f 1 2 (if x 1 2))") (lint-test "(if x (f 1 1 1) (f 1 2 1))" " if: perhaps (if x (f 1 1 1) (f 1 2 1)) -> (f 1 (if x 1 2) 1)") (lint-test "(if x (f (+ x 1) (* y 2) (+ x 1)) (f (+ x 1) (+ x 1) (+ x 1)))" " if: perhaps (if x (f (+ x 1) (* y 2) (+ x 1)) (f (+ x 1) (+ x 1) (+ x 1))) -> (f (+ x 1) (if x (* y 2) (+ x 1)) (+ x 1))") (lint-test "(if (and (= x y) z) (+ x 1) #f)" " if: perhaps (if (and (= x y) z) (+ x 1) #f) -> (and (= x y) z (+ x 1))") (lint-test "(if x (f y) (else z))" " if: else (as car of false branch of if) makes no sense: (if x (f y) (else z))") (lint-test "(if old (list form) (cons form old))" " if: perhaps (if old (list form) (cons form old)) -> (cons form (if old () old))") (lint-test "(if old (cons form old) (list form))" " if: perhaps (if old (cons form old) (list form)) -> (cons form (or old ()))") (lint-test "(if (not x) (list y) (cons y x))" " if: perhaps (if (not x) (list y) (cons y x)) -> (cons y (or x ()))") (lint-test "(if (not x) (cons y x) (list y))" " if: perhaps (if (not x) (cons y x) (list y)) -> (cons y (if (not x) x ()))") (lint-test "(if (float-vector-ref fv 0) 0 1)" " if: if test is never false: (if (float-vector-ref fv 0) 0 1)") (lint-test "(if x (set! y #f) (set! y #t))" " if: perhaps (if x (set! y #f) (set! y #t)) -> (set! y (not x))") (lint-test "(if x (set! y x) (set! y 21))" " if: perhaps (if x (set! y x) (set! y 21)) -> (set! y (or x 21))") (lint-test "(if x (set! y z) (set! y w))" " if: perhaps (if x (set! y z) (set! y w)) -> (set! y (if x z w))") (lint-test "(if x (+ y 1) (- y 1))" " if: perhaps (if x (+ y 1) (- y 1)) -> ((if x + -) y 1)") (lint-test "(if x (set! y 1) (set! y (+ x 1)))" " if: perhaps (if x (set! y 1) (set! y (+ x 1))) -> (set! y (if x 1 (+ x 1)))") (lint-test "(if x (set! y (+ x 1)) (set! y 1))" " if: perhaps (if x (set! y (+ x 1)) (set! y 1)) -> (set! y (if x (+ x 1) 1))") (lint-test "(if x (or y z) (and y z))" " if: perhaps (if x (or y z) (and y z)) -> ((if x or and) y z)") (lint-test "(if x (or (f y) z) (and y (f z)))" "") (lint-test "(if (positive? x) (log x) (exp x))" " if: perhaps (if (positive? x) (log x) (exp x)) -> ((if (positive? x) log exp) x)") (lint-test "(if x (if y z))" " if: perhaps (if x (if y z)) -> (if (and x y) z)") (lint-test "(if (cadr x) (if (cadr x) 0))" " if: perhaps (if (cadr x) (if (cadr x) 0)) -> (if (cadr x) 0)") (lint-test "(if (cadr x) 3 (if (not (cadr x)) 4))" " if: perhaps (if (cadr x) 3 (if (not (cadr x)) 4)) -> (if (cadr x) 3 4)") (lint-test "(if (cadr x) 3 (if (not (cadr x)) 4 5))" " if: perhaps (if (cadr x) 3 (if (not (cadr x)) 4 5)) -> (if (cadr x) 3 4)") (lint-test "(if x x y)" " if: perhaps (if x x y) -> (or x y)") (lint-test "(if (not x) x y)" " if: perhaps (if (not x) x y) -> (and x y)") (lint-test "(if x (not x) y)" " if: perhaps (if x (not x) y) -> (and (not x) y)") (lint-test "(if x y (not x))" " if: perhaps (if x y (not x)) -> (or (not x) y)") (lint-test "(if a A A)" " if: if is not needed here: (if a A A) -> A") (lint-test "(if A A (if B B C))" " if: perhaps (if A A (if B B C)) -> (or A (if B B C)) if: perhaps (if B B C) -> (or B C)") (lint-test "(if a (if b A) A)" " if: perhaps (if a (if b A) A) -> (if (or (not a) b) A)") (lint-test "(if a (if (not a) B) A)" " if: perhaps (if a (if (not a) B) A) -> (if (not a) A)") (lint-test "(if a (if (not a) B C) A)" " if: perhaps (if a (if (not a) B C) A) -> (if a C A)") (lint-test "(if a A (if b B A))" " if: perhaps (if a A (if b B A)) -> (if (or a (not b)) A B)") (lint-test "(if a A (if b A B))" " if: perhaps (if a A (if b A B)) -> (if (or a b) A B)") (lint-test "(if a (if b B A) A)" " if: perhaps (if a (if b B A) A) -> (if (and a b) B A)") (lint-test "(if a (if b A B) A)" " if: perhaps (if a (if b A B) A) -> (if (and a (not b)) B A)") (lint-test "(if a A (if (not a) B))" " if: perhaps (if a A (if (not a) B)) -> (if a A B)") (lint-test "(if A (if B C D) D)" " if: perhaps (if A (if B C D) D) -> (if (and A B) C D)") (lint-test "(if A (if B C D) C)" " if: perhaps (if A (if B C D) C) -> (if (and A (not B)) D C)") (lint-test "(if A B (if C B D))" " if: perhaps (if A B (if C B D)) -> (if (or A C) B D)") (lint-test "(if A B (if C D B))" " if: perhaps (if A B (if C D B)) -> (if (or A (not C)) B D)") (lint-test "(if A (and B C) (and B D))" " if: perhaps (if A (and B C) (and B D)) -> (and B (if A C D))") (lint-test "(if A (or B C) (or B D))" " if: perhaps (if A (or B C) (or B D)) -> (or B (if A C D))") (lint-test "(if A (and B C) (and D C))" " if: perhaps (if A (and B C) (and D C)) -> (and (if A B D) C)") (lint-test "(if A (or B C) (or D C))" " if: perhaps (if A (or B C) (or D C)) -> (or (if A B D) C)") (lint-test "(if a (if b A B) (if b B A))" " if: perhaps (if a (if b A B) (if b B A)) -> (if (eq? (not a) (not b)) A B)") (lint-test "(if (not a) (if b A B) (if b B A))" " if: perhaps (if (not a) (if b A B) (if b B A)) -> (if (eq? (not a) (not b)) B A)") (lint-test "(if (not a) (if (not b) A B) (if (not b) B A))" " if: perhaps (if (not a) (if (not b) A B) (if (not b) B A)) -> (if (eq? (not a) (not b)) A B)") (lint-test "(if a (if (not b) A B) (if (not b) B A))" " if: perhaps (if a (if (not b) A B) (if (not b) B A)) -> (if (eq? (not a) (not b)) B A)") (lint-test "(if a (if b A B) (if b A B))" " if: if is not needed here: (if a (if b A B) (if b A B)) -> (if b A B)") (lint-test "(if test (< a b) (> b a))" " if: if is not needed here: (if test (< a b) (> b a)) -> (< a b)") (lint-test "(if test (< a b c) (> c b a))" " if: if is not needed here: (if test (< a b c) (> c b a)) -> (< a b c)") (lint-test "(if test (* a b) (* b a))" " if: if is not needed here: (if test (* a b) (* b a)) -> (* a b)") (lint-test "(if test (< a b) (not (>= a b)))" " if: if is not needed here: (if test (< a b) (not (>= a b))) -> (< a b) if: perhaps (not (>= a b)) -> (< a b)") (lint-test "(if A (if B C #f) #f)" " if: perhaps (if A (if B C #f) #f) -> (and A B C) if: perhaps (if B C #f) -> (and B C)") (lint-test "(if A (if B #f D) #f)" " if: perhaps (if A (if B #f D) #f) -> (and A (not B) D) if: perhaps (if B #f D) -> (and (not B) D)") (lint-test "(if A #f (if C #f D))" " if: perhaps (if A #f (if C #f D)) -> (and (not (or A C)) D) if: perhaps (if C #f D) -> (and (not C) D)") (lint-test "(if A #f (if C D #f))" " if: perhaps (if A #f (if C D #f)) -> (and (not A) C D) if: perhaps (if C D #f) -> (and C D)") (lint-test "(if A (if B d c) (if B d a))" " if: perhaps (if A (if B d c) (if B d a)) -> (if B d (if A c a))") (lint-test "(if A (if B c a) (if B d a))" " if: perhaps (if A (if B c a) (if B d a)) -> (if B (if A c d) a)") (lint-test "(if (> (random 10) 1) (> (random 10) 1) x)" "") (lint-test "(if (assq (string->symbol x) y) (assq (string->symbol x) y) z)" " if: perhaps (if (assq (string->symbol x) y) (assq (string->symbol x) y) z) -> (or (assq (string->symbol x) y) z)") (lint-test "(if x y x)" " if: perhaps (if x y x) -> (and x y)") (lint-test "(if (> x 1) (> x 1) (< x 2))" " if: perhaps (if (> x 1) (> x 1) (< x 2)) -> #t") (lint-test "(if x x x)" " if: perhaps (if x x x) -> x if: if is not needed here: (if x x x) -> x") (lint-test "(if x x)" " if: perhaps (if x x) -> (or x #)") (lint-test "(if (> x 1) (> x 1))" " if: perhaps (if (> x 1) (> x 1)) -> (or (> x 1) #)") (lint-test "(if (display x) (display x) y)" "") (lint-test "(if (= x 1) 2 (if (= x 3) 2 3))" "if: perhaps (if (= x 1) 2 (if (= x 3) 2 3)) -> (case x ((1) 2) ((3) 2) (else 3)) if: perhaps (if (= x 1) 2 (if (= x 3) 2 3)) -> (if (member x '(1 3) =) 2 3)") (lint-test "(if a b (if c d (if e f g)))" " if: perhaps use cond: (if a b (if c d (if e f g))) -> (cond (a b) (c d) (e f) (else g))") (lint-test "(if a b (if c d (if e f)))" " if: perhaps use cond: (if a b (if c d (if e f))) -> (cond (a b) (c d) (e f))") (lint-test "(if a (begin (b) c) (if d e (if f g (begin (h) i))))" " if: perhaps use cond: (if a (begin (b) c) (if d e (if f g (begin (h) i)))) -> (cond (a (b) c) (d e) (f g) (else (h) i))") (lint-test "(if (f x) (g (f x)))" " if: perhaps (if (f x) (g (f x))) -> (cond ((f x) => g))") (lint-test "(if (f x) (g (f x)) z)" " if: perhaps (if (f x) (g (f x)) z) -> (cond ((f x) => g) (else z))") (lint-test "(if x (set! y z) (set! w z))" "") (lint-test "(if x (set! y x) (set! y #f))" " if: perhaps (if x (set! y x) (set! y #f)) -> (set! y x)") (lint-test "(if x (set! y z) (set! y w))" " if: perhaps (if x (set! y z) (set! y w)) -> (set! y (if x z w))") (lint-test "(if x (set! y (+ 1 z)) (set! y (+ 1 w)))" " if: perhaps (if x (set! y (+ 1 z)) (set! y (+ 1 w))) -> (set! y (+ 1 (if x z w)))") (lint-test "(if (< x y) (set! x y))" " if: perhaps (if (< x y) (set! x y)) -> (set! x (max x y))") (lint-test "(if (<= y x) (set! x y))" " if: perhaps (if (<= y x) (set! x y)) -> (set! x (min x y))") (lint-test "(if (> x y) (set! x y))" " if: perhaps (if (> x y) (set! x y)) -> (set! x (min x y))") (lint-test "(if (>= y x) (set! x y))" " if: perhaps (if (>= y x) (set! x y)) -> (set! x (max x y))") (lint-test "(if (< x y) x y)" " if: perhaps (if (< x y) x y) -> (min x y)") (lint-test "(if (< x y) y x)" " if: perhaps (if (< x y) y x) -> (max y x)") (lint-test "(if (> x y) x y)" " if: perhaps (if (> x y) x y) -> (max x y)") (lint-test "(if (> x y) y x)" " if: perhaps (if (> x y) y x) -> (min y x)") (lint-test "(if (= x y) x y)" " if: perhaps (if (= x y) x y) -> y") (lint-test "(if (= x y) y x)" " if: perhaps (if (= x y) y x) -> x") (lint-test "(if (pair? x) #t #f)" " if: perhaps (if (pair? x) #t #f) -> (pair? x)") (lint-test "(if (pair? x) #t z)" " if: perhaps (if (pair? x) #t z) -> (or (pair? x) z)") (lint-test "(if x (not y) (not z))" "") (lint-test "(if (and (symbol? name) (not (defined? name))) 3 2)" "") (lint-test "(if (and (symbol? name) (not (constant? name))) 3 2)" "") (lint-test "(if (and (let? obj) (defined? 'value obj)) 3 2)" "") (lint-test "(define (f1 snd progress) (let ((fc (list 1.0 progress 0.0))) fc))" " f1: perhaps (let ((fc (list 1.0 progress 0.0))) fc) -> (list 1.0 progress 0.0)") (lint-test "(define (f1 snd) (let ((fc (list 1.0 :progress 0.0))) (copy fc)))" "f1: perhaps (let ((fc (list 1.0 :progress 0.0))) (copy fc)) -> (copy (list 1.0 :progress 0.0)) f1: fc can probably be moved to f1's closure") (lint-test "(if (> (vector-ref ind i) (vector-ref ind j)) (vector-set! ind i (vector-ref ind j)))" " if: perhaps (if (> (vector-ref ind i) (vector-ref ind j)) (vector-set! ind i... -> (vector-set! ind i (min (vector-ref ind i) (vector-ref ind j)))") (lint-test "(if (<= (list-ref ind i) (list-ref ind j)) (list-set! ind i (list-ref ind j)))" " if: perhaps (if (<= (list-ref ind i) (list-ref ind j)) (list-set! ind i (list-ref ind j))) -> (list-set! ind i (max (list-ref ind i) (list-ref ind j)))") (lint-test "(if (<= (list-ref ind i) 32) (list-set! ind i 32))" " if: perhaps (if (<= (list-ref ind i) 32) (list-set! ind i 32)) -> (list-set! ind i (max (list-ref ind i) 32))") (lint-test "(if (<= 32 (list-ref ind i)) (list-set! ind i 32))" " if: perhaps (if (<= 32 (list-ref ind i)) (list-set! ind i 32)) -> (list-set! ind i (min 32 (list-ref ind i)))") (lint-test "(if (> 32 (list-ref ind i)) (list-set! ind i 32))" " if: perhaps (if (> 32 (list-ref ind i)) (list-set! ind i 32)) -> (list-set! ind i (max 32 (list-ref ind i)))") (lint-test "(if (eq? (car sv) 'list-values) 'list (car sv))" " if: perhaps use case: (if (eq? (car sv) 'list-values) 'list (car sv)) -> (case (car sv) ((list-values) 'list) (else))") (lint-test "(if (eq? (car sv) 'list-values) (car sv) 'list)" " if: perhaps use case: (if (eq? (car sv) 'list-values) (car sv) 'list) -> (case (car sv) ((list-values)) (else 'list))") (lint-test "(let ((q (car sv))) (if (eq? q 'list-values) 'list q))" " let: perhaps use case: (let ((q (car sv))) (if (eq? q 'list-values) 'list q)) -> (case (car sv) ((list-values) 'list) (else))") (lint-test "(let ((q (car sv))) (if (eq? q 'list-values) q 'list))" " let: perhaps use case: (let ((q (car sv))) (if (eq? q 'list-values) q 'list)) -> (case (car sv) ((list-values)) (else 'list))") (lint-test "(if (eq? (caddr x) 'a) b (caddr x))" " if: perhaps use case: (if (eq? (caddr x) 'a) b (caddr x)) -> (case (caddr x) ((a) b) (else))") (lint-test "(let ((q (caddr x))) (if (eq? q 'a) b q))" " let: perhaps use case: (let ((q (caddr x))) (if (eq? q 'a) b q)) -> (case (caddr x) ((a) b) (else))") (lint-test "(let ((q (read-char sv))) (if (eof-object? q) 0 q))" " let: perhaps use case: (let ((q (read-char sv))) (if (eof-object? q) 0 q)) -> (case (read-char sv) ((#) 0) (else))") (lint-test "(let ((q (f x))) (if (null? q) 0 q))" " let: perhaps use case: (let ((q (f x))) (if (null? q) 0 q)) -> (case (f x) ((()) 0) (else))") (lint-test "(let* ((p 32) (q (* p (car sv)))) (if (= q 0) q p))" " let*: perhaps use case: (let* ((p 32) (q (* p (car sv)))) (if (= q 0) q p)) -> (let ((p 32)) (case (* p (car sv)) ((0)) (else p)))") (lint-test "(let ((q (read-char sv))) (if (eof-object? q) 0 (f q)))" " let: perhaps use case: (let ((q (read-char sv))) (if (eof-object? q) 0 (f q))) -> (case (read-char sv) ((#) 0) (else => f))") (lint-test "(let ((q (read-char sv))) (if (eof-object? q) (f q) 0))" " let: perhaps use case: (let ((q (read-char sv))) (if (eof-object? q) (f q) 0)) -> (case (read-char sv) ((#) => f) (else 0))") (lint-test "(if (null? (f x)) 0 (f x))" " if: perhaps use case: (if (null? (f x)) 0 (f x)) -> (case (f x) ((()) 0) (else))") (lint-test "(if (null? (caddr x)) 0 (caddr x))" " if: perhaps use case: (if (null? (caddr x)) 0 (caddr x)) -> (case (caddr x) ((()) 0) (else))") (lint-test "(if (null? (caddr x)) () (caddr x))" " if: perhaps use case: (if (null? (caddr x)) () (caddr x)) -> (case (caddr x) ((()) ()) (else))") (lint-test "(if (eq? (car sv) 'a) 'list (f (car sv)))" " if: perhaps use case: (if (eq? (car sv) 'a) 'list (f (car sv))) -> (case (car sv) ((a) 'list) (else => f))") (lint-test "(if (eq? (car sv) 'a) (f (car sv)) 'list)" " if: perhaps use case: (if (eq? (car sv) 'a) (f (car sv)) 'list) -> (case (car sv) ((a) => f) (else 'list))") (lint-test "(let ((q (car sv))) (cond ((eq? q 'list-values) 'list) (else q)))" " let: perhaps use case: (let ((q (car sv))) (cond ((eq? q 'list-values) 'list) (else q))) -> (case (car sv) ((list-values) 'list) (else))") (lint-test "(if A (f x) (or (f x) (g y)))" " if: perhaps (if A (f x) (or (f x) (g y))) -> (or (f x) (and (not A) (g y)))") (lint-test "(if A (or (f x) (g y)) (f x))" " if: perhaps (if A (or (f x) (g y)) (f x)) -> (or (f x) (and A (g y)))") (lint-test "(if A (f x) (or (f x) (g y) (h z)))" " if: perhaps (if A (f x) (or (f x) (g y) (h z))) -> (or (f x) (and (not A) (or (g y) (h z))))") (lint-test "(if A (or (f x) (g y) (h z)) (f x))" " if: perhaps (if A (or (f x) (g y) (h z)) (f x)) -> (or (f x) (and A (or (g y) (h z))))") (lint-test "(if A (or (f x) (h z)) (or (f x) (g y)))" " if: perhaps (if A (or (f x) (h z)) (or (f x) (g y))) -> (or (f x) (if A (h z) (g y)))") (lint-test "(if A (and (f x) (h z)) (and (f x) (g y)))" " if: perhaps (if A (and (f x) (h z)) (and (f x) (g y))) -> (and (f x) (if A (h z) (g y)))") (lint-test "(if A (f x) (begin (f x) (g y)))" " if: perhaps (if A (f x) (begin (f x) (g y))) -> (begin (f x) (when (not A) (g y)))") (lint-test "(if A (begin (f x) (g y)) (f x))" " if: perhaps (if A (begin (f x) (g y)) (f x)) -> (begin (f x) (when A (g y)))") (lint-test "(if A (f x) (begin (f x) (g y) (h z)))" " if: perhaps (if A (f x) (begin (f x) (g y) (h z))) -> (begin (f x) (when (not A) (g y) (h z)))") (lint-test "(if A (begin (f x) (g y) (h z)) (f x))" " if: perhaps (if A (begin (f x) (g y) (h z)) (f x)) -> (begin (f x) (when A (g y) (h z)))") (lint-test "(if x (set! a (* 2 b)) (set! a (* 3 b)))" " if: perhaps (if x (set! a (* 2 b)) (set! a (* 3 b))) -> (set! a (* (if x 2 3) b))") (lint-test "(if x y (cond ((= y z) 2) (else 3)))" " if: perhaps (if x y (cond ((= y z) 2) (else 3))) -> (cond (x y) ((= y z) 2) (else 3))") (lint-test "(if x y (cond ((= y z) 2) ((= y 2) 3)))" " if: perhaps (if x y (cond ((= y z) 2) ((= y 2) 3))) -> (cond (x y) ((= y z) 2) ((= y 2) 3))") (lint-test "(if (eof-object? x) 32 (case x ((#\\a) 3) (else 4)))" " if: perhaps (if (eof-object? x) 32 (case x ((#\\a) 3) (else 4))) -> (case x ((#) 32) ((#\\a) 3) (else 4)) if: perhaps (case x ((#\\a) 3) (else 4)) -> (if (eqv? x #\\a) 3 4)") (lint-test "(if (< x 0) (if (< y 0) (if (< z 0) (+ a b c d e f g h i j k l m n o p q r s) z) y) x)" " if: perhaps (if (< x 0) (if (< y 0) (if (< z 0) (+ a b c d e f g h i j k l m n o p q r... -> (cond ((>= x 0) x) ((>= y 0) y) ((>= z 0) z) (else (+ a b c d e f g h i j k l m n o p q r s))) if: surely there's a better name for this variable than l") (lint-test "(if (< x 0) (if (< y 0) y (if (< z 0) z (+ a b c d e f g h i j k l m n o p q r s))) x)" " if: perhaps (if (< x 0) (if (< y 0) y (if (< z 0) z (+ a b c d e f g h i j k l m n o p... -> (cond ((>= x 0) x) ((< y 0) y) ((< z 0) z) (else (+ a b c d e f g h i j k l m n o p q r s))) if: surely there's a better name for this variable than l") (lint-test "(if (< x 0) x (if (< y 0) (if (< z 0) (+ a b c d e f g h i j k l m n o p q r s) z) y))" " if: perhaps (if (< x 0) x (if (< y 0) (if (< z 0) (+ a b c d e f g h i j k l m n o p q... -> (cond ((< x 0) x) ((>= y 0) y) ((>= z 0) z) (else (+ a b c d e f g h i j k l m n o p q r s))) if: surely there's a better name for this variable than l") (lint-test "(if (< x 1) (let ((y (+ x 1)) (z (- x 1))) (+ y z)) (let ((y (+ x 1)) (z (+ x 2))) (- y z)))" " if: perhaps (if (< x 1) (let ((y (+ x 1)) (z (- x 1))) (+ y z)) (let ((y (+ x 1)) (z... -> (let ((y (+ x 1))) (if (< x 1) (let ((z (- x 1))) (+ y z)) (let ((z (+ x 2))) (- y z)))) if: perhaps (let ((y (+ x 1)) (z (- x 1))) (+ y z)) -> (+ (+ x 1) (- x 1)) if: perhaps (let ((y (+ x 1)) (z (+ x 2))) (- y z)) -> (- (+ x 1) (+ x 2))") (lint-test "(if (< x 1) (let ((y (+ x 1)) (z (- x 1))) (+ y z)) (let ((y (+ x 1)) (z (- x 1))) (- y z)))" " if: perhaps (if (< x 1) (let ((y (+ x 1)) (z (- x 1))) (+ y z)) (let ((y (+ x 1)) (z... -> (let ((<1> (< x 1))) (let ((y (+ x 1)) (z (- x 1))) ((if <1> + -) y z))) if: perhaps (let ((y (+ x 1)) (z (- x 1))) (+ y z)) -> (+ (+ x 1) (- x 1)) if: perhaps (let ((y (+ x 1)) (z (- x 1))) (- y z)) -> (- (+ x 1) (- x 1))") (lint-test "(if (> (+ a b) 3) (let ((a x) (c y)) (* a (log c))) (let ((b z) (c y)) (+ b (log c))))" "if: perhaps (if (> (+ a b) 3) (let ((a x) (c y)) (* a (log c))) (let ((b z) (c y)) (+... -> (let ((c y)) (if (> (+ a b) 3) (let ((a x)) (* a (log c))) (let ((b z)) (+ b (log c))))) if: perhaps (let ((a x) (c y)) (* a (log c))) -> (* x (log y)) if: perhaps (let ((b z) (c y)) (+ b (log c))) -> (+ z (log y))") (lint-test "(if (> (+ a b) 3) (let ((a (+ x 1)) (c y)) (* a (log c))) (let ((a (+ x 1)) (c y)) (+ a (log c))))" " if: perhaps (if (> (+ a b) 3) (let ((a (+ x 1)) (c y)) (* a (log c))) (let ((a (+ x... -> (let ((<1> (> (+ a b) 3))) (let ((a (+ x 1)) (c y)) ((if <1> * +) a (log c)))) if: perhaps (let ((a (+ x 1)) (c y)) (* a (log c))) -> (* (+ x 1) (log y)) if: perhaps (let ((a (+ x 1)) (c y)) (+ a (log c))) -> (+ (+ x 1) (log y))") (lint-test "(let ((a (f x)) (b (g y)) (c (g z))) (h a b c))" " let: perhaps (let ((a (f x)) (b (g y)) (c (g z))) (h a b c)) -> (h (f x) (g y) (g z))") (lint-test "(if a (if b d e) (if c d e))" " if: perhaps (if a (if b d e) (if c d e)) -> (if (if a b c) d e)") (lint-test "(if a (if b d) (if c d))" " if: perhaps (if a (if b d) (if c d)) -> (if (if a b c) d)") (lint-test "(if a (if (f b) d) (if (f c) d))" " if: perhaps (if a (if (f b) d) (if (f c) d)) -> (if (if a (f b) (f c)) d)") (lint-test "(if a (if b c d) d)" " if: perhaps (if a (if b c d) d) -> (if (and a b) c d)") (lint-test "(if x y (if (not x) z w))" " if: perhaps (if x y (if (not x) z w)) -> (if x y z)") (lint-test "(if x y (if (not x) z))" " if: perhaps (if x y (if (not x) z)) -> (if x y z)") (lint-test "(if x y (if x z))" " if: perhaps (if x y (if x z)) -> (if x y)") (lint-test "(if x y (if x z w))" " if: perhaps (if x y (if x z w)) -> (if x y w)") (lint-test "(if x (if x z w) y)" " if: perhaps (if x (if x z w) y) -> (if x z y)") (lint-test "(if x (if x z w))" " if: perhaps (if x (if x z w)) -> (if x z w)") (lint-test "(if x (if x z) w)" " if: perhaps (if x (if x z) w) -> (if x z w)") (lint-test "(if x (if x y))" " if: perhaps (if x (if x y)) -> (if x y)") (lint-test "(if x (if (not x) z w) y)" " if: perhaps (if x (if (not x) z w) y) -> (if x w y)") (lint-test "(if x (if (not x) z w))" " if: perhaps (if x (if (not x) z w)) -> w") (lint-test "(if x (if (not x) z) w)" " if: perhaps (if x (if (not x) z) w) -> (if (not x) w)") (lint-test "(if A (and B C) (and B D))" " if: perhaps (if A (and B C) (and B D)) -> (and B (if A C D))") (lint-test "(if A (and B C E) (and B D E))" " if: perhaps (if A (and B C E) (and B D E)) -> (and B (if A C D) E)") (lint-test "(if A (list B C) (list B D))" " if: perhaps (if A (list B C) (list B D)) -> (list B (if A C D))") (lint-test "(if A (+ B C) (+ B D))" " if: perhaps (if A (+ B C) (+ B D)) -> (+ B (if A C D))") (lint-test "(if A (< B C) (< B D))" " if: perhaps (if A (< B C) (< B D)) -> (< B (if A C D))") (lint-test "(if A (list B C E) (list B D))" "") ; used to suggest values here (lint-test "(if A (+ B C E) (+ B D))" " if: perhaps (if A (+ B C E) (+ B D)) -> (+ B (if A (+ C E) D))") (lint-test "(if A (< B C E) (< B D))" "") (lint-test "(if A (and B C E) (and B D))" " if: perhaps (if A (and B C E) (and B D)) -> (and B (if A (and C E) D))") (lint-test "(if A (and B C E) (and B D F))" " if: perhaps (if A (and B C E) (and B D F)) -> (and B (if A (and C E) (and D F)))") (lint-test "(if A (or B C E) (or B D))" " if: perhaps (if A (or B C E) (or B D)) -> (or B (if A (or C E) D))") (lint-test "(if A (or B C E) (or B D F))" " if: perhaps (if A (or B C E) (or B D F)) -> (or B (if A (or C E) (or D F)))") (lint-test "(if A (or B C E) (or B C D F))" " if: perhaps (if A (or B C E) (or B C D F)) -> (or B C (if A E (or D F)))") (lint-test "(if A (or B C) (or B C D F))" "") (lint-test "(if A (+ B E C) (+ D E C))" " if: perhaps (if A (+ B E C) (+ D E C)) -> (+ (if A B D) E C)") (lint-test "(if A (+ B B E C) (+ D D E C))" " if: perhaps (if A (+ B B E C) (+ D D E C)) -> (+ (if A (+ B B) (+ D D)) E C)") (lint-test "(if A (if B C D) (if (not B) C D))" " if: perhaps (if A (if B C D) (if (not B) C D)) -> (if (eq? (not A) (not B)) C D)") (lint-test "(if A (if (not B) C D) (if B C D))" " if: perhaps (if A (if (not B) C D) (if B C D)) -> (if (not (eq? (not A) (not B))) C D)") (lint-test "(if A (if B C D) (if E C D))" " if: perhaps (if A (if B C D) (if E C D)) -> (if (if A B E) C D)") (lint-test "(+ (if A B C) (if A C D) y)" " +: perhaps (+ (if A B C) (if A C D) y) -> (+ (if A (values B C) (values C D)) y)") (lint-test "(if A (cond (C D) (else F)) B)" " if: perhaps (if A (cond (C D) (else F)) B) -> (cond ((not A) B) (C D) (else F))") (lint-test "(if A (cond (C D) (else F)))" " if: perhaps (if A (cond (C D) (else F))) -> (cond ((not A) #) (C D) (else F))") (lint-test "(if (code-constant? setv) (list 'fill! (cadr body) (cadddr body) start end) (list 'copy (cadr setv) (cadr body) start end))" "") (lint-test "(if (code-constant? setv) (list 'fill! (cadr body) (cadddr body) start end start end) (list 'copy (cadr setv) (cadr body) start end start end))" " if: perhaps (if (code-constant? setv) (list 'fill! (cadr body) (cadddr body) start end... -> (list (if (code-constant? setv) (values 'fill! (cadr body) (cadddr body)) (values 'copy (cadr setv) (cadr body))) start end start end)") (lint-test "(if (code-constant? setv) (list 'fill! start end (cadr body) (cadddr body) start end) (list 'fill! start end (cadr setv) (cadr body) start end))" "") (lint-test "(if (code-constant? setv) (list 'fill! start end start (cadr body) (cadddr body)) (list 'fill! start end start (cadr setv) (cadr body)))" " if: perhaps (if (code-constant? setv) (list 'fill! start end start (cadr body) (cadddr... -> (list 'fill! start end start (if (code-constant? setv) (values (cadr body) (cadddr body)) (values (cadr setv) (cadr body))))") (lint-test "(if x (begin (f y)) (begin (g y)))" " if: perhaps (if x (begin (f y)) (begin (g y))) -> (begin ((if x f g) y)) if: begin could be omitted: (begin (f y)) if: begin could be omitted: (begin (g y))") (lint-test "(if x (f 2 y) (f 4 y))" " if: perhaps (if x (f 2 y) (f 4 y)) -> (f (if x 2 4) y)") (lint-test "(if x (f 2 y) (f 4 z))" "") (lint-test "(if x (let ((z (log y))) (f 2 y z)) (let ((z (log y))) (f 4 y z)))" " if: perhaps (if x (let ((z (log y))) (f 2 y z)) (let ((z (log y))) (f 4 y z))) -> (let ((<1> x)) (let ((z (log y))) (f (if <1> 2 4) y z))) if: perhaps (let ((z (log y))) (f 2 y z)) -> (f 2 y (log y)) if: perhaps (let ((z (log y))) (f 4 y z)) -> (f 4 y (log y))") (lint-test "(if restarting? (eq? 'ronly opt) (eq? 'sonly opt))" " if: perhaps (if restarting? (eq? 'ronly opt) (eq? 'sonly opt)) -> (eq? (if restarting? 'ronly 'sonly) opt)") (lint-test "(if x (let* ((y (f x)) (z (g x))) (display y) (list y z)) (let* ((y (f x)) (z (g x))) (display z) (list y z)))" " if: perhaps (if x (let* ((y (f x)) (z (g x))) (display y) (list y z)) (let* ((y (f x))... -> (let ((<1> x)) (let* ((y (f x)) (z (g x))) (display (if <1> y z)) (list y z)))") (lint-test "(if x (let ((y (f x))) (display y) (list z)) (let ((y (g x))) (display y) (list z)))" " if: perhaps (if x (let ((y (f x))) (display y) (list z)) (let ((y (g x))) (display y)... -> (let ((y ((if x f g) x))) (display y) (list z)) if: perhaps (let ((y (f x))) (display y) (list z)) -> (let () (display (f x)) (list z)) if: perhaps (let ((y (g x))) (display y) (list z)) -> (let () (display (g x)) (list z))") (lint-test "(if x (let ((y (f x))) (display y) z) (let ((y (g x))) (f y) z))" " if: perhaps (let ((y (f x))) (display y) z) -> (let () (display (f x)) z) if: perhaps, assuming f is not a macro, (let ((y (g x))) (f y) z) -> (let () (f (g x)) z)") (lint-test "(if x (let ((y (abs x))) (display z) y) (let ((y (log x))) (display z) y))" " if: perhaps (if x (let ((y (abs x))) (display z) y) (let ((y (log x))) (display z) y)) -> (let ((y ((if x abs log) x))) (display z) y)") (lint-test "(if x (let loop1 ((x y)) (if (null? x) 1 (loop1 (cdr x)))) (let loop2 ((x z)) (if (null? x) 1 (loop2 (cdr x)))))" " loop1: perhaps (let loop1 ((x y)) (if (null? x) 1 (loop1 (cdr x)))) -> (do ((x y (cdr x))) ((null? x) 1)) loop2: perhaps (let loop2 ((x z)) (if (null? x) 1 (loop2 (cdr x)))) -> (do ((x z (cdr x))) ((null? x) 1))") (lint-test "(let loop ((x y)) (case x ((1) (display b)) (else (display c) (loop (+ x 1)))))" " loop: perhaps (let loop ((x y)) (case x ((1) (display b)) (else (display c) (loop (+ x 1))))) -> (do ((x y (+ x 1))) ((memv x '(1)) (display b)) (display c))") (lint-test "(let loop ((x y)) (when (zero? x) (loop (- x 1))))" " loop: perhaps (let loop ((x y)) (when (zero? x) (loop (- x 1)))) -> (do ((x y (- x 1))) ((not (zero? x))))") (lint-test "(let loop ((x y)) (unless (zero? x) (loop (- x 1))))" " loop: perhaps (let loop ((x y)) (unless (zero? x) (loop (- x 1)))) -> (do ((x y (- x 1))) ((zero? x)))") (lint-test "(let loop ((x y)) (when (zero? x) (display b) (loop (- x 1)) x))" "") (lint-test "(let loop ((x y)) (when (zero? x) (display b) (loop (- x 1))))" " loop: perhaps (let loop ((x y)) (when (zero? x) (display b) (loop (- x 1)))) -> (do ((x y (- x 1))) ((not (zero? x))) (display b))") (lint-test "(if polar (let ((vals (parse-polar-coordinates points 3d))) (set! (bezier-x xpath) (car vals)) (set! (bezier-y xpath) (cadr vals)) (set! (bezier-z xpath) (caddr vals)) (set! (bezier-v xpath) (cadddr vals))) (let ((vals (parse-cartesian-coordinates points 3d))) (set! (bezier-x xpath) (car vals)) (set! (bezier-y xpath) (cadr vals)) (set! (bezier-z xpath) (caddr vals)) (set! (bezier-v xpath) (cadddr vals))))" " if: perhaps (if polar (let ((vals (parse-polar-coordinates points 3d))) (set!... -> (let ((vals ((if polar parse-polar-coordinates parse-cartesian-coordinates) points 3d))) (set! (bezier-x xpath) (car vals)) (set! (bezier-y xpath) (cadr vals)) (set! (bezier-z xpath) (caddr vals)) (set! (bezier-v xpath) (cadddr vals)))") (lint-test "(if (< x 1) (let ((a 32) (b 31)) (f a b)) (let ((a 31) (b 32)) (f a b)))" " if: perhaps (let ((a 32) (b 31)) (f a b)) -> (f 32 31) if: perhaps (let ((a 31) (b 32)) (f a b)) -> (f 31 32)") (lint-test "(if (< x 1) (let ((a 32) (b 31) (c 12)) (f a b c)) (let ((a 32) (b 31) (c 11)) (f a b c)))" " if: perhaps (if (< x 1) (let ((a 32) (b 31) (c 12)) (f a b c)) (let ((a 32) (b 31) (c... -> (let ((a 32) (b 31) (c (if (< x 1) 12 11))) (f a b c)) if: perhaps (let ((a 32) (b 31) (c 12)) (f a b c)) -> (f 32 31 12) if: perhaps (let ((a 32) (b 31) (c 11)) (f a b c)) -> (f 32 31 11)") (lint-test "(if x (for-each (lambda (x) (display (+ x a))) (f y)) (for-each (lambda (x) (display (+ x a))) (g y)))" " if: perhaps (if x (for-each (lambda (x) (display (+ x a))) (f y)) (for-each (lambda... -> (for-each (lambda (x) (display (+ x a))) ((if x f g) y))") (lint-test "(cond (x (for-each (lambda (x) (display (+ x a))) (f y))) (else (for-each (lambda (x) (display (+ x a))) (g y))))" " cond: perhaps (cond (x (for-each (lambda (x) (display (+ x a))) (f y))) (else (for-each... -> (for-each (lambda (x) (display (+ x a))) (if x (f y) (g y)))") (lint-test "(if x (for-each (lambda (x) (display (+ x a))) (f y)) (for-each (lambda (x) (display (+ x b))) (f y)))" " if: perhaps (if x (for-each (lambda (x) (display (+ x a))) (f y)) (for-each (lambda... -> (for-each (lambda (x) (display (+ x (if x a b)))) (f y))") (lint-test "(let loop ((lst x) (res ())) (if (null? lst) (reverse res) (loop (cdr lst) (cons (car lst) res))))" " loop: perhaps (let loop ((lst x) (res ())) (if (null? lst) (reverse res) (loop (cdr lst)... -> (copy x)") (lint-test "(let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop (cdr lst) (cons (caar lst) res))))" " loop: perhaps (let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop... -> (map car x)") (lint-test "(let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop (cdr lst) (append (z w (car lst) v) res))))" " loop: perhaps (let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop... -> (map (lambda (<1>) (apply values (z w <1> v))) x)") (lint-test "(let loop ((lst x) (res ())) (if (not (pair? lst)) (reverse res) (loop (cons (caar lst) res) (cdr lst))))" "") ; reversed loop args so nothing to rewrite (lint-test "(let loop ((res ()) (lst x)) (if (pair? lst) (loop (let ((a (g (car lst)))) (cons a res)) (cdr lst)) (reverse! res)))" " loop: perhaps (let loop ((res ()) (lst x)) (if (pair? lst) (loop (let ((a (g (car... -> (map (lambda (<1>) (let ((a (g <1>))) a)) x) let: perhaps (let ((a (g (car lst)))) (cons a res)) -> (cons (g (car lst)) res)") (lint-test "(let loop ((res ()) (lst x)) (if (pair? lst) (loop (let ((a (g (cadar lst)))) (if (g a) (cons a res) res)) (cdr lst)) (reverse! res)))" " loop: perhaps (let loop ((res ()) (lst x)) (if (pair? lst) (loop (let ((a (g (cadar... -> (map (lambda (<1>) (let ((a (g (cadr <1>)))) (if (g a) a (values)))) x)") (lint-test "(let loop ((lst x) (res ())) (if (null? lst) (reverse res) (loop (cdr lst) (if (g z) res (cons (car lst) res)))))" " loop: perhaps (let loop ((lst x) (res ())) (if (null? lst) (reverse res) (loop (cdr lst)... -> (map (lambda (<1>) (if (g z) (values) <1>)) x)") (lint-test "(let loop ((lst x) (res ())) (cond ((null? lst) (reverse res)) (else (loop (cdr lst) (cons (car lst) res)))))" " loop: perhaps (let loop ((lst x) (res ())) (cond ((null? lst) (reverse res)) (else (loop... -> (copy x)") (lint-test "(let loop ((x y)) (if (null? x) () (let ((p (car x))) (cons p (loop (cdr x))))))" " loop: perhaps (let loop ((x y)) (if (null? x) () (let ((p (car x))) (cons p (loop (cdr... -> (copy y)") (lint-test "(let name ((name 3)) name)" " let: perhaps (let name ((name 3)) name) -> (let ((name 3)) name) let: let variable name is declared twice let: name not used, value: (let name ((name 3)) name) let: perhaps (let name ((name 3)) name) -> 3") (lint-test "(if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set! (str i) #\\()))" " if: perhaps (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... -> (case (str i) ((#\\]) (set! (str i) #\\))) ((#\\[) (set! (str i) #\\()))") (lint-test "(if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set! (str i) #\\() (set! x y)))" " if: perhaps (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... -> (case (str i) ((#\\]) (set! (str i) #\\))) ((#\\[) (set! (str i) #\\()) (else (set! x y)))") (lint-test "(if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set! (str i) #\\() (if (char=? (str i) #\\a) (set! x y))))" " if: perhaps use cond: (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... -> (cond ((char=? (str i) #\\]) (set! (str i) #\\))) ((char=? (str i) #\\[) (set! (str i) #\\()) ((char=? (str i) #\\a) (set! x y))) if: perhaps (if (char=? (str i) #\\]) (set! (str i) #\\)) (if (char=? (str i) #\\[) (set!... -> (case (str i) ((#\\]) (set! (str i) #\\))) ((#\\[) (set! (str i) #\\()) ((#\\a) (set! x y)))") (lint-test "(if (= x 1) 2 (if (= x 3) 3 4))" " if: perhaps (if (= x 1) 2 (if (= x 3) 3 4)) -> (case x ((1) 2) ((3) 3) (else 4))") (lint-test "(if (null? (f x)) 0 (if (eof-object? (f x)) 1 (f x)))" " if: perhaps (if (null? (f x)) 0 (if (eof-object? (f x)) 1 (f x))) -> (case (f x) ((()) 0) ((#) 1) (else)) if: perhaps use case: (if (eof-object? (f x)) 1 (f x)) -> (case (f x) ((#) 1) (else))") (lint-test "(if (null? (f x)) 0 (if (eof-object? (f x)) (g (f x)) (f x)))" " if: perhaps (if (null? (f x)) 0 (if (eof-object? (f x)) (g (f x)) (f x))) -> (case (f x) ((()) 0) ((#) => g) (else)) if: perhaps use case: (if (eof-object? (f x)) (g (f x)) (f x)) -> (case (f x) ((#) (g (f x))) (else))") (lint-test "(if z (f y) (f x))" " if: perhaps (if z (f y) (f x)) -> (f (if z y x))") (lint-test "(if z (f y) (g y))" " if: perhaps (if z (f y) (g y)) -> ((if z f g) y)") (lint-test "(if z (f (g y)) (f (h y)))" " if: perhaps (if z (f (g y)) (f (h y))) -> (f ((if z g h) y))") (lint-test "(if z (f (g x)) (f (h x)))" " if: perhaps (if z (f (g x)) (f (h x))) -> (f ((if z g h) x))") (lint-test "(if z (f (h x)) (g (h x)))" " if: perhaps (if z (f (h x)) (g (h x))) -> ((if z f g) (h x))") (lint-test "(if z (f (g (h x))) (f (g (h y))))" " if: perhaps (if z (f (g (h x))) (f (g (h y)))) -> (f (g (h (if z x y))))") (lint-test "(if z (f (g (h x))) (f (g (j x))))" " if: perhaps (if z (f (g (h x))) (f (g (j x)))) -> (f (g ((if z h j) x)))") (lint-test "(if z (f (g (h x))) (f (j (h x))))" " if: perhaps (if z (f (g (h x))) (f (j (h x)))) -> (f ((if z g j) (h x)))") (lint-test "(if z (f (g (h x))) (h (g (h x))))" " if: perhaps (if z (f (g (h x))) (h (g (h x)))) -> ((if z f h) (g (h x)))") (lint-test "(begin (if A (f B) (g C)) (if (and A D) (g Z)) X)" " begin: perhaps (... (if A (f B) (g C)) (if (and A D) (g Z)) ...) -> (... (if A (begin (f B) (when D (g Z))) (g C)) ...)") (lint-test "(begin (if A (f B)) (if (and A C) (g D) (h E)) X)" "") (lint-test "(begin (if A (f B)) (if (and A C) (g D) (h E)))" "") (lint-test "(begin (if A (f B) (z G)) (if (and A C) (g D) (h E)))" "") (lint-test "(begin (if A (f B)) (when (and A C) (g D) (h E)) X)" " begin: perhaps (... (if A (f B)) (when (and A C) (g D) (h E)) ...) -> (... (when A (f B) (when C (g D) (h E))) ...)") (lint-test "(begin (when A (f B)) (when (and A C) (g D) (h E)) X)" " begin: perhaps (... (when A (f B)) (when (and A C) (g D) (h E)) ...) -> (... (when A (f B) (when C (g D) (h E))) ...)") (lint-test "(begin (when A (f B)) (when (and A C) (g D) (h E)))" " begin: perhaps (... (when A (f B)) (when (and A C) (g D) (h E)) ...) -> (... (when A (f B) (when C (g D) (h E))))") (lint-test "(begin (if (and A B) (f C)) (if A (g E)))" " begin: perhaps (... (if (and A B) (f C)) (if A (g E)) ...) -> (... (when A (when B (f C)) (g E)))") (lint-test "(begin (if (and A B) (f C)) (if A (g E) (h F)) X)" " begin: perhaps (... (if (and A B) (f C)) (if A (g E) (h F)) ...) -> (... (if A (begin (when B (f C)) (g E)) (h F)) ...)") (lint-test "(begin (if (and A B) (f C)) (if (and B A) (g E) (h F)) X)" " begin: perhaps (... (if (and A B) (f C)) (if (and B A) (g E) (h F)) ...) -> (... (if (and A B) (begin (f C) (g E)) (begin (h F))) ...)") (lint-test "(begin (if (and A B) (f C)) (if (and C B A) (g E) (h F)) X)" "") (lint-test "(begin (if (and A B C) (f C)) (if (and B A) (g E) (h F)) X)" " begin: perhaps (... (if (and A B C) (f C)) (if (and B A) (g E) (h F)) ...) -> (... (if (and A B) (begin (when C (f C)) (g E)) (h F)) ...)") (lint-test "(begin (if (and A B) (f C)) (if (and B C) (g E) (h F)) X)" "") (lint-test "(begin (if (and A B) (f C)) (when (and B C) (g E)))" " begin: perhaps (... (if (and A B) (f C)) (when (and B C) (g E)) ...) -> (... (when B (when A (f C)) (when C (g E))))") (lint-test "(begin (if (and A B C) (f C)) (when (and B C D) (g E)))" " begin: perhaps (... (if (and A B C) (f C)) (when (and B C D) (g E)) ...) -> (... (when (and B C) (when A (f C)) (when D (g E))))") (lint-test "(if x (display y) (begin (set! z y) (display y)))" " if: perhaps (if x (display y) (begin (set! z y) (display y))) -> (begin (unless x (set! z y)) (display y))") (lint-test "(if x (begin (set! z y) (display y)) (display y))" " if: perhaps (if x (begin (set! z y) (display y)) (display y)) -> (begin (when x (set! z y)) (display y))") (lint-test "(if x (begin (display y) (set! y z)) (begin (display y) (set! z y)))" " if: perhaps (if x (begin (display y) (set! y z)) (begin (display y) (set! z y))) -> (begin (display y) (if x (set! y z) (set! z y)))") (lint-test "(if x (begin (display y) (set! y z) (display x)) (begin (display y) (set! z y) (display x)))" " if: perhaps (if x (begin (display y) (set! y z) (display x)) (begin (display y) (set!... -> (begin (display y) (if x (set! y z) (set! z y)) (display x))") (lint-test "(if x (begin (display x) y) y)" " if: perhaps (if x (begin (display x) y) y) -> (begin (if x (display x)) y)") (lint-test "(if x (begin (set! x y) (display x) y) y)" " if: perhaps (if x (begin (set! x y) (display x) y) y) -> (begin (when x (set! x y) (display x)) y)") (lint-test "(if (not x) (begin (display x) y) y)" " if: perhaps (if (not x) (begin (display x) y) y) -> (begin (if (not x) (display x)) y)") (lint-test "(if (not x) (begin (set! x y) (display x) y) y)" " if: perhaps (if (not x) (begin (set! x y) (display x) y) y) -> (begin (unless x (set! x y) (display x)) y)") (lint-test "(if x y (begin (display x) y))" " if: perhaps (if x y (begin (display x) y)) -> (begin (if (not x) (display x)) y)") (lint-test "(if x y (begin (set! x y) (display x) y))" " if: perhaps (if x y (begin (set! x y) (display x) y)) -> (begin (unless x (set! x y) (display x)) y)") (lint-test "(if (not x) y (begin (display x) y))" " if: perhaps (if (not x) y (begin (display x) y)) -> (begin (if x (display x)) y)") (lint-test "(if (not x) y (begin (set! x y) (display x) y))" " if: perhaps (if (not x) y (begin (set! x y) (display x) y)) -> (begin (when x (set! x y) (display x)) y)") (lint-test "(if (not x) (begin (display 32) y) (begin (display x) y))" " if: perhaps (if (not x) (begin (display 32) y) (begin (display x) y)) -> (begin (display (or x 32)) y)") (lint-test "(if x (begin (display 32) y) (begin (display x) y))" " if: perhaps (if x (begin (display 32) y) (begin (display x) y)) -> (begin (display (if x 32 x)) y)") (lint-test "(if x (begin (set! y x) (set! j x) k) (begin (set! m x) (set! j x) k))" " if: perhaps (if x (begin (set! y x) (set! j x) k) (begin (set! m x) (set! j x) k)) -> (begin (if x (begin (set! y x) (set! j x)) (begin (set! m x) (set! j x))) k)") ; not ideal, but at least not wrong (lint-test "(if A (let () (display x)))" " if: perhaps (if A (let () (display x))) -> (when A (display x)) if: pointless let: (let () (display x))") (lint-test "(if A B (let () (display x)))" " if: perhaps (if A B (let () (display x))) -> (if A B (begin (display x))) if: pointless let: (let () (display x))") (lint-test "(if A (let () (set! x z) (display x)) (let () (write y)))" " if: perhaps (if A (let () (set! x z) (display x)) (let () (write y))) -> (if A (begin (set! x z) (display x)) (begin (write y))) if: let could be begin: (let () (set! x z) (display x)) -> (begin (set! x z) (display x)) if: pointless let: (let () (write y))") (lint-test "(if A (if B (+ x 1)) (if B (- x 1)))" " if: perhaps (if A (if B (+ x 1)) (if B (- x 1))) -> (if B (if A (+ x 1) (- x 1)))") (lint-test "(if A (begin (f x) (g y)) (begin (f x) (g z)))" " if: perhaps (if A (begin (f x) (g y)) (begin (f x) (g z))) -> (begin (f x) (g (if A y z)))") (lint-test "(if A (begin (f x) (g y)) (begin (f y) (g y)))" " if: perhaps (if A (begin (f x) (g y)) (begin (f y) (g y))) -> (begin (f (if A x y)) (g y))") (lint-test "(if A (begin (f x) (g y) (h z)) (begin (f x) (g x) (h z)))" " if: perhaps (if A (begin (f x) (g y) (h z)) (begin (f x) (g x) (h z))) -> (begin (f x) (g (if A y x)) (h z))") (lint-test "(if (not x) (display (+ y 1)) (display x))" " if: perhaps (if (not x) (display (+ y 1)) (display x)) -> (display (or x (+ y 1)))") (lint-test "(if (not x) (set! y z) (set! y x))" " if: perhaps (if (not x) (set! y z) (set! y x)) -> (set! y (or x z))") (lint-test "(if a A (if b A (if c A B)))" " if: perhaps use cond: (if a A (if b A (if c A B))) -> (cond (a A) (b A) (c A) (else B)) if: perhaps (if a A (if b A (if c A B))) -> (if (or a b c) A B) if: perhaps (if b A (if c A B)) -> (if (or b c) A B)") (lint-test "(begin (if x (display x) y) z)" " begin: this branch is pointless: y in (if x (display x) y)") (lint-test "(begin (if x z (display x)) z)" " begin: this branch is pointless: z in (if x z (display x))") (lint-test "(begin (if x (begin (display x) z)) z)" " begin: this is pointless: z in (begin (display x) z) begin: perhaps (if x (begin (display x) z)) -> (when x (display x) z)") (lint-test "(begin (if x (begin (display y) (+ x 1)) (begin (display x) z)) z)" " begin: this is pointless: (+ x 1) in (begin (display y) (+ x 1)) begin: this is pointless: z in (begin (display x) z)") (lint-test "(begin (let () (display x)) y)" " begin: perhaps (begin (let () (display x)) y) -> (let () (display x) y) begin: pointless let: (let () (display x))") (lint-test "(let ((list x)) (if (null? list) 3 2))" " let: perhaps (let ((list x)) (if (null? list) 3 2)) -> (if (null? x) 3 2)") (lint-test "(null? (string->list x))" " null?: perhaps (null? (string->list x)) -> (zero? (length x))") (lint-test "(memq x (if (memq y '(< <=)) '(< <=) '(> >=)))" "") ; this is checking the ->simple-type escape (lint-test "(if q `(not ,op ,x) `(not ,op ,y))" "") ; make sure we don't try to rewrite quasiquote (let-temporarily ((*report-one-armed-if* #t)) (lint-test "(if a (begin (set! x y) z))" " if: perhaps (if a (begin (set! x y) z)) -> (when a (set! x y) z)") (lint-test "(if (not a) (begin (set! x y) z))" " if: perhaps (if (not a) (begin (set! x y) z)) -> (unless a (set! x y) z)") (lint-test "(if a (set! x y))" " if: perhaps (if a (set! x y)) -> (when a (set! x y))") (lint-test "(if (not a) (set! x y))" " if: perhaps (if (not a) (set! x y)) -> (unless a (set! x y))")) (let-temporarily ((*report-doc-strings* #t)) (lint-test "(let () (define (hiho a) \"hiho is a function\" (+ a 1)) (hiho 1))" " let: perhaps (... (define (hiho a) \"hiho is a function\" (+ a 1)) (hiho 1)) -> (... (let ((a 1)) (+ a 1))) hiho: old-style doc string: \"hiho is a function\", use '+documentation+: (define hiho (let ((+documentation+ \"hiho is a function\")) (lambda (a) (+ a 1))))")) (let-temporarily ((*report-undefined-identifiers* #t)) (lint-test "(let ((x 1)) (cdr? x))" " let: perhaps, assuming cdr? is not a macro, (let ((x 1)) (cdr? x)) -> (cdr? 1) this identifier was not defined: cdr?") (lint-test "(let ((x 1)) (+ x (aaa)))" " this identifier was not defined: aaa") (lint-test "(let ((x 1)) (+ x (zzz) (aaa)))" " the following identifiers were not defined: aaa zzz") (lint-test "(let ((example 32)) (+ exampl (* 2 example) (sqrt example)))" " this identifier was not defined: exampl")) (let-temporarily ((*report-shadowed-variables* #t)) (lint-test "(let ((x 1)) (+ (let ((x 2)) (+ x 1)) x))" " let: let variable x in (x 2) shadows an earlier declaration let: perhaps (let ((x 2)) (+ x 1)) -> (+ 2 1)")) (lint-test "(when (not a) (set! x y))" " when: perhaps (when (not a) (set! x y)) -> (unless a (set! x y))") (lint-test "(unless (not a) (set! x y))" " unless: perhaps (unless (not a) (set! x y)) -> (when a (set! x y))") (lint-test "(begin (if x (y)) (if x (z)) 32)" " begin: perhaps (... (if x (y)) (if x (z)) ...) -> (... (when x (y) (z)) ...)") (lint-test "(begin (if x (y)) (if x (z)))" " begin: perhaps (... (if x (y)) (if x (z)) ...) -> (... (when x (y) (z)) ...)") (lint-test "(begin (if x (y)) (if x (z)) (v) (if x (w)))" " begin: perhaps (... (if x (y)) (if x (z)) ...) -> (... (when x (y) (z)) ...)") (lint-test "(begin (if x (y)) (if x (z)) (v) (if x (w)) 12)" " begin: perhaps (... (if x (y)) (if x (z)) ...) -> (... (when x (y) (z)) ...)") (lint-test "(begin (if (< x 0) (display y)) (if (< x 0) z))" " begin: perhaps (... (if (< x 0) (display y)) (if (< x 0) z) ...) -> (... (when (< x 0) (display y) z) ...)") (lint-test "(begin (if (< x 0) (display y) (display (- y 1))) (if (< x 0) z))" " begin: perhaps (if (< x 0) (display y) (display (- y 1))) -> (display (if (< x 0) y (- y 1))) begin: perhaps (... (if (< x 0) (display y) (display (- y 1))) (if (< x 0) z) ...) -> (... (if (< x 0) (begin (display y) z) (begin (display (- y 1)))) ...)") (lint-test "(begin (if (< x 0) (begin (display y) (set! y 3)) (display (- y 1))) (if (< x 0) z (begin (display (+ z 1)) (- z 1))))" " begin: perhaps (... (if (< x 0) (begin (display y) (set! y 3)) (display (- y 1))) (if (<... -> (... (if (< x 0) (begin (display y) (set! y 3) z) (begin (display (- y 1)) (display (+ z 1)) (- z 1))) ...)") (lint-test "(cond . 1)" " cond: cond is messed up: (cond . 1)") (lint-test "(cond 1)" " cond: cond is messed up: (cond 1)") (lint-test "(cond ((< 3 1) 2))" " cond: cond test (< 3 1) is never true: (cond ((< 3 1) 2)) cond: cond test is always false: ((< 3 1) 2) cond: perhaps (cond ((< 3 1) 2)) -> (cond)") (lint-test "(cond (else 2) (x 3))" " cond: cond else clause is not the last: (cond (else 2) (x 3))") (lint-test "(cond (x => abs))" "") (lint-test "(cond (x))" " cond: perhaps (cond (x)) -> x") (lint-test "(cond (x =>))" " cond: cond => target is messed up: (x =>)") (lint-test "(cond (x #f) (#t #t))" " cond: perhaps (cond (x #f) (#t #t)) -> (not x)") (lint-test "(cond (x #t) (else #f))" " cond: perhaps (cond (x #t) (else #f)) -> x") (lint-test "(cond (x #t) (else y))" "") (lint-test "(cond (x #f) (else y))" " cond: perhaps (cond (x #f) (else y)) -> (and (not x) y)") (lint-test "(cond (x #f) (else (f y) g))" " cond: perhaps (cond (x #f) (else (f y) g)) -> (and (not x) (begin (f y) g))") (lint-test "(cond (x #t) (else #t))" " cond: perhaps (cond (x #t) (else #t)) -> #t") (lint-test "(cond ((not x) #f) (else y))" " cond: perhaps (cond ((not x) #f) (else y)) -> (and x y)") (lint-test "(cond ((null? x) #t) (else y))" " cond: this #t could be omitted: ((null? x) #t) cond: perhaps (cond ((null? x) #t) (else y)) -> (or (null? x) y)") (lint-test "(cond ((= x 1) 2) (else 2))" " cond: perhaps (cond ((= x 1) 2) (else 2)) -> 2") (lint-test "(cond ((and (display x) x) 32) (#t 32))" " cond: perhaps (cond ((and (display x) x) 32) (#t 32)) -> (begin (and (display x) x) 32)") (lint-test "(cond (x y) (z 32) (else 32))" " cond: this clause could be omitted: (z 32)") (lint-test "(cond ((= x 1) (display \"a\") 32) (#t (display \"a\") 32))" " cond: perhaps (cond ((= x 1) (display \"a\") 32) (#t (display \"a\") 32)) -> (begin (display \"a\") 32)") (lint-test "(cond ((= x 1) 32))" " cond: perhaps (cond ((= x 1) 32)) -> (if (= x 1) 32)") (lint-test "(cond ((and (display 32) (= x 1)) 1) (#t 1))" " cond: perhaps (cond ((and (display 32) (= x 1)) 1) (#t 1)) -> (begin (and (display 32) (= x 1)) 1)") (lint-test "(cond ((< x 1) 2) (else (cond ((< y 3) 2) (#t 4))))" " cond: else clause could be folded into the outer cond: (cond ((< x 1) 2) (else (cond ((< y 3) 2) (#t 4)))) -> (cond ((< x 1) 2) ((< y 3) 2) (#t 4))") (lint-test "(cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5))" " cond: cond test (< x 2) is never true: (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5)) cond: cond test repeated: ((< x 2) 5) cond: cond test is always false: ((< x 2) 5) cond: perhaps (cond ((< x 2) 3) ((> x 0) 4) ((< x 2) 5)) -> (cond ((< x 2) 3) ((> x 0) 4))") (lint-test "(cond ((< x 1) (+ x 1)) ((> x 1) (+ x 1)) (#t 2))" " cond: perhaps (cond ((< x 1) (+ x 1)) ((> x 1) (+ x 1)) (#t 2)) -> (cond ((not (= x 1)) (+ x 1)) (#t 2))") (lint-test "(cond ((= x 3) 4) ((= x 2) 4) ((= x 1) 4) (else 5))" " cond: perhaps (cond ((= x 3) 4) ((= x 2) 4) ((= x 1) 4) (else 5)) -> (case x ((3 2 1) 4) (else 5))") (lint-test "(cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4) (else 5))" " cond: perhaps (cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4) (else 5)) -> (case x ((3) 3) ((2 1) 4) (else 5))") (lint-test "(cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4))" " cond: perhaps (cond ((= x 3) 3) ((= x 2) 4) ((= x 1) 4)) -> (case x ((3) 3) ((2 1) 4))") (lint-test "(cond (a) (b) (c))" " cond: perhaps (cond (a) (b) (c)) -> (cond ((or a b c)))") (lint-test "(cond ((= x 0) x) ((= x 1) (= x 1)))" " cond: no need to repeat the test: ((= x 1) (= x 1)) -> ((= x 1)) cond: perhaps use case instead of cond: (cond ((= x 0) x) ((= x 1) (= x 1))) -> (case x ((0)) ((1) (= x 1)))") (lint-test "(cond (x => expt))" " cond: => target (expt) may be unhappy: (x => expt)") (lint-test "(cond (x (abs x)))" " in (cond (x (abs x))), perhaps change x to (real? x) cond: perhaps use => here: (x (abs x)) -> (x => abs)") (lint-test "(cond ((> x 2) (not (> x 2))))" " cond: perhaps replace (not (> x 2)) with #f") (lint-test "(cond (x #t) (y #t) (else #f))" " cond: perhaps (cond (x #t) (y #t) (else #f)) -> (or x y) cond: perhaps (cond (x #t) (y #t) (else #f)) -> (or x (and y #t))") (lint-test "(cond (x #f) (y #f) (else #t))" " cond: perhaps (cond (x #f) (y #f) (else #t)) -> (not (or x y))") (lint-test "(cond (x y) ('else z))" " cond: odd cond clause test: is 'else supposed to be else? ('else z)") (lint-test "(cond ((x) y) ((not (x)) z))" " cond: perhaps (cond ((x) y) ((not (x)) z)) -> (cond ((x) y) (else z))") (lint-test "(cond (x (let ((z w)) (+ x z)) y) (else 2))" " in (cond (x (let ((z w)) (+ x z)) y) (else 2)), perhaps change x to (number? x) cond: this could be omitted: (let ((z w)) (+ x z)) cond: perhaps (let ((z w)) (+ x z)) -> (+ x w)") (lint-test "(cond (x (if x y z) (+ x 1)) (z 2))" " cond: this could be omitted: (if x y z)") (lint-test "(cond ((g x) `(c ,x) `(c ,y)))" " cond: perhaps (list-values 'c x) -> (list 'c x) cond: perhaps (list-values 'c y) -> (list 'c y) cond: perhaps (cond ((g x) (list-values 'c x) (list-values 'c y))) -> (when (g x) (list-values 'c x) (list-values 'c y))") (lint-test "(cond ((= x 1) 2) ((= x 2) 3))" " cond: perhaps use case instead of cond: (cond ((= x 1) 2) ((= x 2) 3)) -> (case x ((1) 2) ((2) 3))") (lint-test "(cond ((= x y) (begin (display x) y)) (else x))" " cond: redundant begin: (begin (display x) y)") (lint-test "(cond ((= x y) y) (else (begin (display x) x)))" " cond: redundant begin: (begin (display x) x) cond: display returns its first argument, so this could be omitted: x") (lint-test "(cond ((= x y) z) (else #))" " cond: this # is redundant: (else #)") (lint-test "(cond (x y) (y z (else 3)))" " cond: this could be omitted: z cond: perhaps cond else clause is misplaced: (else 3) in (y z (else 3))") (lint-test "(cond (x y) (y z (#t 3)))" " cond: this could be omitted: z cond: perhaps cond else clause is misplaced: (#t 3) in (y z (#t 3))") (lint-test "(cond (< x 1) (else 1))" " cond: strange cond test: < in (< x 1) is a procedure cond: this could be omitted: x") (lint-test "(cond ((memq x '(a b)) 3) ((eq? x 'c) 4) ((or (eq? x 'd) (eq? 'e x)) 5) (else 6))" " cond: perhaps use case instead of cond: (cond ((memq x '(a b)) 3) ((eq? x 'c) 4) ((or (eq? x 'd) (eq? 'e x)) 5)... -> (case x ((a b) 3) ((c) 4) ((d e) 5) (else 6))") (lint-test "(cond ((eq? x 'a) 1) ((not x) 2) (else 3))" " cond: perhaps use case instead of cond: (cond ((eq? x 'a) 1) ((not x) 2) (else 3)) -> (case x ((a) 1) ((#f) 2) (else 3))") (lint-test "(cond ((eof-object? x) 1) ((null? x) 2) ((not x) 3) (else 4))" " cond: perhaps use case instead of cond: (cond ((eof-object? x) 1) ((null? x) 2) ((not x) 3) (else 4)) -> (case x ((#) 1) ((()) 2) ((#f) 3) (else 4))") (lint-test "(cond ((or (null? x) (not x)) 1) ((eq? x 'a) 3) (else 2))" " cond: perhaps use case instead of cond: (cond ((or (null? x) (not x)) 1) ((eq? x 'a) 3) (else 2)) -> (case x ((() #f) 1) ((a) 3) (else 2))") (lint-test "(cond ((= x 0) 1) ((= x 2) 2) ((= x 3) (cond ((not y) 1) ((null? y) 2) ((eq? y 'a) 3) (else 4))) (else 5))" " cond: perhaps use case instead of cond: (cond ((not y) 1) ((null? y) 2) ((eq? y 'a) 3) (else 4)) -> (case y ((#f) 1) ((()) 2) ((a) 3) (else 4)) cond: perhaps use case instead of cond: (cond ((= x 0) 1) ((= x 2) 2) ((= x 3) (cond ((not y) 1) ((null? y) 2)... -> (case x ((0) 1) ((2) 2) ((3) (cond ((not y) 1) ((null? y) 2) ((eq? y 'a) 3) (else 4))) (else 5)) cond: perhaps (cond ((= x 0) 1) ((= x 2) 2) ((= x 3) (cond ((not y) 1) ((null? y) 2)... -> (cond ((= x 0) 1) ((= x 2) 2) ((not (= x 3)) 5) ((not y) 1) ((null? y) 2) ((eq? y 'a) 3) (else 4))") (lint-test "(cond ((equal? x 'a) 1) ((equal? x 1) 2) (else 3))" " cond: equal? could be eq? in (equal? x 'a) cond: equal? could be eqv? in (equal? x 1) cond: perhaps use case instead of cond: (cond ((equal? x 'a) 1) ((equal? x 1) 2) (else 3)) -> (case x ((a) 1) ((1) 2) (else 3))") (lint-test "(cond ((= x 1) 1) (t 2))" " cond: odd cond clause test: is t supposed to be #t? (t 2)") (lint-test "(cond (t 2))" " cond: odd cond clause test: is t supposed to be #t? (t 2)") (lint-test "(cond ((memq x '(a b)) => car) ((eq? x 'c) 2))" "") ; this should not got to case because the => operator won't work the same (lint-test "(cond ((char=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set! x z)))" " cond: perhaps use case instead of cond: (cond ((char=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set!... -> (case c ((#\\a) (set! x y)) ((#\\b) (set! y x)) (else (set! x z)))") (lint-test "(cond ((char-ci=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else (set! x z)))" " cond: perhaps use case instead of cond: (cond ((char-ci=? c #\\a) (set! x y)) ((char=? c #\\b) (set! y x)) (else... -> (case c ((#\\a #\\A) (set! x y)) ((#\\b) (set! y x)) (else (set! x z)))") (lint-test "(cond ((null? x) 1) ((= x 1) 2) ((boolean? x) 3) (else 4))" " cond: perhaps use case instead of cond: (cond ((null? x) 1) ((= x 1) 2) ((boolean? x) 3) (else 4)) -> (case x ((()) 1) ((1) 2) ((#t #f) 3) (else 4))") (lint-test "(cond ((< x 1) 1) ((string? y) 2))" "") ; check a simplification bug (lint-test "(cond ((eof-object? x)) ((zero? x)))" " cond: perhaps use case instead of cond: (cond ((eof-object? x)) ((zero? x))) -> (case x ((#) #t) ((0 0.0) #t))") (lint-test "(cond ((= x 0) 0) ((not (= x 1)) 1))" " cond: perhaps use case instead of cond: (cond ((= x 0) 0) ((not (= x 1)) 1)) -> (case x ((0) 0) ((1) #) (else 1))") (lint-test "(cond ((= x 0) 0) ((not (= x 1)) 1) (else 2))" " cond: perhaps use case instead of cond: (cond ((= x 0) 0) ((not (= x 1)) 1) (else 2)) -> (case x ((0) 0) ((1) 2) (else 1))") (lint-test "(cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 1) 2))" " cond: perhaps use case instead of cond: (cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 1) 2)) -> (case x ((0) 0) ((1) 2) (else 1)) cond: perhaps (cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 1) 2)) -> (cond ((= x 0) 0) ((not (= x 1)) 1) (#t 2))") (lint-test "(cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 2) 2))" " cond: perhaps use case instead of cond: (cond ((= x 0) 0) ((not (= x 1)) 1) ((= x 2) 2)) -> (case x ((0) 0) ((1) #) (else 1))") (lint-test "(cond ((= x 1) 1) ((not (= x 1)) 2))" " cond: perhaps (cond ((= x 1) 1) ((not (= x 1)) 2)) -> (cond ((= x 1) 1) (else 2)) cond: perhaps (cond ((= x 1) 1) ((not (= x 1)) 2)) -> (cond ((= x 1) 1) (#t 2))") (lint-test "(cond ((eq? x 'a) 1) ((not (eq? x 'b)) 2) (else 3))" " cond: perhaps use case instead of cond: (cond ((eq? x 'a) 1) ((not (eq? x 'b)) 2) (else 3)) -> (case x ((a) 1) ((b) 3) (else 2))") (lint-test "(cond ((= (f1 32) 0) 1) ((zero? (f1 32)) 2) ((not (memv (f1 32) '(2 3 4))) 5) (else 6))" " cond: perhaps use case instead of cond: (cond ((= (f1 32) 0) 1) ((zero? (f1 32)) 2) ((not (memv (f1 32) '(2 3 4)))... -> (case (f1 32) ((0) 1) ((0 0.0) 2) ((2 3 4) 6) (else 5))") (lint-test "(cond ((= x 1) 1) ((not (= x 2)) 2) ((not (= x 3)) 3))" " cond: perhaps use case instead of cond: (cond ((= x 1) 1) ((not (= x 2)) 2) ((not (= x 3)) 3)) -> (case x ((1) 1) ((2) 3) (else 2))") (lint-test "(cond ((= 3 (length eq)) (caddr eq)) (else #f))" " cond: perhaps (cond ((= 3 (length eq)) (caddr eq)) (else #f)) -> (and (= 3 (length eq)) (caddr eq))") (lint-test "(cond ((= 3 (length eq)) (caddr eq)) (else #t))" " cond: perhaps (cond ((= 3 (length eq)) (caddr eq)) (else #t)) -> (or (not (= 3 (length eq))) (caddr eq))") (lint-test "(cond ((= x y) #f) (else (abs x)))" " cond: perhaps (cond ((= x y) #f) (else (abs x))) -> (and (not (= x y)) (abs x))") (lint-test "(cond ((and (= x y) z) (+ x 1)) (else #f))" " cond: perhaps (cond ((and (= x y) z) (+ x 1)) (else #f)) -> (and (= x y) z (+ x 1))") (lint-test "(cond (a A) (else A))" " cond: perhaps (cond (a A) (else A)) -> A") (lint-test "(cond ((a)) (else A))" " cond: perhaps (cond ((a)) (else A)) -> (or (a) A)") (lint-test "(cond (a A) (else (if b B)))" " cond: else clause could be folded into the outer cond: (cond (a A) (else (if b B))) -> (cond (a A) (b B))") (lint-test "(cond (a A) (else (if b B C)))" " cond: else clause could be folded into the outer cond: (cond (a A) (else (if b B C))) -> (cond (a A) (b B) (else C))") (lint-test "(cond (a A) (else (if b (begin (B) D) (begin (C) E))))" " cond: else clause could be folded into the outer cond: (cond (a A) (else (if b (begin (B) D) (begin (C) E)))) -> (cond (a A) (b (B) D) (else (C) E))") (lint-test "(cond (a A) (else (when b B)))" " cond: else clause could be folded into the outer cond: (cond (a A) (else (when b B))) -> (cond (a A) (b B))") (lint-test "(cond (a A) (else (unless b B)))" " cond: else clause could be folded into the outer cond: (cond (a A) (else (unless b B))) -> (cond (a A) ((not b) B))") (lint-test "(cond (A) (B) (else C))" " cond: perhaps (cond (A) (B) (else C)) -> (or A B C)") (lint-test "(cond (A) (B) (else (C) D))" " cond: perhaps (cond (A) (B) (else (C) D)) -> (or A B (begin (C) D))") (lint-test "(cond (A) (B) (C))" " cond: perhaps (cond (A) (B) (C)) -> (cond ((or A B C)))") ; (or A B C #) ?? (lint-test "(cond ((A) B) ((or C D)) (else E))" " cond: perhaps (cond ((A) B) ((or C D)) (else E)) -> (cond ((A) B) (else (or C D E)))") (lint-test "(cond (A (cond (B c) (else D))) (else E))" " cond: perhaps (cond (A (cond (B c) (else D))) (else E)) -> (cond ((not A) E) (B c) (else D))") (lint-test "(cond (A (cond (B c) (else D))))" " cond: perhaps (cond (A (cond (B c) (else D)))) -> (if A (cond (B c) (else D))) cond: perhaps (cond (A (cond (B c) (else D)))) -> (cond ((not A) #) (B c) (else D))") (lint-test "(cond (A B) (C (cond (D d) (else E))) (else F))" " cond: perhaps (cond (A B) (C (cond (D d) (else E))) (else F)) -> (cond (A B) ((not C) F) (D d) (else E))") (lint-test "(cond (A B) (C (if D d E)) (else F))" " cond: perhaps (cond (A B) (C (if D d E)) (else F)) -> (cond (A B) ((not C) F) (D d) (else E))") (lint-test "(cond (A B) ((not C) (cond (D d) (else E))) (else F))" " cond: perhaps (cond (A B) ((not C) (cond (D d) (else E))) (else F)) -> (cond (A B) (C F) (D d) (else E))") (lint-test "(cond (A B) ((< C 1) (cond (D d) (else E))) (else F))" " cond: perhaps (cond (A B) ((< C 1) (cond (D d) (else E))) (else F)) -> (cond (A B) ((>= C 1) F) (D d) (else E))") (lint-test "(cond (W X) (A B) (C D) (else B))" " cond: perhaps (cond (W X) (A B) (C D) (else B)) -> (cond (W X) ((or A (not C)) B) (else D))") (lint-test "(cond (W X) (A #f) (C D) (else #f))" " cond: perhaps (cond (W X) (A #f) (C D) (else #f)) -> (cond (W X) ((or A (not C)) #f) (else D))") (lint-test "(cond (Y #t) (W X) (A #f) (C #t) (else #f))" " cond: perhaps (cond (Y #t) (W X) (A #f) (C #t) (else #f)) -> (cond ... ((or A (not C)) #f) (else #t))") (lint-test "(cond (W #t) (A B) (C #t) (else B))" " cond: perhaps (cond (W #t) (A B) (C #t) (else B)) -> (cond (W #t) ((or A (not C)) B) (else #t))") (lint-test "(cond (W B) (A B) (C #t) (else B))" " cond: perhaps (cond (W B) (A B) (C #t) (else B)) -> (cond ((or W A) B) (C #t) (else B)) cond: perhaps (cond (W B) (A B) (C #t) (else B)) -> (cond (W B) ((or A (not C)) B) (else #t))") (lint-test "(cond ((string=? x \"a\") 1) ((string=? x \"b\") 2) ((string=? x \"c\") 3) (else 4))" " cond: perhaps (cond ((string=? x \"a\") 1) ((string=? x \"b\") 2) ((string=? x \"c\") 3) (else 4)) -> (cond ((assq (string->symbol x) '((a . 1) (b . 2) (c . 3))) => cdr) (else 4))") (lint-test "(cond ((any-op x) 1) ((eq? x 'b) 2) ((eq? x 'c) 3) (else 4))" " cond: perhaps (cond ((any-op x) 1) ((eq? x 'b) 2) ((eq? x 'c) 3) (else 4)) -> (cond ((any-op x) 1) ((assq x '((b . 2) (c . 3))) => cdr) (else 4))") (lint-test "(cond ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5) (else 1.8))" " cond: perhaps (cond ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5) (else 1.8)) -> (cond ((assoc order '((1 . 1.0) (2 . 1.3)) =) => cdr) ((< order 9) 1.5) (else 1.8))") (lint-test "(cond ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5))" " cond: perhaps (cond ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5)) -> (cond ((assoc order '((1 . 1.0) (2 . 1.3)) =) => cdr) ((< order 9) 1.5))") (lint-test "(cond ((< order 8) 1.6) ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5))" " cond: perhaps (cond ((< order 8) 1.6) ((= order 1) 1.0) ((= order 2) 1.3) ((< order 9) 1.5)) -> (cond ((< order 8) 1.6) ((assoc order '((1 . 1.0) (2 . 1.3)) =) => cdr) ((< order 9) 1.5))") (lint-test "(cond ((and (integer? x) (exact? x) (integer? y) (exact? y)) 2) (else 3))" " cond: perhaps (cond ((and (integer? x) (exact? x) (integer? y) (exact? y)) 2) (else 3)) -> (cond ((and (integer? x) (integer? y)) 2) (else 3))") (lint-test "(cond ((and (integer? x) (exact? y) (integer? y) (exact? x)) 2) (else 3))" " cond: perhaps (cond ((and (integer? x) (exact? y) (integer? y) (exact? x)) 2) (else 3)) -> (cond ((and (integer? x) (integer? y)) 2) (else 3))") (lint-test "(cond ((integer? x) (+ x 1)) ((real? x) (- x 1.0)) (else (+ x 1)))" " cond: perhaps (cond ((integer? x) (+ x 1)) ((real? x) (- x 1.0)) (else (+ x 1))) -> (if (or (integer? x) (not (real? x))) (+ x 1) (- x 1.0))") (lint-test "(cond ((complex? x) (+ x 1)) ((not (integer? x)) 0) (else (+ x 1)))" " cond: perhaps (cond ((complex? x) (+ x 1)) ((not (integer? x)) 0) (else (+ x 1))) -> (if (complex? x) (+ x 1) 0)") (lint-test "(cond (A a) (B b) (else a))" " cond: perhaps (cond (A a) (B b) (else a)) -> (if (or A (not B)) a b)") (lint-test "(cond (A #f) (B b) (else #f))" " cond: perhaps (cond (A #f) (B b) (else #f)) -> (and (not A) B b)") (lint-test "(cond (A #f) (B #t) (else #f))" " cond: perhaps (cond (A #f) (B #t) (else #f)) -> (and (not A) B) cond: perhaps (cond (A #f) (B #t) (else #f)) -> (and (not A) B)") (lint-test "(cond (A #t) (B b) (else #t))" " cond: perhaps (cond (A #t) (B b) (else #t)) -> (or A (not B) b)") (lint-test "(cond (A #t) (B #f) (else #t))" " cond: perhaps (cond (A #t) (B #f) (else #t)) -> (or A (not B))") (lint-test "(cond (A a) (B a) (else b))" " cond: perhaps (cond (A a) (B a) (else b)) -> (cond ((or A B) a) (else b))") (lint-test "(cond ((and A B) c) (B d) (else e))" " cond: perhaps (cond ((and A B) c) (B d) (else e)) -> (cond (B (if A c d)) (else e))") (lint-test "(cond ((and A B) c) (A d) (else e))" " cond: perhaps (cond ((and A B) c) (A d) (else e)) -> (cond (A (if B c d)) (else e))") (lint-test "(cond (A B) ((or A C) D))" " cond: perhaps (cond (A B) ((or A C) D)) -> (cond (A B) (C D))") (lint-test "(cond (A B) ((or A C) D) (C E))" " cond: cond test C is never true: (cond (A B) ((or A C) D) (C E)) cond: cond test is always false: (C E) cond: perhaps (cond (A B) ((or A C) D) (C E)) -> (cond (A B) (C D))") (lint-test "(cond ((< x 1) 21) ((< x 2) 32) ((or (< x 1) (> x 3)) 33))" " cond: perhaps (cond ((< x 1) 21) ((< x 2) 32) ((or (< x 1) (> x 3)) 33)) -> (cond ((assoc x '((1 . 21) (2 . 32)) <) => cdr) ((> x 3) 33))") (lint-test "(cond ((not x) (display (+ y 1))) (else (display x)))" " cond: perhaps (cond ((not x) (display (+ y 1))) (else (display x))) -> (display (if (not x) (+ y 1) x)) cond: perhaps (cond ((not x) (display (+ y 1))) (else (display x))) -> (if x (display x) (display (+ y 1)))") (lint-test "(cond ((not x) (display (+ y 1)) z) (else (display x) a))" " cond: perhaps (cond ((not x) (display (+ y 1)) z) (else (display x) a)) -> (cond (x (display x) a) (else (display (+ y 1)) z))") (lint-test "(begin (cond (x y) (z (display a) (+ a 1))) z)" " begin: this is pointless: y in (x y) begin: this is pointless: (+ a 1) in (z (display a) (+ a 1))") (lint-test "(begin (cond ((A) (f B)) ((< C 1) (cond ((D) (f d)) (else (f E))))) x)" " begin: perhaps (cond ((D) (f d)) (else (f E))) -> (f (if (D) d E)) begin: perhaps (cond ((A) (f B)) ((< C 1) (cond ((D) (f d)) (else (f E))))) -> (cond ((A) (f B)) ((>= C 1)) ((D) (f d)) (else (f E)))") (lint-test "(cond ((A) (f B)) ((< C 1) (cond ((D) (f d)) (else (f E)))))" " cond: perhaps (cond ((D) (f d)) (else (f E))) -> (f (if (D) d E)) cond: perhaps (cond ((A) (f B)) ((< C 1) (cond ((D) (f d)) (else (f E))))) -> (cond ((A) (f B)) ((>= C 1) #) ((D) (f d)) (else (f E)))") (lint-test "(cond ((= x 0) 1) ((= x 3) (cond ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3) (else 4))) ((< x 200) 2) (else 5))" " cond: perhaps (cond ((= x 0) 1) ((= x 3) (cond ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3)... -> (cond ((= x 0) 1) ((not (= x 3)) (if (< x 200) 2 5)) ((not y) 1) ((pair? y) 2) ((eq? y 'a) 3) (else 4))") (lint-test "(cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c) (display z)))" " cond: possibly use case at the end: (cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c)... -> (if (pair? x) 3 (case x ((a) z) ((b) (* 2 z)) ((c) (display z))))") (lint-test "(cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c) (display z)) (else (display y)))" " cond: possibly use case at the end: (cond ((pair? x) 3) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c)... -> (if (pair? x) 3 (case x ((a) z) ((b) (* 2 z)) ((c) (display z)) (else (display y))))") (lint-test "(cond ((pair? x) #f) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c) (display z)))" " cond: possibly use case at the end: (cond ((pair? x) #f) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c)... -> (and (not (pair? x)) (case x ((a) z) ((b) (* 2 z)) ((c) (display z))))") (lint-test "(cond ((pair? x) 3) ((integer? x) 4) ((eq? x 'a) z) ((eq? x 'b) (* 2 z)) ((eq? x 'c) (display z)))" " cond: possibly use case at the end: (cond ((pair? x) 3) ((integer? x) 4) ((eq? x 'a) z) ((eq? x 'b) (* 2 z))... -> (cond ((pair? x) 3) ((integer? x) 4) (else (case x ((a) z) ((b) (* 2 z)) ((c) (display z)))))") (lint-test "(cond ((< x 1) (+ x 1)) (else (+ x 2)))" " cond: perhaps (cond ((< x 1) (+ x 1)) (else (+ x 2))) -> (+ x (if (< x 1) 1 2))") (lint-test "(cond ((< x 1) (fx1 x y z)) (else (fx1 x z z)))" " cond: perhaps (cond ((< x 1) (fx1 x y z)) (else (fx1 x z z))) -> (fx1 x (if (< x 1) y z) z)") (lint-test "(cond ((< x 1) (fx1 x y z)) (else (fx1 x z a z)))" " cond: perhaps (cond ((< x 1) (fx1 x y z)) (else (fx1 x z a z))) -> (fx1 x (if (< x 1) y (values z a)) z)") (lint-test "(cond ((< x 1) (fx1 x y z)) (else (fx1 z z y z)))" " cond: perhaps (cond ((< x 1) (fx1 x y z)) (else (fx1 z z y z))) -> (fx1 (if (< x 1) x (values z z)) y z)") (lint-test "(cond ((< x 1) (fx1 x z)) (else (fx1 x z)))" " cond: perhaps (cond ((< x 1) (fx1 x z)) (else (fx1 x z))) -> (fx1 x z)") (lint-test "(cond ((< x 1) (fx1 x y y z)) (else (fx1 x y z)))" " cond: perhaps (cond ((< x 1) (fx1 x y y z)) (else (fx1 x y z))) -> (fx1 x y (if (< x 1) (values y z) z))") (lint-test "(cond ((< x 1) (fx1 x y y z)) (else (fx1 x z)))" " cond: perhaps (cond ((< x 1) (fx1 x y y z)) (else (fx1 x z))) -> (fx1 x (if (< x 1) (values y y z) z))") (lint-test "(cond ((< x 1) (fx1 x y z)) (else (fx1 x y y z)))" " cond: perhaps (cond ((< x 1) (fx1 x y z)) (else (fx1 x y y z))) -> (fx1 x y (if (< x 1) z (values y z)))") (lint-test "(cond ((< x 1) (list x)) (else (list x y)))" "") (lint-test "(cond ((< x 1) (list x y)) (else (list x)))" "") (lint-test "(cond ((< x 1) (+ x 1)) ((< y 1) (+ x 3)) (else (+ x 2)))" " cond: perhaps (cond ((< x 1) (+ x 1)) ((< y 1) (+ x 3)) (else (+ x 2))) -> (+ x (cond ((< x 1) 1) ((< y 1) 3) (else 2)))") (lint-test "(cond ((< x 1) (+ x 1 y)) ((< y 1) (+ x 3 y)) (else (+ x 2 y)))" " cond: perhaps (cond ((< x 1) (+ x 1 y)) ((< y 1) (+ x 3 y)) (else (+ x 2 y))) -> (+ x (cond ((< x 1) 1) ((< y 1) 3) (else 2)) y)") (lint-test "(cond (else (+ x 1)))" " cond: perhaps (cond (else (+ x 1))) -> (+ x 1)") (lint-test "(cond ((< x 1) (log x 2)) ((< x 2) (log x 3)) (else (error 'oops)))" " cond: perhaps (cond ((< x 1) (log x 2)) ((< x 2) (log x 3)) (else (error 'oops))) -> (log x (cond ((< x 1) 2) ((< x 2) 3) (else (error 'oops))))") (lint-test "(cond (X (f y z)) (else (g y z)))" " cond: perhaps (cond (X (f y z)) (else (g y z))) -> ((cond (X f) (else g)) y z)") (lint-test "(cond (X (f y z)) (Y (g y z)))" "") (lint-test "(cond (X (f y z)) (Y (f y z)) (Z (f y z)))" " cond: perhaps (cond (X (f y z)) (Y (f y z)) (Z (f y z))) -> (if (or X Y Z) (f y z)) cond: perhaps (cond (X (f y z)) (Y (f y z)) (Z (f y z))) -> (cond ((or X Y Z) (f y z)))") (lint-test "(cond (X (g y a)) (else (g y z)))" " cond: perhaps (cond (X (g y a)) (else (g y z))) -> (g y (if X a z))") ; (lint-test "(cond ((not x) (cdr x)) (else (display y)))" " cond: x in (cdr x) should be a pair, but it is #f?") (lint-test "(cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6))" " cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6)) -> (cond ((pair? x) 3) ((assq x '((a . 4) (b . 5) (c . 6))) => cdr))") (lint-test "(cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) (else #f))" " cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) (else #f)) -> (cond ((pair? x) 3) ((assq x '((a . 4) (b . 5) (c . 6))) => cdr) (else #f))") (lint-test "(cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) ((eq? x 'd) 7))" " cond: perhaps (cond ((pair? x) 3) ((eq? x 'a) 4) ((eq? x 'b) 5) ((eq? x 'c) 6) ((eq? x... -> (cond ((pair? x) 3) ((assq x '((a . 4) (b . 5) (c . 6) (d . 7))) => cdr))") (lint-test "(cond ((= i n) #f) ((pred? (vector-ref v i)) #t) (else (loop (+ 1 i))))" " cond: perhaps (cond ((= i n) #f) ((pred? (vector-ref v i)) #t) (else (loop (+ 1 i)))) -> (and (not (= i n)) (or (pred? (vector-ref v i)) (loop (+ 1 i))))") (lint-test "(cond ((= i n) #f) ((pred? (vector-ref v i))) (else (loop (+ 1 i))))" " cond: perhaps (cond ((= i n) #f) ((pred? (vector-ref v i))) (else (loop (+ 1 i)))) -> (and (not (= i n)) (or (pred? (vector-ref v i)) (loop (+ 1 i))))") (lint-test "(cond ((= i n) #t) ((pred? (vector-ref v i)) (loop (+ 1 i))) (else #f))" " cond: this #t could be omitted: ((= i n) #t) cond: perhaps (cond ((= i n) #t) ((pred? (vector-ref v i)) (loop (+ 1 i))) (else #f)) -> (or (= i n) (and (pred? (vector-ref v i)) (loop (+ 1 i))))") (lint-test "(cond ((= i n)) ((pred? (vector-ref v i)) (loop (+ 1 i))) (else #f))" " cond: perhaps (cond ((= i n)) ((pred? (vector-ref v i)) (loop (+ 1 i))) (else #f)) -> (or (= i n) (and (pred? (vector-ref v i)) (loop (+ 1 i))))") (lint-test "(cond (A #f) (B #t) (else C))" " cond: perhaps (cond (A #f) (B #t) (else C)) -> (and (not A) (or B C))") (lint-test "(cond (A #t) (B C) (else #f))" " cond: perhaps (cond (A #t) (B C) (else #f)) -> (or A (and B C))") (lint-test "(cond (A #f) (B) (else C))" " cond: perhaps (cond (A #f) (B) (else C)) -> (and (not A) (or B C))") (lint-test "(cond (A) (B C) (else #f))" " cond: perhaps (cond (A) (B C) (else #f)) -> (or A (and B C))") (lint-test "(cond ((getenv s) x) ((= y z) w))" "") (lint-test "(cond (A #f) (B #f))" " cond: perhaps (cond (A #f) (B #f)) -> (if (or A B) #f)") (lint-test "(cond (A C) (B C))" " cond: perhaps (cond (A C) (B C)) -> (if (or A B) C)") (lint-test "(cond ((and (pair? x) (pair? y) (pair? z)) 32) ((and (pair? x) (pair? y) (pair? w)) 12) ((and (pair? x) (pair? y) (pair? v)) 2))" " cond: perhaps (cond ((and (pair? x) (pair? y) (pair? z)) 32) ((and (pair? x) (pair? y)... -> (cond ((not (and (pair? x) (pair? y))) #) ((pair? z) 32) ((pair? w) 12) ((pair? v) 2))") (lint-test "(cond ((and (pair? x) (pair? y) (pair? z)) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2))" " cond: perhaps (cond ((and (pair? x) (pair? y) (pair? z)) 32) ((and (pair? x) (pair? w))... -> (cond ((not (pair? x)) #) ((and (pair? y) (pair? z)) 32) ((pair? w) 12) (else 2))") (lint-test "(cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2))" " cond: perhaps (cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2)) -> (cond ((pair? z) 32) ((not (pair? x)) #) ((pair? w) 12) (else 2))") (lint-test "(cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2) (else 0))" " cond: perhaps (cond ((pair? z) 32) ((and (pair? x) (pair? w)) 12) ((pair? x) 2) (else 0)) -> (cond ((pair? z) 32) ((not (pair? x)) 0) ((pair? w) 12) (else 2))") (lint-test "(cond ((and x (pair? y)) 1) ((and x (string? y)) 2) ((and x (char? y)) 3) (else 4))" " cond: perhaps (cond ((and x (pair? y)) 1) ((and x (string? y)) 2) ((and x (char? y)) 3)... -> (cond ((not x) 4) ((pair? y) 1) ((string? y) 2) ((char? y) 3) (else 4))") (lint-test "(cond ((= x y) 2) ((= x 2) #f) (else #t))" " cond: perhaps (cond ((= x y) 2) ((= x 2) #f) (else #t)) -> (cond ((= x y) 2) (else (not (= x 2))))") (lint-test "(cond ((= x y) 2) ((= x 2) #t) (else #f))" " cond: this #t could be omitted: ((= x 2) #t) cond: perhaps (cond ((= x y) 2) ((= x 2) #t) (else #f)) -> (cond ((= x y) 2) (else (= x 2)))") (lint-test "(cond ((not x) y) (else z))" " cond: perhaps (cond ((not x) y) (else z)) -> (if x z y)") (lint-test "(cond ((not x) (f z) y) (else z))" " cond: perhaps (cond ((not x) (f z) y) (else z)) -> (cond (x z) (else (f z) y))") (lint-test "(cond ((not x)) (else z))" " cond: perhaps (cond ((not x)) (else z)) -> (or (not x) z)") (lint-test "(cond ((not x)) (else (f y) z))" " cond: perhaps (cond ((not x)) (else (f y) z)) -> (or (not x) (begin (f y) z))") (lint-test "(cond ((memq x y) z) (else (f x) z))" " cond: perhaps (cond ((memq x y) z) (else (f x) z)) -> (begin (if (not (memq x y)) (f x)) z)") (lint-test "(cond (x (f y) z) (else z))" " cond: perhaps (cond (x (f y) z) (else z)) -> (begin (if x (f y)) z)") (lint-test "(cond ((memq x y) (display y) z) (else (f x) z))" " cond: perhaps (cond ((memq x y) (display y) z) (else (f x) z)) -> (begin (if (memq x y) (display y) (f x)) z)") (lint-test "(cond (x (f y) z) (else (g y) (h y) z))" " cond: perhaps (cond (x (f y) z) (else (g y) (h y) z)) -> (begin (if x (f y) (begin (g y) (h y))) z)") (lint-test "(cond (x (f y) (g x) z) (else (g y) (h y) z))" " cond: perhaps (cond (x (f y) (g x) z) (else (g y) (h y) z)) -> (begin (if x (begin (f y) (g x)) (begin (g y) (h y))) z)") (lint-test "(cond (x (f y) (g x) z) (else z))" " cond: perhaps (cond (x (f y) (g x) z) (else z)) -> (begin (if x (begin (f y) (g x))) z)") (lint-test "(cond ((f x) (display y) z) ((h x) (f x) (display y) z) (else z))" " cond: perhaps (cond ((f x) (display y) z) ((h x) (f x) (display y) z) (else z)) -> (begin (cond ((f x) (display y)) ((h x) (f x) (display y))) z)") (lint-test "(let ((x 2)) (cond (A B) (C => (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y)))))))" " let: perhaps move the let into the '(C => (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y))))) branch: (let ((x 2)) (cond (A B) (C => (let ((y 4)) (lambda (n) (lambda (m) (+ n m... -> (cond ... (C => (let ((x 2)) (let ((y 4)) (lambda (n) (lambda (m) (+ n m x y)))))) ...)") (lint-test "(cond (A a) (B b) (else (if C (c) (d)) #t))" " cond: else clause could be folded into the outer cond: (cond (A a) (B b) (else (if C (c) (d)) #t)) -> (cond (A a) (B b) (C (c) #t) (else (d) #t))") (lint-test "(cond (A a) (B b) (else (if C (c)) #t))" " cond: else clause could be folded into the outer cond: (cond (A a) (B b) (else (if C (c)) #t)) -> (cond (A a) (B b) (C (c) #t) (else #t))") (lint-test "(cond (A a) (B b) (else (cond (C (c)) (else (d))) #t))" " cond: else clause could be folded into the outer cond: (cond (A a) (B b) (else (cond (C (c)) (else (d))) #t)) -> (cond (A a) (B b) (C (c) #t) (else (d) #t)) cond: perhaps (cond (C (c)) (else (d))) -> ((cond (C c) (else d)))") (lint-test "(cond (A a) (B b) (else (cond (C (c)) (D (d))) #t))" " cond: else clause could be folded into the outer cond: (cond (A a) (B b) (else (cond (C (c)) (D (d))) #t)) -> (cond (A a) (B b) (C (c) #t) (D (d) #t) (else #t))") (lint-test "(cond (A a) (B b) (else (when C (c) (d)) #t))" " cond: else clause could be folded into the outer cond: (cond (A a) (B b) (else (when C (c) (d)) #t)) -> (cond (A a) (B b) (C (c) (d) #t) (else #t))") (lint-test "(cond (A a) (B b) (else (unless C (c) (d)) #t))" " cond: else clause could be folded into the outer cond: (cond (A a) (B b) (else (unless C (c) (d)) #t)) -> (cond (A a) (B b) ((not C) (c) (d) #t) (else #t))") (lint-test "(begin (if (> x 1) (set! x y)) (if (> x 1) (display x)))" " begin: perhaps (... (if (> x 1) (set! x y)) (if (> x 1) (display x)) ...) -> (... (when (> x 1) (set! x y) (when (> x 1) (display x))) ...)") (lint-test "(begin (if (> x 1) (display x)) (if (> x 1) (set! x y)))" " begin: perhaps (... (if (> x 1) (display x)) (if (> x 1) (set! x y)) ...) -> (... (when (> x 1) (display x) (set! x y)) ...)") (lint-test "(cond ((> x 1) (set! x y)) ((> x 1) (display x)))" " cond: cond test (> x 1) is never true: (cond ((> x 1) (set! x y)) ((> x 1) (display x))) cond: cond test repeated: ((> x 1) (display x)) cond: cond test is always false: ((> x 1) (display x)) cond: perhaps (cond ((> x 1) (set! x y)) ((> x 1) (display x))) -> (cond ((> x 1) (set! x y)))") (lint-test "(cond (A (f x) => y))" " cond: '=> has no effect here: (A (f x) => y) cond: perhaps (cond (A (f x) => y)) -> (when A (f x) => y)") (lint-test "(when (and (< x 1) y) (if z (display z)))" " when: perhaps (when (and (< x 1) y) (if z (display z))) -> (when (and (< x 1) y z) (display z))") (lint-test "(when y (if z (display z)))" " when: perhaps (when y (if z (display z))) -> (when (and y z) (display z))") (lint-test "(when y (if (or (< x 1) z) (display z)))" " when: perhaps (when y (if (or (< x 1) z) (display z))) -> (when (and y (or (< x 1) z)) (display z))") (lint-test "(when (and (< x 1) y) (when z (display z) x))" " when: perhaps (when (and (< x 1) y) (when z (display z) x)) -> (when (and (< x 1) y z) (display z) x)") (lint-test "(when x (when y z))" " when: perhaps (when x (when y z)) -> (when (and x y) z)") (lint-test "(unless x (unless y z))" " unless: perhaps (unless x (unless y z)) -> (unless (or x y) z)") (lint-test "(unless (and (< x 1) y) (if z (display z)))" " unless: perhaps (unless (and (< x 1) y) (if z (display z))) -> (when (and (not (and (< x 1) y)) z) (display z))") (lint-test "(unless y (if z (display z)))" " unless: perhaps (unless y (if z (display z))) -> (when (and (not y) z) (display z))") (lint-test "(unless y (if (or (< x 1) z) (display z)))" " unless: perhaps (unless y (if (or (< x 1) z) (display z))) -> (when (and (not y) (or (< x 1) z)) (display z))") (lint-test "(unless (and (< x 1) y) (when z (display z) x))" " unless: perhaps (unless (and (< x 1) y) (when z (display z) x)) -> (when (and (not (and (< x 1) y)) z) (display z) x)") (lint-test "(unless (and (< x 1) y) (unless z (display z) x))" " unless: perhaps (unless (and (< x 1) y) (unless z (display z) x)) -> (unless (or (and (< x 1) y) z) (display z) x)") (lint-test "(when (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3)))" " when: perhaps (when (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3))) -> (cond ((>= x 2) #) ((= x 0) 1) ((negative? x) 2) (else 3))") (lint-test "(unless (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3)))" " unless: perhaps (unless (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3))) -> (when (>= x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3))) unless: perhaps (unless (< x 2) (cond ((= x 0) 1) ((negative? x) 2) (else 3))) -> (cond ((< x 2) #) ((= x 0) 1) ((negative? x) 2) (else 3))") (lint-test "(unless (and x (not y)) (display z))" " unless: perhaps (unless (and x (not y)) (display z)) -> (when (or (not x) y) ...)") (lint-test "(unless (and (not x) y) (display z))" " unless: perhaps (unless (and (not x) y) (display z)) -> (when (or x (not y)) ...)") (lint-test "(unless (and (not x) (not y)) (display z))" " unless: perhaps (unless (and (not x) (not y)) (display z)) -> (when (or x y) ...)") (lint-test "(when (and (not x) (not y)) (display z))" " when: perhaps (when (and (not x) (not y)) (display z)) -> (unless (or x y) ...) when: perhaps (and (not x) (not y)) -> (not (or x y))") (lint-test "(when A (unless B (display C) (f D E)))" " when: perhaps (when A (unless B (display C) (f D E))) -> (when (and A (not B)) (display C) (f D E))") (lint-test "(unless A (when B (display C) (f D E)))" " unless: perhaps (unless A (when B (display C) (f D E))) -> (when (and (not A) B) (display C) (f D E))") (lint-test "(when A (unless (odd? B) (display C) (f D E)))" " when: perhaps (when A (unless (odd? B) (display C) (f D E))) -> (when (and A (even? B)) (display C) (f D E)) when: perhaps (unless (odd? B) (display C) (f D E)) -> (when (even? B) (display C) (f D E))") (lint-test "(unless (< x y) (cond ((A B) (C D)) (else E)))" " unless: perhaps (unless (< x y) (cond ((A B) (C D)) (else E))) -> (when (>= x y) (cond ((A B) (C D)) (else E))) unless: perhaps (unless (< x y) (cond ((A B) (C D)) (else E))) -> (cond ((< x y) #) ((A B) (C D)) (else E))") (lint-test "(unless (< x 1) (cond ((integer? x) 1) (else 2)))" " unless: perhaps (unless (< x 1) (cond ((integer? x) 1) (else 2))) -> (when (>= x 1) (cond ((integer? x) 1) (else 2))) unless: perhaps (unless (< x 1) (cond ((integer? x) 1) (else 2))) -> (cond ((< x 1) #) ((integer? x) 1) (else 2))") (lint-test "(when (< x 1) (cond ((integer? x) 1) (else 2)))" " when: perhaps (when (< x 1) (cond ((integer? x) 1) (else 2))) -> (cond ((>= x 1) #) ((integer? x) 1) (else 2))") (lint-test "(unless (< y 3) 32)" " unless: perhaps (unless (< y 3) 32) -> (when (>= y 3) 32)") (lint-test "(if (< x 1) (cond ((integer? x) 1) (else 2)))" " if: perhaps (if (< x 1) (cond ((integer? x) 1) (else 2))) -> (cond ((>= x 1) #) ((integer? x) 1) (else 2))") (lint-test "(cond ((< x 1) (cond ((integer? x) 1) (else 2))))" " cond: perhaps (cond ((< x 1) (cond ((integer? x) 1) (else 2)))) -> (if (< x 1) (cond ((integer? x) 1) (else 2))) cond: perhaps (cond ((< x 1) (cond ((integer? x) 1) (else 2)))) -> (cond ((>= x 1) #) ((integer? x) 1) (else 2))") (lint-test "(if (and (< x 1) y) (when z (display z) x))" " if: perhaps (if (and (< x 1) y) (when z (display z) x)) -> (when (and (< x 1) y z) (display z) x)") (lint-test "(if (and (< x 1) y) (unless z (display z) x))" " if: perhaps (if (and (< x 1) y) (unless z (display z) x)) -> (when (and (< x 1) y (not z)) (display z) x)") (lint-test "(let ((x (g y))) (when x (display x)) (when x (set! y x)))" " let: perhaps (... (when x (display x)) (when x (set! y x)) ...) -> (when x (display x) (set! y x))") (lint-test "(let ((x (g y))) (unless x (display x)) (unless x (set! y x)))" " let: perhaps (... (unless x (display x)) (unless x (set! y x)) ...) -> (unless x (display x) (set! y x))") (lint-test "(begin (and x (display y)) (log z))" " begin: perhaps (and x (display y)) -> (if x (display y))") (lint-test "(begin (or x (display y)) (log z))" " begin: perhaps (or x (display y)) -> (if (not x) (display y))") (lint-test "(begin (if x #f (display y)) y)" " begin: this branch is pointless: #f in (if x #f (display y)) begin: perhaps (if x #f (display y)) -> (unless x (display y))") (lint-test "(begin (if x (display y) #f) y)" " begin: this branch is pointless: #f in (if x (display y) #f) begin: perhaps (if x (display y) #f) -> (when x (display y))") (lint-test "(begin (if x #f (begin (display y) (read z))) y)" " begin: this branch is pointless: #f in (if x #f (begin (display y) (read z))) begin: perhaps (if x #f (begin (display y) (read z))) -> (unless x (display y) (read z))") (lint-test "(begin (if (not x) #f (begin (display y) (read z))) y)" " begin: this branch is pointless: #f in (if (not x) #f (begin (display y) (read z))) begin: perhaps (if (not x) #f (begin (display y) (read z))) -> (when x (display y) (read z))") (lint-test "(car (cons 1 2))" " car: (car (cons 1 2)) is the same as 1") (lint-test "(car (string->list x))" " car: perhaps (car (string->list x)) -> (string-ref x 0)") (lint-test "(car (string->list (symbol->string x)))" " car: perhaps (car (string->list (symbol->string x))) -> (string-ref (symbol->string x) 0)") (lint-test "(set-car! (list-tail x y) z)" " set-car!: perhaps (set-car! (list-tail x y) z) -> (list-set! x y z)") (lint-test "(set-car! (cdr x) y)" " set-car!: perhaps (set-car! (cdr x) y) -> (list-set! x 1 y)") (lint-test "(set-car! (cddr (cdddr x)) y)" " set-car!: perhaps (set-car! (cddr (cdddr x)) y) -> (list-set! x 5 y)") (lint-test "(begin (set-car! x (car y)) (set-cdr! x (cdr y)))" " begin: perhaps ...(set-car! x (car y)) (set-cdr! x (cdr y)) -> (copy y x)") (lint-test "(car (list-tail x y))" " car: perhaps (car (list-tail x y)) -> (list-ref x y)") (lint-test "(car (list x y))" " car: perhaps (car (list x y)) -> x") (lint-test "(car (append x y))" " car: perhaps (car (append x y)) -> (car x)") (lint-test "(caddr (vector->list x))" " caddr: perhaps (caddr (vector->list x)) -> (vector-ref x 2)") (lint-test "(and x x y)" " and: perhaps (and x x y) -> (and x y)") (lint-test "(or x x y)" " or: perhaps (or x x y) -> (or x y)") (lint-test "(or x (or x y))" " or: perhaps (or x (or x y)) -> (or x y)") (lint-test "(< x 1 2 0 y)" " <: this comparison can't be true: (< x 1 2 0 y)") (lint-test "(< (- x y) 0)" " <: perhaps (< (- x y) 0) -> (< x y)") (lint-test "(> (- (log x) (log y)) 0.0)" " >: perhaps (> (- (log x) (log y)) 0.0) -> (> (log x) (log y)) >: perhaps (- (log x) (log y)) -> (log (/ x y))") (lint-test "(< 0 (- x y))" " <: perhaps (< 0 (- x y)) -> (> x y)") (lint-test "(> x (- y 1))" "") ; only optimizable if x and y are known to be integers (lint-test "(< x 1 2 y)" "") (lint-test "(< x 1 y)" "") (lint-test "(< 0 (floor x) 1)" " <: perhaps (< 0 (floor x) 1) -> #f") (lint-test "(< x x)" " <: this looks odd: (< x x)") (lint-test "(< x y x)" " <: it looks odd to have repeated arguments in (< x y x) <: perhaps (< x y x) -> #f") (lint-test "(< x x y)" " <: it looks odd to have repeated arguments in (< x x y) <: perhaps (< x x y) -> #f") (lint-test "(<= x x y z)" " <=: it looks odd to have repeated arguments in (<= x x y z) <=: perhaps (<= x x y z) -> (= x y z)") (lint-test "(<= x y x z x)" " <=: it looks odd to have repeated arguments in (<= x y x z x) <=: perhaps (<= x y x z x) -> (= x y z)") (lint-test "(<= x x x)" " <=: it looks odd to have repeated arguments in (<= x x x) <=: perhaps (<= x x x) -> #t") (lint-test "(> x y z y)" " >: it looks odd to have repeated arguments in (> x y z y) >: perhaps (> x y z y) -> #f") (lint-test "(char>? x #\\a #\\b y)" " char>?: this comparison can't be true: (char>? x #\\a #\\b y)") (lint-test "(< (char->integer x) 95)" " <: perhaps (< (char->integer x) 95) -> (char= (char->integer x) 90 (char->integer y))" " >=: perhaps (>= (char->integer x) 90 (char->integer y)) -> (char>=? x #\\Z y)") (lint-test "(> (abs x) -1)" " >: abs can't be negative: (> (abs x) -1)") (lint-test "(or (= (denominator n) 1) (= (denominator n) 0))" " or: perhaps (or (= (denominator n) 1) (= (denominator n) 0)) -> (member (denominator n) '(1 0) =) or: perhaps (= (denominator n) 1) -> (integer? n) or: denominator is never 0: (= (denominator n) 0)") (lint-test "(or (> (denominator n) 0) (<= (denominator n) 0))" " or: perhaps (or (> (denominator n) 0) (<= (denominator n) 0)) -> #t or: denominator is always > than 0: (> (denominator n) 0) or: denominator is never <= than 0: (<= (denominator n) 0)") (lint-test "(string>? \"a\" x \"b\" y)" " string>?: this comparison can't be true: (string>? \"a\" x \"b\" y)") (lint-test "(copy (copy x))" " copy: (copy (copy x)) could be (copy x)") (lint-test "(copy (copy x) (list 1))" " copy: (copy (copy x) (list 1)) could be (copy x (list 1))") (lint-test "(copy (copy x) y)" " copy: (copy (copy x) y) could be (copy x y)") (lint-test "(copy (copy x y 1 2))" " copy: (copy (copy x y 1 2)) could be (copy x y 1 2)") (lint-test "(copy x x)" " copy: (copy x x) is a no-op") (lint-test "(copy x x 0)" " copy: (copy x x 0) is a no-op") (lint-test "(copy x y 1 0)" " copy: these copy indices make no sense: (copy x y 1 0)") (lint-test "(copy x y 0 0)" " copy: these copy indices make no sense: (copy x y 0 0)") (lint-test "(string-ref (symbol->string 'abs) 1)" " string-ref: perhaps (string-ref (symbol->string 'abs) 1) -> #\\b string-ref: perhaps (symbol->string 'abs) -> \"abs\"") (lint-test "(string-ref (substring x 1) 2)" " string-ref: perhaps (string-ref (substring x 1) 2) -> (string-ref x (+ 2 1))") (lint-test "(string-ref (make-string 3 #\\a) 1)" " string-ref: perhaps (string-ref (make-string 3 #\\a) 1) -> #\\a") (lint-test "(string-ref (round x) str)" " string-ref: in (string-ref (round x) str), string-ref's first argument should be a string, but (round x) is an integer?") (lint-test "(string-ref x (cons 1 2))" " string-ref: in (string-ref x (cons 1 2)), string-ref's second argument should be an integer, but (cons 1 2) is a pair?") (lint-test "(string-copy (string-copy x))" " string-copy: (string-copy (string-copy x)) could be (string-copy x)") (lint-test "(string-append x)" " string-append: perhaps (string-append x) -> x, or use copy") (lint-test "(string-append \"\" \"\" x)" " string-append: perhaps (string-append \"\" \"\" x) -> x, or use copy") (lint-test "(string-append \"\" \"\")" " string-append: perhaps (string-append \"\" \"\") -> \"\"") (lint-test "(string-append \"\" (string-append x y) \"\")" " string-append: perhaps (string-append \"\" (string-append x y) \"\") -> (string-append x y)") (lint-test "(string-append \"123\" \"456\")" " string-append: perhaps (string-append \"123\" \"456\") -> \"123456\"") (lint-test "(string-append x (string-append y z))" " string-append: perhaps (string-append x (string-append y z)) -> (string-append x y z)") (lint-test "(string-append x \"a\" \"bc\" y)" " string-append: perhaps (string-append x \"a\" \"bc\" y) -> (string-append x \"abc\" y)") (lint-test "(vector-append)" " vector-append: perhaps (vector-append) -> #()") (lint-test "(vector-append x)" " vector-append: perhaps (vector-append x) -> (copy x)") (lint-test "(vector-append #(1 2) (vector-append #(3)))" " vector-append: perhaps (vector-append #(1 2) (vector-append #(3))) -> #(1 2 3) vector-append: #(1 2) could be #i(1 2) vector-append: #(3) could be #i(3)") (lint-test "(vector-append x (vector-append y z))" " vector-append: perhaps (vector-append x (vector-append y z)) -> (vector-append x y z)") (lint-test "(vector-append v1 (apply vector-append vs))" " vector-append: perhaps (vector-append v1 (apply vector-append vs)) -> (vector-append v1 (apply values vs))") (lint-test "(object->string (object->string x))" " object->string: (object->string (object->string x)) could be (object->string x)") (lint-test "(object->string x :else)" " object->string: bad second argument: :else") (lint-test "(display (format #f str x))" " display: perhaps (display (format #f str x)) -> (format () str x)") (lint-test "(display (apply format #f str x) p)" " display: perhaps (display (apply format #f str x) p) -> (apply format p str x)") (lint-test "(reverse (reverse x))" " reverse: (reverse (reverse x)) could be (copy x)") (lint-test "(reverse (cdr (reverse x)))" " reverse: perhaps (reverse (cdr (reverse x))) -> (copy x (make-list (- (length x) 1)))") (lint-test "(reverse (cons x (reverse y)))" " reverse: perhaps (reverse (cons x (reverse y))) -> (append y (list x))") (lint-test "(reverse (list-tail (reverse slist) index))" " reverse: perhaps (reverse (list-tail (reverse slist) index)) -> (copy slist (make-list (- (length slist) index)))") (lint-test "(reverse (append (reverse b) res))" " reverse: perhaps (reverse (append (reverse b) res)) -> (append (reverse res) b)") (lint-test "(reverse (reverse! x))" " reverse: (reverse (reverse! x)) could be (copy x)") (lint-test "(reverse (string->list x))" " reverse: perhaps less consing: (reverse (string->list x)) -> (string->list (reverse x))") (lint-test "(reverse '(1 2 3))" " reverse: perhaps (reverse '(1 2 3)) -> '(3 2 1)") (lint-test "(reverse (sort! x <))" " reverse: possibly (reverse (sort! x <)) -> (sort! x >)") (lint-test "(reverse (map abs (sort! x <)))" " reverse: possibly (reverse (map abs (sort! x <))) -> (map abs (sort! x >))") ; (lint-test "(let ((v (list 1 2))) (reverse! v) v)" "") ; (lint-test "(let ((v1 (list 1 2))) (set! v1 (reverse! v1)))" "") (lint-test "(vector->list (list->vector x))" " vector->list: (vector->list (list->vector x)) could be (copy x)") (lint-test "(string->number (number->string x))" " string->number: (string->number (number->string x)) could be x") (lint-test "(string->number \"123\" 21)" " string->number: string->number radix should be between 2 and 16: (string->number \"123\" 21)") (lint-test "(string->number (string num-char))" " string->number: perhaps (string->number (string num-char)) -> (- (char->integer num-char) (char->integer #\\0))") (lint-test "(string->number (or (f x) \"4\"))" " string->number: perhaps (string->number (or (f x) \"4\")) -> (cond ((f x) => string->number) (else 4))") (lint-test "(length (string->list x))" " length: perhaps (length (string->list x)) -> (length x)") (lint-test "(length (vector->list x))" " length: perhaps (length (vector->list x)) -> (length x)") (lint-test "(length (vector->list x 1))" " length: perhaps (length (vector->list x 1)) -> (- (length x) 1)") (lint-test "(length (vector->list x 1 3))" " length: perhaps (length (vector->list x 1 3)) -> 2") (lint-test "(length (vector->list x y 3))" " length: perhaps (length (vector->list x y 3)) -> (- 3 y)") (lint-test "(list->string (vector->list x))" " list->string: perhaps (list->string (vector->list x)) -> (copy x (make-string (length x)))") (lint-test "(list->vector (string->list x))" " list->vector: perhaps (list->vector (string->list x)) -> (copy x (make-vector (length x)))") (lint-test "(vector->list (make-vector 3 #f))" " vector->list: perhaps (vector->list (make-vector 3 #f)) -> (make-list 3 #f)") (lint-test "(list->vector (make-list 3 #f))" " list->vector: perhaps (list->vector (make-list 3 #f)) -> (make-vector 3 #f)") (lint-test "(list->string (reverse x))" " list->string: perhaps (list->string (reverse x)) -> (reverse (list->string x))") (lint-test "(define (getservent) (getserv))" " getservent: (define (getservent) (getserv)) could probably be (define getservent getserv)") (lint-test "(< (char->integer key) 256)" " <: perhaps (< (char->integer key) 256) -> #t") (lint-test "(require \"repl.scm\")" " require: require's arguments should be symbols: (require \"repl.scm\")") (lint-test "(list-ref (cddr f) (- (length f) 3))" " list-ref: perhaps (list-ref (cddr f) (- (length f) 3)) -> (list-ref f (- (length f) 1))") (lint-test "(list-ref (cdddr f) 2)" " list-ref: perhaps (list-ref (cdddr f) 2) -> (list-ref f 5)") (lint-test "(list-ref (cdr f) (- len 1))" " list-ref: perhaps (list-ref (cdr f) (- len 1)) -> (list-ref f len)") (lint-test "(let ((lst '(1 2 3))) (+ (list-ref lst 0) (list-ref lst 1) (list-ref lst 2) (list-ref lst 3)))" " let: perhaps (list-ref lst 0) -> (car lst) let: lst could be a vector, rather than a list") (lint-test "(let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 0) 0) (list-ref (list-ref lst 0) 1) (list-ref (list-ref lst 0) 2) (list-ref (list-ref lst 0) 3)))" " let: perhaps (list-ref (list-ref lst 0) 0) -> (caar lst) let: lst could be a vector, rather than a list let: lst is not set, and is always accessed via (list-ref lst 0) so its binding could probably be (lst (list-ref '((1) 2 3) 0)) in (let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 0) 0) (list-ref...") (lint-test "(let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 1) 0) (list-ref (list-ref lst 1) 1) (list-ref (list-ref lst 1) 2) (list-ref (list-ref lst 1) 3)))" " let: perhaps (list-ref (list-ref lst 1) 0) -> (caadr lst) let: lst could be a vector, rather than a list let: lst is not set, and is always accessed via (list-ref lst 1) so its binding could probably be (lst (list-ref '((1) 2 3) 1)) in (let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 1) 0) (list-ref...") (lint-test "(let ((lst '((1) 2 3))) (+ (list-ref (list-ref lst 2) 0) (list-ref (list-ref lst 3) 1) (list-ref (list-ref lst 4) 2) (list-ref (list-ref lst 2) 3)))" " let: perhaps (list-ref (list-ref lst 2) 0) -> (car (list-ref lst 2)) let: lst could be a vector, rather than a list ") (lint-test "(list->vector (reverse (vector->list x)))" " list->vector: perhaps (list->vector (reverse (vector->list x))) -> (reverse x) list->vector: perhaps less consing: (reverse (vector->list x)) -> (vector->list (reverse x))") (lint-test "(list->vector (reverse! (vector->list x)))" " list->vector: perhaps (list->vector (reverse! (vector->list x))) -> (reverse x) list->vector: perhaps less consing: (reverse! (vector->list x)) -> (vector->list (reverse x))") (lint-test "(list->vector (copy (vector->list x)))" " list->vector: perhaps (list->vector (copy (vector->list x))) -> (copy x)") (lint-test "(list->string (reverse (string->list (substring str 1))))" " list->string: perhaps (list->string (reverse (string->list (substring str 1)))) -> (reverse (substring str 1)) list->string: perhaps less consing: (reverse (string->list (substring str 1))) -> (string->list (reverse (substring str 1)))") (lint-test "(list->string (cdr (string->list x)))" " list->string: perhaps (list->string (cdr (string->list x))) -> (substring x 1)") (lint-test "(list->vector (list-tail (vector->list x) y))" " list->vector: perhaps (list->vector (list-tail (vector->list x) y)) -> (copy x (make-vector (- (length x) y))) ") (lint-test "(string->list \"123\")" " string->list: perhaps (string->list \"123\") -> '(#\\1 #\\2 #\\3)") (lint-test "(list->vector '(1 2 3))" " list->vector: perhaps (list->vector '(1 2 3)) -> #(1 2 3)") (lint-test "(list->vector (cons x '()))" " list->vector: perhaps (list->vector (cons x '())) -> (vector x) list->vector: perhaps (cons x '()) -> (list x) list->vector: quote is not needed here: '()") (lint-test "(list->vector (list x y z))" " list->vector: perhaps (list->vector (list x y z)) -> (vector x y z)") (lint-test "(list->vector (append (vector->list x) (vector->list y)))" " list->vector: perhaps (list->vector (append (vector->list x) (vector->list y))) -> (append x y) list->vector: perhaps (append (vector->list x) (vector->list y)) -> (vector->list (append x y))") (lint-test "(list->string '(#\\a #\\b #\\c))" " list->string: perhaps (list->string '(#\\a #\\b #\\c)) -> \"abc\"") (lint-test "(list->string (cons x '()))" " list->string: perhaps (list->string (cons x '())) -> (string x) list->string: perhaps (cons x '()) -> (list x) list->string: quote is not needed here: '()") (lint-test "(list->string (list x y z))" " list->string: perhaps (list->string (list x y z)) -> (string x y z)") (lint-test "(list->vector (sort! (vector->list x) y))" " list->vector: perhaps (list->vector (sort! (vector->list x) y)) -> (sort! x y)") (lint-test "(list->string (sort! (string->list x) y))" " list->string: perhaps (list->string (sort! (string->list x) y)) -> (sort! x y)") (lint-test "(string->list x y y)" " string->list: these string->list indices make no sense: (string->list x y y)") (lint-test "(symbol->keyword (string->symbol x))" " symbol->keyword: perhaps (symbol->keyword (string->symbol x)) -> (string->keyword x)") (lint-test "(vector->list (vector a b c))" " vector->list: perhaps (vector->list (vector a b c)) -> (list a b c)") (lint-test "(vector->list (vector-copy v start end))" " vector->list: perhaps (vector->list (vector-copy v start end)) -> (vector->list v start end)") (lint-test "(string->list (string a b c))" " string->list: perhaps (string->list (string a b c)) -> (list a b c)") (lint-test "(list->string (list a b c))" " list->string: perhaps (list->string (list a b c)) -> (string a b c)") (lint-test "(list->string (make-list a b))" " list->string: perhaps (list->string (make-list a b)) -> (make-string a b)") (lint-test "(string->symbol (string-append x y z))" " string->symbol: perhaps (string->symbol (string-append x y z)) -> (symbol x y z)") (lint-test "(symbol (string-append x y z))" " symbol: perhaps (symbol (string-append x y z)) -> (symbol x y z)") (lint-test "(symbol (string-append x y z) a)" "") (lint-test "(string->symbol \"a\")" " string->symbol: perhaps (string->symbol \"a\") -> 'a") (lint-test "(symbol \"a\")" " symbol: perhaps (symbol \"a\") -> 'a") (lint-test "(symbol \"a\" \"b\")" " symbol: perhaps (symbol \"a\" \"b\") -> 'ab") (lint-test "(symbol \"a b\")" "") (lint-test "(string->symbol (apply string-append x))" " string->symbol: perhaps (string->symbol (apply string-append x)) -> (apply symbol x)") (lint-test "(symbol (apply string-append x))" " symbol: perhaps (symbol (apply string-append x)) -> (apply symbol x)") (lint-test "(string->symbol (if (null? x) \"abc\" x))" " string->symbol: perhaps (string->symbol (if (null? x) \"abc\" x)) -> (if (null? x) 'abc (string->symbol x))") (lint-test "(string->symbol (if (not (null? x)) x \"abc\"))" " string->symbol: perhaps (string->symbol (if (not (null? x)) x \"abc\")) -> (if (not (null? x)) (string->symbol x) 'abc)") (lint-test "(string->symbol (if (null? x) \"abc\" \"x\"))" " string->symbol: perhaps (string->symbol (if (null? x) \"abc\" \"x\")) -> (if (null? x) 'abc 'x)") (lint-test "(equal? x (list 1 2))" " equal?: perhaps (list 1 2) -> '(1 2)") (lint-test "(equal? x (list (list 1 2) (list 3 4)))" " equal?: perhaps (list (list 1 2) (list 3 4)) -> '((1 2) (3 4))") (lint-test "(equal? x (vector (list 1 2) (list 3 4)))" " equal?: perhaps (vector (list 1 2) (list 3 4)) -> #((1 2) (3 4))") (lint-test "(equal? x (list (vector 1 2) (list 3 (list 4 5))))" " equal?: perhaps (list (vector 1 2) (list 3 (list 4 5))) -> '(#(1 2) (3 (4 5)))") (lint-test "(car (reverse x))" " car: perhaps use 'last from srfi-1, or (car (reverse x)) -> (list-ref x (- (length x) 1))") (lint-test "(caddr (reverse! x))" " caddr: perhaps (caddr (reverse! x)) -> (list-ref x (- (length x) 3))") (lint-test "(append 3)" " append: perhaps (append 3) -> 3") (lint-test "(append)" " append: perhaps (append) -> ()") (lint-test "(append (append))" " append: perhaps (append (append)) -> ()") (lint-test "(append '(1) (append '(2)))" " append: append does not copy its last argument, so (append '(1) (append '(2))) is dangerous append: perhaps (append '(1) (append '(2))) -> (list 1 2)") (lint-test "(append x (append))" " append: perhaps clearer: (append x (append)) -> (copy x)") (lint-test "(append '(1 2) (list))" " append: perhaps clearer: (append '(1 2) (list)) -> (copy '(1 2)) append: perhaps (list) -> (); there is only one nil") (lint-test "(append x '())" " append: perhaps clearer: (append x '()) -> (copy x) append: quote is not needed here: '()") (lint-test "(append '(1) (append 2))" " append: perhaps (append '(1) (append 2)) -> (cons 1 2)") (lint-test "(append '(1) (append '(2) '(3)) '(4))" " append: append does not copy its last argument, so (append '(1) (append '(2) '(3)) '(4)) is dangerous append: perhaps (append '(1) (append '(2) '(3)) '(4)) -> (list 1 2 3 4)") (lint-test "(append (list x y) (list z))" " append: perhaps (append (list x y) (list z)) -> (list x y z)") (lint-test "(append '(1 2) (list 3))" " append: perhaps (append '(1 2) (list 3)) -> (list 1 2 3)") (lint-test "(append '(1) '(2 3))" " append: append does not copy its last argument, so (append '(1) '(2 3)) is dangerous append: perhaps (append '(1) '(2 3)) -> (list 1 2 3)") (lint-test "(append '(x) '((+ 1 2) #(a)))" " append: append does not copy its last argument, so (append '(x) '((+ 1 2) #(a))) is dangerous append: perhaps (append '(x) '((+ 1 2) #(a))) -> (list 'x '(+ 1 2) #(a))") ;; (equal? (list 'x '(+ 1 2) #(a)) (append '(x) '((+ 1 2) #(a)))) -> #t (lint-test "(append (list x) (list y z) (list 1))" " append: perhaps (append (list x) (list y z) (list 1)) -> (list x y z 1)") (lint-test "(append (list x y) '(z))" " append: append does not copy its last argument, so (append (list x y) '(z)) is dangerous append: perhaps (append (list x y) '(z)) -> (list x y 'z)") (lint-test "(append (list x) y)" " append: perhaps (append (list x) y) -> (cons x y)") (lint-test "(append (list x) (list y z))" " append: perhaps (append (list x) (list y z)) -> (list x y z)") (lint-test "(append () '(1 2) 1)" " append: perhaps (append () '(1 2) 1) -> (append '(1 2) 1)") (lint-test "(append '() (append) (list 1) (list) () (list 2) ())" " append: perhaps (append '() (append) (list 1) (list) () (list 2) ()) -> (list 1 2) append: quote is not needed here: '() append: perhaps (list) -> (); there is only one nil") (lint-test "(append x y (append))" " append: perhaps (append x y (append)) -> (append x y ())") (lint-test "(append x y ())" "") (lint-test "(append (list x) y (list z))" " append: perhaps (append (list x) y (list z)) -> (cons x (append y (list z)))") (lint-test "(append x (list y) z)" " append: perhaps (append x (list y) z) -> (append x (cons y z))") (lint-test "(append '(x) y)" " append: perhaps (append '(x) y) -> (cons 'x y)") (lint-test "(append '(0) y)" " append: perhaps (append '(0) y) -> (cons 0 y)") (lint-test "(begin (set! x (append x y)) (set! x (append x z w)))" " begin: perhaps (set! x (append x y)) (set! x (append x z w)) -> (set! x (append x y z w))") (lint-test "(append x (copy y) z)" " append: perhaps (append x (copy y) z) -> (append x y z)") (lint-test "(append x (copy y))" "") (lint-test "(append (cons x y) z)" " append: perhaps (append (cons x y) z) -> (cons x (append y z))") (lint-test "(append (list x y) (cons z ()))" " append: perhaps (append (list x y) (cons z ())) -> (list x y z) append: perhaps (cons z ()) -> (list z)") (lint-test "(append (list w) (list x y) (list z))" " append: perhaps (append (list w) (list x y) (list z)) -> (list w x y z)") (lint-test "(append (list w) (list x y) (cons z ()))" " append: perhaps (append (list w) (list x y) (cons z ())) -> (list w x y z) append: perhaps (cons z ()) -> (list z)") (lint-test "(append (cons x ()) (list y w z))" " append: perhaps (append (cons x ()) (list y w z)) -> (list x y w z) append: perhaps (cons x ()) -> (list x)") (lint-test "(append (cons a ()) c)" " append: perhaps (append (cons a ()) c) -> (cons a c) append: perhaps (cons a ()) -> (list a)") (lint-test "(append (list a b) (cons c d))" " append: perhaps (append (list a b) (cons c d)) -> (cons a (cons b (cons c d)))") (lint-test "(append (apply append x) y)" " append: perhaps (append (apply append x) y) -> (append (apply values x) y)") (lint-test "(append (cons x y) z w)" " append: perhaps (append (cons x y) z w) -> (cons x (append y z w))") (lint-test "(append (list 'p) (list 'q) (list 'r) (list #f) x)" " append: perhaps (append (list 'p) (list 'q) (list 'r) (list #f) x) -> (cons 'p (cons 'q (cons 'r (cons #f x))))") (lint-test "(append \"hi\" \"\")" " append: perhaps clearer: (append \"hi\" \"\") -> (copy \"hi\")") (lint-test "(append #(1 2 3) #())" " append: perhaps clearer: (append #(1 2 3) #()) -> (copy #(1 2 3)) append: #(1 2 3) could be #i(1 2 3)") (lint-test "(append #(1 2 3) (vector))" " append: perhaps clearer: (append #(1 2 3) (vector)) -> (copy #(1 2 3)) append: #(1 2 3) could be #i(1 2 3)") (lint-test "(append \"hi\" (string))" " append: perhaps clearer: (append \"hi\" (string)) -> (copy \"hi\") append: (string) could be \"\"") (lint-test "(append x (list))" " append: perhaps clearer: (append x (list)) -> (copy x) append: perhaps (list) -> (); there is only one nil") (lint-test "(cons x (list y z))" " cons: perhaps (cons x (list y z)) -> (list x y z)") (lint-test "(cons x (list))" " cons: perhaps (cons x (list)) -> (list x) cons: perhaps (list) -> (); there is only one nil") (lint-test "(cons 1 ())" " cons: perhaps (cons 1 ()) -> (list 1)") (lint-test "(cons a (cons b (cons c ())))" " cons: perhaps (cons a (cons b (cons c ()))) -> (list a b c)") (lint-test "(cons a (cons b (list c)))" " cons: perhaps (cons a (cons b (list c))) -> (list a b c)") (lint-test "(cons a (cons b (list c d)))" " cons: perhaps (cons a (cons b (list c d))) -> (list a b c d)") (lint-test "(cons a (cons b c))" "") (lint-test "(cons a (cons b (cons c '())))" " cons: perhaps (cons a (cons b (cons c '()))) -> (list a b c) cons: quote is not needed here: '()") (lint-test "(cons (car x) (cdr x))" " cons: possibly (cons (car x) (cdr x)) -> (copy x)") (lint-test "(cons (cadar x) (cddar x))" " cons: possibly (cons (cadar x) (cddar x)) -> (copy (cdar x))") (lint-test "(set! x (cons a (list)))" " set!: perhaps (cons a (list)) -> (list a) set!: perhaps (list) -> (); there is only one nil") (lint-test "(set! x (cons a (list b c)))" " set!: perhaps (cons a (list b c)) -> (list a b c)") (lint-test "(set! x (cons a (cons b (list c d))))" " set!: perhaps (cons a (cons b (list c d))) -> (list a b c d)") (lint-test "(set! x (cons a (cons b ())))" " set!: perhaps (cons a (cons b ())) -> (list a b)") (lint-test "(cons 'x (or y (list 'z)))" "") ; quote for list here is incorrect (lint-test "`(,@x ,@(map (lambda (z) `(,z ,@z)) y))" " list-values: perhaps (list-values (apply-values x) (apply-values (map (lambda (z) (list-values... -> (append x (map (lambda (z) (cons z z)) y)) list-values: perhaps (list-values z (apply-values z)) -> (cons z z)") (lint-test "`(,@x ,@(map (lambda (z) `(,@z ,@z)) y))" " list-values: perhaps (list-values (apply-values x) (apply-values (map (lambda (z) (list-values... -> (append x (map (lambda (z) (append z z)) y)) list-values: perhaps (list-values (apply-values z) (apply-values z)) -> (append z z)") (lint-test "`(,@x ,@(map (lambda (z) `(,@z ,@z ,@x)) y))" " list-values: perhaps (list-values (apply-values z) (apply-values z) (apply-values x)) -> (append z z x)") (lint-test "(append `(,x) z)" " append: perhaps (append (list x) z) -> (cons x z) append: perhaps (list-values x) -> (list x)") (lint-test "(values `(x ,@y))" " values: perhaps (values (list-values 'x (apply-values y))) -> (cons 'x y) values: perhaps (list-values 'x (apply-values y)) -> (cons 'x y)") (lint-test "(values `(x ,y) a)" " values: perhaps (values (list-values 'x y) a) -> (values (list 'x y) a) values: perhaps (list-values 'x y) -> (list 'x y)") (lint-test "(values `(,x ,@y) z)" " values: perhaps (values (list-values x (apply-values y)) z) -> (values (cons x y) z) values: perhaps (list-values x (apply-values y)) -> (cons x y)") (lint-test "(values `(,@x ,@y) `(,x z))" " values: perhaps (values (list-values (apply-values x) (apply-values y)) (list-values x 'z)) -> (values (append x y) (list x 'z)) values: perhaps (list-values (apply-values x) (apply-values y)) -> (append x y) values: perhaps (list-values x 'z) -> (list x 'z)") (lint-test "(values (values 1))" "values: perhaps (values (values 1)) -> (values 1) values: perhaps (values 1) -> 1") (lint-test "(define (g x) `(+ ,y ,@(map f x)))" " g: perhaps (list-values '+ y (apply-values (map f x))) -> (cons '+ (cons y (map f x)))") (lint-test "(define (g x) `(+ ,@(map f x)))" " g: perhaps (list-values '+ (apply-values (map f x))) -> (cons '+ (map f x))") (lint-test "(define (g x) `(,e ,@(map f x)))" " g: perhaps (list-values e (apply-values (map f x))) -> (cons e (map f x))") (lint-test "(define (g x) `(f ,@x ,@y))" " g: perhaps (list-values 'f (apply-values x) (apply-values y)) -> (cons 'f (append x y))") (lint-test "(define (g x) `(display ,(map f x)))" " g: perhaps (list-values 'display (map f x)) -> (list 'display (map f x))") (lint-test "(define-macro (g x) `(f ,x))" " define-macro: perhaps (define-macro (g x) (list-values 'f x)) -> (define g f) g: perhaps (list-values 'f x) -> (list 'f x)") (lint-test "(define-macro (g x) `(,@x ,y))" " g: perhaps (list-values (apply-values x) y) -> (append x (list y))") (lint-test "(define-macro (g x) `(,@x z))" " g: perhaps (list-values (apply-values x) 'z) -> (append x (list 'z))") (lint-test "(define-macro (g x) `(,@x ,(f y)))" " g: perhaps (list-values (apply-values x) (f y)) -> (append x (list (f y)))") (lint-test "(define-macro (g x) `(+ ,y ,@(map f x)))" " g: perhaps (list-values '+ y (apply-values (map f x))) -> (cons '+ (cons y (map f x)))") (lint-test "(define-macro (g x) `(,@x ,y ,@z))" " g: perhaps (list-values (apply-values x) y (apply-values z)) -> (append x (cons y z))") (lint-test "(define-macro (g x) `(,@x ,@y ,z))" " g: perhaps (list-values (apply-values x) (apply-values y) z) -> (append x y (list z))") (lint-test "(define f `((cond . ,forced-indent) (case . ,print-case) (let . ,let-expr)))" "") (lint-test "(define f `((cond . ,forced-indent) (let . ,let-expr)))" " f: perhaps (list-values ( (list-values 'cond) forced-indent) (... -> (list ( (list 'cond) forced-indent) ( (list 'let) let-expr))") (lint-test "(set! x `(f . (,g . 100)))" " set!: perhaps (list-values 'f g) -> (list 'f g)") (lint-test "(set! x `(f . (g . 100)))" " set!: perhaps (list-values 'f 'g) -> (list 'f 'g)") (lint-test "(set! x `(f . g))" " set!: perhaps (list-values 'f) -> (list 'f)") (lint-test "(set! x `((f . (,g . 100)) (f1 . (,g1 . 1001))))" " set!: perhaps (list-values ( (list-values 'f g) 100) ( (list-values 'f1... -> (list ( (list 'f g) 100) ( (list 'f1 g1) 1001))") (lint-test "(set! x `((f . (g . 100)) (f1 . (g1 . 1001))))" " set!: perhaps (list-values ( (list-values 'f 'g) 100) ( (list-values 'f1... -> (list ( (list 'f 'g) 100) ( (list 'f1 'g1) 1001))") (lint-test "(sort! x abs)" " sort!: abs is a questionable sort! function") (lint-test "(sort! x (lambda (a b) (< a b)))" " sort!: perhaps (lambda (a b) (< a b)) -> <") (lint-test "(sort! x (lambda (a b) (< b a)))" " sort!: perhaps (lambda (a b) (< b a)) -> >") (lint-test "(abs 1 2)" " abs: abs has too many arguments: (abs 1 2)") (lint-test "(-)" " -: - needs at least 1 argument: (-)") (lint-test "(modulo 3)" " modulo: modulo needs 2 arguments: (modulo 3)") (lint-test "(let () (define* (f1 a b) (+ a b)) (f1 :c 1))" " let: perhaps (... (define* (f1 a b) (+ a b)) (f1 :c 1)) -> (... (let ((a :c) (b 1)) (+ a b))) let: f1 keyword argument :c (in (f1 :c 1)) does not match any argument in (a b)") (lint-test "(let () (define (f2 a b) (+ a b)) (f2 1 2 3))" " let: perhaps (... (define (f2 a b) (+ a b)) (f2 1 2 3)) -> (... (let ((a 1) (b 2)) (+ a b))) f2: leaving aside +'s optional args, f2 could be (define f2 +) let: f2 has too many arguments: (f2 1 2 3)") (lint-test "(let () (define* (f3 a . b) (+ a b)) (f3 1 2 3))" "") (lint-test "(let () (define* (f4 (a #f)) a) (f4))" " let: perhaps (... (define* (f4 (a #f)) a) (f4)) -> (... (let ((a #f)) a)) f4: the default argument value is #f in define*, so (a #f) can be a") (lint-test "(let () (define (f1 a) a) 32)" " let: f1 not used, value: (define (f1 a) a)") (lint-test "(letrec ((f1 (lambda (a) a))) 32)" " letrec: letrec could be let: (letrec ((f1 (lambda (a) a))) 32) letrec: f1 not used, initially: (lambda (a) a) from letrec") (lint-test "(letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+ x f2))" " letrec: in (letrec ((x 32) (f1 (let ((y 1)) (lambda (z) (+ x y z)))) (f2 (f1 x))) (+..., letrec should be letrec* because x is used in f2's value (not a function): (f1 x)") (lint-test "(letrec* ((f1 (lambda (x) (+ x (f2 x)))) (f2 (lambda (x) (+ x (f1 x))))) (+ (f1 2) (f2 1)))" " letrec*: letrec* could be letrec: (letrec* ((f1 (lambda (x) (+ x (f2 x)))) (f2 (lambda (x) (+ x (f1 x)))))...") ;; test shadowing checks (lint-test "(letrec ((f1 (lambda (x) (* x (f1 2))))) (lambda (y) (+ y (f1 y))))" " letrec: perhaps (letrec ((f1 (lambda (x) (* x (f1 2))))) (lambda (y) (+ y (f1 y)))) -> (lambda (y) (+ y (let f1 ((x y)) (* x (f1 2)))))") (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (let ((z 3)) (+ y (f1 y)))))" " letrec: z can be moved to the enclosing function's closure") (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (let* ((z 3)) (+ y (f1 y)))))" " letrec: let* could be let: (let* ((z 3)) (+ y (f1 y)))") (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (letrec ((z 3)) (+ y (f1 y)))))" " letrec: letrec could be let: (letrec ((z 3)) (+ y (f1 y)))") (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (do ((z 3)) () (+ y (f1 y)))))" "") (lint-test "(letrec ((f1 (lambda (x) (* x z (f1 2))))) (lambda (y) (lambda (z) (+ y (f1 y)))))" "") (lint-test "(letrec ((f1 (lambda (x z) (* x z (f1 2))))) (lambda (y) (let ((z (g 3))) (+ z (f1 y)))))" " letrec: perhaps (letrec ((f1 (lambda (x z) (* x z (f1 2))))) (lambda (y) (let ((z (g 3)))... -> (lambda (y) (let ((z (g 3))) (+ z (let f1 ((x y)) (* x z (f1 2))))))") (lint-test "(let () (define x 3) 32)" " let: x not used, initially: 3 from define let: perhaps (let () (define x 3) 32) -> (let ((x 3)) ...)") (lint-test "(let ((z 1)) (define x 12) (define (y a) a) 32)" " let: perhaps (... (define x 12) (define (y a) a) 32) -> (... (let ((x 12)) ...)) let: y not used, value: (define (y a) a) let: x not used, initially: 12 from define let: z not used, initially: 1 from let let: perhaps (let ((z 1)) (define x 12) (define (y a) a) 32) -> (let ((z 1) (x 12)) ...)") (lint-test "(let ((z 1)) (define x 12) (define (y a) a) (+ z 32))" " let: perhaps (... (define x 12) (define (y a) a) (+ z 32)) -> (... (let ((x 12)) ...)) let: y not used, value: (define (y a) a) let: x not used, initially: 12 from define let: perhaps (let ((z 1)) (define x 12) (define (y a) a) (+ z 32)) -> (let ((z 1) (x 12)) ...)") (lint-test "(let* ((a 1) (b 2) (c (+ a 1))) (* c 2))" " let*: b not used, initially: 2 from let* let*: perhaps restrict a which is not used in the let* body (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((b 2) (c (let ((a 1)) (+ a 1)))) ...) let*: perhaps split this let*: (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let ((a 1) (b 2)) (let ((c (+ a 1))) ...)) let*: perhaps (let* ((a 1) (b 2) (c (+ a 1))) (* c 2)) -> (let* ((a 1) (b 2)) (* (+ a 1) 2))") (lint-test "(let () (define (f4 a . b) (+ a b)) (f4))" " let: f4 needs 1 argument: (f4)") (lint-test "(let ((a)) #f)" " let: let variable value is missing? (a)") (lint-test "(let ((a . 1)) #f)" " let: let binding is an improper list? (a . 1)") (lint-test "(let ((a 1) . b) a)" " let: let is messed up: (let ((a 1) . b) a)") (lint-test "(let ((1 2)) #f)" " let: let variable is not a symbol? (1 2)") (lint-test "(let ((pi 2)) #f)" " let: can't bind a constant: (pi 2)") (lint-test "(let ((:a 1)) :a)" " let: let variable is a keyword? (:a 1) let: perhaps (let ((:a 1)) :a) -> 1") (lint-test "(let ((a 2) (a 3)) a)" " let: let variable a is declared twice let: a not used, initially: 2 from let") (lint-test "(let (a) a)" " let: let is messed up: (let (a) a)") (lint-test "(let ((a 1) (set! a 2)))" " let: let is messed up: (let ((a 1) (set! a 2)))") (lint-test "(let ((a 1)) (set! a 2))" " let: a set, but not used: (set! a 2) let: perhaps (let ((a 1)) (set! a 2)) -> 2 let: set! is pointless in (set! a 2): use 2") (lint-test "(let ((a 1) (b (display 2))) (set! a 2))" " let: b not used, initially: (display 2) from let let: a set, but not used: (set! a 2) let: perhaps (let ((a 1) (b (display 2))) (set! a 2)) -> (let ((b (display 2))) 2) let: set! is pointless in (set! a 2): use 2") (lint-test "(let ((a 1)) #f)" " let: a not used, initially: 1 from let") (lint-test "(let :x ((i y)) (x i))" " let: bad let name: :x") (lint-test "(let xx () z)" " let: perhaps (let xx () z) -> z let: xx not used, value: (let xx () z)") (lint-test "(let ((x (log y))) x)" " let: perhaps (let ((x (log y))) x) -> (log y)") (lint-test "(let* ((x (log y))) x)" " let*: let* could be let: (let* ((x (log y))) x) let*: perhaps (let* ((x (log y))) x) -> (log y)") (lint-test "(let* ((y 3) (x (log y))) x)" " let*: perhaps restrict y which is not used in the let* body (let* ((y 3) (x (log y))) x) -> (let ((x (let ((y 3)) (log y)))) ...) let*: perhaps substitute y into x: (let* ((y 3) (x (log y))) x) -> (let ((x (log 3))) ...) let*: perhaps (let* ((y 3) (x (log y))) x) -> (let ((y 3)) (log y))") (lint-test "(let ((y 3) (x (log z))) x)" " let: y not used, initially: 3 from let") (lint-test "(let* ((z 3) (y z) (x (log y))) x)" " let*: perhaps restrict z, y which are not used in the let* body (let* ((z 3) (y z) (x (log y))) x) -> (let ((x (let ((y (let ((z 3)) z))) (log y)))) ...) let*: perhaps substitute y into x: (let* ((z 3) (y z) (x (log y))) x) -> (let* ((z 3) (x (log z))) ...) let*: perhaps (let* ((z 3) (y z) (x (log y))) x) -> (let* ((z 3) (y z)) (log y))") (lint-test "(let* ((x 1) (x (+ x 1))) x)" " let*: let* variable x is declared twice let*: perhaps (let* ((x 1) (x (+ x 1))) x) -> (let ((x 1)) (+ x 1))") (lint-test "(let* ((x 1) (x (+ y 1))) x)" " let*: let* could be let: (let* ((x 1) (x (+ y 1))) x) let*: let* variable x is declared twice let*: x not used, initially: 1 from let* let*: perhaps (let* ((x 1) (x (+ y 1))) x) -> (let ((x 1)) (+ y 1))") (lint-test "(let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (+ a b c d)))" " let*: perhaps (let* ((c (+ b 3)) (d (+ c 4))) (+ a b c d)) -> (let ((c (+ b 3))) (+ a b c (+ c 4))) let*: perhaps (let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (+ a b c d))) -> (let* ((a 1) (b (+ a 2)) (c (+ b 3)) (d (+ c 4))) (+ a b c d))") (lint-test "(let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (display a) (+ a b c d)))" " let*: perhaps (let* ((a 1) (b (+ a 2))) (let* ((c (+ b 3)) (d (+ c 4))) (display a) (+ a... -> (let* ((a 1) (b (+ a 2)) (c (+ b 3)) (d (+ c 4))) (display a) ...)") (lint-test "(let* ((a 1) (b (+ a 1))) b)" " let*: perhaps restrict a which is not used in the let* body (let* ((a 1) (b (+ a 1))) b) -> (let ((b (let ((a 1)) (+ a 1)))) ...) let*: perhaps substitute a into b: (let* ((a 1) (b (+ a 1))) b) -> (let ((b (+ 1 1))) ...) let*: perhaps (let* ((a 1) (b (+ a 1))) b) -> (let ((a 1)) (+ a 1))") (lint-test "(let* ((a 1) (b (+ a 1))) (+ a b))" " let*: perhaps (let* ((a 1) (b (+ a 1))) (+ a b)) -> (let ((a 1)) (+ a (+ a 1)))") (lint-test "(let ((x (assoc y z))) (if x (cdr x)))" " let: perhaps (let ((x (assoc y z))) (if x (cdr x))) -> (cond ((assoc y z) => cdr))") (lint-test "(let ((x (assoc y z))) (if x (cdr x) 32))" " let: perhaps (let ((x (assoc y z))) (if x (cdr x) 32)) -> (cond ((assoc y z) => cdr) (else 32))") (lint-test "(let ((x (f y))) (and x (g x)))" " let: perhaps (let ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f))") (lint-test "(let ((x (f y))) (or (not x) (g x)))" " let: perhaps (let ((x (f y))) (or (not x) (g x))) -> (cond ((f y) => g) (else #t))") (lint-test "(let* ((x (f y))) (and x (g x)))" " let*: let* could be let: (let* ((x (f y))) (and x (g x))) let*: perhaps (let* ((x (f y))) (and x (g x))) -> (cond ((f y) => g) (else #f))") (lint-test "(let* ((x (f y))) (or (not x) (g x)))" " let*: let* could be let: (let* ((x (f y))) (or (not x) (g x))) let*: perhaps (let* ((x (f y))) (or (not x) (g x))) -> (cond ((f y) => g) (else #t))") (lint-test "(let* ((x (log 2)) (y (+ x 1))) (display y))" " let*: perhaps restrict x which is not used in the let* body (let* ((x (log 2)) (y (+ x 1))) (display y)) -> (let ((y (let ((x (log 2))) (+ x 1)))) ...) let*: perhaps substitute x into y: (let* ((x (log 2)) (y (+ x 1))) (display y)) -> (let ((y (+ (log 2) 1))) ...) let*: perhaps (let* ((x (log 2)) (y (+ x 1))) (display y)) -> (let ((x (log 2))) (display (+ x 1)))") (lint-test "(let* ((z 1) (w (read p)) (v (read p)) (y (+ z w)) (x (< y 3))) (if x (f x)))" " let*: v not used, initially: (read p) from let* let*: perhaps restrict z, y which are not used in the let* body (let* ((z 1) (w (read p)) (v (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) -> (let* ((w (read p)) (v (read p)) (x (let ((y (let ((z 1)) (+ z w)))) (< y 3)))) ...) let*: perhaps substitute y into x: (let* ((z 1) (w (read p)) (v (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) -> (let* ((z 1) (w (read p)) (v (read p)) (x (< (+ z w) 3))) ...) let*: perhaps (let* ((z 1) (w (read p)) (v (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) -> (let* ((z 1) (w (read p)) (v (read p)) (y (+ z w))) (cond ((< y 3) => f)))") (lint-test "(let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x)))" " let*: perhaps restrict z, w, y which are not used in the let* body (let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) -> (let ((x (let ((y (let* ((w (read p)) (z 1)) (+ z w)))) (< y 3)))) ...) let*: perhaps substitute w into y: (let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) -> (let* ((z 1) (y (+ z (read p))) (x (< y 3))) ...) let*: perhaps (let* ((z 1) (w (read p)) (y (+ z w)) (x (< y 3))) (if x (f x))) -> (let* ((z 1) (w (read p)) (y (+ z w))) (cond ((< y 3) => f)))") (lint-test "(let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i)))" " let*: perhaps restrict a which is not used in the let* body (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) -> (let ((b (let ((a (car x))) (+ a 1)))) ...) let*: perhaps (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) -> (let ((a (car x))) (do ((b (+ a 1)) (i 0 (+ i 1))) ...)) let*: perhaps substitute a into b: (let* ((a (car x)) (b (+ a 1))) (do ((i 0 (+ i 1))) ((= i b)) (display i))) -> (let ((b (+ (car x) 1))) ...)") (lint-test "(let ((x (f y))) (if x (g x) x))" " let: perhaps (let ((x (f y))) (if x (g x) x)) -> (cond ((f y) => g) (else #f)) let: perhaps (if x (g x) x) -> (and x (g x))") (lint-test "(let ((x (assoc y z))) (if (pair? x) (g x) x))" " let: perhaps (let ((x (assoc y z))) (if (pair? x) (g x) x)) -> (cond ((assoc y z) => g) (else #f))") (lint-test "(let ((x (assoc y z))) (if (null? x) (g x)))" " let: in (if (null? x) (g x)), x can't be null because assoc in (x (assoc y z)) only returns #f or a pair") (lint-test "(let ((x (g y))) (if x x (g z)))" " let: perhaps (let ((x (g y))) (if x x (g z))) -> (or (g y) (g z)) let: perhaps (if x x (g z)) -> (or x (g z))") (lint-test "(let ((x (g y))) (if x #t #f))" " let: perhaps (let ((x (g y))) (if x #t #f)) -> (g y) let: perhaps (if x #t #f) -> x") (lint-test "(let ((x (g y))) (if x (car (cddr x)) z))" " let: perhaps (let ((x (g y))) (if x (car (cddr x)) z)) -> (cond ((g y) => caddr) (else z)) let: perhaps (car (cddr x)) -> (caddr x)") (lint-test "(let ((x (f y))) (if (not x) y (g x)))" " let: perhaps (let ((x (f y))) (if (not x) y (g x))) -> (cond ((f y) => g) (else y)) let: perhaps use case: (let ((x (f y))) (if (not x) y (g x))) -> (case (f y) ((#f) y) (else => g))") (lint-test "(let ((x (f y))) (cond (x (g x))))" " let: perhaps (let ((x (f y))) (cond (x (g x)))) -> (cond ((f y) => g)) let: perhaps use => here: (x (g x)) -> (x => g)") (lint-test "(let ((x (f y))) (cond (x (g x)) (else y)))" " let: perhaps (let ((x (f y))) (cond (x (g x)) (else y))) -> (cond ((f y) => g) (else y)) let: perhaps use => here: (x (g x)) -> (x => g)") (lint-test "(let ((x (f y))) (cond (x x) (else y)))" " let: perhaps (let ((x (f y))) (cond (x x) (else y))) -> (or (f y) y) let: no need to repeat the test: (x x) -> (x)") (lint-test "(let ((x (f y))) (cond (x x) (else (g y) y)))" " let: perhaps (let ((x (f y))) (cond (x x) (else (g y) y))) -> (or (f y) (begin (g y) y)) let: no need to repeat the test: (x x) -> (x)") (lint-test "(let ((x (f y))) (cond (x (g x)) (y z) (else y)))" " let: perhaps (let ((x (f y))) (cond (x (g x)) (y z) (else y))) -> (cond ((f y) => g) (y z) (else y)) let: perhaps use => here: (x (g x)) -> (x => g)") (lint-test "(let ((x (f y))) (cond (x (set-cdr! x y)) (else y)))" " in (cond (x (set-cdr! x y)) (else y)), perhaps change x to (pair? x)") (lint-test "(let () (let ((a x)) (+ a 1)))" " let: pointless let: (let () (let ((a x)) (+ a 1))) let: perhaps (let () (let ((a x)) (+ a 1))) -> (let ((a x)) (+ a 1)) let: perhaps (let ((a x)) (+ a 1)) -> (+ x 1)") (lint-test "(let ((a x)) (let () (+ a 1)))" " let: pointless let: (let ((a x)) (let () (+ a 1))) -> (let ((a x)) (+ a 1)) let: perhaps (let ((a x)) (let () (+ a 1))) -> (let () (+ x 1)) let: pointless let: (let () (+ a 1)) let: perhaps (let () (+ a 1)) -> (+ a 1)") (lint-test "(let ((x 32)) (define x 33) x)" " let: perhaps omit x and return 33 let: let variable x is redefined in the let body. Perhaps use set! instead: (set! x 33) let: x not used, initially: 32 from let") (lint-test "(let ((x 32)) (define (x y) (+ y 33)) (x 1))" " let: perhaps (... (define (x y) (+ y 33)) (x 1)) -> (... (let ((y 1)) (+ y 33))) let: let variable x is declared twice let: x not used, initially: 32 from let") (lint-test "(let ((x (assq 'a y))) (set! z (if x (cadr x) 0)))" " let: perhaps (let ((x (assq 'a y))) (set! z (if x (cadr x) 0))) -> (set! z (cond ((assq 'a y) => cadr) (else 0)))") (lint-test "(let ((x (assq 'a y))) (g (if x (cadr x) 0) y))" " let: perhaps (let ((x (assq 'a y))) (g (if x (cadr x) 0) y)) -> (g (cond ((assq 'a y) => cadr) (else 0)) y)") (lint-test "(let ((x (assq 'a y))) (g (if x (cadr x)) y))" " let: perhaps (let ((x (assq 'a y))) (g (if x (cadr x)) y)) -> (g (cond ((assq 'a y) => cadr)) y)") (lint-test "(let ((x 1) (y 2) (z 3)) (+ x y z))" " let: perhaps (let ((x 1) (y 2) (z 3)) (+ x y z)) -> (+ 1 2 3)") (lint-test "(let ((x 1)) (set! y x))" " let: perhaps (let ((x 1)) (set! y x)) -> (set! y 1)") (lint-test "(let ((x (f 0)) (y (f 1))) (or x y))" " let: perhaps, ignoring short-circuit issues, (let ((x (f 0)) (y (f 1))) (or x y)) -> (or (f 0) (f 1))") (lint-test "(let ((x (undo-edit))) (set! y (or y x)))" " let: perhaps, ignoring short-circuit issues, (let ((x (undo-edit))) (set! y (or y x))) -> (set! y (or y (undo-edit))) let: perhaps (set! y (or y x)) -> (if (not y) (set! y x))") (lint-test "(let ((x #(0 a))) (fill! x 1) (f x (x 1)))" " let: perhaps (let ((x #(0 a))) (fill! x 1) (f x (x 1))) -> (let ((x #(1 1))) (f x (x 1)))") (lint-test "(let ((x (make-vector 3))) (fill! x 1) (f x (x 1)))" " let: perhaps (let ((x (make-vector 3))) (fill! x 1) (f x (x 1))) -> (let ((x (make-vector 3 1))) (f x (x 1)))") (lint-test "(let ((x (make-list 3 9))) (fill! x 1) (f x (x 1)))" " let: perhaps (let ((x (make-list 3 9))) (fill! x 1) (f x (x 1))) -> (let ((x (make-list 3 1))) (f x (x 1)))") (lint-test "(let ((v (make-vector 3))) (vector-fill! v 3))" " let: perhaps (let ((v (make-vector 3))) (vector-fill! v 3)) -> (vector-fill! (make-vector 3) 3) let: perhaps (let ((v (make-vector 3))) (vector-fill! v 3)) -> (let () 3)") (lint-test "(let ((x 1)) (set! x 2) (+ x 1))" " let: perhaps (let ((x 1)) (set! x 2) (+ x 1)) -> (let ((x 2)) (+ x 1))") (lint-test "(let ((y 3) (x 1)) (set! x 2) (+ x y))" " let: perhaps (let ((y 3) (x 1)) (set! x 2) (+ x y)) -> (let ((y 3) (x 2)) (+ x y))") (lint-test "(let ((y 3) (x 1)) (set! x 2) (display x) (+ x y))" " let: perhaps (let ((y 3) (x 1)) (set! x 2) (display x) (+ x y)) -> (let ((y 3) (x 2)) (display x) ...)") (lint-test "(let ((x (f y))) (if x (g x) (set! x 3)))" "") ; too complicated to deal with this (lint-test "(let* ((x (f y))) (if x (g x) (set! x 3)))" " let*: let* could be let: (let* ((x (f y))) (if x (g x) (set! x 3)))") (lint-test "(let* ((z 1) (x (< z 2))) (if x (f x)))" " let*: perhaps restrict z which is not used in the let* body (let* ((z 1) (x (< z 2))) (if x (f x))) -> (let ((x (let ((z 1)) (< z 2)))) ...) let*: perhaps substitute z into x: (let* ((z 1) (x (< z 2))) (if x (f x))) -> (let ((x (< 1 2))) ...) let*: perhaps (let* ((z 1) (x (< z 2))) (if x (f x))) -> (let ((z 1)) (cond ((< z 2) => f)))") (lint-test "(let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x)))" " let*: perhaps restrict z, y which are not used in the let* body (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x))) -> (let ((x (let ((y (let ((z 1)) (+ z 2)))) (< y 3)))) ...) let*: perhaps substitute z into y: (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x))) -> (let* ((y (+ 1 2)) (x (< y 3))) ...) let*: perhaps (let* ((z 1) (y (+ z 2)) (x (< y 3))) (if x (f x))) -> (let* ((z 1) (y (+ z 2))) (cond ((< y 3) => f)))") (lint-test "(let f0 ((i 1)) (if (> i 0) (f0 #() (- i 1))))" " let: f0 has too many arguments: (f0 #() (- i 1))") (lint-test "(letrec ((f0 (lambda (i) (if (> i 0) (f0 #() (- i 1)))))) (f0 1))" " letrec: perhaps (letrec ((f0 (lambda (i) (if (> i 0) (f0 #() (- i 1)))))) (f0 1)) -> (let f0 ((i 1)) (if (> i 0) (f0 #() (- i 1))))") (lint-test "(letrec ((f0 (lambda () (if (> i 0) (f0))))) (f0))" " letrec: perhaps (letrec ((f0 (lambda () (if (> i 0) (f0))))) (f0)) -> (let f0 () (if (> i 0) (f0)))") (lint-test "(let ((a 0)) (display x) (set! a 2) (+ a 1))" " let: perhaps change a's initial value to 2, and remove (set! a 2) in (let ((a 0)) (display x) (set! a 2) (+ a 1))") (lint-test "(let ((x (string->number z))) (if (number? x) (g x)))" " let: perhaps (let ((x (string->number z))) (if (number? x) (g x))) -> (cond ((string->number z) => g))") (lint-test "(let ((x (memq a z))) (if (list? x) (g x)))" " let: in (if (list? x) (g x)), x can't be null so pair? might be better let: perhaps (let ((x (memq a z))) (if (list? x) (g x))) -> (cond ((memq a z) => g))") (lint-test "(let () (error 'oops \"an error\") #t)" " let: let could be begin: (let () (error 'oops \"an error\") #t) -> (begin (error 'oops \"an error\") #t) let: (error 'oops \"an error\") makes this pointless: #t") (lint-test "(let () (error 'oops \"an error\") (display \"oops\") #t)" " let: let could be begin: (let () (error 'oops \"an error\") (display \"oops\") #t) -> (begin (error 'oops \"an error\") (display \"oops\") #t) let: (error 'oops \"an error\") makes the rest of the body unreachable: (... (display \"oops\") ...)") (lint-test "(let ((a 1)) (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d)))))" " let: perhaps (let ((d 4)) (+ a b c d)) -> (+ a b c 4) let: perhaps move 'c into the inner let: (let ((c 3)) (let ((d 4)) (+ a b c d))) -> (let ((c 3) (d 4)) (+ a b c d)) let: perhaps (let ((c 3)) (let ((d 4)) (+ a b c d))) -> (let ((c 3) (d 4)) (+ a b c d)) let: perhaps (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d)))) -> (let ((b 2) (c 3) (d 4)) (+ a b c d)) let: perhaps (let ((a 1)) (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d))))) -> (let ((a 1) (b 2) (c 3) (d 4)) (+ a b c d))") (lint-test "(let ((a 1)) (let ((b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))))" " let: perhaps move 'b into the inner let: (let ((b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((b 2) (c 3) (d 4)) (display a) (+ b c d)) let: perhaps (let ((b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((b 2) (c 3) (d 4)) (display a) ...) let: perhaps (let ((a 1)) (let ((b 2)) (let ((c 3) (d 4)) (display a) (+ b c d)))) -> (let ((a 1) (b 2) (c 3) (d 4)) (display a) ...)") (lint-test "(let ((a 1) (b 2)) (let ((c 3) (d 4)) (display a) (+ b c d)))" " let: perhaps move 'b into the inner let: (let ((a 1) (b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((b 2) (c 3) (d 4)) (display a) (+ b c d)) let: perhaps move 'a into the inner let: (let ((a 1) (b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((a 1) (c 3) (d 4)) (display a) (+ b c d)) let: perhaps (let ((a 1) (b 2)) (let ((c 3) (d 4)) (display a) (+ b c d))) -> (let ((a 1) (b 2) (c 3) (d 4)) (display a) ...)") (lint-test "(let ((x 1) (y x)) (+ x y))" " let: x in (y x) does not appear to be defined in the calling environment let: perhaps (let ((x 1) (y x)) (+ x y)) -> (+ 1 x)") (lint-test "(let ((x 3)) (+ x (let ((x 1) (y x)) (+ x y))))" " let: x in (y x) refers to the caller's x, not the let variable let: perhaps (let ((x 1) (y x)) (+ x y)) -> (+ 1 x)") (lint-test "(let ((x 0)) (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) (display x) (if (zero? x) (+ 1 (f52 x))))" " let: perhaps (... (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) (display x) (if... -> (... (display x) (if (zero? x) (+ 1 (let* f52 ((a x)) (if (zero? a) x (f52 (- a 1))))))) f52: perhaps (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) -> (define* (f52 (a 2)) (do ((a a (- a 1))) ((zero? a) x))) let: x is 0, so (zero? x) is #t") (lint-test "(let ((x 0)) (define (f52) (if (zero? a) x (f52))) (f52))" " let: perhaps (... (define (f52) (if (zero? a) x (f52))) (f52)) -> (... (let f52 () (if (zero? a) x (f52)))) x is used only in f52") (lint-test "(let ((x 0)) (define (f52 x) (if (zero? a) x (f52 x))) (f52 x))" " let: the inner function f52 could be moved to an outer letrec: (let ((x 0)) (define (f52 x) (if (zero? a) x (f52 x))) (f52 x)) -> (letrec ((f52 (lambda (x) (if (zero? a) x (f52 x))))) (let ((x 0)) ...)) let: perhaps (... (define (f52 x) (if (zero? a) x (f52 x))) (f52 x)) -> (... (let f52 ((x x)) (if (zero? a) x (f52 x)))) f52: perhaps (define (f52 x) (if (zero? a) x (f52 x))) -> (define (f52 x) (do ((x x)) ((zero? a) x)))") (lint-test "(let ((x 0)) (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) (if (zero? x) (+ 1 (f52 x))))" " let: perhaps (... (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) (if (zero? x) (+... -> (... (if (zero? x) (+ 1 (let* f52 ((a x)) (if (zero? a) x (f52 (- a 1))))))) f52: perhaps (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) -> (define* (f52 (a 2)) (do ((a a (- a 1))) ((zero? a) x))) let: x is 0, so (zero? x) is #t") (lint-test "(define (f x) (let ((y 2)) (set! x (+ x y)) (set! y (+ y 1)) (set! x (+ x 1)) (display x)))" " f: (set! y (+ y 1)) in (let ((y 2)) (set! x (+ x y)) (set! y (+ y 1)) (set! x (+ x 1)) (display x)) could be omitted f: this let could be tightened: (let ((y 2)) (set! x (+ x y)) (set! y (+ y 1)) (set! x (+ x 1)) (display x)) -> (let ((y 2)) (set! x (+ x y)) (set! y (+ y 1))) (set! x (+ x 1)) ...") (lint-test "(define (f a) (let ((x 1) (y 2) (z (vector 3))) (vector-set! z 0 (+ x 1)) (display y) (newline) (+ y (vector-ref z 0))))" " f: y can probably be moved to f's closure f: x can be moved to f's closure f: x is only used in expression 1 (of 4), (vector-set! z 0 (+ x 1)) of (let ((x 1) (y 2) (z (vector 3))) (vector-set! z 0 (+ x 1)) (display y)... f: the scope of x could be reduced: (let ((x 1) (y 2) (z (vector 3))) (vector-set! z 0 (+ x 1)) (display y)... -> (let ((y 2) (z (vector 3))) (let ((x 1)) (vector-set! z 0 (+ x 1))) (display y) ...)") (lint-test "(define (f a) (let ((x 1) (y 2) (z (vector 3 4))) (vector-set! z 0 (+ x 1)) (display (vector-ref z x)) (set! y (+ y 1)) (newline) (+ y 1)))" "f: x can be moved to f's closure f: x is only used in expressions 1 and 2 (of 5), (vector-set! z 0 (+ x 1)) (display (vector-ref z x)) of (let ((x 1) (y 2) (z (vector 3 4))) (vector-set! z 0 (+ x 1)) (display... f: the scope of x, z could be reduced: (let ((x 1) (y 2) (z (vector 3 4))) (vector-set! z 0 (+ x 1)) (display... -> (let ((y 2)) (let ((x 1) (z (vector 3 4))) (vector-set! z 0 (+ x 1)) (display (vector-ref z x))) (set! y (+ y 1)) ...)") (lint-test "(define (f a) (let* ((x 1) (y (+ x 2)) (z (vector 3))) (vector-set! z 0 (+ x 1)) (display y) (newline) (+ y x)))" "f: perhaps split this let*: (let* ((x 1) (y (+ x 2)) (z (vector 3))) (vector-set! z 0 (+ x 1))... -> (let ((x 1)) (let ((y (+ x 2)) (z (vector 3))) ...)) f: the scope of z could be reduced: (let* ((x 1) (y (+ x 2)) (z (vector 3))) (vector-set! z 0 (+ x 1))... -> (let* ((x 1) (y (+ x 2))) (let ((z (vector 3))) (vector-set! z 0 (+ x 1))) (display y) ...)") (lint-test "(define (f x) (let ((y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin (set! y (g x)) (display y)))))" " f: perhaps (if z? (begin (set! y (g x)) (display y))) -> (when z? (set! y (g x)) (display y)) f: y is only used in expression 4 (of 4), (if z? (begin (set! y (g x)) (display y))) of (let ((y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin (set! y (g...") (lint-test "(define (f x) (let* ((z x) (y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin (set! y (g x)) (display y)))))" " f: let* could be let: (let* ((z x) (y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin... f: perhaps (if z? (begin (set! y (g x)) (display y))) -> (when z? (set! y (g x)) (display y)) f: y is only used in expression 4 (of 4), (if z? (begin (set! y (g x)) (display y))) of (let* ((z x) (y #f)) (set! z (+ z 1)) (display z) (f z) (if z? (begin...") (lint-test "(let ((x (f y))) (g (car x)) (h (caar x)) (j (caddar x)))" " let: x is not set, and is always accessed via (car x) so its binding could probably be (x (car (f y))) in (let ((x (f y))) (g (car x)) (h (caar x)) (j (caddar x)))") (lint-test "(let ((x (f y))) (g (cddar x)) (h (caar x)) (j (caddar x)))" " let: x is not set, and is always accessed via (car x) so its binding could probably be (x (car (f y))) in (let ((x (f y))) (g (cddar x)) (h (caar x)) (j (caddar x)))") (lint-test "(let ((x 2)) (g (+ x x)) (h (+ x x)) (j (+ x x)))" " let: x is not set, and is always accessed via (+ x x) so its binding could probably be (x (+ 2 2)) in (let ((x 2)) (g (+ x x)) (h (+ x x)) (j (+ x x)))") (lint-test "(let ((x 2)) (g (< 0 x 1)) (h (> 1 x 0)) (j (< 0 x 1)))" " let: x is not set, and is always accessed via (< 0 x 1) so its binding could probably be (x (< 0 2 1)) in (let ((x 2)) (g (< 0 x 1)) (h (> 1 x 0)) (j (< 0 x 1)))") (lint-test "(let ((x (f y))) (g (cddr x)) (h (caar x)) (j (caddar x)))" "") (lint-test "(let ((x (f y))) (g (cddar x)) (h (caadr x)) (j (caddar x)))" "") (lint-test "(let ((x (f y))) (g (abs (car x))) (h (caar x)) (j (caddar x)))" " let: x is not set, and is always accessed via (car x) so its binding could probably be (x (car (f y))) in (let ((x (f y))) (g (abs (car x))) (h (caar x)) (j (caddar x)))") (lint-test "(let ((a (car x))) (if b (display (g a b))))" " let: perhaps move the let to the true branch: (let ((a (car x))) (if b (display (g a b)))) -> (if b (let ((a (car x))) (display (g a b))))") (lint-test "(let ((a (car x))) (if b (+ a (f a)) (display c)))" " let: perhaps move the let to the true branch: (let ((a (car x))) (if b (+ a (f a)) (display c))) -> (if b (let ((a (car x))) (+ a (f a))) (display c))") (lint-test "(let ((a (car x))) (if b (begin (display x) (+ a (f a))) (display c)))" " let: perhaps move the let to the true branch: (let ((a (car x))) (if b (begin (display x) (+ a (f a))) (display c))) -> (if b (let ((a (car x))) (display x) (+ a (f a))) (display c))") (lint-test "(let ((a (car x))) (when b (display (g a b))))" " let: perhaps move the let inside the when: (let ((a (car x))) (when b (display (g a b)))) -> (when b (let ((a (car x))) (display (g a b))))") (lint-test "(let ((a (car x))) (cond (b (display (g a b))) (else (set! y z) (display x))))" " let: perhaps move the let into the '(b (display (g a b))) branch: (let ((a (car x))) (cond (b (display (g a b))) (else (set! y z) (display x)))) -> (cond (b (let ((a (car x))) (display (g a b)))) ...)") (lint-test "(let ((a (car x))) (case b ((0) (display (g a b))) (else (set! y z) (display x))))" " let: perhaps move the let into the '((0) (display (g a b))) branch: (let ((a (car x))) (case b ((0) (display (g a b))) (else (set! y z)... -> (case b ((0) (let ((a (car x))) (display (g a b)))) ...)") (lint-test "(if z (let () (* 2 y)))" " if: perhaps (if z (let () (* 2 y))) -> (when z (* 2 y)) if: pointless let: (let () (* 2 y)) if: perhaps (let () (* 2 y)) -> (* 2 y)") (lint-test "(if z (let () (display y) (* 2 y)))" " if: perhaps (if z (let () (display y) (* 2 y))) -> (when z (display y) (* 2 y)) if: let could be begin: (let () (display y) (* 2 y)) -> (begin (display y) (* 2 y))") (lint-test "(let ((v 3)) v)" " let: perhaps (let ((v 3)) v) -> 3") ; this aimed at a lint bug (lint-test "(let ((v (make-vector 3))) #f)" " let: v not used, initially: (make-vector 3) from let") ; also same bug (lint-test "(let () (abs -1))" " let: pointless let: (let () (abs -1)) let: perhaps (let () (abs -1)) -> (abs -1) let: perhaps (abs -1) -> 1") (lint-test "(eq? x '())" " eq?: perhaps (eq? x '()) -> (null? x) eq?: quote is not needed here: '()") (lint-test "(equal? x '#())" " equal?: quote is not needed here: '#()") (lint-test "(equal? x '\"\")" " equal?: quote is not needed here: '\"\"") (lint-test "(eq? x '#)" " eq?: quote is not needed here: '#") (lint-test "(eq? x '#t)" " eq?: quote is not needed here: '#t") (lint-test "(eq? x '#f)" " eq?: perhaps (eq? x '#f) -> (not x) eq?: quote is not needed here: '#f") (lint-test "(equal? x '(1))" "") (lint-test "(eqv? x '3)" " eqv?: quote is not needed here: '3") (lint-test "(eq? x 'x)" "") (lint-test "(eq? x 1.5)" " eq?: eq? should be eqv? in (eq? x 1.5)") (lint-test "(eq? 3 x)" " eq?: eq? should be eqv? in (eq? 3 x)") (lint-test "(eq? x (not x))" " eq?: this looks odd: (eq? x (not x))") (lint-test "(eq? #(a) #(a))" " eq?: this looks odd: (eq? #(a) #(a)) eq?: perhaps (eq? #(a) #(a)) -> #f eq?: eq? should be equal? in (eq? #(a) #(a))") (lint-test "(eq? #() ())" " eq?: perhaps (eq? #() ()) -> #f eq?: eq? should be equal? in (eq? #() ()) eq?: perhaps (eq? #() ()) -> #f") (lint-test "(eqv? x #())" " eqv?: eqv? should be equal? in (eqv? x #())") (lint-test "(eq? x \"\")" " eq?: eq? should be equal? in (eq? x \"\")") (lint-test "(eq? #() (vector))" " eq?: eq? should be equal? in (eq? #() (vector))") (lint-test "(eq? () (list))" " eq?: perhaps (eq? () (list)) -> #t eq?: perhaps (list) -> (); there is only one nil") (lint-test "(eqv? x (string))" " eqv?: eqv? should be equal? in (eqv? x (string)) eqv?: (string) could be \"\"") (lint-test "(eq? (symbol->string x) z)" " eq?: eq? should be equal? in (eq? (symbol->string x) z)") (lint-test "(eq? (symbol? x) #t)" " eq?: perhaps (eq? (symbol? x) #t) -> (symbol? x)") (lint-test "(eq? (symbol? x) #f)" " eq?: perhaps (eq? (symbol? x) #f) -> (not (symbol? x))") (lint-test "(eq? (memq x y) #t)" " eq?: perhaps (eq? (memq x y) #t) -> #f") (lint-test "(eq? x '())" " eq?: perhaps (eq? x '()) -> (null? x) eq?: quote is not needed here: '()") (lint-test "(eq? '() x)" " eq?: perhaps (eq? '() x) -> (null? x) eq?: quote is not needed here: '()") (lint-test "(eq? x '#\\a)" " eq?: eq? should be eqv? in (eq? x '#\\a) eq?: quote is not needed here: '#\\a") (lint-test "(eq? x x)" " eq?: this looks odd: (eq? x x), isn't it always #t?") (lint-test "(eqv? x ())" " eqv?: eqv? could be null?: (eqv? x ()) -> (null? x)") (lint-test "(eqv? x '())" " eqv?: eqv? could be null?: (eqv? x '()) -> (null? x) eqv?: quote is not needed here: '()") (lint-test "(eqv? x #(a))" " eqv?: eqv? should be equal? in (eqv? x #(a))") (lint-test "(eqv? x 'a)" " eqv?: eqv? could be eq? in (eqv? x 'a)") (lint-test "(eqv? x #f)" " eqv?: eqv? could be not: (eqv? x #f) -> (not x)") (lint-test "(equal? x 'a)" " equal?: equal? could be eq? in (equal? x 'a)") (lint-test "(equal? x (integer->char 96))" " equal?: equal? could be eqv? in (equal? x (integer->char 96)) equal?: perhaps (integer->char 96) -> #\\`") (lint-test "(equal? x #f)" " equal?: equal? could be not: (equal? x #f) -> (not x)") (lint-test "(equal? #f x)" " equal?: equal? could be not: (equal? #f x) -> (not x)") (lint-test "(equal? x ())" " equal?: equal? could be null?: (equal? x ()) -> (null? x)") (lint-test "(equal? x '())" " equal?: equal? could be null?: (equal? x '()) -> (null? x) equal?: quote is not needed here: '()") (lint-test "(equal? (expt x y) z)" " equal?: equal? could be eqv? in (equal? (expt x y) z)") (lint-test "(equivalent? x 0)" "") (lint-test "(equivalent? (abs x) 0.0)" "") (lint-test "(equal? (floor x) (round y))" " equal?: equal? could be eqv? or = in (equal? (floor x) (round y))") (lint-test "(equal? (string x) (string-append y z))" " equal?: equal? could be string=? in (equal? (string x) (string-append y z))") (lint-test "(eqv? (integer->char x) #\\null)" " eqv?: eqv? could be char=? in (eqv? (integer->char x) #\\null)") (lint-test "(eq? #\\space (string-ref x 0))" " eq?: eq? should be eqv? or char=? in (eq? #\\space (string-ref x 0))") (lint-test "(eq? (sin x) (cos y))" " eq?: eq? should be eqv? or = in (eq? (sin x) (cos y))") (lint-test "(equal? (length x) (length y))" " equal?: equal? could be eqv? in (equal? (length x) (length y))") (lint-test "(equal? (string->number x) (string->number y))" " equal?: equal? could be eqv? in (equal? (string->number x) (string->number y))") (lint-test "(eqv? \":\" (string-ref s 0))" " eqv?: this can't be right: (eqv? \":\" (string-ref s 0)) eqv?: eqv? should be equal? in (eqv? \":\" (string-ref s 0)) eqv?: perhaps (eqv? \":\" (string-ref s 0)) -> #f") (lint-test "(eqv? \"a\" (string))" " eqv?: (eqv? \"a\" (string)) is #f eqv?: eqv? should be equal? or string=? in (eqv? \"a\" (string)) eqv?: (string) could be \"\"") (lint-test "(eqv? (string) \"a\")" " eqv?: (eqv? (string) \"a\") is #f eqv?: eqv? should be equal? or string=? in (eqv? (string) \"a\") eqv?: (string) could be \"\"") (lint-test "(eqv? \"a\" (substring x 2 3))" " eqv?: perhaps (eqv? \"a\" (substring x 2 3)) -> (char=? #\\a (string-ref x 2)) eqv?: eqv? should be equal? or string=? in (eqv? \"a\" (substring x 2 3))") (lint-test "(eqv? (string #\\a) (substring x 2 3))" " eqv?: perhaps (eqv? (string #\\a) (substring x 2 3)) -> (char=? #\\a (string-ref x 2)) eqv?: eqv? should be equal? or string=? in (eqv? (string #\\a) (substring x 2 3)) eqv?: (string #\\a) could be \"a\"") (lint-test "(eqv? (substring x 0 1) (string #\\a))" " eqv?: perhaps (eqv? (substring x 0 1) (string #\\a)) -> (char=? #\\a (string-ref x 0)) eqv?: eqv? should be equal? or string=? in (eqv? (substring x 0 1) (string #\\a)) eqv?: (string #\\a) could be \"a\"") (lint-test "(string=? \"a\" (substring x 2 3))" " string=?: perhaps (string=? \"a\" (substring x 2 3)) -> (char=? #\\a (string-ref x 2))") (lint-test "(string=? (string) \"a\")" " string=?: (string=? (string) \"a\") is #f string=?: (string) could be \"\"") (lint-test "(string=? (string y) (substring x 2 3))" " string=?: perhaps (string=? (string y) (substring x 2 3)) -> (char=? y (string-ref x 2))") (lint-test "(string=? (string x) (string y))" " string=?: perhaps (string=? (string x) (string y)) -> (char=? x y)") (lint-test "(string=? (substring y 0 1) (substring x 2 3))" " string=?: perhaps (string=? (substring y 0 1) (substring x 2 3)) -> (char=? (string-ref y 0) (string-ref x 2))") (lint-test "(char-ci=? x #\\return)" " char-ci=?: char-ci=? could be char=? here: (char-ci=? x #\\return)") (lint-test "(equal? (vector-copy #(a b c)) #(a b c))" " equal?: perhaps (equal? (vector-copy #(a b c)) #(a b c)) -> (equal? #(a b c) #(a b c))") (lint-test "(not (equal? v (copy v)))" " not: perhaps (equal? v (copy v)) -> (equal? v v)") (lint-test "(eq? (floor x) 'a)" " eq?: eq? should be eqv? in (eq? (floor x) 'a) eq?: perhaps (eq? (floor x) 'a) -> #f") (lint-test "(eq? (floor pi) #t)" " eq?: eq? should be eqv? in (eq? (floor pi) #t) eq?: perhaps (eq? (floor pi) #t) -> #f") (lint-test "(eqv? (string->symbol x) 123)" " eqv?: perhaps (eqv? (string->symbol x) 123) -> #f") (lint-test "(eq? 'a (integer->char 48))" " eq?: eq? should be eqv? in (eq? 'a (integer->char 48)) eq?: perhaps (eq? 'a (integer->char 48)) -> #f eq?: perhaps (integer->char 48) -> #\\0") (lint-test "(equal? (string->symbol x) 123)" " equal?: equal? could be eqv? in (equal? (string->symbol x) 123) equal?: perhaps (equal? (string->symbol x) 123) -> #f") (lint-test "(equal? (floor pi) (list 1 2))" " equal?: equal? could be eqv? in (equal? (floor pi) (list 1 2)) equal?: perhaps (equal? (floor pi) (list 1 2)) -> #f equal?: perhaps (list 1 2) -> '(1 2)") (lint-test "(equivalent? (list 1 2) (vector 1 2))" " equivalent?: perhaps (equivalent? (list 1 2) (vector 1 2)) -> #f equivalent?: perhaps (list 1 2) -> '(1 2) equivalent?: perhaps (vector 1 2) -> #(1 2)") (lint-test "(eq? x 'a)" "") (lint-test "(equal? '(1 2) '(1 2))" " equal?: perhaps (equal? '(1 2) '(1 2)) -> #t") (lint-test "(equal? '(1 2) #(1 2))" " equal?: perhaps (equal? '(1 2) #(1 2)) -> #f equal?: perhaps (equal? '(1 2) #(1 2)) -> #f equal?: #(1 2) could be #i(1 2)") (lint-test "(equal? '(1 . 2) (cons 1 2))" "") (lint-test "(map abs '(1 2) '(3 4))" " map: map has too many arguments in: (map abs '(1 2) '(3 4))") (lint-test "(map (lambda (a b) a) '(1 2))" " map: map has too few arguments in: (map (lambda (a b) a) '(1 2))") (lint-test "(map (lambda (a) (abs a)) '(1 2 3))" " map: perhaps (lambda (a) (abs a)) -> abs") (lint-test "(map abs (vector->list #(1 2)))" " map: (vector->list #(1 2)) could be simplified to: #(1 2) ; (map accepts non-list sequences) map: perhaps (vector->list #(1 2)) -> '(1 2) map: #(1 2) could be #i(1 2)") (lint-test "(begin (map g123 x) x)" " begin: map could be for-each: (for-each g123 x)") (lint-test "(map log x x)" "") (lint-test "(map f (map g h))" " map: perhaps (map f (map g h)) -> (map (lambda (<1>) (f (g <1>))) h)") (lint-test "(for-each x (map g h))" " for-each: perhaps (for-each x (map g h)) -> (for-each (lambda (<1>) (x (g <1>))) h)") (lint-test "(map f (map (lambda (x) (g x y)) h))" " map: perhaps (map f (map (lambda (x) (g x y)) h)) -> (map (lambda (<1>) (f (g <1> y))) h)") (lint-test "(map (lambda (x) (f x y)) (map g h))" " map: perhaps (map (lambda (x) (f x y)) (map g h)) -> (map (lambda (<1>) (f (g <1>) y)) h)") (lint-test "(map (lambda (x) (f x y)) (map (lambda (y) (g z y)) h))" " map: perhaps (map (lambda (x) (f x y)) (map (lambda (y) (g z y)) h)) -> (map (lambda (<1>) (f (g z <1>) y)) h)") (lint-test "(map f (map (lambda (x) (g 'x x)) h))" " map: perhaps (map f (map (lambda (x) (g 'x x)) h)) -> (map (lambda (<1>) (f (g 'x <1>))) h)") (lint-test "(map (lambda (x) (display 1) (f x)) (map g h))" " map: perhaps (map (lambda (x) (display 1) (f x)) (map g h)) -> (map (lambda (<1>) (display 1) (f (g <1>))) h)") (lint-test "(map (lambda (x) (display 1) (f x)) (map (lambda (y) (+ y 1)) h))" " map: perhaps (map (lambda (x) (display 1) (f x)) (map (lambda (y) (+ y 1)) h)) -> (map (lambda (<1>) (display 1) (f (+ <1> 1))) h)") (lint-test "(map (lambda (x) x) lst)" " map: perhaps (map (lambda (x) x) lst) -> lst") (lint-test "(for-each (lambda (x) (+ (abs x) 1)) lst)" " for-each: pointless for-each: (for-each (lambda (x) (+ (abs x) 1)) lst)") (lint-test "(for-each x #\\a)" " for-each: in (for-each x #\\a), for-each's second argument should be a sequence, but #\\a is a char?") (lint-test "(map f (cdr (vector->list v)))" " map: map accepts vector arguments, so perhaps (cdr (vector->list v)) -> (subvector v 1 (length v))") (lint-test "(for-each f (list-tail (string->list str) x))" " for-each: for-each accepts string arguments, so perhaps (list-tail (string->list str) x) -> (substring str x)") (lint-test "(map char-downcase (string->list str))" " map: (string->list str) could be simplified to: str ; (map accepts non-list sequences) map: perhaps (map char-downcase (string->list str)) -> (string->list (string-downcase str))") (lint-test "(for-each display (list a))" " for-each: perhaps (for-each display (list a)) -> (display a) for-each: perhaps (for-each display (list a)) -> (format () \"~A\" a)") (lint-test "(map display (vector 'a 'b 'c))" " map: perhaps (vector 'a 'b 'c) -> #(a b c)") (lint-test "(map (lambda (v) #f) y)" " map: perhaps (map (lambda (v) #f) y) -> (make-list (abs (length y)) #f)") (lint-test "(map abs ())" " map: this (map abs ()) has no effect (null arg)") (lint-test "(map fnc '(2))" " map: perhaps (map fnc '(2)) -> (list (fnc 2))") (lint-test "(for-each fnc (list x) '(2))" " for-each: perhaps (for-each fnc (list x) '(2)) -> (fnc x 2)") (lint-test "(for-each display #())" " for-each: this (for-each display #()) has no effect (zero length arg) for-each: perhaps (for-each display #()) -> (format () \"~{~A~}\" #())") (lint-test "(for-each display \"\")" " for-each: this (for-each display \"\") has no effect (zero length arg) for-each: perhaps (for-each display \"\") -> (format () \"~{~A~}\" \"\")") (lint-test "(for-each display ())" " for-each: this (for-each display ()) has no effect (null arg) for-each: perhaps (for-each display ()) -> (format () \"~{~A~}\" ())") (lint-test "(for-each fxy ())" " for-each: this (for-each fxy ()) has no effect (null arg)") (lint-test "(for-each fxy '())" " for-each: this (for-each fxy '()) has no effect (null arg) for-each: quote is not needed here: '()") (lint-test "(for-each fxy #())" " for-each: this (for-each fxy #()) has no effect (zero length arg)") (lint-test "(map car (list (cons a b)))" " map: perhaps (map car (list (cons a b))) -> (list (car (cons a b)))") (lint-test "(map abs #(1))" " map: perhaps (map abs #(1)) -> (list (abs 1)) map: #(1) could be #i(1)") (lint-test "(catch #(a) (lambda () #f) (lambda a a))" " catch: catch tag #(a) is unreliable (catch uses eq? to match tags)") (lint-test "(catch x (lambda () #f) (lambda a a))" "") (lint-test "(catch 'hi x y)" "") (lint-test "(car #(a))" " car: in (car #(a)), car's argument should be a pair, but #(a) is a vector?") (unless pure-s7 (lint-test "(vector->list 1.4)" " vector->list: in (vector->list 1.4), vector->list's argument should be a vector, but 1.4 is a float?")) (lint-test "(vector-set! #(0 a) 0 2)" " vector-set!: #(0 a) is a constant, so vector-set! is problematic, and #(0 a) is discarded; perhaps (vector-set! #(0 a) 0 2) -> 2") (lint-test "(list-set! (list 0 1) 0 2)" " list-set!: (list 0 1) is simply discarded; perhaps (list-set! (list 0 1) 0 2) -> 2") (lint-test "(string-set! (make-string 3) 0 #\\a)" " string-set!: (make-string 3) is simply discarded; perhaps (string-set! (make-string 3) 0 #\\a) -> #\\a") (lint-test "(let ((x '(0 1))) (list-set! x 0 3.1))" "let: perhaps (let ((x '(0 1))) (list-set! x 0 3.1)) -> (list-set! '(0 1) 0 3.1) let: x's value, '(0 1), is a literal constant, so this set! is trouble: (list-set! x 0 3.1)") (lint-test "(let ((c #(0 a))) (vector-set! c 0 1))" "let: perhaps (let ((c #(0 a))) (vector-set! c 0 1)) -> (vector-set! #(0 a) 0 1) let: c's value, #(0 a), is a literal constant, so this set! is trouble: (vector-set! c 0 1)") (lint-test "(let ((x (vector 0 1))) (vector-set! x 0 1))" " let: perhaps (let ((x (vector 0 1))) (vector-set! x 0 1)) -> (vector-set! (vector 0 1) 0 1)") (lint-test "(let ((x (vector 0 1))) (string-set! x 0 #\\a))" " let: perhaps (let ((x (vector 0 1))) (string-set! x 0 #\\a)) -> (string-set! (vector 0 1) 0 #\\a) let: x is a vector, but string-set! in (string-set! x 0 #\\a) wants a string?") (lint-test "(list-set! (cdr x) 0 y)" " list-set!: perhaps (list-set! (cdr x) 0 y) -> (list-set! x 1 y)") (lint-test "(vector-set! (vector-ref x 0) 1 2)" " vector-set!: perhaps (vector-set! (vector-ref x 0) 1 2) -> (set! (x 0 1) 2)") (lint-test "(int-vector-set! (vector-ref x 0) 1 2)" " int-vector-set!: perhaps (int-vector-set! (vector-ref x 0) 1 2) -> (set! (x 0 1) 2)") (lint-test "(hash-table-set! (vector-ref x 0) 'a 2)" " hash-table-set!: perhaps (hash-table-set! (vector-ref x 0) 'a 2) -> (set! ((x 0) 'a) 2)") (lint-test "(let-set! (vector-ref x 0) 'a 2)" " let-set!: perhaps (let-set! (vector-ref x 0) 'a 2) -> (set! ((x 0) 'a) 2)") (lint-test "(+ . 1)" " +: unexpected dot: (+ . 1)") (lint-test "(or . 0)" " or: unexpected dot: (or . 0)") (lint-test "(not . 0)" " not: unexpected dot: (not . 0)") (lint-test "(and . 0)" " and: unexpected dot: (and . 0)") (lint-test "(length (a . b))" " length: missing quote? (a . b) in (length (a . b))") (unless (or pure-s7 immutable-unquote) (lint-test "(length ,a)" (if immutable-unquote " length: stray comma? ,a in (length ,a)" " length: stray comma? (unquote a) in (length (unquote a))"))) (lint-test "(make-vector (length (append x y)))" " make-vector: perhaps (length (append x y)) -> (+ (length x) (length y))") (lint-test "(make-float-vector 3 0.0)" " make-float-vector: 0.0 is the default initial value in (make-float-vector 3 0.0)") (lint-test "(make-vector 3 #)" " make-vector: # is the default initial value in (make-vector 3 #)") (lint-test "(set! a b c)" " set!: set! has too many arguments: (set! a b c)") (lint-test "(set! a)" " set!: set! has too few arguments: (set! a)") (lint-test "(set! (vector-ref v 0) 3)" " set!: perhaps (set! (vector-ref v 0) 3) -> (vector-set! v 0 3)") (lint-test "(set! pi 3)" " set!: can't set! (set! pi 3) (it is a constant)") (lint-test "(set! if 3)" " set!: bad idea: (set! if 3)") (lint-test "(set! abs 3)" " set!: not recommended: (set! abs 3)") (lint-test "(set! 3 1)" " set!: can't set! (set! 3 1)") (lint-test "(set! () 3)" " set!: can't set! (set! () 3)") (lint-test "(set! a a)" " set!: pointless set! (set! a a)") (lint-test "(set! a (copy a))" " set!: pointless set! (set! a (copy a))") (lint-test "(set! x (if y x 1))" " set!: perhaps (set! x (if y x 1)) -> (if (not y) (set! x 1))") (lint-test "(set! x (if y 1 x))" " set!: perhaps (set! x (if y 1 x)) -> (if y (set! x 1))") (lint-test "(set! x (and x y))" " set!: perhaps (set! x (and x y)) -> (if x (set! x y))") (lint-test "(set! x (and y x))" " set!: perhaps (set! x (and y x)) -> (if (not y) (set! x #f))") (lint-test "(set! x (or x y))" " set!: perhaps (set! x (or x y)) -> (if (not x) (set! x y))") (lint-test "(set! x (or y x))" "") (lint-test "(set! x (cond (z w) (else x)))" " set!: perhaps (set! x (cond (z w) (else x))) -> (if z (set! x w))") (lint-test "(set! x (cond (z x) (else w)))" " set!: perhaps (set! x (cond (z x) (else w))) -> (if (not z) (set! x w))") (lint-test "(begin (set! x (cons 1 z)) (set! x (cons 2 x)))" " begin: perhaps (set! x (cons 1 z)) (set! x (cons 2 x)) -> (set! x (cons 2 (cons 1 z)))") (lint-test "(begin (set! x 0) (set! x 1))" " begin: this could be omitted: (set! x 0)") (lint-test "(begin (set! x y) (set! x y))" " begin: this pair of set!s looks odd: (... (set! x y) (set! x y) ...) begin: this could be omitted: (set! x y)") (lint-test "(begin (set! x y) (set! y x))" " begin: this pair of set!s looks odd: (... (set! x y) (set! y x) ...)") (lint-test "(begin (set! x y) (set! x (+ x 1)))" " begin: perhaps (set! x y) (set! x (+ x 1)) -> (set! x (+ y 1))") (lint-test "(quote 3)" " quote: quote is not needed here: (quote 3)") (lint-test "(quote . 3)" " quote: stray dot in quote's arguments? (quote . 3)") (lint-test "(quote 3 4)" " quote: quote has too many arguments: (quote 3 4)") (lint-test "'#(a)" " #_quote: quote is not needed here: '#(a)") (lint-test "(let () (when a (+ x 1)) y)" " let: let could be begin: (let () (when a (+ x 1)) y) -> (begin (when a (+ x 1)) y) let: this could be omitted: (when a (+ x 1))") (lint-test "(let () (unless a (+ x 1)) y)" " let: let could be begin: (let () (unless a (+ x 1)) y) -> (begin (unless a (+ x 1)) y) let: this could be omitted: (unless a (+ x 1))") (lint-test "(let () (cond ((< x y) 3) ((< y z) 4)) (+ x 1))" " let: let could be begin: (let () (cond ((< x y) 3) ((< y z) 4)) (+ x 1)) -> (begin (cond ((< x y) 3) ((< y z) 4)) (+ x 1)) let: this could be omitted: (cond ((< x y) 3) ((< y z) 4))") (lint-test "(let () (case x ((0) 1) (else 2)) x)" " let: let could be begin: (let () (case x ((0) 1) (else 2)) x) -> (begin (case x ((0) 1) (else 2)) x) let: this could be omitted: (case x ((0) 1) (else 2)) let: perhaps (case x ((0) 1) (else 2)) -> (if (eqv? x 0) 1 2)") (lint-test "(begin (let ((a (+ x 1)) (b 2)) (+ a b)) 32)" " begin: perhaps (begin (let ((a (+ x 1)) (b 2)) (+ a b)) 32) -> (let ((a (+ x 1)) (b 2)) (+ a b) 32) begin: this could be omitted: (let ((a (+ x 1)) (b 2)) (+ a b)) begin: perhaps (let ((a (+ x 1)) (b 2)) (+ a b)) -> (+ (+ x 1) 2)") (lint-test "(begin (if x y z) a)" " begin: this could be omitted: (if x y z)") (lint-test "(lambda (a) (if x y z) a)" " lambda: this could be omitted: (if x y z)") (lint-test "(lambda (a) (case x ((0) 1) (else x)) a)" " lambda: this could be omitted: (case x ((0) 1) (else x)) lambda: perhaps (case x ((0) 1) (else x)) -> (if (eqv? x 0) 1 x) lambda: in (else x), the result can be omitted") (lint-test "(let () (do ((i 0 (+ i 1))) ((= i 1))) x)" " let: let could be begin: (let () (do ((i 0 (+ i 1))) ((= i 1))) x) -> (begin (do ((i 0 (+ i 1))) ((= i 1))) x) let: this could be omitted: (do ((i 0 (+ i 1))) ((= i 1))) let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 1))) let: do is unnecessary: (do ((i 0 (+ i 1))) ((= i 1)))") (lint-test "(let () (write-byte i) (write-byte i) (write-byte i) (write-byte i) (write-byte i) (newline))" " let: let could be begin: (let () (write-byte i) (write-byte i) (write-byte i) (write-byte i)... -> (begin (write-byte i) (write-byte i) (write-byte i) (write-byte i)... let: perhaps (write-byte i)... -> (do ((<1> 0 (+ <1> 1))) ((= <1> 5)) (write-byte i))") (lint-test "(let () (write-byte 0) (write-byte 0) (write-byte 0) (write-byte 0) (write-byte 0))" " let: let could be begin: (let () (write-byte 0) (write-byte 0) (write-byte 0) (write-byte 0)... -> (begin (write-byte 0) (write-byte 0) (write-byte 0) (write-byte 0)... let: perhaps (write-byte 0)... -> (do ((i 0 (+ i 1))) ((= i 5)) (write-byte 0))") (lint-test "(let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3) (write-byte 4))" " let: let could be begin: (let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3)... -> (begin (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3)... let: perhaps (write-byte 0)... -> (for-each write-byte '(0 1 2 3 4))") (lint-test "(let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3) (write-byte (* x 2)))" " let: let could be begin: (let () (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3)... -> (begin (write-byte 0) (write-byte 1) (write-byte 2) (write-byte 3)... let: perhaps (write-byte 0)... -> (for-each write-byte (vector 0 1 2 3 (* x 2))) let: in (write-byte (* x 2)), write-byte's argument should be a byte, but (* x 2) is a number?") (lint-test "(let () (writ 0) (writ 1) (writ 2) (writ 3) (writ (* x 2)))" " let: assuming writ is not a macro, perhaps (... (writ 0) ...) -> (for-each writ (vector 0 1 2 3 (* x 2)))") (lint-test "(let () (writ 0) (writ 1) (writ) (writ 3) (writ (* x 2)))" "") (lint-test "(let () (writ 0 x) (writ 1 x) (writ 2 x) (writ 3 x) (writ 4 x))" " let: perhaps (writ 0 x)... -> (for-each (lambda (arg) (writ arg x)) '(0 1 2 3 4))") (lint-test "(let () (writ x 0) (writ x 1) (writ x 2) (writ x 3) (writ x (* x 2)))" " let: assuming writ is not a macro, perhaps (... (writ x 0) ...) -> (for-each (lambda (arg) (writ x arg)) (vector 0 1 2 3 (* x 2)))") (lint-test "(let () (writ x 0) (writ x 1) (writ y 2) (writ x 3) (writ x (* x 2)))" "") (lint-test "(let () (writ (display x) 0) (writ (display x) 1) (writ (display x) 2) (writ (display x)))" "") (lint-test "(case 3)" " case: case is messed up: (case 3)") (lint-test "(case 3 ((0) #t))" " case: perhaps (case 3 ((0) #t)) -> (if (eqv? 3 0) #t) case: case selector is a constant: (case 3 ((0) #t))") (lint-test "(case (list 1) ((0) #t))" " case: perhaps (case (list 1) ((0) #t)) -> (if (eqv? (list 1) 0) #t) case: case selector may not work with eqv: (list 1) case: case key 0 in ((0) #t) is pointless") (lint-test "(case x (0))" " case: bad case key 0 in (0)") (lint-test "(case x ((0)))" "") ; result can be null (lint-test "(case x ((0) 1) ((1) 2) ((3 0) 4))" " case: repeated case key 0 in ((3 0) 4)") (lint-test "(case x ((0) 1) ((1) 2) ((3 . 0) 4))" " case: stray dot in case case key list: ((3 . 0) 4)") (lint-test "(case x ((#(a)) 2))" " case: perhaps (case x ((#(a)) 2)) -> (if (eqv? x #(a)) 2) case: case key #(a) in ((#(a)) 2) is unlikely to work (case uses eqv? but #(a) is a vector?)") (lint-test "(case x ((+nan.0) 1) ((()) 2))" " case: case key +nan.0 in ((+nan.0) 1) is unlikely to work") ; (lint-test "(case x ((1 +nan.0) 2) ((+nan.0) 3) ((-nan.0) 4))" "") (lint-test "(case x (else 2) ((0) 1))" " case: case else clause is not the last: ((else 2) ((0) 1))") (lint-test "(case x ((0) 32) (else 32))" " case: perhaps (case x ((0) 32) (else 32)) -> 32") (lint-test "(case (string->symbol x) ((a) 1) ((2 3) 3))" " case: case key 2 in ((2 3) 3) is pointless case: case key 3 in ((2 3) 3) is pointless") (lint-test "(case c ((a) b) (else (begin (display d) e)))" " case: perhaps (case c ((a) b) (else (begin (display d) e))) -> (if (eq? c 'a) b (begin (display d) e)) case: redundant begin: (begin (display d) e)") (lint-test "(case x ((0) 32) ((1) 32))" "case: perhaps merge keys (1) with (0): (case x ((0) 32) ((1) 32)) -> (case x ((0 1) 32))") (lint-test "(case x ((0) 32) (else (case x ((1) 32))))" " case: perhaps (case x ((0) 32) (else (case x ((1) 32)))) -> (if (eqv? x 0) 32 (case x ((1) 32))) case: perhaps (case x ((1) 32)) -> (if (eqv? x 1) 32) case: perhaps merge keys (1) with (0): (case x ((0) 32) (else (case x ((1) 32)))) -> (case x ((0 1) 32))") (lint-test "(case x ((0) 32) (else (case x ((1) 32)) x))" " case: this could be omitted: (case x ((1) 32)) case: perhaps (case x ((1) 32)) -> (if (eqv? x 1) 32)") (lint-test "(case x ((0) (display 1) 2) (else (display 1) 2))" " case: perhaps (case x ((0) (display 1) 2) (else (display 1) 2)) -> (begin (display 1) 2)") (lint-test "(case x (else (case x ((0) 1))))" " case: perhaps (case x ((0) 1)) -> (if (eqv? x 0) 1) case: perhaps (case x (else (case x ((0) 1)))) -> (case x ((0) 1))") (lint-test "(case x (else (case x (else 1))))" " case: perhaps (case x (else 1)) -> 1 case: perhaps (case x (else (case x (else 1)))) -> 1") (lint-test "(case x ((0) 1) ((1 2) 1))" " case: perhaps merge keys (1 2) with (0): (case x ((0) 1) ((1 2) 1)) -> (case x ((0 1 2) 1))") (lint-test "(case x ((a b a) 1) ((c) 2))" " case: repeated case key a in ((a b a) 1)") (lint-test "(case x ((3) 2) ((4 8) 3) ((1) 3) ((0) 2))" " case: perhaps merge keys (1) with (4 8), (0) with (3): (case x ((3) 2) ((4 8) 3) ((1) 3) ((0) 2)) -> (case x ((0 3) 2) ((1 4 8) 3))") (lint-test "(case x ((#\\1) 2) ((#\\space #\\c) 3) ((#\\x) 3) ((#\\null) 2))" " case: perhaps merge keys (#\\x) with (#\\space #\\c), (#\\null) with (#\\1): (case x ((#\\1) 2) ((#\\space #\\c) 3) ((#\\x) 3) ((#\\null) 2)) -> (case x ((#\\null #\\1) 2) ((#\\space #\\c #\\x) 3))") (lint-test "(case ((1) 1) (t 2))" " case: bad case key t in (t 2)") (lint-test "(case x ((a) #t) (else #f))" " case: perhaps (case x ((a) #t) (else #f)) -> (eq? x 'a)") (lint-test "(case x ((a b) #f) (else #t))" " case: perhaps (case x ((a b) #f) (else #t)) -> (not (memq x '(a b)))") (lint-test "(case x ((1 2) #t) (else #f))" " case: perhaps (case x ((1 2) #t) (else #f)) -> (memv x '(1 2))") (lint-test "(case x ((2) #f) (else #t))" " case: perhaps (case x ((2) #f) (else #t)) -> (not (eqv? x 2))") (lint-test "(case x ((1) y) ((2) z) (#t 3))" " case: bad case key #t in (#t 3)") (lint-test "(case x ((a) y) ((b) z) (else (if (eq? x 'c) 32 (+ x 1))))" " case: perhaps (case x ((a) y) ((b) z) (else (if (eq? x 'c) 32 (+ x 1)))) -> (case x ((a) y) ((b) z) ((c) 32) (else (+ x 1)))") (lint-test "(case x ((a) y) ((b) z) (else (if (eq? x 'c) 32)))" " case: perhaps (case x ((a) y) ((b) z) (else (if (eq? x 'c) 32))) -> (case x ((a) y) ((b) z) ((c) 32))") (lint-test "(case x ((a) (+ y 1) z) ((b) (display x)) (else c))" " case: perhaps use => here: (case x ((a) (+ y 1) z) ((b) (display x)) (else c)) -> (case x ... ((b) => display) ...) case: this could be omitted: (+ y 1)") (lint-test "(begin (case x ((a) (+ y 1) z) ((b) (display x)) (else c)) (display x))" " begin: this case clause can be omitted: ((a) (+ y 1) z) begin: this case clause can be omitted: (else c) begin: perhaps use => here: (case x ((a) (+ y 1) z) ((b) (display x)) (else c)) -> (case x ... ((b) => display) ...) begin: this could be omitted: (+ y 1)") (lint-test "(case x (else 3))" " case: perhaps (case x (else 3)) -> 3") (lint-test "(case x ((1) (+ x 1)) (else (+ x 3)))" " case: perhaps (case x ((1) (+ x 1)) (else (+ x 3))) -> (+ x (if (eqv? x 1) 1 3))") (lint-test "(case x ((#\\a #\\b) (+ x 1)) (else (+ x 3)))" " case: perhaps (case x ((#\\a #\\b) (+ x 1)) (else (+ x 3))) -> (+ x (if (memv x '(#\\a #\\b)) 1 3))") (lint-test "(case (+ x 1) ((1) (fx1 x y z)) ((2 3) (fx1 x y a)) (else (fx1 x y a b)))" " case: perhaps (case (+ x 1) ((1) (fx1 x y z)) ((2 3) (fx1 x y a)) (else (fx1 x y a b))) -> (fx1 x y (case (+ x 1) ((1) z) ((2 3) a) (else (values a b))))") (lint-test "(case x ((symbol) (display x) (+ x 1)))" " case: perhaps (case x ((symbol) (display x) (+ x 1))) -> (when (eq? x 'symbol) (display x) (+ x 1))") (lint-test "(case x ((:symbol) (display x) (+ x 1)))" " case: perhaps (case x ((:symbol) (display x) (+ x 1))) -> (when (eq? x :symbol) (display x) (+ x 1))") (lint-test "(case x ((0) (log x 2)) ((1) (log x 3)) (else (error 'oops)))" " case: perhaps (case x ((0) (log x 2)) ((1) (log x 3)) (else (error 'oops))) -> (log x (case x ((0) 2) ((1) 3) (else (error 'oops))))") (lint-test "(case x ((a) (f y z)) (else (g y z)))" " case: perhaps (case x ((a) (f y z)) (else (g y z))) -> ((if (eq? x 'a) f g) y z)") (lint-test "(case x ((a b) (f y z)) (else (g y z)))" " case: perhaps (case x ((a b) (f y z)) (else (g y z))) -> ((case x ((a b) f) (else g)) y z)") (lint-test "(case x ((a) (f y a)) (else (f y z)))" " case: perhaps (case x ((a) (f y a)) (else (f y z))) -> (f y (if (eqv? x a) a z))") (lint-test "(case (abs x) ((integer?) 1) ((x) 2) ((1) 3))" "case: case key integer? in ((integer?) 1) is pointless case: case key x in ((x) 2) is pointless") (lint-test "(case (floor x) ((1 2) 3) ((a b) 4))" " case: case key a in ((a b) 4) is pointless case: case key b in ((a b) 4) is pointless") (lint-test "(define (f x) (case x ((0 0.0) 32) ((0.5 1/2) 54) ((0+i 1) 12)))" "") (lint-test "(define (g x) (case x ((-0 0) 0) ((+inf.0) 1)))" "g: repeated case key 0 in ((0 0) 0)") (lint-test "(define (h x) (case x ((-0 -0.0) 1) ((1 3/3) 32)))" " h: repeated case key 1 in ((1 1) 32)") (lint-test "(if (not sym) (set! sym (eqv-selector p)) (equal? sym (eqv-selector p)))" "") (lint-test "(cond (X (f y z)) (else (set! y z)))" "") (lint-test "(case x ((a) (set! y z)) (else (g y z)))" " case: perhaps (case x ((a) (set! y z)) (else (g y z))) -> (if (eq? x 'a) (set! y z) (g y z))") (lint-test "(case (pair? x) ((#f) y) (else z))" " case: perhaps (case (pair? x) ((#f) y) (else z)) -> (if (not (pair? x)) y z)") (lint-test "(case x ((#f) y) (else z))" " case: perhaps (case x ((#f) y) (else z)) -> (if (not x) y z)") (lint-test "(case arg-count ((0) (call-case 0)) ((1) (call-case 1)) ((2) (call-case 2)) ((3) (call-case 3)) ((4) (call-case 4)) ((5) (call-case 5)) ((6) (call-case 6)) (else 12))" " case: perhaps use => here: (case arg-count ((0) (call-case 0)) ((1) (call-case 1)) ((2) (call-case... -> (case arg-count ((0 1 2 3 4 5 6) => call-case) ...)") (lint-test "(case x ((0) (f 0)) ((1) z) (else y))" " case: perhaps use => here: (case x ((0) (f 0)) ((1) z) (else y)) -> (case x ((0) => f) ...)") (lint-test "(case x ((0) (f 0)) ((1) z) ((2) (f 2)) (else y))" " case: perhaps use => here: (case x ((0) (f 0)) ((1) z) ((2) (f 2)) (else y)) -> (case x ((0 2) => f) ...)") (lint-test "(case x ((0) (f 0)) ((1) z) ((2) (f 2)))" " case: perhaps use => here: (case x ((0) (f 0)) ((1) z) ((2) (f 2))) -> (case x ((0 2) => f) ...)") (lint-test "(case x ((3) (g 3)) ((0) (f 0)) ((1) z) ((2) (f 2)))" " case: perhaps use => here: (case x ((3) (g 3)) ((0) (f 0)) ((1) z) ((2) (f 2))) -> (case x ((3) => g) ((0 2) => f) ...)") (lint-test "(case x ((3) (f 3)) ((0) (f 0)) ((2) (f 2)))" " case: perhaps use => here: (case x ((3) (f 3)) ((0) (f 0)) ((2) (f 2))) -> (case x ((3 0 2) => f))") (lint-test "(case x ((3) (f 3)) ((0) (f x)) ((2) (f 2)))" " case: perhaps use => here: (case x ((3) (f 3)) ((0) (f x)) ((2) (f 2))) -> (case x ((3 0 2) => f))") (lint-test "(case x ((1 2 3) (f x)) ((0) (f x)) ((4) (f 4)))" " case: perhaps use => here: (case x ((1 2 3) (f x)) ((0) (f x)) ((4) (f 4))) -> (case x ((1 2 3 0 4) => f)) case: perhaps merge keys (0) with (1 2 3): (case x ((1 2 3) (f x)) ((0) (f x)) ((4) (f 4))) -> (case x ((0 1 2 3) (f x)) ((4) (f 4)))") (lint-test "(case x ((0 1) (abs x)))" " case: perhaps use => here: (case x ((0 1) (abs x))) -> (case x ((0 1) => abs)) case: perhaps (case x ((0 1) (abs x))) -> (if (memv x '(0 1)) (abs x))") (lint-test "(case i ((x) x) ((y) y) ((z) z))" " case: perhaps use => here: (case i ((x) x) ((y) y) ((z) z)) -> (case i ((x y z) => symbol->value))") (lint-test "(case selector ((add-external!) add-external!) ((defun!) defun!) ((depgraph) depgraph) ((a) 1) (else 'oops))" " case: perhaps use => here: (case selector ((add-external!) add-external!) ((defun!) defun!)... -> (case selector ((add-external! defun! depgraph) => symbol->value) ...)") (lint-test "(case x ((0) 0) ((1 2) x) (else x))" " case: in ((0) 0), the result can be omitted case: in ((1 2) x), the result can be omitted case: in (else x), the result can be omitted case: perhaps (case x ((0) 0) ((1 2) x) (else x)) -> (case x ((0) 0) (else x))") (lint-test "(begin (if (= x 1) (display y)) (if (= x 2) (f y)) (if (= x 3) (display z)) (f x))" " begin: perhaps (... (if (= x 1) (display y)) (if (= x 2) (f y)) ...) -> (case x ((1) (display y)) ((2) (f y)) ((3) (display z)))") (lint-test "(begin (if (eq? x 'a) (display y)) (if (eqv? x 2) (f y)) (if (char=? x #\\3) (display z)) (f x))" " begin: perhaps (... (if (eq? x 'a) (display y)) (if (eqv? x 2) (f y)) ...) -> (case x ((a) (display y)) ((2) (f y)) ((#\\3) (display z)))") (lint-test "(let ((x 2)) (case y ((A) B) ((C D) => (lambda (m) (+ m x)))))" " let: perhaps move the let into the '((C D) => (lambda (m) (+ m x))) branch: (let ((x 2)) (case y ((A) B) ((C D) => (lambda (m) (+ m x))))) -> (case y ... ((C D) => (let ((x 2)) (lambda (m) (+ m x)))) ...)") (lint-test "(do ())" " do: do is messed up: (do ())") (lint-test "(do () ())" " do: infinite loop: (do () ())") (lint-test "(do () (#f))" " do: infinite loop: (do () (#f))") (lint-test "(do () (#f) (+ x 2))" " do: infinite loop: (do () (#f) (+ x 2)) do: this could be omitted: (+ x 2)") (lint-test "(call-with-exit (lambda (quit) (do () () (quit))))" "") (lint-test "(call-with-exit (lambda (quit) (do ((i 0 (quit))) ())))" "") (lint-test "(do ((x 2) y) ())" " do: do binding is not a list? y do: x not used, initially: 2 from do") (lint-test "(do ((x 2 1)) () x)" " do: this could be omitted: x") (lint-test "(do ((x 2 1)) () (display 1))" " do: x set, but not used: 2 from do") (lint-test "(do ((x 2)) () (display 1))" " do: x not used, initially: 2 from do") (lint-test "(do ((i 0 (+ i 1))) ((+ i 10) i))" " do: end test is never false: (+ i 10)") (lint-test "(do ((i 0 (+ i 1))) (#f i))" " do: result is unreachable: (#f i)") (lint-test "(do ((i 0 (+ i 0))) ((= i 10) i))" " do: perhaps (+ i 0) -> i") (lint-test "(do ((i 0 (+ i 1))) ((= i 0)) (display i))" " do: do is a no-op because (= i 0) is true at the start: (do ((i 0 (+ i 1))) ((= i 0)) (display i))") (lint-test "(do ((i 0 (+ i 1))) ((>= 0 i)) (display i))" " do: do is a no-op because (>= 0 i) is true at the start: (do ((i 0 (+ i 1))) ((>= 0 i)) (display i))") (lint-test "(do ((i 0 (+ i 1))) ((= i 1)) (display i))" " do: do is unnecessary: (do ((i 0 (+ i 1))) ((= i 1)) (display i))") (lint-test "(do ((i 0 (+ i 1))) ((= 1 i)) (display i))" " do: do is unnecessary: (do ((i 0 (+ i 1))) ((= 1 i)) (display i))") (lint-test "(do ((i 0 (+ i 1))) ((= i len)) (string-set! s i #\\a))" " do: perhaps (do ((i 0 (+ i 1))) ((= i len)) (string-set! s i #\\a)) -> (fill! s #\\a 0 len)") (lint-test "(do ((i 2 (+ i 1))) ((= i len)) (string-set! s i #\\a))" " do: perhaps (do ((i 2 (+ i 1))) ((= i len)) (string-set! s i #\\a)) -> (fill! s #\\a 2 len)") (lint-test "(do ((i 2 (+ i 10))) ((= i len)) (string-set! s i #\\a))" "") (lint-test "(do ((i 0 (+ i 1))) ((= i len)) (vector-set! v0 i (vector-ref v1 i)))" " do: perhaps (do ((i 0 (+ i 1))) ((= i len)) (vector-set! v0 i (vector-ref v1 i))) -> (copy v1 v0 0 len)") (lint-test "(do ((x 0 (+ x 1))) ((>= x c) #f) (vector-set! array x (list-ref cells x)))" " do: perhaps (do ((x 0 (+ x 1))) ((>= x c) #f) (vector-set! array x (list-ref cells x))) -> (copy cells array 0 c)") (lint-test "(do ((i start (- i 1))) ((< i 0)) (string-set! s i (string-ref t i)))" " do: perhaps (do ((i start (- i 1))) ((< i 0)) (string-set! s i (string-ref t i))) -> (copy t s 0 (+ start 1))") (lint-test "(do ((i (- (length t) 1) (- i 1))) ((negative? i)) (string-set! s i (string-ref t i)))" " do: perhaps (do ((i (- (length t) 1) (- i 1))) ((negative? i)) (string-set! s i... -> (copy t s)") (lint-test "(do ((i (- end 1) (- i 1))) ((< i 1)) (float-vector-set! s i (float-vector-ref t i)))" " do: perhaps (do ((i (- end 1) (- i 1))) ((< i 1)) (float-vector-set! s i... -> (copy t s 1 end)") (lint-test "(do ((i 0 (+ 1 1))) ((= i 3) z))" " do: perhaps (+ 1 1) -> 2") (lint-test "(do ((x lst (cdr lst))) ((null? x) y))" " do: this looks suspicious: (x lst (cdr lst))") (lint-test "(do ((i 0 (+ i 1))) ((>= i len)) (display i))" "") (lint-test "(do ((i 0 (+ i 1))) ((< i len)) (display i))" " do: do step looks like it doesn't match end test: (+ i 1) -> (< i len)") (lint-test "(do ((i 0 (- i 1))) ((<= i len)) (display i))" "") (lint-test "(do ((i 0 (- i 1))) ((> i len)) (display i))" " do: do step looks like it doesn't match end test: (- i 1) -> (> i len)") (lint-test "(do ((i 0 (+ i 1))) (= i 10) (display i))" "do: this could be omitted: i do: perhaps missing parens: (= i 10) do: do is a no-op because = is true at the start: (do ((i 0 (+ i 1))) (= i 10) (display i)) do: strange do end-test: = in (= i 10) is a procedure") (lint-test "(do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 10)) (display i))" " do: j set, but not used: 0 from do") (lint-test "(let ((x #t)) (do ((i 0 (+ i 1))) (x) (display i)))" " let: perhaps (let ((x #t)) (do ((i 0 (+ i 1))) (x) (display i))) -> (do ((x #t) (i 0 (+ i 1))) ...)") (lint-test "(do ((i 0 (display i))) ((x y) z))" "") (lint-test "(do ((i 0 (+ i 1))) (abs i) (display i))" " do: do is a no-op because abs is true at the start: (do ((i 0 (+ i 1))) (abs i) (display i)) do: strange do end-test: abs in (abs i) is a procedure") (lint-test "(begin (do ((i 0 (+ i 1))) ((= i 10) i) (display i)) x)" " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 10) i) (display i)) x) -> (do ((i 0 (+ i 1))) ((= i 10) i x) (display i)) begin: (do ((i 0 (+ i 1))) ((= i 10) i) (display i)): result i is not used") (lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (display p))" " do: do is unnecessary: (do ((p (list 1) (cdr p))) ((null? p)) (display p))") (lint-test "(do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x))" " do: do is unnecessary: (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z... do: perhaps (do ((p (list 1) (cdr p))) ((null? p)) (set! y (log z 2)) (do ((z z (+ z... -> (for-each (lambda ([p]) (set! y (log z 2)) (do ((z z (+ z 1))) ((= z 0)) (display z)) (display x)) (list 1))") (lint-test "(do ((i 0 (+ i 1))) ((= i 3) ()) (display i))" "") (lint-test "(do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y)))" " do: this do-loop could probably be replaced by the end test in a let: (do ((x y (cdr x))) ((null? x)) (let ((y x)) (car y))) do: this could be omitted: (let ((y x)) (car y)) do: perhaps (let ((y x)) (car y)) -> (car x)") (lint-test "(do ((i 0 (+ i 1))) ((= i 3) ()))" " do: this do-loop could be replaced by (): (do ((i 0 (+ i 1))) ((= i 3) ()))") (lint-test "(do ((i 0 (+ i 1))) ((= i 3) #t))" " do: this do-loop could be replaced by #t: (do ((i 0 (+ i 1))) ((= i 3) #t)) do: return value is redundant: ((= i 3) #t)") (lint-test "(do ((i 0 (+ i 1))) ((vector-ref v i) (vector-ref v i)))" " do: return value is redundant: ((vector-ref v i) (vector-ref v i))") (lint-test "(do ((i 0 (+ i 1))) ((= i 3) (not (= i 3))) (display i))" " do: perhaps use => here: ((= i 3) (not (= i 3))) -> ((= i 3) => not)") (lint-test "(begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32)" " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 3)) (display i)) 32) -> (do ((i 0 (+ i 1))) ((= i 3) 32) (display i))") (lint-test "(begin (do ((i 0 (+ i 1))) ((= i 3) (display x)) (display i)) 32)" " begin: perhaps (begin (do ((i 0 (+ i 1))) ((= i 3) (display x)) (display i)) 32) -> (do ((i 0 (+ i 1))) ((= i 3) (display x) 32) (display i))") (lint-test "(begin (do () ((= i 3)) (display i)) 32)" " begin: perhaps (begin (do () ((= i 3)) (display i)) 32) -> (do () ((= i 3) 32) (display i))") (lint-test "(let ((x 2)) (do ((x 0 (+ x 1))) ((= x 2)) (display x)) (display x))" "") ; x shadowed if moved into do (lint-test "(let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y)))" " let: x in (y x (- y 1)) does not appear to be defined in the calling environment let: perhaps (let ((xx 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3) xx) (display y))) -> (do ((xx 0) (x 1 (+ x 1)) (y x (- y 1))) ...)") (lint-test "(let ((x 0)) (do ((x 1 (+ x 1)) (y x (- y 1))) ((= x 3)) (display y)))" " let: x in (y x (- y 1)) refers to the caller's x, not the do-loop variable") (lint-test "(let ((x 0)) (do ((x x (+ x 1)) (y x (- y 1))) ((= x 3)) (display y)))" "") (lint-test "(let ((a 1) (b 2)) (do ((x a (+ x 1)) (y (+ b 1) (+ y 1))) ((= i 3)) (display (+ x y))))" " let: perhaps (let ((a 1) (b 2)) (do ((x a (+ x 1)) (y (+ b 1) (+ y 1))) ((= i 3))... -> (do ((x 1 (+ x 1)) (y (+ 2 1) (+ y 1))) ...)") (lint-test "(let ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i)))" " let: perhaps (let ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i))) -> (do ((i 1 (+ i 1))) ...)") (lint-test "(let ((a 1)) (do ((i a (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ i j))))" " let: perhaps (let ((a 1)) (do ((i a (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ i j)))) -> (do ((i 1 (+ i 1)) (j 0 (+ j 1))) ...)") (lint-test "(let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i j))))" " let: perhaps (let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i j)))) -> (do ((a 1) (i 0 (+ i 1)) (j 0 (+ j 1))) ...)") (lint-test "(let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i j))) 32)" " let: perhaps (let ((a 1)) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3)) (display (+ a i... -> (do ((a 1) (i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 3) 32) ...)") (lint-test "(do ((i 0 (+ i j)) (j 0 (+ j 1))) ((= i 10)) (display i))" ; displays 00136 " do: perhaps (do ((i 0 (+ i j)) (j 0 (+ j 1))) ((= i 10)) (display i)) -> (do ((i 0) (j 0 (+ j 1))) ((= i 10)) (display i) (set! i (+ i j)))") (lint-test "(do ((i 0 j) (j 0 (+ j 1))) ((= i 2)) (display i))" " do: perhaps (do ((i 0 j) (j 0 (+ j 1))) ((= i 2)) (display i)) -> (do ((i 0) (j 0 (+ j 1))) ((= i 2)) (display i) (set! i j))") (lint-test "(do ((i 0 (+ i 1)) (j 1)) ((= i 3)) (display (+ i j)) (set! j (+ j 1)))" " do: perhaps move (set! j (+ j 1)) to j's step expression: (j 1 (+ j 1))") (lint-test "(do ((i 0 (+ i 1)) (j 1)) ((= i 3)) (display (+ i j)) (set! j (+ j i)))" "") (lint-test "(do ((i 0 (+ i 1)) (j 1 (+ j 1))) ((= i 3)) (display (+ i j)) (set! j (+ j 1)))" " do: perhaps move (set! j (+ j 1)) to j's step expression: (j 1 (+ 2 j))") (lint-test "(do ((i 0 (+ i 1)) (j 1 0)) ((= i 3)) (display (+ i j)) (set! j (+ j i)))" " do: this set! is pointless: (set! j (+ j i))") (lint-test "(do ((i 0 (+ i 1)) (j 1 0)) ((= i 3)) (display (+ i j)) (set! j (display (+ j i))))" " do: this set! is pointless: (set! j (display (+ j i))); perhaps replace it with (display (+ j i))") (lint-test "(do ((i 0 (+ i j)) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k)))" " do: perhaps (do ((i 0 (+ i j)) (j 0 (+ k 1)) (k 1)) ((= i 10)) (display (+ i j k))) -> (do ((i 0) (j 0) (k 1)) ((= i 10)) (display (+ i j k)) (set! i (+ i j)) (set! j (+ k 1)))") (lint-test "(do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4)) (display (+ i j)))" " do: this do loop is unreadable; perhaps (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4)) (display (+ i j))) -> (let <1> ((i 0) (j 1) (k 0)) (if (= k 4) () (begin (display (+ i j)) (<1> j i (+ k 1)))))") (lint-test "(do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 5) (set! x k) (+ k 1)) (display (+ i j)))" " do: this do loop is unreadable; perhaps (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 5) (set! x k) (+ k 1)) (display... -> (let <1> ((i 0) (j 1) (k 0)) (if (= k 5) (begin (set! x k) (+ k 1)) (begin (display (+ i j)) (<1> j i (+ k 1)))))") (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a)))" " do: perhaps (let ((a 12)) (set! a (+ a i)) (display a)) -> (let ((a (+ 12 i))) (display a)) do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) -> (do ((i 0 (+ i 1)) (a 12 12)) ((= i 3)) (set! a (+ a i)) ...)") (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let () (set! a (+ a i)) (display a)))" " do: pointless let: (let () (set! a (+ a i)) (display a)) do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let () (set! a (+ a i)) (display a))) -> (do ((i 0 (+ i 1))) ((= i 3)) (set! a (+ a i)) ...)") (lint-test "(do () ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a)))" " do: perhaps (let ((a 12)) (set! a (+ a i)) (display a)) -> (let ((a (+ 12 i))) (display a)) do: perhaps (do () ((= i 3)) (let ((a 12)) (set! a (+ a i)) (display a))) -> (do ((a 12 12)) ((= i 3)) (set! a (+ a i)) ...)") (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((j (abs x))) (display (+ i j (* 2 j)))))" " do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((j (abs x))) (display (+ i j (* 2 j))))) -> (do ((i 0 (+ i 1)) (j (abs x) (abs x))) ((= i 3)) (display (+ i j (* 2 j))))") (lint-test "(do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12) (b 1)) (set! a (+ a b i)) (display a)))" " do: perhaps combine these two lines: (set! a (+ a b i)) (display a) do: perhaps (do ((i 0 (+ i 1))) ((= i 3)) (let ((a 12) (b 1)) (set! a (+ a b i))... -> (do ((i 0 (+ i 1)) (a 12 12) (b 1 1)) ((= i 3)) (set! a (+ a b i)) ...)") (lint-test "(do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4) (+ i j k)))" " do: this do loop is unreadable; perhaps (do ((i 0 j) (j 1 i) (k 0 (+ k 1))) ((= k 4) (+ i j k))) -> (let <1> ((i 0) (j 1) (k 0)) (if (= k 4) (+ i j k) (<1> j i (+ k 1))))") (lint-test "(let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ i x))) (abs y))" " let: perhaps (let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ i x))) (abs y)) -> (do ((x (log y)) (i 0 (+ i 1))) ((= i 3) (abs y)) ...)") (lint-test "(let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ i x))) (abs x))" " let: perhaps (let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ i x))) (abs x)) -> (do ((x (log y)) (i 0 (+ i 1))) ((= i 3) (abs x)) ...)") (lint-test "(let ((x (log y))) (do ((i 0 (+ i x))) ((= i 3)) (display i)))" " let: perhaps (let ((x (log y))) (do ((i 0 (+ i x))) ((= i 3)) (display i))) -> (do ((x (log y)) (i 0 (+ i x))) ...)") (lint-test "(let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3) x) (display i)))" " let: perhaps (let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3) x) (display i))) -> (do ((x (log y)) (i 0 (+ i 1))) ...)") (lint-test "(let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display x)))" " let: perhaps (let ((x (log y))) (do ((i 0 (+ i 1))) ((= i 3)) (display x))) -> (do ((x (log y)) (i 0 (+ i 1))) ...)") (lint-test "(let ((x (log y))) (do () ((= i 3)) (display x)))" " let: perhaps (let ((x (log y))) (do () ((= i 3)) (display x))) -> (do ((x (log y))) ...)") (lint-test "(let ((x (log y)) (z (log w))) (do () ((= i 3)) (display x)) (display x) (cdr v))" " let: z not used, initially: (log w) from let") (lint-test "(let ((x (log y))) (do ((x 0 (+ x 1))) ((= i 3)) (display x)))" " let: x not used, initially: (log y) from let") (lint-test "(let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x)) (display i)))" " let: perhaps (let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x)) (display i))) -> (do ((x (length y)) (i 0 (+ i 1))) ...)") (lint-test "(let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x) (display x)) (display i)) (log x))" " let: perhaps (let ((x (length y))) (do ((i 0 (+ i 1))) ((= i x) (display x)) (display... -> (do ((x (length y)) (i 0 (+ i 1))) ((= i x) (display x) (log x)) ...)") (lint-test "(do ((p lst (cdr p))) ((null? p)) (display (car p)))" " do: perhaps (do ((p lst (cdr p))) ((null? p)) (display (car p))) -> (for-each (lambda ([p]) (display [p])) lst)") (lint-test "(do ((p lst (cdr p))) ((not (pair? p))) (if (cadar p) (display (cdddar p))))" " do: perhaps (do ((p lst (cdr p))) ((not (pair? p))) (if (cadar p) (display (cdddar p)))) -> (for-each (lambda ([p]) (if (cadr [p]) (display (cdddr [p])))) lst)") (lint-test "(do ((i 0 (+ i 1))) ((= i (vector-length x))) (find (vector-ref x i)))" " do: perhaps (do ((i 0 (+ i 1))) ((= i (vector-length x))) (find (vector-ref x i))) -> (for-each (lambda ([x]) (find [x])) x)") (lint-test "(let ((n (length v))) (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v j))) (f (car x) (cdr x)))))" " let: perhaps (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v j))) (f (car x) (cdr x)))) -> (for-each (lambda ([v]) (let ((x [v])) (f (car x) (cdr x)))) v) let: perhaps (let ((n (length v))) (do ((j 0 (+ j 1))) ((= j n)) (let ((x (vector-ref v... -> (do ((n (length v)) (j 0 (+ j 1))) ...)") (lint-test "(do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36) (+ beg2 dist)) (af .1 (* af .85))) ((= i 20)) (savannah-8 beg2 (* amp af)) (set! dist (+ dist .001)))" " do: perhaps (do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36) (+ beg2 dist)) (af 0.1... -> (do ((dist 0.01) (i 0 (+ i 1)) (beg2 (+ beg 2.36)) (af 0.1 (* af 0.85))) ((= i 20)) (savannah-8 beg2 (* amp af)) (set! dist (+ dist 0.001)) (set! beg2 (+ beg2 dist)))") (lint-test "(do ((r ()) (i 0 (+ i 1))) ((= i 3) r) (set! r (append r (list i))))" " do: perhaps (set! r (append r ...)) -> (set! r (cons ... r)), reversing r at the end") (lint-test "(do ((j m (- j 1)) (a '() (cons '() a))) ((= j 0) a))" " do: quote is not needed here: '() do: quote is not needed here: '() do: perhaps (do ((j m (- j 1)) (a '() (cons '() a))) ((= j 0) a)) -> (make-list m '())") (lint-test "(do ((j 0 (+ 1 j)) (a () (cons () a))) ((>= j 10) a))" " do: perhaps (do ((j 0 (+ 1 j)) (a () (cons () a))) ((>= j 10) a)) -> (make-list 10 ())") (lint-test "(do ((j 10 (- j 1)) (a () (cons 1 a))) ((<= j 3) a))" " do: perhaps (do ((j 10 (- j 1)) (a () (cons 1 a))) ((<= j 3) a)) -> (make-list 7 1)") (lint-test "(do ((j 10 (- 1 j)) (a () (cons () a))) ((<= j 3) a))" " do: do is unnecessary: (do ((j 10 (- 1 j)) (a () (cons () a))) ((<= j 3) a))") (lint-test "(do ((j m (- j 1)) (a () (cons () a))) ((< j 0) a))" " do: perhaps (do ((j m (- j 1)) (a () (cons () a))) ((< j 0) a)) -> (make-list (+ m 1) ())") (lint-test "(do ((j 0 (+ 1 j)) (a () (cons () a))) ((> j 10) a))" " do: perhaps (do ((j 0 (+ 1 j)) (a () (cons () a))) ((> j 10) a)) -> (make-list 11 ())") (lint-test "(do ((j 0 (+ 1 j)) (a () (cons () a))) ((> j len) a))" " do: perhaps (do ((j 0 (+ 1 j)) (a () (cons () a))) ((> j len) a)) -> (make-list (+ len 1) ())") (lint-test "(do ((j 10 (- j 1)) (a () (cons () a))) ((< j 0) a))" " do: perhaps (do ((j 10 (- j 1)) (a () (cons () a))) ((< j 0) a)) -> (make-list 11 ())") (lint-test "(do ((j 10 (- j 1)) (a (list) (cons 'abs a))) ((< j 0) a))" " do: perhaps (list) -> (); there is only one nil do: perhaps (do ((j 10 (- j 1)) (a (list) (cons 'abs a))) ((< j 0) a)) -> (make-list 11 'abs)") (lint-test "(do ((i (- end 1) (- i 1)) (ans () (cons (string-ref s i) ans))) ((< i start) ans))" " do: perhaps (do ((i (- end 1) (- i 1)) (ans () (cons (string-ref s i) ans))) ((< i... -> (do ((i (- end 1) (- i 1)) (ans ())) ((< i start) ans) (set! ans (cons (string-ref s i) ans))) do: perhaps (do ((i (- end 1) (- i 1)) (ans () (cons (string-ref s i) ans))) ((< i start) ans)) -> string->list") (lint-test "(do ((i 10 (- i 1)) (ans () (cons (vector-ref s i) ans))) ((< i 0) ans))" " do: perhaps (do ((i 10 (- i 1)) (ans () (cons (vector-ref s i) ans))) ((< i 0) ans)) -> (do ((i 10 (- i 1)) (ans ())) ((< i 0) ans) (set! ans (cons (vector-ref s i) ans))) do: perhaps (do ((i 10 (- i 1)) (ans () (cons (vector-ref s i) ans))) ((< i 0) ans)) -> vector->list") (lint-test "(do ((k r (- k 1)) (r () (cons (vector-ref v (- k 1)) r))) ((= k 10) r))" "do: perhaps (do ((k r (- k 1)) (r () (cons (vector-ref v (- k 1)) r))) ((= k 10) r)) -> (do ((k r (- k 1)) (r ())) ((= k 10) r) (set! r (cons (vector-ref v (- k 1)) r))) do: perhaps (do ((k r (- k 1)) (r () (cons (vector-ref v (- k 1)) r))) ((= k 10) r)) -> vector->list") (lint-test "(do ((i (- len 1) (- i 1)) (result () (cons (f (vector-ref v i)) result))) ((negative? i) result))" " do: perhaps (do ((i (- len 1) (- i 1)) (result () (cons (f (vector-ref v i)) result)))... -> (do ((i (- len 1) (- i 1)) (result ())) ((negative? i) result) (set! result (cons (f (vector-ref v i)) result))) do: perhaps (do ((i (- len 1) (- i 1)) (result () (cons (f (vector-ref v i)) result))) ((negative? i) result)) -> (map f v)") (lint-test "(do ((ds () (cons d ds)) (d 0 (+ d 1))) ((= d r) ds))" " do: perhaps (do ((ds () (cons d ds)) (d 0 (+ d 1))) ((= d r) ds)) -> (do ((ds ()) (d 0 (+ d 1))) ((= d r) ds) (set! ds (cons d ds)))") (lint-test "(define (f x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (* x y i))))" " f: (* x y) in (* x y i) is constant in the do loop") (lint-test "(define (f1 x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (- x y i))))" " f1: (- x y) in (- x y i) is constant in the do loop") (lint-test "(define (f2 x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (* i 12 (+ x y)))))" " f2: (* 12 (+ x y)) in (* i 12 (+ x y)) is constant in the do loop") (lint-test "(define (f3 x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (* i 12 (random x)))))" "") (lint-test "(define (f4 x y) (do ((i 0 (+ i 1))) ((= i 10)) (display (* i 12 (eval x)))))" "") (lint-test "(define (g x) (do ((i 0 (+ i 1))) ((= i 10)) (display (abs x))))" "") (lint-test "(define (g2 y) (do ((i 0 (+ i 1))) ((= i 10)) (define z 21) (display (+ x y z i))))" " g2: (+ x y) in (+ x y z i) is constant in the do loop") (lint-test "(define (g3 y) (do ((i 0 (+ i 1))) ((= i 10)) (display (- x (/ (abs y) (floor x)) i))))" " g3: (- x (/ (abs y) (floor x))) in (- x (/ (abs y) (floor x)) i) is constant in the do loop") (lint-test "(define (g4 y) (do ((i 0 (+ i 1))) ((= i 10)) (display (- y (/ (abs i) (floor x))))))" "") (lint-test "(define (h1 snd chn) (do ((n2 (floor (/ n 2.0))) (i 0 (+ i 1))) ((= i n)) (set! (fr (if (< i n2) i (- (+ i out-n) n 1))) (edot-product (* freq 0.0-1.0i i) in-data))))" " h1: (+ n 1) in (- (+ i out-n) n 1) is constant in the do loop h1: (* freq 0.0-1.0i) in (* freq 0.0-1.0i i) is constant in the do loop") (lint-test "(define (h3) (do ((x 3) (i 0 (+ i 1))) ((= i 3)) (when (> x 0) (set! x (- x))))) (define (h4) (do ((abs 0 (+ abs 1))) ((= abs 3) 32) (display abs)))" "") (lint-test "(define (h5) (do ((abs 0 (+ abs 1))) ((= abs 3) 32) (display '(32))))" "") (lint-test "(define (h6 v) (do ((j 0) (i 0 (+ i 1))) ((= i 3)) (float-vector-set! v j (* 2 (float-vector-ref v j)))))" "") (lint-test "(let loop ((i 0) (lst ())) (if (= i 10) lst (loop (+ i 1) (cons 1 lst))))" " loop: perhaps (let loop ((i 0) (lst ())) (if (= i 10) lst (loop (+ i 1) (cons 1 lst)))) -> (do ((i 0 (+ i 1)) (lst () (cons 1 lst))) ((= i 10) lst)) loop: perhaps (let loop ((i 0) (lst ())) (if (= i 10) lst (loop (+ i 1) (cons 1 lst)))) -> (make-list 10 1)") (lint-test "(let ((x (f y))) (display x) (define z (f x)) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i))))" " let: the scope of z could be reduced: (... (define z (f x)) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i)))) -> (... (let ((z (f x))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i))))) let: (define z (f x)) occurs in the midst of the body; perhaps use let: (let ((z (f x))) (do ((i 0 (+ i 1))) ((= i 3)) (display (+ x z i)))) let: (+ x z) in (+ x z i) is constant in the do loop") (lint-test "(let () (display x) (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))))" " let: the scope of z could be reduced: (... (define z (f x)) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i)))) -> (... (let ((z (f x))) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))))) let: (define z (f x)) occurs in the midst of the body; perhaps use let: (let ((z (f x))) (do ((i z (+ i 1))) ((= i 3)) (display (+ z i))))") (lint-test "(let () (display x) (define z (f x)) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i))))" " let: the scope of z could be reduced: (... (define z (f x)) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i)))) -> (... (let ((z (f x))) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i))))) let: (define z (f x)) occurs in the midst of the body; perhaps use let: (let ((z (f x))) (do ((i z (+ i 1)) (j 0)) ((= i 3)) (display (+ z i)))) let: j not used, initially: 0 from do") (lint-test "(let ((x (make-vector 3 0)) (y (* 2 x))) (set! x (reverse x)) (vector-ref x y))" " let: x in (y (* 2 x)) does not appear to be defined in the calling environment let: perhaps combine these two lines: (set! x (reverse x)) (vector-ref x y)") (lint-test "(let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (reverse x)) (vector-ref x y))" " let: perhaps (let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (reverse x)) (vector-ref x y)) -> (let ((x (reverse (make-vector 3 0))) (y (* 2 z))) (vector-ref x y))") (lint-test "(let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (f x y x)) (vector-ref x y))" "") (lint-test "(let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (f x y)))" " let: perhaps (let ((x (make-vector 3 0)) (y (* 2 z))) (set! x (f x y))) -> (let ((x (make-vector 3 0)) (y (* 2 z))) (f x y)) let: set! is pointless in (set! x (f x y)): use (f x y)") (lint-test "(let ((x (make-vector 3 0))) (set! x (f x y)))" " let: perhaps (let ((x (make-vector 3 0))) (set! x (f x y))) -> (f (make-vector 3 0) y) let: set! is pointless in (set! x (f x y)): use (f x y)") ;(lint-test "(byte-vector 3213)" " byte-vector: byte-vector's argument should be a byte?: 3213: (byte-vector 3213)") (lint-test "(make-byte-vector 0)" " make-byte-vector: perhaps (make-byte-vector 0) -> #u()") (lint-test "(make-byte-vector 3 (random 256))" "") (lint-test "(make-byte-vector 3 (random 257))" " make-byte-vector: in (make-byte-vector 3 (random 257)), make-byte-vector's second argument should be a byte, but (random 257) is an integer?") (lint-test "(let ())" " let: let is messed up: (let ())") (lint-test "(let ((x (lambda (a) (x 1)))) x)" " let: let variable x is called in its binding? Perhaps let should be letrec: ((x (lambda (a) (x 1)))) let: perhaps (let ((x (lambda (a) (x 1)))) x) -> (lambda (a) (x 1))") (lint-test "(let* ((x 1)) x)" " let*: let* could be let: (let* ((x 1)) x) let*: perhaps (let* ((x 1)) x) -> 1") (lint-test "(let* ((x 1) (x x)) x)" " let*: let* variable x is declared twice let*: perhaps (let* ((x 1) (x x)) x) -> (let ((x 1)) x)") (lint-test "(let* ((x (g g0)) (y (g g0))) (+ x y))" " let*: perhaps (let* ((x (g g0)) (y (g g0))) (+ x y)) -> (let ((x (g g0))) (+ x (g g0)))") (lint-test "(let* ((x 0) (y (g 0))) (+ x y))" " let*: perhaps (let* ((x 0) (y (g 0))) (+ x y)) -> (let ((x 0)) (+ x (g 0)))") (lint-test "(let ((x 0)) (let ((y (g 0))) (+ x y)))" " let: perhaps (let ((y (g 0))) (+ x y)) -> (+ x (g 0)) let: perhaps move 'x into the inner let: (let ((x 0)) (let ((y (g 0))) (+ x y))) -> (let ((x 0) (y (g 0))) (+ x y)) let: perhaps (let ((x 0)) (let ((y (g 0))) (+ x y))) -> (let* ((x 0) (y (g 0))) (+ x y))") (lint-test "(let* ((a 1) (b (+ a 1))) (let ((c (+ a b))) (display c)))" " let*: perhaps (let ((c (+ a b))) (display c)) -> (display (+ a b)) let*: perhaps (let* ((a 1) (b (+ a 1))) (let ((c (+ a b))) (display c))) -> (let* ((a 1) (b (+ a 1)) (c (+ a b))) (display c))") (lint-test "(let* ((a 1) (b (+ a 1))) (let* ((c (+ a b)) (d (+ c 1))) (display d)) (display a))" " let*: perhaps restrict c which is not used in the let* body (let* ((c (+ a b)) (d (+ c 1))) (display d)) -> (let ((d (let ((c (+ a b))) (+ c 1)))) ...) let*: perhaps substitute c into d: (let* ((c (+ a b)) (d (+ c 1))) (display d)) -> (let ((d (+ (+ a b) 1))) ...) let*: perhaps (let* ((c (+ a b)) (d (+ c 1))) (display d)) -> (let ((c (+ a b))) (display (+ c 1)))") (lint-test "(let* ((a 1) (b (+ a 1))) (let ((c (+ a b)) (d a)) (display (+ c d))))" " let*: perhaps (let ((c (+ a b)) (d a)) (display (+ c d))) -> (display (+ (+ a b) a))") (lint-test "(let* ((x (log y 2)) (y (log y 2)) (z (f x))) (+ x y z z))" " let*: y's value (log y 2) could be x") (lint-test "(let* ((x (log a 2)) (y (log y 2)) (z (log y 2))) (+ x y z z))" " let*: perhaps split this let*: (let* ((x (log a 2)) (y (log y 2)) (z (log y 2))) (+ x y z z)) -> (let ((y (log y 2))) (let ((x (log a 2)) (z (log y 2))) ...))") (lint-test "(let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d))" " let*: perhaps restrict a, c which are not used in the let* body (let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d)) -> (let* ((b (let ((a 12)) (+ a 1))) (d (let ((c 20)) (+ c 1)))) ...) let*: perhaps split this let*: (let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d)) -> (let ((a 12) (c 20)) (let ((b (+ a 1)) (d (+ c 1))) ...)) let*: perhaps substitute a into b, c into d: (let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d)) -> (let* ((b (+ 12 1)) (d (+ 20 1))) ...) let*: perhaps (let* ((a 12) (b (+ a 1)) (c 20) (d (+ c 1))) (+ b d)) -> (let* ((a 12) (b (+ a 1)) (c 20)) (+ b (+ c 1)))") (lint-test "(let ((a 1)) (let ((b (+ a 1))) (+ a b)))" " let: perhaps (let ((b (+ a 1))) (+ a b)) -> (+ a (+ a 1)) let: perhaps (let ((a 1)) (let ((b (+ a 1))) (+ a b))) -> (let* ((a 1) (b (+ a 1))) (+ a b))") (lint-test "(let ((a 1)) (let ((b 2)) (+ a b)))" " let: perhaps (let ((b 2)) (+ a b)) -> (+ a 2) let: perhaps move 'a into the inner let: (let ((a 1)) (let ((b 2)) (+ a b))) -> (let ((a 1) (b 2)) (+ a b)) let: perhaps (let ((a 1)) (let ((b 2)) (+ a b))) -> (let ((a 1) (b 2)) (+ a b))") (lint-test "(let ((a 1)) (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c))))" " let: perhaps (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c))) -> (let ((b (+ a 1))) (display (+ a b (* b 2)))) let: perhaps (let ((a 1)) (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c)))) -> (let* ((a 1) (b (+ a 1)) (c (* b 2))) (display (+ a b c)))") (lint-test "(let ((x 1) (y 2)) (set! x (* y 2)) x)" " let: set! returns the new value, so this could be omitted: x let: perhaps (let ((x 1) (y 2)) (set! x (* y 2)) x) -> (let ((y 2)) (* y 2))") (lint-test "(let ((x (read-byte)) (y 2)) (set! x (* y x)) x)" " let: set! returns the new value, so this could be omitted: x let: perhaps (let ((x (read-byte)) (y 2)) (set! x (* y x)) x) -> (let ((x (read-byte)) (y 2)) (* y x))") (lint-test "(let ((x (read-byte)) (y 2)) (set! x (* y 2)))" " let: x set, but not used: (set! x (* y 2)) let: perhaps (let ((x (read-byte)) (y 2)) (set! x (* y 2))) -> (let ((x (read-byte)) (y 2)) (* y 2)) let: set! is pointless in (set! x (* y 2)): use (* y 2)") (lint-test "(let ((x 1) (y 2)) (set! x (* y x)) x)" " let: set! returns the new value, so this could be omitted: x let: perhaps (let ((x 1) (y 2)) (set! x (* y x)) x) -> (let ((x 1) (y 2)) (* y x))") (lint-test "(let ((x 1)) (set! x (* 2 x)) x)" " let: set! returns the new value, so this could be omitted: x let: perhaps (let ((x 1)) (set! x (* 2 x)) x) -> (let ((x (* 2 1))) x)") (lint-test "(let ((x 1)) (set! x 2) x)" " let: set! returns the new value, so this could be omitted: x let: perhaps (let ((x 1)) (set! x 2) x) -> (let ((x 2)) x)") (lint-test "(let ((x 1) (y (f g 2))) (let loop ((a (+ x 1)) (b y)) (loop a b)))" " let: perhaps (let ((x 1) (y (f g 2))) (let loop ((a (+ x 1)) (b y)) (loop a b))) -> (let loop ((a (+ 1 1)) (b (f g 2))) (loop a b))") (lint-test "(let loop ((i 0)) (+ i 1))" " let: loop not used, value: (let loop ((i 0)) (+ i 1))") (lint-test "(let () (define x 43) (display (+ x x)))" " let: perhaps (let () (define x 43) (display (+ x x))) -> (let ((x 43)) ...)") (lint-test "(let ((x 43)) (define y 44) (display (+ x y)))" " let: perhaps (let ((x 43)) (define y 44) (display (+ x y))) -> (let ((x 43) (y 44)) ...)") (lint-test "(lambda () (let ((x 43)) (define y 44) (display (+ x y))))" " lambda: y can be moved to lambda's closure lambda: x can be moved to lambda's closure lambda: perhaps (let ((x 43)) (define y 44) (display (+ x y))) -> (let ((x 43) (y 44)) ...)") (lint-test "(let () (define x 3) (define (y a) a) (g z))" " let: perhaps (... (define x 3) (define (y a) a) (g z)) -> (... (let ((x 3)) ...)) let: y not used, value: (define (y a) a) let: x not used, initially: 3 from define let: perhaps (let () (define x 3) (define (y a) a) (g z)) -> (let ((x 3)) ...)") (lint-test "(let* ((x y) (a (* 2 x))) (+ (f a (+ a 1)) (* 3 x)))" " let*: assuming we see all set!s, the binding (x y) is pointless: perhaps (let* ((x y) (a (* 2 x))) (+ (f a (+ a 1)) (* 3 x))) -> (let ((a (* 2 y))) (+ (f a (+ a 1)) (* 3 y)))") (lint-test "(let* ((x y) (a (* 2 (+ x y)))) (+ (f a (+ a 1)) (* 3 x)))" " let*: assuming we see all set!s, the binding (x y) is pointless: perhaps (let* ((x y) (a (* 2 (+ x y)))) (+ (f a (+ a 1)) (* 3 x))) -> (let ((a (* 2 (+ y y)))) (+ (f a (+ a 1)) (* 3 y)))") (lint-test "(let* ((x y) (a (* 2 x))) (set! x (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))" "") (lint-test "(let* ((x y) (a (* 2 x))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))" "") (lint-test "(let* ((x y) (a (* 2 x))) (cons (push! a x) (* 3 x)))" "") (lint-test "(let* ((x y) (a (* 2 x))) (cons (push! a y) (* 3 x)))" "") (lint-test "(let ((x y) (a (* 2 y))) (+ (f a (+ a 1)) (* 3 x)))" "") (lint-test "(let ((x y) (a (* 2 y))) (+ (f a (+ a 1)) (* 3 y x)))" "") (lint-test "(let ((x y) (a (* 2 y))) (set! x (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))" " let: perhaps (let ((x y) (a (* 2 y))) (set! x (* 3 x)) (+ (f a (+ a 1)) (* 3 x))) -> (let ((x (* 3 y)) (a (* 2 y))) (+ (f a (+ a 1)) (* 3 x)))") (lint-test "(let ((x y) (a (* 2 y))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))" " let: x is not set, and is always accessed via (* 3 x) so its binding could probably be (x (* 3 y)) in (let ((x y) (a (* 2 y))) (set! y (* 3 x)) (+ (f a (+ a 1)) (* 3 x)))") (lint-test "(let ((old-x x)) (set! x 12) (display (log x)) (set! x old-x))" " let: perhaps use let-temporarily here: (let ((old-x x)) (set! x 12) (display (log x)) (set! x old-x)) -> (let-temporarily ((x 12)) (display (log x)))") (lint-test "(let ((old-x x)) (set! x 12) (display (log x)) (set! x 1) (set! x old-x))" " let: this could be omitted: (set! x 1) let: perhaps use let-temporarily here: (let ((old-x x)) (set! x 12) (display (log x)) (set! x 1) (set! x old-x)) -> (let-temporarily ((x 12)) (display (log x)) (set! x 1))") (lint-test "(let ((old-x x) (z (f 3))) (set! x z) (display (log x)) (set! x old-x))" " let: perhaps use let-temporarily here: (let ((old-x x) (z (f 3))) (set! x z) (display (log x)) (set! x old-x)) -> (let ((z (f 3))) (let-temporarily ((x z)) (display (log x))))") (lint-test "(let ((z (f 3)) (old-x x)) (set! x z) (display (log x)) (set! x old-x))" " let: perhaps use let-temporarily here: (let ((z (f 3)) (old-x x)) (set! x z) (display (log x)) (set! x old-x)) -> (let ((z (f 3))) (let-temporarily ((x z)) (display (log x))))") (lint-test "(let ((old-p (*s7* 'print-length))) (set! (*s7* 'print-length) 32) (display x) (set! (*s7* 'print-length) old-p))" " let: perhaps use let-temporarily here: (let ((old-p (*s7* 'print-length))) (set! (*s7* 'print-length) 32)... -> (let-temporarily (((*s7* 'print-length) 32)) (display x))") (lint-test "(let ((b 32)) (let ((ob b) (res 0)) (set! b 31) (set! res (+ b 1)) (set! b ob) res))" " let: perhaps use let-temporarily here: (let ((ob b) (res 0)) (set! b 31) (set! res (+ b 1)) (set! b ob) res) -> (let ((res 0)) (let-temporarily ((b 31)) (set! res (+ b 1)) res))") (lint-test "(define equalize-panes (let ((equalize-sound (lambda (ind) (let-temporarily (((channel-style ind) channels-combined)))))) (lambda* (snd) (if snd (equalize-sound snd) (for-each equalize-sound (sounds))))))" "") (lint-test "(let-temporarily () 3)" " let-temporarily: let-temporarily with no vars? (let-temporarily () 3)") (lint-test "(let-temporarily)" " let-temporarily: let-temporarily is messed up: (let-temporarily)") (lint-test "(null? (let ((p (lambda (x) (not ((if (path? obj) path? picture?) x))))) (filt p (cons obj more-objs))))" " null?: perhaps (null? (let ((p (lambda (x) (not ((if (path? obj) path? picture?) x)))))... -> (let ... (null? (filt p (cons obj more-objs))))") (lint-test "((if y +) 2 3)" " (if y +): y better not be #f here: ((if y +) 2 3)") (lint-test "((if y abs -))" " (if y abs -): abs in (if y abs -) can't be called with 0 arguments: ((if y abs -)) (if y abs -): - in (if y abs -) can't be called with 0 arguments: ((if y abs -))") (lint-test "((if y abs exp) 1.0 2.0)" " (if y abs exp): abs in (if y abs exp) can't be called with 2 arguments: ((if y abs exp) 1.0 2.0) (if y abs exp): exp in (if y abs exp) can't be called with 2 arguments: ((if y abs exp) 1.0 2.0)") (lint-test "((if y string=? string>?) 1 2)" " (if y string=? string>?): in ((if y string=? string>?) 1 2), ((if y string=? string>?) 1 2)'s first argument should be a string, but 1 is an integer? (if y string=? string>?): in ((if y string=? string>?) 1 2), ((if y string=? string>?) 1 2)'s second argument should be a string, but 2 is an integer? (if y string=? string>?): in ((if y string=? string>?) 1 2), ((if y string=? string>?) 1 2)'s first argument should be a string, but 1 is an integer? (if y string=? string>?): in ((if y string=? string>?) 1 2), ((if y string=? string>?) 1 2)'s second argument should be a string, but 2 is an integer?") (lint-test "((if y abs +) 1.0 2.0)" "(if y abs +): abs in (if y abs +) can't be called with 2 arguments: ((if y abs +) 1.0 2.0)") (lint-test "((if y 32 #) 1.0 2.0)" " (if y 32 #): 32 in (if y 32 #) can't be called with 2 arguments: ((if y 32 #) 1.0 2.0) (if y 32 #): # in (if y 32 #) can't be called with 2 arguments: ((if y 32 #) 1.0 2.0)") (lint-test "(let () (define-constant _cons_ 32) (define (_cons_ a_) (+ 1 a)))" " let: _cons_ in (define (_cons_ a_) (+ 1 a)) is already a constant, defined 32 let: let variable _cons_ is declared twice let: _cons_ not used, initially: 32 from define-constant") (lint-test "(let ((x 32)) (display x) (define-constant x 2) (f x))" " let: let variable x is later redefined as a constant") (lint-test "(let ((x 32)) (display x) (define x 2) (f x))" " let: (define x 2) occurs in the midst of the body; perhaps use let: (let ((x 2)) (f x)) let: let variable x is redefined in the let body. Perhaps use set! instead: (set! x 2)") (lint-test "(let ((a 1)) (display (f b)) (let ((b 2)) (display (+ a b))) (display c))" " let: perhaps (let ((b 2)) (display (+ a b))) -> (display (+ a 2)) let: perhaps move 'a into the inner let: (let ((a 1)) (display (f b)) (let ((b 2)) (display (+ a b))) (display c)) -> (let ((a 1) (b 2)) (display (+ a b)))") (lint-test "(let ((a 1)) (display (f b)) (let ((b (+ a 1))) (display (+ a b))) (display c))" " let: perhaps (let ((b (+ a 1))) (display (+ a b))) -> (display (+ a (+ a 1)))") (lint-test "(let ((a 1)) (f x) (let ((c 0)) (let ((b (+ c a))) (display b)) (let ((b (+ 1 a))) (display b))))" " let: perhaps (let ((b (+ c a))) (display b)) -> (display (+ c a)) let: perhaps (let ((b (+ 1 a))) (display b)) -> (display (+ 1 a)) let: perhaps move 'a into the inner let: (let ((a 1)) (f x) (let ((c 0)) (let ((b (+ c a))) (display b)) (let ((b... -> (let ((a 1) (c 0)) (let ((b (+ c a))) (display b)) (let ((b (+ 1 a)))...") (lint-test "(let ((a 1)) (display (f b)) (let ((b 2)) (do () () (display (+ a b)))) (display c))" " let: perhaps (let ((b 2)) (do () () (display (+ a b)))) -> (do ((b 2)) ...)") (lint-test "(let ((a 1)) (display (f b)) (let ((b 2)) (lambda () (display (+ a b)))) (display c))" " let: this has no effect: (lambda () (display (+ a b)))") (lint-test "(let ((a 1)) (display (f b)) (let ((b 2)) (let loop () (display (+ a b)))) (display c))" " let: loop not used, value: (let loop () (display (+ a b)))") (lint-test "(let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b))) (display c))" " let*: let* could be let: (let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b)))... let*: perhaps (let ((b 2)) (display (+ a b))) -> (display (+ a 2)) let*: perhaps move 'a into the inner let: (let* ((x 1) (a 1)) (display (f x)) (let ((b 2)) (display (+ a b)))... -> (let ((a 1) (b 2)) (display (+ a b)))") (lint-test "(lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2)) (display (f211 (+ a b))))))" " lambda: the inner function f211 could be moved outside the lambda: (lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2))... -> (let () (define (f211 x) (+ x 1)) (lambda () ...)) lambda: perhaps move 'f211 into the inner let: (lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2))... -> (let ((f211 (lambda (x) (+ x 1))) (b 2)) (display (f211 (+ a b)))) lambda: a can probably be moved to lambda's closure") (lint-test "(let () (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let ((b 2)) (display (f212 (+ a b)))))))" " let: pointless let: (let () (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let... let: perhaps (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let ((b 2))... -> (let* ((a 1) (f212 (lambda (x) (+ x 1)))) (display a) ...)") (lint-test "(lambda* ((a 1)) (define f213 (lambda (x) (+ x 1))) (let () (display a) (let ((b 2)) (display (f213 (+ a b))))))" " lambda*: the inner function f213 could be moved outside the lambda*: (lambda* ((a 1)) (define f213 (lambda (x) (+ x 1))) (let () (display a)... -> (let () (define f213 (lambda (x) (+ x 1))) (lambda* ((a 1)) ...)) lambda*: pointless let: (let () (display a) (let ((b 2)) (display (f213 (+ a b)))))") (lint-test "(let ((a 1)) (let ((f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2)))) (* a (f214 1) (f22 2))))" " let: perhaps move 'a into the inner let: (let ((a 1)) (let ((f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2))))... -> (let ((a 1) (f214 (lambda (x) (+ x 1))) (f22 (lambda (x) (+ x 2)))) (* a...") (lint-test "(define (f216 a) (define (f217 x) (+ x 1)) (display a) (let ((b 2)) (display (f217 (+ a b)))))" " define: the inner function f217 could be moved to f216's closure: (define (f216 a) (define (f217 x) (+ x 1)) (display a) (let ((b 2))... -> (define f216 (let () (define (f217 x) (+ x 1)) (lambda (a) ...))) f216: perhaps move 'f217 into the inner let: (define (f216 a) (define (f217 x) (+ x 1)) (display a) (let ((b 2))... -> (let ((f217 (lambda (x) (+ x 1))) (b 2)) (display (f217 (+ a b))))") (lint-test "(define f218 (lambda (a) (define (f219 x) (+ x 1)) (display a) (let ((b 2)) (display (f219 (+ a b))))))" " f218: the inner function f219 could be moved outside the lambda: (lambda (a) (define (f219 x) (+ x 1)) (display a) (let ((b 2)) (display... -> (let () (define (f219 x) (+ x 1)) (lambda (a) ...)) f218: perhaps move 'f219 into the inner let: (lambda (a) (define (f219 x) (+ x 1)) (display a) (let ((b 2)) (display... -> (let ((f219 (lambda (x) (+ x 1))) (b 2)) (display (f219 (+ a b))))") (lint-test "(define f220 (lambda (a) (if x (begin (define (f221 x) (+ x 1)) (display a) (let ((b 2)) (display (f221 (+ a b))))))))" " f220: perhaps (if x (begin (define (f221 x) (+ x 1)) (display a) (let ((b 2)) (display... -> (when x (define (f221 x) (+ x 1)) (display a) (let ((b 2)) (display (f221... f220: perhaps move 'f221 into the inner let: (lambda (a) (if x (begin (define (f221 x) (+ x 1)) (display a) (let ((b... -> (let ((f221 (lambda (x) (+ x 1))) (b 2)) (display (f221 (+ a b))))") (lint-test "(let* ((x (log y)) (a (+ x 1)) (a (* x 2))) (+ a 1))" " let*: let* variable a is declared twice let*: a not used, initially: (+ x 1) from let* let*: perhaps (let* ((x (log y)) (a (+ x 1)) (a (* x 2))) (+ a 1)) -> (let* ((x (log y)) (a (+ x 1))) (+ (* x 2) 1))") (lint-test "(let* ((x (log y)) (a (+ x 1)) (a (* y 2))) (+ a 1))" " let*: let* variable a is declared twice let*: a not used, initially: (+ x 1) from let* let*: perhaps restrict x which is not used in the let* body (let* ((x (log y)) (a (+ x 1)) (a (* y 2))) (+ a 1)) -> (let* ((a (let ((x (log y))) (+ x 1))) (a (* y 2))) ...) let*: perhaps substitute x into a: (let* ((x (log y)) (a (+ x 1)) (a (* y 2))) (+ a 1)) -> (let* ((a (+ (log y) 1)) (a (* y 2))) ...) let*: perhaps (let* ((x (log y)) (a (+ x 1)) (a (* y 2))) (+ a 1)) -> (let* ((x (log y)) (a (+ x 1))) (+ (* y 2) 1))") (lint-test "(let* ((x (log y)) (a (+ y 1)) (a (* x 2))) (+ a 1))" " let*: let* variable a is declared twice let*: a not used, initially: (+ y 1) from let* let*: perhaps restrict x which is not used in the let* body (let* ((x (log y)) (a (+ y 1)) (a (* x 2))) (+ a 1)) -> (let* ((a (+ y 1)) (a (let ((x (log y))) (* x 2)))) ...) let*: perhaps (let* ((x (log y)) (a (+ y 1)) (a (* x 2))) (+ a 1)) -> (let* ((x (log y)) (a (+ y 1))) (+ (* x 2) 1))") (lint-test "(let* ((x (log y)) (a (+ y 1)) (b (* x a))) (+ b 1))" " let*: perhaps restrict x, a which are not used in the let* body (let* ((x (log y)) (a (+ y 1)) (b (* x a))) (+ b 1)) -> (let ((b (let* ((a (+ y 1)) (x (log y))) (* x a)))) ...) let*: perhaps substitute a into b: (let* ((x (log y)) (a (+ y 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (b (* x (+ y 1)))) ...) let*: perhaps (let* ((x (log y)) (a (+ y 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (a (+ y 1))) (+ (* x a) 1))") (lint-test "(let* ((x (log y)) (a (+ x 1)) (b (* x a))) (+ b 1))" " let*: perhaps restrict a which is not used in the let* body (let* ((x (log y)) (a (+ x 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (b (let ((a (+ x 1))) (* x a)))) ...) let*: perhaps substitute a into b: (let* ((x (log y)) (a (+ x 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (b (* x (+ x 1)))) ...) let*: perhaps (let* ((x (log y)) (a (+ x 1)) (b (* x a))) (+ b 1)) -> (let* ((x (log y)) (a (+ x 1))) (+ (* x a) 1))") (lint-test "(let* ((a (log x)) (b (f100 a))) (* b 2))" " let*: perhaps restrict a which is not used in the let* body (let* ((a (log x)) (b (f100 a))) (* b 2)) -> (let ((b (let ((a (log x))) (f100 a)))) ...) let*: perhaps substitute a into b: (let* ((a (log x)) (b (f100 a))) (* b 2)) -> (let ((b (f100 (log x)))) ...) let*: perhaps (let* ((a (log x)) (b (f100 a))) (* b 2)) -> (let ((a (log x))) (* (f100 a) 2))") (lint-test "(let ((a (log x))) (let ((b (+ a 1))) (* b 2)))" " let: perhaps (let ((b (+ a 1))) (* b 2)) -> (* (+ a 1) 2) let: perhaps (let ((a (log x))) (let ((b (+ a 1))) (* b 2))) -> (let* ((a (log x)) (b (+ a 1))) (* b 2))") (lint-test "(let* ((a (log x)) (b (log y)) (c (+ a b))) (* c 2))" " let*: perhaps restrict a, b which are not used in the let* body (let* ((a (log x)) (b (log y)) (c (+ a b))) (* c 2)) -> (let ((c (let* ((b (log y)) (a (log x))) (+ a b)))) ...) let*: perhaps substitute b into c: (let* ((a (log x)) (b (log y)) (c (+ a b))) (* c 2)) -> (let* ((a (log x)) (c (+ a (log y)))) ...) let*: perhaps (let* ((a (log x)) (b (log y)) (c (+ a b))) (* c 2)) -> (let* ((a (log x)) (b (log y))) (* (+ a b) 2))") (lint-test "(let* ((a (log x)) (b (read)) (c (+ a b))) (* 2 c))" " let*: perhaps restrict a, b which are not used in the let* body (let* ((a (log x)) (b (read)) (c (+ a b))) (* 2 c)) -> (let ((c (let* ((b (read)) (a (log x))) (+ a b)))) ...) let*: perhaps substitute b into c: (let* ((a (log x)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (log x)) (c (+ a (read)))) ...) let*: perhaps (let* ((a (log x)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (log x)) (b (read))) (* 2 (+ a b)))") (lint-test "(let* ((a (read)) (b (read)) (c (+ a b))) (* 2 c))" " let*: perhaps restrict b which is not used in the let* body (let* ((a (read)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (read)) (c (let ((b (read))) (+ a b)))) ...) let*: perhaps substitute b into c: (let* ((a (read)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (read)) (c (+ a (read)))) ...) let*: perhaps (let* ((a (read)) (b (read)) (c (+ a b))) (* 2 c)) -> (let* ((a (read)) (b (read))) (* 2 (+ a b)))") (lint-test "(let ((x (log y))) (let ((z (+ x y))) (* z 2)))" " let: perhaps (let ((z (+ x y))) (* z 2)) -> (* (+ x y) 2) let: perhaps (let ((x (log y))) (let ((z (+ x y))) (* z 2))) -> (let* ((x (log y)) (z (+ x y))) (* z 2))") (lint-test "(let* ((a (read)) (b (read)) (c (* a 2))) (+ c b))" " let*: perhaps (let* ((a (read)) (b (read)) (c (* a 2))) (+ c b)) -> (let* ((a (read)) (b (read))) (+ (* a 2) b))") (lint-test "(let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d))" " let*: perhaps restrict b which is not used in the let* body (let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d)) -> (let* ((a (read)) (c (let ((b (read))) (* b 2))) (d (* a 2))) ...) let*: perhaps split this let*: (let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d)) -> (let* ((a (read)) (b (read))) (let ((c (* b 2)) (d (* a 2))) ...)) let*: perhaps substitute b into c: (let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d)) -> (let* ((a (read)) (c (* (read) 2)) (d (* a 2))) ...) let*: perhaps (let* ((a (read)) (b (read)) (c (* b 2)) (d (* a 2))) (+ c d)) -> (let* ((a (read)) (b (read)) (c (* b 2))) (+ c (* a 2)))") (lint-test "(let* ((x (f a)) (y (car x)) (z (cadr x)) (w (caddr x))) (g x y z w))" " let*: perhaps split this let*: (let* ((x (f a)) (y (car x)) (z (cadr x)) (w (caddr x))) (g x y z w)) -> (let ((x (f a))) (let ((y (car x)) (z (cadr x)) (w (caddr x))) ...)) let*: perhaps (let* ((x (f a)) (y (car x)) (z (cadr x)) (w (caddr x))) (g x y z w)) -> (let* ((x (f a)) (y (car x)) (z (cadr x))) (g x y z (caddr x)))") (lint-test "(let* ((x (f a)) (y (car x)) (x (cadr x)) (w (caddr x))) (g x y z w))" " let*: let* variable x is declared twice let*: perhaps (let* ((x (f a)) (y (car x)) (x (cadr x)) (w (caddr x))) (g x y z w)) -> (let* ((x (f a)) (y (car x)) (x (cadr x))) (g x y z (caddr x)))") (lint-test "(let* ((x (f a)) (y (display x)) (z (cadr x)) (w (caddr x))) (g x y z w))" " let*: perhaps split this let*: (let* ((x (f a)) (y (display x)) (z (cadr x)) (w (caddr x))) (g x y z w)) -> (let* ((x (f a)) (y (display x))) (let ((z (cadr x)) (w (caddr x))) ...)) let*: perhaps (let* ((x (f a)) (y (display x)) (z (cadr x)) (w (caddr x))) (g x y z w)) -> (let* ((x (f a)) (y (display x)) (z (cadr x))) (g x y z (caddr x)))") (lint-test "(let* ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i)))" " let*: let* could be let: (let* ((a 1)) (do ((i a (+ i 1))) ((= i 3)) (display i)))") (lint-test "(let* ((z (log w)) (x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x)))" " let*: perhaps (let* ((z (log w)) (x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x))) -> (let ((z (log w))) (do ((x (log z)) (i 0 (+ x z))) ...))") (lint-test "(let* ((x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x)))" " let*: let* could be let: (let* ((x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x))) let*: perhaps (let* ((x (log z))) (do ((i 0 (+ x z))) ((= i 3)) (display x))) -> (do ((x (log z)) (i 0 (+ x z))) ...)") (lint-test "(let* ((a (log b)) (z (log w)) (x (log z))) (do ((i 0 (+ x z a))) ((= i 3)) (display x)))" " let*: perhaps split this let*: (let* ((a (log b)) (z (log w)) (x (log z))) (do ((i 0 (+ x z a))) ((= i... -> (let ((z (log w))) (let ((a (log b)) (x (log z))) ...)) let*: perhaps (let* ((a (log b)) (z (log w)) (x (log z))) (do ((i 0 (+ x z a))) ((= i... -> (let* ((a (log b)) (z (log w))) (do ((x (log z)) (i 0 (+ x z a))) ...))") (lint-test "(let* ((z (log w)) (x (log z))) (do () ((= i 3) z) (display x)))" " let*: perhaps (let* ((z (log w)) (x (log z))) (do () ((= i 3) z) (display x))) -> (let ((z (log w))) (do ((x (log z))) ...))") (lint-test "(let* ((x (log z))) (do () ((= i 3) z) (display x)))" " let*: let* could be let: (let* ((x (log z))) (do () ((= i 3) z) (display x))) let*: perhaps (let* ((x (log z))) (do () ((= i 3) z) (display x))) -> (do ((x (log z))) ...)") (lint-test "(let* ((a (log b)) (z (log w)) (x (log z))) (do () ((= i 3) (+ a z)) (display x)))" " let*: perhaps split this let*: (let* ((a (log b)) (z (log w)) (x (log z))) (do () ((= i 3) (+ a z))... -> (let ((z (log w))) (let ((a (log b)) (x (log z))) ...)) let*: perhaps (let* ((a (log b)) (z (log w)) (x (log z))) (do () ((= i 3) (+ a z))... -> (let* ((a (log b)) (z (log w))) (do ((x (log z))) ...))") (lint-test "(let* ((a 1) (b (f a)) (c 2) (e 0) (d (g (+ a b c)))) (display d) (* a b c d e))" " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (e 0) (d (g (+ a b c)))) (display d) (* a b c... -> (let ((a 1) (c 2) (e 0)) (let* ((b (f a)) (d (g (+ a b c)))) ...))") (lint-test "(let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1))) (display d) (* a b c d e))" " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1))) (display d) (*... -> (let ((a 1) (c 2)) (let* ((b (f a)) (d (g (+ a b c))) (e (+ d 1))) ...))") (lint-test "(let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2))) (display d) (* a b c d e f))" " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (c 2) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2)))... -> (let ((a 1) (c 2)) (let* ((b (f a)) (d (g (+ a b c)))) (let ((e (+ d 1)) (f (+ d 2))) ...)))") (lint-test "(let* ((a 1) (b (f a)) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d e f))" " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (d (g (+ a b c))) (e (+ d 1)) (f (+ d 2))) (display... -> (let* ((a 1) (b (f a)) (d (g (+ a b c)))) (let ((e (+ d 1)) (f (+ d 2))) ...))") (lint-test "(let* ((a 1) (b (f a)) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d e f))" " let*: perhaps split this let*: (let* ((a 1) (b (f a)) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a b d... -> (let ((a 1) (d 3)) (let ((b (f a))) (let ((e (+ d 1)) (f (+ d 2))) ...)))") (lint-test "(let* ((a 1) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a d e f))" " let*: perhaps split this let*: (let* ((a 1) (d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* a d e f)) -> (let ((a 1) (d 3)) (let ((e (+ d 1)) (f (+ d 2))) ...))") (lint-test "(let* ((d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* d e f))" " let*: perhaps split this let*: (let* ((d 3) (e (+ d 1)) (f (+ d 2))) (display d) (* d e f)) -> (let ((d 3)) (let ((e (+ d 1)) (f (+ d 2))) ...))") (lint-test "(let* ((d 3) (e (+ d 1))) (display d) (* d e))" "") (lint-test "(let* ((a 3) (b (set! c 1)) (c 3)) (display a) (* a b c))" " let*: perhaps split this let*: (let* ((a 3) (b (set! c 1)) (c 3)) (display a) (* a b c)) -> (let ((b (set! c 1))) (let ((a 3) (c 3)) ...))") (lint-test "(let* ((f 3) (a (set! c 1)) (c 3) (b 4) (d 5)) (display a) (* a c b d f))" " let*: perhaps split this let*: (let* ((f 3) (a (set! c 1)) (c 3) (b 4) (d 5)) (display a) (* a c b d f)) -> (let ((f 3) (b 4) (d 5)) (let* ((a (set! c 1)) (c 3)) ...))") (lint-test "(let* ((f (+ a 1)) (a (+ c 1)) (c 3)) (display a) (* a c f))" "") (lint-test "(letrec () 1)" " letrec: letrec could be let: (letrec () 1)") (lint-test "(letrec* ((a (lambda b (a 1)))) a)" " letrec*: letrec* could be letrec: (letrec* ((a (lambda b (a 1)))) a)") (lint-test "(letrec* ((x 12) (x y)) x)" " letrec*: letrec* could be let*: (letrec* ((x 12) (x y)) x) letrec*: letrec* variable x is declared twice letrec*: x not used, initially: 12 from letrec*") (lint-test "(letrec ((x x)) x)" " letrec: (x x) is the same as (x #) in letrec") (lint-test "(letrec* ((x x)) x)" " letrec*: letrec* could be letrec: (letrec* ((x x)) x) letrec*: (x x) is the same as (x #) in letrec*") (lint-test "(letrec* ((x 1) (y (log 2))) (+ (g x) y))" " letrec*: letrec* could be let: (letrec* ((x 1) (y (log 2))) (+ (g x) y))") (lint-test "(letrec ((f (lambda (z) (+ (f z) 1)))) (lambda (x) (* (f x) x)))" " letrec: perhaps (letrec ((f (lambda (z) (+ (f z) 1)))) (lambda (x) (* (f x) x))) -> (lambda (x) (* (let f ((z x)) (+ (f z) 1)) x))") (lint-test "(begin . 1)" " begin: stray dot in begin? (begin . 1)") (lint-test "(begin (map abs x) #f)" " begin: this could be omitted: (map abs x)") (lint-test "(begin (map display x) #f)" " begin: map could be for-each: (for-each display x)") (lint-test "(begin 1 #f)" " begin: this could be omitted: 1") (lint-test "(begin (+ x y) 3)" " begin: this could be omitted: (+ x y)") (lint-test "(begin (display 1) (begin #f))" " begin: redundant begin: (begin #f) begin: begin could be omitted: (begin #f)") (lint-test "(begin (lambda (x) (log x 4)) 32)" " begin: this has no effect: (lambda (x) (log x 4))") (lint-test "(let () (display 1) (begin (display 1) #f))" " let: let could be begin: (let () (display 1) (begin (display 1) #f)) -> (begin (display 1) (begin (display 1) #f)) let: redundant begin: (begin (display 1) #f)") (lint-test "(if (< x 1) (begin x) y)" " if: begin could be omitted: (begin x)") (lint-test "(if (< x 1) (begin (display 1) x) y)" "") (lint-test "(let ((menu (lw6-current-menu))) (if menu (begin #f)))" " let: perhaps (let ((menu (lw6-current-menu))) (if menu (begin #f))) -> (if (lw6-current-menu) (begin #f)) let: perhaps (if menu (begin #f)) -> (when menu #f) let: begin could be omitted: (begin #f)") (lint-test "(let ((menu (lw6-current-menu))) (when menu (begin #f)))" " let: perhaps (let ((menu (lw6-current-menu))) (when menu (begin #f))) -> (when (lw6-current-menu) (begin #f)) let: redundant begin: (begin #f) let: begin could be omitted: (begin #f)") (lint-test "(let ((vec (vector-ref matrix x))) (if vec (vector-set! (vector-ref matrix x) y value)))" " let: perhaps (let ((vec (vector-ref matrix x))) (if vec (vector-set! (vector-ref matrix... -> (if (vector-ref matrix x) (vector-set! (vector-ref matrix x) y value)) let: perhaps (vector-set! (vector-ref matrix x) y value) -> (set! (matrix x y) value)") (lint-test "(let ((menu (g-menu))) (if menu (display #f)) 32)" " let: perhaps (let ((menu (g-menu))) (if menu (display #f)) 32) -> (let () (if (g-menu) (display #f)) 32)") (lint-test "(let ((menu (g-menu))) (cond (menu (display menu)) (else (display x))) 32)" " let: perhaps (let ((menu (g-menu))) (cond (menu (display menu)) (else (display x))) 32) -> (let () (cond ((g-menu) => display) (else (display x))) 32) let: perhaps (cond (menu (display menu)) (else (display x))) -> (display (if menu menu x)) let: perhaps use => here: (menu (display menu)) -> (menu => display)") (lint-test "(let ((A (abs x)) (B (abs y))) (if A (f A)))" " let: perhaps (let ((A (abs x)) (B (abs y))) (if A (f A))) -> (let ((B (abs y))) (cond ((abs x) => f))) let: B not used, initially: (abs y) from let let: A is never #f, so (if A (f A)) -> (f A)") (lint-test "(format)" " format: format needs at least 2 arguments: (format) format: format has too few arguments: (format)") (lint-test "(format \"buffer?\")" " format: format needs at least 2 arguments: (format \"buffer?\") format: in (format \"buffer?\"), format's argument should be an output-port or a boolean, but \"buffer?\" is a string? format: perhaps (format \"buffer?\") -> \"buffer?\"") (lint-test "(format (format #f str))" " format: format needs at least 2 arguments: (format (format #f str)) format: in (format (format #f str)), format's argument should be an output-port or a boolean, but (format #f str) is a string? format: redundant format: (format (format #f str))") (lint-test "(format #f \"~H\" 1)" " format: unrecognized format directive: H in \"~H\", (format #f \"~H\" 1)") (lint-test "(format #f \"~^\")" " format: ~^ has ~^ outside ~{~}?") (lint-test "(format #f \"~A\")" " format: format has too few arguments: (format #f \"~A\")") (lint-test "(format #f \"~A\" 1 2)" " format: format has too many arguments: (format #f \"~A\" 1 2)") (lint-test "(format #f \"asdf~\")" " format: format control string ends in tilde: (format #f \"asdf~\")") (lint-test "(format #f \"~{~A\" 1)" " format: format has 1 unmatched {: (format #f \"~{~A\" 1)") (lint-test "(format #f \"123\")" " format: (format #f \"123\") could be \"123\", (format is a no-op here)") (lint-test "(format #f \"~nD\" 1 2)" "") (lint-test "(format #f \"~n,nD\" 1 2 3)" "") (lint-test "(format #f \"~%~&\")" " format: ~%~& in ~%~& could be ~%") (lint-test "(format #f \"~~%~&\")" "") (lint-test "(format #f \"1~%~&2\")" " format: ~%~& in 1~%~&2 could be ~%") (lint-test "(format #f \"~nT\" 1 2)" " format: format has too many arguments: (format #f \"~nT\" 1 2)") (lint-test "(format #f \"~nD\" 1)" " format: format has too few arguments: (format #f \"~nD\" 1)") (lint-test "(format 1)" " format: format needs at least 2 arguments: (format 1) format: in (format 1), format's argument should be an output-port or a boolean, but 1 is an integer? format: format with one argument takes a string: (format 1)") (lint-test "(format #f \"~NC ~W\" 1 #\\c 2)" "") (lint-test "(format #f \"~4,3F\" x)" "") (lint-test "(format #f \"~32T\")" "") (lint-test "(format #f \"~a\\x00;b\" x)" " format: #\\null in a format control string will confuse both lint and format: \"~a\\x00;b\" in (format #f \"~a\\x00;b\" x)") (lint-test "(let () (format #t \"~A\" x) x)" " let: let could be begin: (let () (format #t \"~A\" x) x) -> (begin (format #t \"~A\" x) x) let: perhaps use () with format since the string value is discarded: (format () \"~A\" x)") (lint-test "(format #f \"~A\" (number->string x))" " format: format argument (number->string x) could be x") (lint-test "(format #f \"~A\" (number->string x 16))" " format: format argument (number->string x 16) could use the format directive ~X and change the argument to x") (lint-test "(format #f \"~A\" (symbol->string 'x))" " format: format argument (symbol->string 'x) could be 'x format: perhaps (symbol->string 'x) -> \"x\"") (lint-test "(format #f \"~A\" (make-string len c))" " format: format argument (make-string len c) could use the format directive ~NC and change the argument to ... len c ...") (lint-test "(format #f \"~A\" (make-string len #\\space))" " format: format argument (make-string len #\\space) could use the format directive ~NC and change the argument to ... len #\\space ...") (lint-test "(f \"*****************************\")" " f: perhaps \"*****************************\" -> (format #f \"~NC\" 29 #\\*)") (lint-test "(format #f \"~A~%\" (apply string-append x))" " format: use ~{...~} rather than string-append: (apply string-append x)") (lint-test "(format #f \"~A\" (symbol->string x))" " format: format argument (symbol->string x) could be x") (lint-test "(format #f \"~S\" (symbol->string x))" "") (lint-test "(format #f \"~A\" (string->symbol x))" " format: perhaps (format #f \"~A\" (string->symbol x)) -> (object->string (string->symbol x) #f) format: format argument (string->symbol x) could be x") (lint-test "(format #f \"~A\" x)" " format: perhaps (format #f \"~A\" x) -> (object->string x #f)") (lint-test "(format #f \"~S\" x)" " format: perhaps (format #f \"~S\" x) -> (object->string x)") (lint-test "(format t \" \")" " format: 't in (format t \" \") should probably be #t") (lint-test "(format #f \"~A ~S\" (symbol->string x) (string->symbol x))" " format: format argument (symbol->string x) could be x") (lint-test "(format #f \"~S~A\" (symbol->string x) (string->symbol x))" " format: format argument (string->symbol x) could be x") (lint-test "(format #f \"this is~% a test~%\")" "format: format is not needed in (format #f \"this is~% a test~%\"): perhaps use \"this is\\n a test\\n\" instead") (lint-test "(format p \"~%~S\" (object->string (car expr) #t 60))" "") (lint-test "(format #f \"~12,'-T~A\" 123)" "") (lint-test "(for-each (lambda (x) (display x)) args)" " for-each: perhaps (for-each (lambda (x) (display x)) args) -> (format () \"~{~A~}\" args) for-each: perhaps (lambda (x) (display x)) -> display") (lint-test "(for-each (lambda (x) (display #\\space) (write x)) args)" " for-each: perhaps (for-each (lambda (x) (display #\\space) (write x)) args) -> (format () \"~{ ~S~}\" args)") (lint-test "(for-each (lambda (x) (newline port) (write-char x port)) args)" " for-each: perhaps (for-each (lambda (x) (newline port) (write-char x port)) args) -> (format port \"~{~%~C~}\" args)") (lint-test "(for-each (lambda (x) (newline port) (display (number->string x 16) port)) args)" " for-each: perhaps (for-each (lambda (x) (newline port) (display (number->string x 16) port))... -> (format port \"~{~%~X~}\" args)") (lint-test "(values 1)" " values: perhaps (values 1) -> 1") (lint-test "(call-with-values p c)" " call-with-values: perhaps (call-with-values p c) -> (c (p))") (lint-test "(call-with-values log c)" " call-with-values: log does not return multiple values") (lint-test "(call-with-values (lambda x 0) list)" " call-with-values: (lambda x 0)'s parameter x will always be ()") (lint-test "(call-with-values (lambda (x) 0) list)" " call-with-values: (lambda (x) 0) requires too many arguments") (lint-test "(call-with-values (lambda () (f x)) cons)" " call-with-values: perhaps (call-with-values (lambda () (f x)) cons) -> (cons (f x))") (lint-test "(call-with-values (lambda () (read-char p)) cons)" " call-with-values: (read-char p) does not return multiple values") (lint-test "(call-with-values (lambda () (values 1 2 3)) list)" " call-with-values: perhaps (call-with-values (lambda () (values 1 2 3)) list) -> (list 1 2 3)") (lint-test "(call-with-values (lambda () (values 1 2)) abs)" " call-with-values: call-with-values consumer abs wants 1 value, but producer (lambda () (values 1 2)) returns 2 call-with-values: perhaps (call-with-values (lambda () (values 1 2)) abs) -> (abs 1 2)") (lint-test "(let () (define (fv a) (values (+ a 1) (- a 1))) (define (fw a b) (list (+ a 1) b)) (fw (fv 1)))" "") (lint-test "(let () (define (fv a) (values (+ a 1) (- a 1))) (list (fv 1)))" " let: perhaps (... (define (fv a) (values (+ a 1) (- a 1))) (list (fv 1))) -> (... (list (let ((a 1)) (values (+ a 1) (- a 1)))))") (unless (provided? 'snd) (lint-test "(let () (define (fv) (values 1 -1)) (call-with-values fv list))" " let: perhaps (call-with-values fv list) -> (list (fv))") (lint-test "(let () (define (fv) (values 1 -1)) (define (fw a b) (list (+ a 1) b)) (call-with-values fv fw))" " let: perhaps (call-with-values fv fw) -> (fw (fv))")) (lint-test "(receive (value submitter) (current-input-status elt) #f)" " receive: perhaps (call-with-values (lambda () (current-input-status elt)) (lambda (value... -> ((lambda (value submitter) #f) (current-input-status elt))") (lint-test "(multiple-value-bind (a b) (f) b)" " multiple-value-bind: perhaps (multiple-value-bind (a b) (f) b) -> ((lambda (a b) b) (f))") (lint-test "(multiple-value-bind (a b) (values 2 3) b)" " multiple-value-bind: perhaps (multiple-value-bind (a b) (values 2 3) b) -> ((lambda (a b) b) (values 2 3))") (lint-test "(multiple-value-bind (a b c d) (values 2 (values 3 4) 5) (+ a b c d))" " multiple-value-bind: perhaps (multiple-value-bind (a b c d) (values 2 (values 3 4) 5) (+ a b c d)) -> ((lambda (a b c d) (+ a b c d)) (values 2 (values 3 4) 5)) multiple-value-bind: perhaps (values 2 (values 3 4) 5) -> (values 2 3 4 5)") (lint-test "(multiple-value-bind (a b) (values 1 2 3) b)" " multiple-value-bind: multiple-value-bind wants 2 values, but (values 1 2 3) returns 3 multiple-value-bind: perhaps (multiple-value-bind (a b) (values 1 2 3) b) -> ((lambda (a b) b) (values 1 2 3))") (lint-test "(multiple-value-bind (a b) (f) (cons a b))" " multiple-value-bind: perhaps (multiple-value-bind (a b) (f) (cons a b)) -> (cons (f))") (lint-test "(multiple-value-bind (a b) (values 1 2) (cons a b))" " multiple-value-bind: perhaps (multiple-value-bind (a b) (values 1 2) (cons a b)) -> (cons (values 1 2))") (lint-test "(multiple-value-bind (a b) (f) b)" " multiple-value-bind: perhaps (multiple-value-bind (a b) (f) b) -> ((lambda (a b) b) (f))") (lint-test "(let () (define (f1) (values 2 3 4)) (multiple-value-bind (a b) (f1) (+ a b)))" " let: perhaps (... (define (f1) (values 2 3 4)) (multiple-value-bind (a b) (f1) (+ a b))) -> (... (multiple-value-bind (a b) (values 2 3 4) (+ a b))) let: multiple-value-bind wants 2 values, but (f1) returns 3 let: perhaps (multiple-value-bind (a b) (f1) (+ a b)) -> ((lambda (a b) (+ a b)) (f1))") (lint-test "(let () (define (f1) (values 2)) (multiple-value-bind (a b) (f1) (+ a b)))" " let: perhaps (... (define (f1) (values 2)) (multiple-value-bind (a b) (f1) (+ a b))) -> (... (multiple-value-bind (a b) (values 2) (+ a b))) f1: perhaps (values 2) -> 2 let: multiple-value-bind wants 2 values, but (f1) returns 1 let: perhaps (multiple-value-bind (a b) (f1) (+ a b)) -> ((lambda (a b) (+ a b)) (f1))") (lint-test "(let () (multiple-value-bind (a b) ((lambda () (values 1 2 3))) (+ a b)))" " let: pointless let: (let () (multiple-value-bind (a b) ((lambda () (values 1 2 3))) (+ a b))) let: multiple-value-bind wants 2 values, but ((lambda () (values 1 2 3))) returns 3 let: perhaps (multiple-value-bind (a b) ((lambda () (values 1 2 3))) (+ a b)) -> ((lambda (a b) (+ a b)) ((lambda () (values 1 2 3)))) let: perhaps ((lambda () (values 1 2 3))) -> (values 1 2 3)") (lint-test "(let*-values (((a b) (f x))) (+ a b))" " let*-values: perhaps (let*-values (((a b) (f x))) (+ a b)) -> ((lambda (a b) (+ a b)) (f x))") (lint-test "(let*-values (((a) (f x))) (+ a b))" " let*-values: perhaps (let*-values (((a) (f x))) (+ a b)) -> (let ((a (f x))) (+ a b))") (lint-test "(let*-values ((a (f x))) (apply + a))" " let*-values: perhaps (let*-values ((a (f x))) (apply + a)) -> ((lambda a (apply + a)) (f x))") (lint-test "(let*-values (((a b) (f x)) ((c) (g y))) (+ a b c))" " let*-values: perhaps (let*-values (((a b) (f x)) ((c) (g y))) (+ a b c)) -> ((lambda (a b) (let ((c (g y))) (+ a b c))) (f x))") (lint-test "(let*-values (((a) (f x)) ((c d) (g y))) (display c) (+ a b c))" " let*-values: perhaps (let*-values (((a) (f x)) ((c d) (g y))) (display c) (+ a b c)) -> (let ((a (f x))) ((lambda (c d) (display c) (+ a b c)) (g y)))") (lint-test "(let*-values (((a . b) (f x)) (c (g y))) (display c) (+ a b c))" " let*-values: perhaps (let*-values (((a . b) (f x)) (c (g y))) (display c) (+ a b c)) -> ((lambda (a . b) ((lambda c (display c) (+ a b c)) (g y))) (f x))") (lint-test "(let*-values (((a . b) (f x)) (c (g y)) ((d e f) (h a b))) (display c) (+ a b c))" " let*-values: perhaps (let*-values (((a . b) (f x)) (c (g y)) ((d e f) (h a b))) (display c) (+... -> ((lambda (a . b) ((lambda c ((lambda (d e f) (display c) (+ a b c)) (h a b))) (g y))) (f x))") (lint-test "(let-values (((x) (values 1))) x)" " let-values: perhaps (let-values (((x) (values 1))) x) -> ((lambda (x) x) (values 1)) let-values: perhaps (values 1) -> 1") (lint-test "(let-values ((x (values 1))) x)" " let-values: perhaps (let-values ((x (values 1))) x) -> ((lambda x x) (values 1)) let-values: perhaps (values 1) -> 1") (lint-test "(let-values (((x) (values 1)) ((y) (values 2))) (list x y))" " let-values: perhaps (let-values (((x) (values 1)) ((y) (values 2))) (list x y)) -> (with-let (apply sublet (curlet) (list ((lambda (x) (values :x x)) (values 1)) ((lambda (y) (values :y y)) (values 2)))) (list x y)) let-values: perhaps (values 1) -> 1 let-values: perhaps (values 2) -> 2") (lint-test "(let ((x 32)) (let-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y)))" " let: perhaps (let-values (((x) (values 1)) ((y) (values (+ x 1)))) (list x y)) -> (with-let (apply sublet (curlet) (list ((lambda (x) (values :x x)) (values 1)) ((lambda (y) (values :y y)) (values (+ x 1))))) (list x y)) let: perhaps (values 1) -> 1 let: perhaps (values (+ x 1)) -> (+ x 1)") (lint-test "(let-values (((x y) (values 1 2))) (list x y))" " let-values: perhaps (let-values (((x y) (values 1 2))) (list x y)) -> ((lambda (x y) (list x y)) (values 1 2))") (lint-test "(let ((d 32)) (let-values (((a) 1) ((c d e) (values 3 4 5)) ((b) d)) (+ a b (* c d e))))" " let: perhaps (let-values (((a) 1) ((c d e) (values 3 4 5)) ((b) d)) (+ a b (* c d e))) -> (with-let (apply sublet (curlet) (list ((lambda (a) (values :a a)) 1) ((lambda (c d e) (values :c c :d d :e e)) (values 3 4 5)) ((lambda (b) (values :b b)) d))) (+ a b (* c d e)))") (lint-test "(let ((a 32) (b -1)) (let-values (((a b) (values 1 2)) ((x y) (values a b))) (list a b x y)))" " let: perhaps (let-values (((a b) (values 1 2)) ((x y) (values a b))) (list a b x y)) -> (with-let (apply sublet (curlet) (list ((lambda (a b) (values :a a :b b)) (values 1 2)) ((lambda (x y) (values :x x :y y)) (values a b)))) (list a b x y))") (lint-test "(let () (define-values (x y) (values 3 2)) (+ x y))" " let: perhaps (define-values (x y) (values 3 2)) -> (varlet (curlet) ((lambda (x y) (curlet)) (values 3 2)))") (lint-test "(define (sequence-map/maker maker proc seq . opts) (let-optionals opts ((start 0) (end (sequence-length seq))) maker))" " define: perhaps (define (sequence-map/maker maker proc seq . opts) (let-optionals opts... -> (define* (sequence-map/maker maker proc seq (start 0) (end (sequence-length seq))) ...)") (lint-test "(open-output-file x \"fb+\")" " open-output-file: unexpected mode: (open-output-file x \"fb+\")") (lint-test "(vector 1 2 . 3)" " vector: unexpected dot: (vector 1 2 . 3)") (lint-test "(begin (display x) (newline) (display y) (newline))" " begin: perhaps (... (display x) (newline) (display y) (newline)) -> (format () \"~A~%~A~%\" x y)") (lint-test "(begin (display x) (newline) (display y) (newline) 32)" " begin: perhaps (... (display x) (newline) (display y) (newline)) -> (format () \"~A~%~A~%\" x y)") (lint-test "(begin (write x p) (newline p) (write-char #\\a p) (write-string \"bc\" p))" " begin: perhaps (... (write x p) (newline p) (write-char #\\a p) (write-string \"bc\" p)) -> (format p \"~S~%abc\" x)") (lint-test "(begin (newline) (set! x 1) (display x) (newline) (newline))" " begin: perhaps (... (display x) (newline) (newline)) -> (format () \"~A~%~%\" x)") (lint-test "(begin (write-string x p y z) (write-string \"1234\" p 1) (write-string \"5678\" p 2 3) (write-string \"abc\" p 2 z))" " begin: perhaps (... (write-string x p y z) (write-string \"1234\" p 1) (write-string \"5678\"... -> (format p \"~A2347~A\" (substring x y z) (substring \"abc\" 2 z))") (lint-test "(display x #f)" " display: (display x #f) could be x") (lint-test "(read-line in-port 'concat)" "read-line: in (read-line in-port 'concat), read-line's second argument should be a boolean, but 'concat is a symbol? read-line: the third argument should be boolean (#f=default, #t=include trailing newline): (read-line in-port 'concat)") (lint-test "(begin (display (number->string x)) (display #\\space) (display (number->string y 8)))" " begin: perhaps (... (display (number->string x)) (display #\\space) (display... -> (format () \"~A ~O\" x y)") (lint-test "(let ((f2 (lambda (x) (display (+ x 1))))) (f2 1) (f2 3) (f2 4))" " let: perhaps (let ((f2 (lambda (x) (display (+ x 1))))) (f2 1) (f2 3) (f2 4)) -> (for-each (lambda (x) (display (+ x 1))) '(1 3 4))") (lint-test "(let ((f2 (lambda (x) (display x)))) (f2 'a) (f2 'b) (f2 'c))" " let: perhaps (lambda (x) (display x)) -> display let: perhaps (let ((f2 (lambda (x) (display x)))) (f2 'a) (f2 'b) (f2 'c)) -> (for-each (lambda (x) (display x)) '(a b c))") (lint-test "(let ((f2 (lambda (x) (display (+ x 1))))) (f2 a) (f2 b) (f2 (f c)))" " let: perhaps (let ((f2 (lambda (x) (display (+ x 1))))) (f2 a) (f2 b) (f2 (f c))) -> (for-each (lambda (x) (display (+ x 1))) (list a b (f c)))") (lint-test "(+ 1 (begin (x y) #\\a))" " +: in (+ 1 (begin (x y) #\\a)), +'s second argument should be a number, but #\\a is a char?") (lint-test "(+ 1 (cond ((x 1) 3) ((x 2) 1+i) ((x 3) '(1 2))))" " +: in (+ 1 (cond ((x 1) 3) ((x 2) 1.0+1.0i) ((x 3) '(1 2)))), +'s second argument should be a number, but '(1 2) is a pair?") (lint-test "(+ 1 (cond ((x 1) 3) ((x 2) 1+i) ((x 3) 1/2)))" "") (lint-test "(substring x 0)" " substring: perhaps clearer: (substring x 0) -> (copy x)") (lint-test "(substring (substring x 1) 2)" " substring: perhaps (substring (substring x 1) 2) -> (substring x 3)") (lint-test "(substring (substring x 2 6) 1)" " substring: perhaps (substring (substring x 2 6) 1) -> (substring x 3 6)") (lint-test "(substring (substring x 2) 1 6)" " substring: perhaps (substring (substring x 2) 1 6) -> (substring x 3 8)") (lint-test "(substring (substring x 2 6) 1 3)" " substring: perhaps (substring (substring x 2 6) 1 3) -> (substring x 3 5)") (lint-test "(substring (substring x 2) 1 4)" " substring: perhaps (substring (substring x 2) 1 4) -> (substring x 3 6)") (lint-test "(substring (substring x x1) x2 y2)" " substring: perhaps (substring (substring x x1) x2 y2) -> (substring x (+ x2 x1) (+ y2 x1))") (lint-test "(substring x (+ y 1) (+ y 1))" " substring: leaving aside errors, (substring x (+ y 1) (+ y 1)) is \"\"") (lint-test "(substring x 0 (length x))" " substring: perhaps (substring x 0 (length x)) -> (substring x 0)") (lint-test "(let ((len (string-length x))) (substring x 1 len))" " let: perhaps (let ((len (string-length x))) (substring x 1 len)) -> (substring x 1 (string-length x)) let: perhaps, if len is still (string-length x), (substring x 1 len) -> (substring x 1)") (lint-test "(substring (string-append str (make-string len #\\space)) 0 len)" " substring: perhaps (substring (string-append str (make-string len #\\space)) 0 len) -> (copy str (make-string len #\\space))") (lint-test "(substring \"--------\" x)" " substring: perhaps (substring \"--------\" x) -> (make-string (- 8 x) #\\-)") (lint-test "(substring \"--------\" x y)" " substring: perhaps (substring \"--------\" x y) -> (make-string (- y x) #\\-)") (lint-test "(list-tail x 0)" " list-tail: perhaps (list-tail x 0) -> x") (lint-test "(list-tail x 1)" " list-tail: perhaps (list-tail x 1) -> (cdr x)") (lint-test "(list-tail x 2)" " list-tail: perhaps (list-tail x 2) -> (cddr x)") (lint-test "(list-tail (list-tail x 1) 2)" " list-tail: perhaps (list-tail (list-tail x 1) 2) -> (list-tail x 3) list-tail: perhaps (list-tail x 1) -> (cdr x)") (lint-test "(list-tail (list-tail x y) z)" " list-tail: perhaps (list-tail (list-tail x y) z) -> (list-tail x (+ y z))") (lint-test "(list (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)))" " list: perhaps (list (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f (g x y) z (* a b)) (f... -> (let ((<1> (lambda () (f (g x y) z (* a b))))) (list (<1>) (<1>) (<1>) (<1>)))") (lint-test "(list (f 'a) (f 'b) (f 'c))" " list: perhaps (list (f 'a) (f 'b) (f 'c)) -> (map f '(a b c))") (lint-test "(list (f a) (f b) (f c))" " list: perhaps (list (f a) (f b) (f c)) -> (map f (list a b c))") (lint-test "(vector 12 12 12 12 12 12)" " vector: perhaps (vector 12 12 12 12 12 12) -> (make-vector 6 12)") (lint-test "(vector (car x) (car x) (car x) (car x))" " vector: perhaps (vector (car x) (car x) (car x) (car x)) -> (make-vector 4 (car x))") (lint-test "(vector #(1 2) #(1 2) #(1 2) #(1 2))" " vector: perhaps (vector #(1 2) #(1 2) #(1 2) #(1 2)) -> (make-vector 4 #(1 2)) or wrap (copy #(1 2)) in a function and call that 4 times vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2) vector: #(1 2) could be #i(1 2)") (lint-test "((list 1 2 3) x)" " (list 1 2 3): perhaps use vector here: ((list 1 2 3) x)") (lint-test "(int-vector 0 0 0 0)" " int-vector: perhaps (int-vector 0 0 0 0) -> (make-int-vector 4)") (lint-test "(unless x)" " unless: unless is messed up: (unless x)") (lint-test "(unless (abs x) #f)" " unless: unless test is never false: (unless (abs x) #f)") (lint-test "(with-let x)" " with-let: with-let is messed up: (with-let x)") (lint-test "(with-let (curlet) x)" " with-let: with-let is not needed here: (with-let (curlet) x)") (lint-test "(object->string x y)" "") (lint-test "(object->string x :readable)" "") (lint-test "(or)" " or: perhaps (or) -> #f") (lint-test "(or x)" " or: perhaps (or x) -> x") (lint-test "(or 'a)" " or: perhaps (or 'a) -> 'a") (lint-test "(or 'a 'b)" " or: perhaps (or 'a 'b) -> 'a") (lint-test "(or x x)" " or: perhaps (or x x) -> x") (lint-test "(or x x y)" " or: perhaps (or x x y) -> (or x y)") (lint-test "(or x y z z y)" " or: perhaps (or x y z z y) -> (or x y z)") (lint-test "(or (and x (or y z)) x)" "") ; these 3 hit the (cur 0) code and the 8-way var code (lint-test "(or (and x y z) x z)" "") ; I think these results are correct -- many truths... (lint-test "(or (and x y z) x)" "") (lint-test "(or (and x y) (and x z))" " or: perhaps (or (and x y) (and x z)) -> (and x (or y z))") (lint-test "(or 1 x)" " or: perhaps (or 1 x) -> 1") (lint-test "(or (or y) x)" " or: perhaps (or (or y) x) -> (or y x)") (lint-test "(or (or y x) x)" " or: perhaps (or (or y x) x) -> (or y x)") (lint-test "(or x (not x))" "") (lint-test "(or x (and x y))" " or: perhaps (or x (and x y)) -> x") (lint-test "(or (and x y) y)" " or: perhaps (or (and x y) y) -> y") (lint-test "(or x #f y)" " or: perhaps (or x #f y) -> (or x y)") (lint-test "(or x #f)" " or: perhaps (or x #f) -> x") (lint-test "(or x y #f)" " or: perhaps (or x y #f) -> (or x y)") (lint-test "(or x #t)" "") (lint-test "(or #t (display \"oops\"))" " or: perhaps (or #t (display \"oops\")) -> #t") (lint-test "(or (pair? x) #t (even? y))" " or: perhaps (or (pair? x) #t (even? y)) -> (or (pair? x) #t)") (lint-test "(or x (not (and x y)))" "") ; someday? (lint-test "(or (pair? x) (list? x))" " or: perhaps (or (pair? x) (list? x)) -> (list? x)") (lint-test "(or (number? x) (rational? x))" " or: perhaps (or (number? x) (rational? x)) -> (number? x)") (lint-test "(or (pair? x) (null? x))" " or: perhaps (or (pair? x) (null? x)) -> (list? x)") (lint-test "(or (list? x) (list? x))" " or: perhaps (or (list? x) (list? x)) -> (list? x)") (lint-test "(or #f (= x 1))" " or: perhaps (or #f (= x 1)) -> (= x 1)") (lint-test "(or (integer? (cadr x)) (number? (cadr x)))" " or: perhaps (or (integer? (cadr x)) (number? (cadr x))) -> (number? (cadr x))") (lint-test "(or (eq? x 'a) (eq? x 'b) (eq? x 'c))" " or: perhaps (or (eq? x 'a) (eq? x 'b) (eq? x 'c)) -> (memq x '(a b c))") (lint-test "(or (= x 1) (= x 2) (= x 3))" " or: perhaps (or (= x 1) (= x 2) (= x 3)) -> (member x '(1 2 3) =)") (lint-test "(or (equal? x #()) (equal? x #(a)))" " or: perhaps (or (equal? x #()) (equal? x #(a))) -> (member x '(#() #(a)))") (lint-test "(or (string=? x \"a\") (string=? x \"b\"))" " or: perhaps (or (string=? x \"a\") (string=? x \"b\")) -> (member x '(\"a\" \"b\") string=?)") (lint-test "(or (char=? (cadr x) #\\a) (char=? (cadr x) #\\b))" " or: perhaps (or (char=? (cadr x) #\\a) (char=? (cadr x) #\\b)) -> (memv (cadr x) '(#\\a #\\b))") (lint-test "(or (= (let ((z 1)) (display z) z) 1) (= (let ((z 1)) (display z) z) 2))" " or: perhaps (or (= (let ((z 1)) (display z) z) 1) (= (let ((z 1)) (display z) z) 2)) -> (member (let ((z 1)) (display z) z) '(1 2) =) or: display returns its first argument, so this could be omitted: z or: display returns its first argument, so this could be omitted: z") (lint-test "(or (not (null? x)) (not (pair? x)))" " or: perhaps (or (not (null? x)) (not (pair? x))) -> #t") (lint-test "(or (not (symbol? x)) (keyword? x))" "") (lint-test "(or (not (= x 1)) (not (= y 1)))" " or: perhaps (or (not (= x 1)) (not (= y 1))) -> (not (= x 1 y))") (lint-test "(or (char=? x #\\a) (char=? x #\\A))" " or: perhaps (or (char=? x #\\a) (char=? x #\\A)) -> (char-ci=? x #\\A)") (lint-test "(or (string=? x \"a\") (string=? x \"A\"))" " or: perhaps (or (string=? x \"a\") (string=? x \"A\")) -> (string-ci=? x \"A\")") (lint-test "(or (< x y) (= x y))" " or: perhaps (or (< x y) (= x y)) -> (<= x y)") (lint-test "(or (eq? x #t) (eqv? #f x))" " or: perhaps (or (eq? x #t) (eqv? #f x)) -> (boolean? x) or: eqv? could be not: (eqv? #f x) -> (not x)") (lint-test "(and (< x 1) (string? y))" "") ; check a simplification bug (lint-test "(or (< x 1) (string? y))" "") (lint-test "(or (= x 1) (= x 1))" " or: perhaps (or (= x 1) (= x 1)) -> (= x 1)") (lint-test "(or (= (length val) 20) (= (length val) 21))" " or: perhaps (or (= (length val) 20) (= (length val) 21)) -> (<= 20 (length val) 21)") (lint-test "(or (not (= x 1)) (not (= y 1)))" " or: perhaps (or (not (= x 1)) (not (= y 1))) -> (not (= x 1 y))") (lint-test "(or (not (= x 1)) (not (= x 2)))" " or: perhaps (or (not (= x 1)) (not (= x 2))) -> #t") (lint-test "(or (not (= x y)) (not (= x z)))" " or: perhaps (or (not (= x y)) (not (= x z))) -> (not (= x y z))") (lint-test "(or () (= x 1))" " or: perhaps (or () (= x 1)) -> ()") (lint-test "(or #f #f)" " or: perhaps (or #f #f) -> #f") (lint-test "(or (and (= n 2) (= d 2)) (and (= n 4) (= d 4)))" " or: perhaps (or (and (= n 2) (= d 2)) (and (= n 4) (= d 4))) -> (or (= n 2 d) (= n 4 d))") (lint-test "(or (= n 2 d) (= n 4 d))" "") (lint-test "(or (< x 1) (>= x 1))" " or: perhaps (or (< x 1) (>= x 1)) -> #t") (lint-test "(or (< x 1) (< x 2))" " or: perhaps (or (< x 1) (< x 2)) -> (< x 2)") (lint-test "(or (< x 1) (> x 2))" " or: perhaps (or (< x 1) (> x 2)) -> (not (<= 1 x 2))") (lint-test "(or (<= x 1) (< x 1))" " or: perhaps (or (<= x 1) (< x 1)) -> (<= x 1)") (lint-test "(or (< x 2) (> x 1))" " or: perhaps (or (< x 2) (> x 1)) -> #t") (lint-test "(or (<= x 1) (<= 2 x))" " or: perhaps (or (<= x 1) (<= 2 x)) -> (not (< 1 x 2))") (lint-test "(or (< x 3) (> 2 x))" " or: perhaps (or (< x 3) (> 2 x)) -> (< x 3)") (lint-test "(or (char=? x #\\1))" " or: perhaps (or (char=? x #\\1)) -> #t") (lint-test "(or (string (string x 12))" " or: perhaps (or (integer? x) (< x 3) (> x 12)) -> (or (integer? x) (not (<= 3 x 12)))") (lint-test "(or (zero? x) (positive? x))" " or: perhaps (or (zero? x) (positive? x)) -> (not (negative? x))") (lint-test "(or (zero? x) (negative? x))" " or: perhaps (or (zero? x) (negative? x)) -> (not (positive? x))") (lint-test "(and (<= x y) (<= y z) (f x y z))" " and: perhaps (and (<= x y) (<= y z) (f x y z)) -> (and (<= x y z) (f x y z))") (lint-test "(and (<= x y) (<= y z))" " and: perhaps (and (<= x y) (<= y z)) -> (<= x y z)") (lint-test "(or (< x y) (> x z))" " or: perhaps (or (< x y) (> x z)) -> (not (<= y x z))") (lint-test "(or (>= x y) (<= x z))" " or: perhaps (or (>= x y) (<= x z)) -> (not (> y x z))") (lint-test "(or (< (car v1) (car v2)) (> (car v1) (car v2)))" " or: perhaps (or (< (car v1) (car v2)) (> (car v1) (car v2))) -> (not (= (car v1) (car v2)))") (lint-test "(or (< (car v1) (car v2)) (>= (car v1) (car v2)))" " or: perhaps (or (< (car v1) (car v2)) (>= (car v1) (car v2))) -> #t") (lint-test "(or (<= (car v1) (car v2)) (>= (car v1) (car v2)))" " or: perhaps (or (<= (car v1) (car v2)) (>= (car v1) (car v2))) -> #t") (lint-test "(or (and A B) (and (not A) (not B)))" " or: perhaps (or (and A B) (and (not A) (not B))) -> (eq? (not A) (not B))") (lint-test "(or (and A (not B)) (and (not A) B))" " or: perhaps (or (and A (not B)) (and (not A) B)) -> (not (eq? (not A) (not B)))") (lint-test "(or (and A B) (and (not A) C))" " or: perhaps (or (and A B) (and (not A) C)) -> (if A B C)") (lint-test "(if (or (and A B) (and (not A) C)) 32)" " or: perhaps (or (and A B) (and (not A) C)) -> (if A B C)") (lint-test "(or (and (not A) B) (and A C))" " or: perhaps (or (and (not A) B) (and A C)) -> (if A C B)") (lint-test "(or (and A B) (and A C))" " or: perhaps (or (and A B) (and A C)) -> (and A (or B C))") (lint-test "(or (and A B) (and C B))" " or: perhaps (or (and A B) (and C B)) -> (and (or A C) B)") (lint-test "(and (or A B) (or A C))" " and: perhaps (and (or A B) (or A C)) -> (or A (and B C))") (lint-test "(and (or A B) (or C B))" " and: perhaps (and (or A B) (or C B)) -> (or (and A C) B)") (lint-test "(or (not A) (and A B))" " or: perhaps (or (not A) (and A B)) -> (or (not A) B)") (lint-test "(or A (and (not A) B))" " or: perhaps (or A (and (not A) B)) -> (or A B)") (lint-test "(and A (not A))" " and: perhaps (and A (not A)) -> #f") (lint-test "(or (and x y) (and x z) (and x w))" " or: perhaps (or (and x y) (and x z) (and x w)) -> (and x (or y z w))") (lint-test "(or (and x y) (and z y) (and w y))" " or: perhaps (or (and x y) (and z y) (and w y)) -> (and (or x z w) y)") (lint-test "(or (and x y w) (and x z) (and x a b))" " or: perhaps (or (and x y w) (and x z) (and x a b)) -> (and x (or (and y w) z (and a b)))") (lint-test "(or (and (eq? x 'a) (< y 1)) (and (memq x '(b c)) (< y 2) (> z 1)) (and (null? x) (< y 3)))" " or: perhaps (or (and (eq? x 'a) (< y 1)) (and (memq x '(b c)) (< y 2) (> z 1)) (and... -> (case x ((a) (< y 1)) ((b c) (and (< y 2) (> z 1))) ((()) (< y 3)) (else #f))") (lint-test "(or (and (eq? x 'a) (< y 1)) (and (memq x '(b c)) (< y 2) (> z 1)) (< y 3))" "") (lint-test "(or (eq? x 'a) (eq? x 'b) (eq? x 'c) (and (< z 3) (< y 4)))" " or: perhaps (or (eq? x 'a) (eq? x 'b) (eq? x 'c) (and (< z 3) (< y 4))) -> (or (memq x '(a b c)) (and (< z 3) (< y 4)))") (lint-test "(or (< y 4) (eq? x 'a) (eq? x 'b) (eq? x 'c))" " or: perhaps (or (< y 4) (eq? x 'a) (eq? x 'b) (eq? x 'c)) -> (or (< y 4) (memq x '(a b c)))") (lint-test "(or (> y 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (and (< z 3) (< y 4)))" " or: perhaps (or (> y 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (and (< z 3) (< y 4))) -> (or (> y 32) (memq x '(a b c)) (and (< z 3) (< y 4)))") (lint-test "(or (> y 32) (> z 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (< z 3) (< y 4))" " or: perhaps (or (> y 32) (> z 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (< z 3) (< y 4)) -> (or (> y 32) (> z 32) (memq x '(a b c)) (< z 3) (< y 4))") (lint-test "(or (> y 32) (> z 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (< z 3) (> z 4))" " or: perhaps (or (> y 32) (> z 32) (eq? x 'a) (eq? x 'b) (eq? x 'c) (< z 3) (> z 4)) -> (or (> y 32) (> z 32) (memq x '(a b c)) (not (<= 3 z 4)))") (lint-test "(or (and (eq? x 'a) (< y 1)) (and (eq? x 'b) (< z 2)) (and (eq? x 'a) (< w 2)))" "") (lint-test "(or (not (= x y)) (not (= x z)))" " or: perhaps (or (not (= x y)) (not (= x z))) -> (not (= x y z))") (lint-test "(or (not x) (< x 1))" " in (or (not x) (< x 1)), perhaps change (not x) to (not (real? x))") (lint-test "(or (not x) (boolean? x))" " or: perhaps (or (not x) (boolean? x)) -> (boolean? x)") (lint-test "(or (not x) (< x 1) y)" " in (or (not x) (< x 1) y), perhaps change (not x) to (not (real? x))") (lint-test "(or (not (eq? val1 val2)) (not (eq? val2 val3)))" ; don't combine here into one eq? " or: perhaps (or (not (eq? val1 val2)) (not (eq? val2 val3))) -> (not (and (eq? val1 val2) (eq? val2 val3)))") (lint-test "(and x (x))" " in (and x (x)), perhaps change x to (procedure? x)") (lint-test "(if x (x))" " in (if x (x)), perhaps change x to (procedure? x)") (lint-test "(not (or (not x) (not y)))" " not: perhaps (not (or (not x) (not y))) -> (and x y)") (lint-test "(not (or (not (< x y)) (not (equal? a b)) (not z)))" " not: perhaps (not (or (not (< x y)) (not (equal? a b)) (not z))) -> (and (< x y) (equal? a b) z)") (lint-test "(not (and (not x) (not y)))" " not: perhaps (not (and (not x) (not y))) -> (or x y)") (lint-test "(not (and (not (< x y)) (not (equal? a b)) (not z)))" " not: perhaps (not (and (not (< x y)) (not (equal? a b)) (not z))) -> (or (< x y) (equal? a b) z)") (lint-test "(not (or (not x) (< y z) (not (< z x))))" " in (and x (< z x)), perhaps change x to (real? x) not: perhaps (not (or (not x) (< y z) (not (< z x)))) -> (and x (>= y z) (< z x))") (lint-test "(not (and (> x 2) (< x 5)))" " not: perhaps (not (and (> x 2) (< x 5))) -> (not (> 5 x 2))") (lint-test "(not (and (> x 2) (not z)))" " not: perhaps (not (and (> x 2) (not z))) -> (or (<= x 2) z)") (lint-test "(not (> x 1))" " not: perhaps (not (> x 1)) -> (<= x 1)") (lint-test "(not (<= 1 x 2))" "") (lint-test "(not (exact? x))" " not: perhaps (not (exact? x)) -> (inexact? x)") (lint-test "(not (not x))" " paranoia: if you want a boolean, (not (not x)) -> (and x #t) not: perhaps (not (not x)) -> x") (lint-test "(not (not (list? x)))" " paranoia: list? returns a boolean, so (not (not (list? x))) -> (list? x) not: perhaps (not (not (list? x))) -> (list? x)") (lint-test "(not (zero? (logand x (ash 1 z))))" " not: perhaps (not (zero? (logand x (ash 1 z)))) -> (logbit? x z)") (lint-test "(not (zero? (logand x 64)))" " not: perhaps (not (zero? (logand x 64))) -> (logbit? x 6)") (lint-test "(not x y)" " not: not has too many arguments: (not x y)") (lint-test "(not (+ x y))" " not: (not (+ x y)) can't be true (+ never returns #f) not: perhaps (not (+ x y)) -> #f") (lint-test "(not (list x y))" " not: (not (list x y)) can't be true (list never returns #f) not: perhaps (not (list x y)) -> #f") (lint-test "(not (if (f x) #t x))" " not: perhaps (not (if (f x) #t x)) -> (if (f x) #f (not x)) not: perhaps (if (f x) #t x) -> (or (f x) x)") (lint-test "(not (begin (f x) x))" " not: perhaps (not (begin (f x) x)) -> (begin (f x) (not x))") (lint-test "(not (case x ((0) (f x)) ((1) (not x))))" " not: perhaps (not (case x ((0) (f x)) ((1) (not x)))) -> (case x ((0) (not (f x))) ((1) x)) not: perhaps use => here: (case x ((0) (f x)) ((1) (not x))) -> (case x ((0) => f) ((1) => not)) not: in ((1) (not x)), perhaps replace (not x) with #f") (lint-test "(not (cond ((f x) x) ((g x) (not x)) (else (error 'oops))))" " not: perhaps (not (cond ((f x) x) ((g x) (not x)) (else (error 'oops)))) -> (cond ((f x) (not x)) ((g x) x) (else (error 'oops)))") (lint-test "(or (not (< x 2)) (not (> x 1)))" " or: perhaps (or (not (< x 2)) (not (> x 1))) -> (not (< 1 x 2))") ; confusing... (lint-test "(or (string? x) (string=? x \"\"))" " or: perhaps (or (string? x) (string=? x \"\")) -> (string? x)") (lint-test "(or (number? x) (= x 1.0))" " or: perhaps (or (number? x) (= x 1.0)) -> (number? x)") (lint-test "(or (not x) (not (pair? x)))" " or: perhaps (or (not x) (not (pair? x))) -> (not (pair? x))") (lint-test "(or (null? x) (not (list? x)))" " or: perhaps (or (null? x) (not (list? x))) -> (not (pair? x))") (lint-test "(or (null? x) (not (string? x)))" " or: perhaps (or (null? x) (not (string? x))) -> (not (string? x))") (lint-test "(or (null? x) (not (pair? x)))" " or: perhaps (or (null? x) (not (pair? x))) -> (not (pair? x))") (lint-test "(or (pair? x) (not (pair? x)))" " or: perhaps (or (pair? x) (not (pair? x))) -> #t") (lint-test "(or (let? x) (not (let? x)))" " or: perhaps (or (let? x) (not (let? x))) -> #t") (lint-test "(or (< x y) (and (>= x y) (= x 3)))" " or: perhaps (or (< x y) (and (>= x y) (= x 3))) -> (or (< x y) (= x 3))") (lint-test "(or (symbol? x) (and (not (symbol? x)) (= x 3)))" " or: perhaps (or (symbol? x) (and (not (symbol? x)) (= x 3))) -> (or (symbol? x) (= x 3))") (lint-test "(or (< x y) (and (>= x y)))" " or: perhaps (or (< x y) (and (>= x y))) -> #t or: perhaps (or (< x y) (and (>= x y))) -> #t") (lint-test "(or (< x y) (and (= x 3)))" " or: perhaps (or (< x y) (and (= x 3))) -> (or (< x y) (= x 3))") (lint-test "(or (< x y) (and (>= x y) (= x 3) (= y 1)))" " or: perhaps (or (< x y) (and (>= x y) (= x 3) (= y 1))) -> (or (< x y) (and (= x 3) (= y 1)))") (lint-test "(or (< x y) (and (>= x y) (= x 1) (= y 3)))" " or: perhaps (or (< x y) (and (>= x y) (= x 1) (= y 3))) -> (or (< x y) (and (= x 1) (= y 3)))") (lint-test "(and (< x y) (or (>= x y) (= x 3)))" " and: perhaps (and (< x y) (or (>= x y) (= x 3))) -> (and (< x y) (= x 3))") (lint-test "(and (symbol? x) (or (not (symbol? x)) (eq? x 'a)))" " and: perhaps (and (symbol? x) (or (not (symbol? x)) (eq? x 'a))) -> (and (symbol? x) (eq? x 'a))") (lint-test "(if (symbol? x) (or (not (symbol? x)) (eq? x 'a)) #f)" " and: perhaps (and (symbol? x) (or (not (symbol? x)) (eq? x 'a))) -> (and (symbol? x) (eq? x 'a)) if: perhaps (if (symbol? x) (or (not (symbol? x)) (eq? x 'a)) #f) -> (and (symbol? x) (or (not (symbol? x)) (eq? x 'a)))") (lint-test "(if (symbol? x) x (if (not (symbol? x)) 32))" " if: perhaps (if (symbol? x) x (if (not (symbol? x)) 32)) -> (if (symbol? x) x 32)") (lint-test "(cond ((symbol? x) x) ((not (symbol? x)) 32))" " cond: perhaps (cond ((symbol? x) x) ((not (symbol? x)) 32)) -> (cond ((symbol? x) x) (else 32)) cond: perhaps (cond ((symbol? x) x) ((not (symbol? x)) 32)) -> (cond ((symbol? x) x) (#t 32))") (lint-test "(cond ((< x y) 32) ((>= x y) 45))" " cond: perhaps (cond ((< x y) 32) ((>= x y) 45)) -> (cond ((< x y) 32) (else 45))") (lint-test "(and)" " and: perhaps (and) -> #t") (lint-test "(and x)" " and: perhaps (and x) -> x") (lint-test "(and x #t)" "") (lint-test "(and x #f)" " and: perhaps (and x #f) -> #f") (lint-test "(and #f (display \"oops\"))" " and: perhaps (and #f (display \"oops\")) -> #f") (lint-test "(and (pair? x) #f (even? y))" " and: perhaps (and (pair? x) #f (even? y)) -> #f") (lint-test "(and x (not x))" " and: perhaps (and x (not x)) -> #f") (lint-test "(and x (and x y))" " and: perhaps (and x (and x y)) -> (and x y)") (lint-test "(and x (or x y))" " and: perhaps (and x (or x y)) -> x") (lint-test "(and (or x y) x)" " and: perhaps (and (or x y) x) -> x") (lint-test "(and (or x y) (or x z))" " and: perhaps (and (or x y) (or x z)) -> (or x (and y z))") (lint-test "(and (number? x) (pair? x))" " and: perhaps (and (number? x) (pair? x)) -> #f") (lint-test "(and x (pair? x))" " and: perhaps (and x (pair? x)) -> (pair? x)") (lint-test "(and x (or y 123) z)" " and: perhaps (and x (or y 123) z) -> (and x z)") (lint-test "(and (pair? x) (list? x))" " and: perhaps (and (pair? x) (list? x)) -> (pair? x)") (lint-test "(and (number? x) (rational? x))" " and: perhaps (and (number? x) (rational? x)) -> (rational? x)") (lint-test "(and (pair? x) (null? x))" " and: perhaps (and (pair? x) (null? x)) -> #f") (lint-test "(and (list? x) (list? x))" " and: perhaps (and (list? x) (list? x)) -> (list? x)") (lint-test "(and 3.1 #f (= x 1))" " and: perhaps (and 3.1 #f (= x 1)) -> #f") (lint-test "(and 3.1 #t (= x 1))" " and: perhaps (and 3.1 #t (= x 1)) -> (= x 1)") (lint-test "(and (number? (cadr x)) (integer? (cadr x)))" " and: perhaps (and (number? (cadr x)) (integer? (cadr x))) -> (integer? (cadr x))") (lint-test "(and x y x)" "") (lint-test "(and x y y)" " and: perhaps (and x y y) -> (and x y)") (lint-test "(and x y x y)" " and: perhaps (and x y x y) -> (and x y)") (lint-test "(and x #f y)" " and: perhaps (and x #f y) -> #f") (lint-test "(and x y #t z)" " and: perhaps (and x y #t z) -> (and x y z)") (lint-test "(and x y z z y)" " and: perhaps (and x y z z y) -> (and x y z y)") (lint-test "(and (g x) (g y) (g x))" "") (lint-test "(and (cadr x) (car y) (cadr x))" "") (lint-test "(and (cadr x) (car y) (cadr x) (car y))" " and: perhaps (and (cadr x) (car y) (cadr x) (car y)) -> (and (cadr x) (car y))") (lint-test "(and (g x) #f (g y))" " and: perhaps (and (g x) #f (g y)) -> (and (g x) #f)") (lint-test "(and x (or y 123 z))" " and: perhaps (and x (or y 123 z)) -> (and x (or y 123))") (lint-test "(and x (or y 123 z) w)" " and: perhaps (and x (or y 123 z) w) -> (and x w)") (lint-test "(and x (or (g y) z) w)" "") (lint-test "(and (integer? x) (number? x))" " and: perhaps (and (integer? x) (number? x)) -> (integer? x)") (lint-test "(and x y #t)" "") (lint-test "(and x y (integer? 1))" " and: perhaps (and x y (integer? 1)) -> (and x y #t)") (lint-test "(and x (or x))" " and: perhaps (and x (or x)) -> x") (lint-test "(and (cadr x) (cadr x))" " and: perhaps (and (cadr x) (cadr x)) -> (cadr x)") (lint-test "(and (< x y) (< y z))" " and: perhaps (and (< x y) (< y z)) -> (< x y z)") (lint-test "(and (< x y) (< y z))" " and: perhaps (and (< x y) (< y z)) -> (< x y z)") (lint-test "(and (< y z) (< x y))" " and: perhaps (and (< y z) (< x y)) -> (< x y z)") (lint-test "(and (< x y) (< x y))" " and: perhaps (and (< x y) (< x y)) -> (< x y)") (lint-test "(and (< x y) (< y x))" " and: perhaps (and (< x y) (< y x)) -> #f") (lint-test "(and (< x y) (< z x))" " and: perhaps (and (< x y) (< z x)) -> (< z x y)") (lint-test "(and (= x y) (= y z))" " and: perhaps (and (= x y) (= y z)) -> (= x y z)") (lint-test "(and (= x y) (= x z))" " and: perhaps (and (= x y) (= x z)) -> (= x y z)") (lint-test "(and (= x y) (= y x))" " and: perhaps (and (= x y) (= y x)) -> (= x y)") (lint-test "(and (= x y) (= z x))" " and: perhaps (and (= x y) (= z x)) -> (= z x y)") (lint-test "(and (>= x y) (>= z x))" " and: perhaps (and (>= x y) (>= z x)) -> (>= z x y)") (lint-test "(and (>= x y) (>= x z))" " and: perhaps (and (>= x y) (>= x z)) -> (>= x (max y z))") (lint-test "(and (= x y) (= x z))" " and: perhaps (and (= x y) (= x z)) -> (= x y z)") (lint-test "(and (< x y) (> z y))" " and: perhaps (and (< x y) (> z y)) -> (< x y z)") (lint-test "(and (< x y) (< y (let ((z 1)) (display z) z)))" " and: display returns its first argument, so this could be omitted: z") (lint-test "(and (pair? x) (null? x))" " and: perhaps (and (pair? x) (null? x)) -> #f") (lint-test "(and (> x 1) (> x 2))" " and: perhaps (and (> x 1) (> x 2)) -> (> x 2)") (lint-test "(and (< x 1) (< x 2))" " and: perhaps (and (< x 1) (< x 2)) -> (< x 1)") (lint-test "(and (< x 1) (< 2 x))" " and: perhaps (and (< x 1) (< 2 x)) -> #f") (lint-test "(and (> x 1) (> 2 x))" " and: perhaps (and (> x 1) (> 2 x)) -> (> 2 x 1)") (lint-test "(and (< x y) (< x z))" " and: perhaps (and (< x y) (< x z)) -> (< x (min y z))") (lint-test "(and (= x 0) (zero? y))" " and: perhaps (and (= x 0) (zero? y)) -> (= 0 x y)") (lint-test "(and (= 0 x) (= y 0) (zero? z))" " and: perhaps (and (= 0 x) (= y 0) (zero? z)) -> (= 0 x y z)") (lint-test "(and (= x 0) (zero? x))" " and: perhaps (and (= x 0) (zero? x)) -> (= 0 x)") (lint-test "(and (integer? x) (exact? x))" " and: perhaps (and (integer? x) (exact? x)) -> (integer? x)") (lint-test "(and (integer? x) #t)" " and: perhaps (and (integer? x) #t) -> (integer? x)") (lint-test "(and (inexact? x) (real? x))" " and: perhaps (and (inexact? x) (real? x)) -> (and (real? x) (inexact? x))") (lint-test "(and (infinite? x) (number? x))" " and: perhaps (and (infinite? x) (number? x)) -> (infinite? x)") (lint-test "(and (not (= x 1)) (not (= x 2)))" " and: perhaps (and (not (= x 1)) (not (= x 2))) -> (not (member x '(1 2) =))") (lint-test "(and (not (list? x)) (not (pair? x)))" " and: perhaps (and (not (list? x)) (not (pair? x))) -> (not (list? x))") (lint-test "(and (not (null? x)) (not (pair? x)))" " and: perhaps (and (not (null? x)) (not (pair? x))) -> (not (list? x))") (lint-test "(and (not (null? x)) (not (list? x)))" " and: perhaps (and (not (null? x)) (not (list? x))) -> (not (list? x))") (lint-test "(and (zero? x) (zero? y))" " and: perhaps (and (zero? x) (zero? y)) -> (= 0 x y)") (lint-test "(and (string? x) (string=? x \"\"))" " and: perhaps (and (string? x) (string=? x \"\")) -> (equal? x \"\")") (lint-test "(and (number? x) (= x 1.0))" " and: perhaps (and (number? x) (= x 1.0)) -> (memv x '(1 1.0))") (lint-test "(and (real? x) (= x 1))" " and: perhaps (and (real? x) (= x 1)) -> (memv x '(1 1.0))") (lint-test "(and (integer? x) (= x 1))" " and: perhaps (and (integer? x) (= x 1)) -> (eqv? x 1)") (lint-test "(and (integer? x) (= x y))" " and: perhaps (and (integer? x) (= x y)) -> (eqv? x y)") (lint-test "(and (complex? x) (= x y))" "") (lint-test "(and (symbol? x) (eq? x 'a))" " and: perhaps (and (symbol? x) (eq? x 'a)) -> (eq? x 'a)") (lint-test "(and (keyword? x) (eq? x :a))" " and: perhaps (and (keyword? x) (eq? x :a)) -> (eq? x :a)") (lint-test "(or (= x 1) (not (and (not (= y 2)) (not (= z 3)))))" " or: perhaps (or (= x 1) (not (and (not (= y 2)) (not (= z 3))))) -> (or (= x 1) (= y 2) (= z 3))") (lint-test "(and (= x 1) (not (or (not (= y 2)) (not (= z 3)))))" " and: perhaps (and (= x 1) (not (or (not (= y 2)) (not (= z 3))))) -> (and (= x 1) (= y 2) (= z 3))") (lint-test "(and (pair? x) (not (list? x)))" " and: perhaps (and (pair? x) (not (list? x))) -> #f") (lint-test "(and (list? x) (not (pair? x)))" " and: perhaps (and (list? x) (not (pair? x))) -> (null? x)") (lint-test "(and (not (null? x)) (list? x))" " and: perhaps (and (not (null? x)) (list? x)) -> (pair? x)") (lint-test "(and (pair? x) (not (null? x)))" " and: perhaps (and (pair? x) (not (null? x))) -> (pair? x)") (lint-test "(and (pair? x) (not (string? x)))" " and: perhaps (and (pair? x) (not (string? x))) -> (pair? x)") (lint-test "(and (not (pair? x)) (symbol? x))" " and: perhaps (and (not (pair? x)) (symbol? x)) -> (symbol? x)") (lint-test "(and (not (eof-object? x)) (char=? x #\\a))" " and: perhaps (and (not (eof-object? x)) (char=? x #\\a)) -> (eqv? x #\\a)") (lint-test "(and (real? x) (not (rational? x)))" " and: perhaps (and (real? x) (not (rational? x))) -> (float? x)") (lint-test "(and (list? x) (not (proper-list? x)))" "") (lint-test "(and (real? x) (not (integer? x)))" "") (lint-test "(and (number? x) (inexact? x) (real? x))" " and: perhaps (and (number? x) (inexact? x) (real? x)) -> (and (real? x) (inexact? x))") (lint-test "(and (not (complex? x)) (real? x))" " and: perhaps (and (not (complex? x)) (real? x)) -> #f") (lint-test "(and (pair? x) (eq? x #))" " and: perhaps (and (pair? x) (eq? x #)) -> #f") (lint-test "(and (eq? x 'a) (pair? x))" " and: perhaps (and (eq? x 'a) (pair? x)) -> #f") (lint-test "(and (not (pair? x)) (or (not (pair? y)) (not (pair? z))))" " and: perhaps (and (not (pair? x)) (or (not (pair? y)) (not (pair? z)))) -> (not (or (pair? x) (and (pair? y) (pair? z))))") (lint-test "(or (not (pair? x)) (and (not (pair? y)) (not (pair? z))))" " or: perhaps (or (not (pair? x)) (and (not (pair? y)) (not (pair? z)))) -> (not (and (pair? x) (or (pair? y) (pair? z))))") (lint-test "(if (and (not (pair? x)) (not (pair? z))) 1 2)" " if: perhaps (and (not (pair? x)) (not (pair? z))) -> (not (or (pair? x) (pair? z)))") (lint-test "(if (or (not (pair? x)) (not (pair? z))) 2 1)" " if: perhaps (or (not (pair? x)) (not (pair? z))) -> (not (and (pair? x) (pair? z)))") (lint-test "(and (number? port) (exact? port) (integer? port))" " and: perhaps (and (number? port) (exact? port) (integer? port)) -> (integer? port)") (lint-test "(and (number? port) (integer? port) (exact? port))" " and: perhaps (and (number? port) (integer? port) (exact? port)) -> (integer? port)") (lint-test "(and (integer? port) (number? port) (real? port))" " and: perhaps (and (integer? port) (number? port) (real? port)) -> (integer? port)") (lint-test "(and (real? port) (number? port) (integer? port))" " and: perhaps (and (real? port) (number? port) (integer? port)) -> (integer? port)") (lint-test "(and (real? port) (integer? port) (integer? port))" " and: perhaps (and (real? port) (integer? port) (integer? port)) -> (integer? port)") (lint-test "(and (real? port) (number? port) (integer? port) (even? port))" " and: perhaps (and (real? port) (number? port) (integer? port) (even? port)) -> (and (integer? port) (even? port))") (lint-test "(and (real? port) (number? port) (integer? port) (even? port) (positive? port))" " and: perhaps (and (real? port) (number? port) (integer? port) (even? port) (positive? port)) -> (and (integer? port) (even? port) (positive? port))") (lint-test "(and (integer? x) (< x 12) (> x 3))" " and: perhaps (and (integer? x) (< x 12) (> x 3)) -> (and (integer? x) (> 12 x 3))") (lint-test "(and (equal? (car a) (car b)) (equal? (cdr a) (cdr b)))" " and: perhaps (and (equal? (car a) (car b)) (equal? (cdr a) (cdr b))) -> (equal? a b)") (lint-test "(and (equal? (caadr a) (caadr b)) (equal? (cdadr a) (cdadr b)))" " and: perhaps (and (equal? (caadr a) (caadr b)) (equal? (cdadr a) (cdadr b))) -> (equal? (cadr a) (cadr b))") (lint-test "(and (equal? (car x) (car original)) (equal? (cdr x) (cdr original)))" " and: perhaps (and (equal? (car x) (car original)) (equal? (cdr x) (cdr original))) -> (equal? x original)") (lint-test "(and (complex? x) (immutable? x))" "") ; x=2 (lint-test "(and (char-alphabetic? x) (immutable? x))" "") ; x=#\a (lint-test "(and (continuation? x) (procedure? x))" "") ; x is continuation (lint-test "(and (not (constant? x)) (symbol? x))" "") ; x=:constant (lint-test "(and (exact? x) (odd? x))" "") ; x=1 (lint-test "(and (directory? x) (file-exists? x))" "and: perhaps (and (directory? x) (file-exists? x)) -> (directory? x)") (lint-test "(and (not (float? x)) (real? x))" "") ; x=pi (lint-test "(and (not (sequence? x)) (proper-list? x))" "and: perhaps (and (not (sequence? x)) (proper-list? x)) -> #f") (lint-test "(and (real? x) (not (nan? x)))" "") ; x=nan.0 (lint-test "(and t! (string? t!))" " and: perhaps (and t! (string? t!)) -> (string? t!)") (lint-test "(and t! (string? t!) v (string? v))" " and: perhaps (and t! (string? t!) v (string? v)) -> (and (string? t!) (string? v))") (lint-test "(and v (boolean? v) (not (equal? v w)))" " and: perhaps (and v (boolean? v) (not (equal? v w))) -> (and (eq? v #t) (not (equal? v w)))") (lint-test "(and x (< x 2))" " in (and x (< x 2)), perhaps change x to (real? x)") (lint-test "(and w x (substring s 0 x))" " in (and x (substring s 0 x)), perhaps change x to (integer? x)") (lint-test "(and x (+ (log x) 1))" " in (and x (+ (log x) 1)), perhaps change x to (number? x)") (lint-test "(and z x (+ (log x) 1))" " in (and z x (+ (log x) 1)), perhaps change x to (number? x)") (lint-test "(when x (display (log x)))" " in (when x (display (log x))), perhaps change x to (number? x)") (lint-test "(and x (substring s 0 x))" " in (and x (substring s 0 x)), perhaps change x to (integer? x)") (lint-test "(and v (v 100))" " in (and v (v 100)), perhaps change v to (procedure? v) ; or maybe sequence?") (lint-test "(when x (substring y x))" " in (when x (substring y x)), perhaps change x to (integer? x)") (lint-test "(cond (x (+ 1 (abs x))) (else y))" " in (cond (x (+ 1 (abs x))) (else y)), perhaps change x to (real? x)") (lint-test "(and t! v (string? t!) (string? v))" " in (and t! v (string? t!) (string? v)), perhaps change (and ... t! ... (string? t!)) to (string? t!) in (and t! v (string? t!) (string? v)), perhaps change (and ... v ... (string? v)) to (string? v)") (lint-test "(and (number? a!) (positive? a!))" " in (and (number? a!) (positive? a!)), perhaps change (number? a!) to (real? a!)") (lint-test "(and (number? x) (< x 1))" " in (and (number? x) (< x 1)), perhaps change (number? x) to (real? x)") (lint-test "(and (number? x) (even? x))" " in (and (number? x) (even? x)), perhaps change (number? x) to (integer? x)") (lint-test "(and (list? arg2) (pair? arg2) (memq (car arg2) '(x y)))" " and: perhaps (and (list? arg2) (pair? arg2) (memq (car arg2) '(x y))) -> (and (pair? arg2) (memq (car arg2) '(x y)))") (lint-test "(and (eq? val1 val2) (eq? val2 val3))" "") ; don't combine these! (lint-test "(and (equal? val1 val2) (equal? val2 val3))" "") (lint-test "(and (pair? x) (not (pair? (car x))) (not y) (not (pair? (cdr x))) (string? z))" " and: perhaps (and (pair? x) (not (pair? (car x))) (not y) (not (pair? (cdr x))) (string? z)) -> (and (pair? x) (not (or (pair? (car x)) y (pair? (cdr x)))) (string? z))") (lint-test "(and (integer? val) (or (= val 100) (= val 120)))" " and: perhaps (and (integer? val) (or (= val 100) (= val 120))) -> (memv val '(100 120)) in (and (integer? val) (member val '(100 120) =)), perhaps change (member val '(100 120) =) to (memv ...) and: perhaps (and (integer? val) (or (= val 100) (= val 120))) -> (and (integer? val) (member val '(100 120) =))") (lint-test "(and (integer? x) (= x 0))" " and: perhaps (and (integer? x) (= x 0)) -> (eqv? x 0)") (lint-test "(and (real? x) (= x 0))" " and: perhaps (and (real? x) (= x 0)) -> (memv x '(0 0.0))") (lint-test "(and (integer? x) (= x 2/3))" " and: (and (integer? x) (= x 2/3)), but 2/3 is not integer?") (lint-test "(and (integer? x) (= (* 2 y) x))" " and: perhaps (and (integer? x) (= (* 2 y) x)) -> (eqv? x (* 2 y))") (lint-test "(and (exact? x) (= x 0))" " and: perhaps (and (exact? x) (= x 0)) -> (eqv? x 0)") (lint-test "(and (symbol? x) (memq x '(a b c)))" " and: perhaps (and (symbol? x) (memq x '(a b c))) -> (memq x '(a b c))") (lint-test "(and (not (eof-object? x)) (or (char=? x #\\space) (char=? x #\\a)))" " and: perhaps (and (not (eof-object? x)) (or (char=? x #\\space) (char=? x #\\a))) -> (memv x '(#\\space #\\a)) and: perhaps (and (not (eof-object? x)) (or (char=? x #\\space) (char=? x #\\a))) -> (and (not (eof-object? x)) (memv x '(#\\space #\\a)))") (lint-test "(or (pair? x) (not (pair? (car x))) (not y) (not (pair? (cdr x))) (string? z))" " or: perhaps (or (pair? x) (not (pair? (car x))) (not y) (not (pair? (cdr x))) (string? z)) -> (or (pair? x) (not (and (pair? (car x)) y (pair? (cdr x)))) (string? z))") (lint-test "(or (not (list? info)) (not (list? diff)) (not (eq? (car diff) 'filter)) (fnq (caar info) 1.0) (fnq (caadr info) 0.5) (fnq (caaddr info) 0.25) (not (= (cadar info) 0)) (not (= (cadadr info) 1)) (not (= (cadr (caddr info)) 1)))" " in (and (list? info) (list? diff) (eq? (car diff) 'filter)), perhaps change (list? diff) to (pair? diff) or: perhaps (or (not (list? info)) (not (list? diff)) (not (eq? (car diff) 'filter))... -> (or (not (and (list? info) (list? diff) (eq? (car diff) 'filter))) (fnq (caar info) 1.0) (fnq (caadr info) 0.5) (fnq (caaddr info) 0.25) (not (and (= (cadar info) 0) (= (cadadr info) 1) (= (cadr (caddr info)) 1))))") (lint-test "(cond ((number? x) (< x 1)) ((number? y) (display (abs y))))" " in (cond ((number? x) (< x 1)) ((number? y) (display (abs y)))), perhaps change (number? x) to (real? x) in (cond ((number? x) (< x 1)) ((number? y) (display (abs y)))), perhaps change (number? y) to (real? y)") (lint-test "(cond ((number? y) (display (abs y))) ((number? x) (< x 1)))" " in (cond ((number? y) (display (abs y))) ((number? x) (< x 1))), perhaps change (number? y) to (real? y) in (cond ((number? y) (display (abs y))) ((number? x) (< x 1))), perhaps change (number? x) to (real? x)") (lint-test "(cond ((number? (car x)) (< (car x) 1)) ((number? (vector-ref z y)) (display (abs (vector-ref z y)))))" " in (cond ((number? (car x)) (< (car x) 1)) ((number? (vector-ref z y))..., perhaps change (number? (car x)) to (real? (car x)) in (cond ((number? (car x)) (< (car x) 1)) ((number? (vector-ref z y))..., perhaps change (number? (vector-ref z y)) to (real? (vector-ref z y))") (lint-test "(cond ((not x) y) ((string=? x z) z))" " in (cond ((not x) y) ((string=? x z) z)), perhaps change (not x) to (not (string? x))") (lint-test "(and (number? x) (display (abs x)))" " in (and (number? x) (display (abs x))), perhaps change (number? x) to (real? x)") (lint-test "(and (number? x) x (display (abs x)))" " in (and (number? x) x (display (abs x))), perhaps change x to (real? x)") (lint-test "(and (number? (car x)) (display (abs (car x))))" " in (and (number? (car x)) (display (abs (car x)))), perhaps change (number? (car x)) to (real? (car x))") (lint-test "(and (number? (car x)) (display (abs (car x))) y)" " in (and (number? (car x)) (display (abs (car x))) y), perhaps change (number? (car x)) to (real? (car x))") (lint-test "(or (not (number? x)) (display (abs x)))" " in (or (not (number? x)) (display (abs x))), perhaps change (not (number? x)) to (not (real? x))") (lint-test "(or (not (number? (car x))) (display (abs (car x))))" " in (or (not (number? (car x))) (display (abs (car x)))), perhaps change (not (number? (car x))) to (not (real? (car x)))") (lint-test "(or (not (number? (car x))) (display (abs (car x))) y)" " in (or (not (number? (car x))) (display (abs (car x))) y), perhaps change (not (number? (car x))) to (not (real? (car x)))") (lint-test "(if (number? x) (display (abs x)))" " in (if (number? x) (display (abs x))), perhaps change (number? x) to (real? x)") (lint-test "(if (not (number? x)) x (display (abs x)))" " in (if (not (number? x)) x (display (abs x))), perhaps change (not (number? x)) to (not (real? x))") (lint-test "(if (number? (car x)) (display (abs (car x))))" " in (if (number? (car x)) (display (abs (car x)))), perhaps change (number? (car x)) to (real? (car x))") (lint-test "(if (not (number? (car x))) x (display (abs (car x))))" " in (if (not (number? (car x))) x (display (abs (car x)))), perhaps change (not (number? (car x))) to (not (real? (car x)))") (lint-test "(string-append x (if y z) x)" " string-append: in (string-append x (if y z) x), string-append's second argument should be a string, but # is untyped") (lint-test "(string-append x (if y z w) x)" "") (lint-test "(string-append str (apply string-append strs))" " string-append: perhaps (string-append str (apply string-append strs)) -> (string-append str (apply values strs))") (lint-test "(string-append (apply string-append strs) str1 str2)" " string-append: perhaps (string-append (apply string-append strs) str1 str2) -> (string-append (apply values strs) str1 str2)") (lint-test "(car (car x))" " car: perhaps (car (car x)) -> (caar x)") (lint-test "(cdr (cadr x))" " cdr: perhaps (cdr (cadr x)) -> (cdadr x)") (lint-test "(car (car (cdr x)))" " car: perhaps (car (car (cdr x))) -> (caadr x)") (lint-test "(car (car (cdr (cdr x))))" " car: perhaps (car (car (cdr (cdr x)))) -> (caaddr x)") (lint-test "(car (cadr (cdr x)))" " car: perhaps (car (cadr (cdr x))) -> (caaddr x)") (lint-test "(cddar (car x))" " cddar: perhaps (cddar (car x)) -> (cddaar x)") (lint-test "(cadr (car (cdr x)))" " cadr: perhaps (cadr (car (cdr x))) -> (cadadr x)") (lint-test "(cddddr (cddr x))" " cddddr: perhaps (cddddr (cddr x)) -> (list-tail x 6)") (lint-test "(car (cddddr (cddr x)))" " car: perhaps (car (cddddr (cddr x))) -> (list-ref x 6)") (lint-test "(cadr (cddr (cdddr x)))" " cadr: perhaps (cadr (cddr (cdddr x))) -> (list-ref x 6)") (lint-test "(cadr (cddr (cdddr (cdr x))))" " cadr: perhaps (cadr (cddr (cdddr (cdr x)))) -> (list-ref x 7)") (lint-test "(cddddr (cdddr (cddddr x)))" " cddddr: perhaps (cddddr (cdddr (cddddr x))) -> (list-tail x 11)") (lint-test "(car (caddr x))" " car: perhaps (car (caddr x)) -> (caaddr x)") (lint-test "(cdr (caadr x))" " cdr: perhaps (cdr (caadr x)) -> (cdaadr x)") (lint-test "(car (cadddr x))" "") (lint-test "(cdr (caaddr x))" "") (lint-test "(cadr (cddr x))" " cadr: perhaps (cadr (cddr x)) -> (cadddr x)") (lint-test "(cddr (cadr x))" " cddr: perhaps (cddr (cadr x)) -> (cddadr x)") (lint-test "(caddr (cddr x))" " caddr: perhaps (caddr (cddr x)) -> (list-ref x 4)") (lint-test "(cdddr (cadr x))" "") (lint-test "(caddr (cdr x))" " caddr: perhaps (caddr (cdr x)) -> (cadddr x)") (lint-test "(cdddr (car x))" " cdddr: perhaps (cdddr (car x)) -> (cdddar x)") (lint-test "(let ((x 3) (y 5)) (set! x (+ x y)) (+ x y))" " let: set! returns the new value, so this could be omitted: (+ x y)") (lint-test "(let ((x 3)) (set! x (+ x 1)) x)" " let: set! returns the new value, so this could be omitted: x let: perhaps (let ((x 3)) (set! x (+ x 1)) x) -> (let ((x (+ 3 1))) x)") (lint-test "(let ((x (list 1 2))) (set-car! x 3) (car x))" " let: set-car! returns the new value, so this could be omitted: (car x)") (lint-test "(let ((x (list 1 2))) (set-cdr! x 3) (cdr y))" "") (lint-test "(let ((g (make-oscil)) (v (make-vector 3))) (fill! v g) (oscil-bank v))" "") (lint-test "(begin (vector-set! x 0 32) (vector-ref x 0))" " begin: vector-set! returns the new value, so this could be omitted: (vector-ref x 0)") (lint-test "(begin (list-set! x (* y 2) 32) (list-ref x (* y 2)))" " begin: list-set! returns the new value, so this could be omitted: (list-ref x (* y 2))") (lint-test "(let () (vector-set! x 0 32) (vector-ref x 0))" " let: let could be begin: (let () (vector-set! x 0 32) (vector-ref x 0)) -> (begin (vector-set! x 0 32) (vector-ref x 0)) let: vector-set! returns the new value, so this could be omitted: (vector-ref x 0)") (lint-test "(let () (list-set! x (* y 2) 32) (list-ref x (* y 2)))" " let: let could be begin: (let () (list-set! x (* y 2) 32) (list-ref x (* y 2))) -> (begin (list-set! x (* y 2) 32) (list-ref x (* y 2))) let: list-set! returns the new value, so this could be omitted: (list-ref x (* y 2))") (lint-test "(begin (vector-set! x 0 (* y 2)) (* y 2))" " begin: vector-set! returns the new value, so this could be omitted: (* y 2)") (lint-test "(begin (z 1) (do ((i 0 (+ i 1))) ((= i n) 32)))" " begin: this do-loop could be replaced by 32: (do ((i 0 (+ i 1))) ((= i n) 32))") (lint-test "(vector-set! v i (vector-ref v i))" " vector-set!: redundant vector-set!: (vector-set! v i (vector-ref v i))") (lint-test "(list-set! v (+ i 1) (list-ref v (+ i 1)))" " list-set!: redundant list-set!: (list-set! v (+ i 1) (list-ref v (+ i 1)))") (lint-test "(string-set! v (+ i 1) (string-ref v (+ i 1)))" " string-set!: redundant string-set!: (string-set! v (+ i 1) (string-ref v (+ i 1)))") (lint-test "(vector-ref (vector-ref x 0) y)" " vector-ref: perhaps (vector-ref (vector-ref x 0) y) -> (x 0 y)") (lint-test "(vector-ref (make-vector 3) 1)" " vector-ref: this doesn't make much sense: (vector-ref (make-vector 3) 1)") (lint-test "(list-ref (list-ref (list-ref (cadr x) (+ y 1)) (+ y 2)) (+ y 3))" " list-ref: perhaps (list-ref (list-ref (list-ref (cadr x) (+ y 1)) (+ y 2)) (+ y 3)) -> ((cadr x) (+ y 1) (+ y 2) (+ y 3))") (if (not pure-s7) (lint-test "(current-output-port 123)" " current-output-port: too many arguments: (current-output-port 123)")) (lint-test "(copy (owlet))" " copy: (copy (owlet)) could be (owlet): owlet is copied internally") (lint-test "(gcd x '(asd))" " gcd: in (gcd x '(asd)), gcd's second argument should be rational, but '(asd) is a list?") (lint-test "(string #\\null)" "") (lint-test "(string (char->integer x))" " string: in (string (char->integer x)), string's argument should be a char, but (char->integer x) is an integer?") (lint-test "(string (string-ref x 0))" " string: perhaps (string (string-ref x 0)) -> (substring x 0 1)") (lint-test "(string (string-ref x 0) #\\a)" "") (lint-test "(string (char-downcase (string-ref x 1)) (char-downcase (string-ref x 2)))" " string: perhaps (string (char-downcase (string-ref x 1)) (char-downcase (string-ref x 2))) -> (string-downcase (string (string-ref x 1) (string-ref x 2)))") (lint-test "(+ 1 (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f)))" " +: in (+ 1 (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f))), +'s second argument should be a number, but #() is a vector? +: this dynamic-wind is pointless, (dynamic-wind (lambda () #f) (lambda () #()) (lambda () #f)) -> #()") (lint-test "(+ 1 (do () ((x) (display 3) #())))" " +: in (+ 1 (do () ((x) (display 3) #()))), +'s second argument should be a number, but #() is a vector?") (lint-test "(+ 1 (case x ((0) 1) ((1) #()) (else 2)))" " +: in (+ 1 (case x ((0) 1) ((1) #()) (else 2))), +'s second argument should be a number, but #() is a vector?") (lint-test "(+ 1 (values 2 3) #\\a)" " +: in (+ 1 (values 2 3) #\\a), +'s fourth argument should be a number, but #\\a is a char?") (lint-test "(+ 1 (values 2 #\\a) x)" " +: in (+ 1 (values 2 #\\a) x), +'s third argument should be a number, but #\\a is a char?") (lint-test "(let () ((lambda (a b) (+ (* 2 a) b)) (values 1 2)))" " let: pointless let: (let () ((lambda (a b) (+ (* 2 a) b)) (values 1 2)))") (lint-test "(close-output-port 022120)" " close-output-port: in (close-output-port 22120), close-output-port's argument should be an output-port or #f, but 22120 is an integer?") (lint-test "(close-input-port (log 32))" " close-input-port: in (close-input-port (log 32)), close-input-port's argument should be an input-port, but (log 32) is a number?") (lint-test "(+ 1 (call-with-exit (lambda (rtn) (+ x (rtn #\\a)))))" " +: in (+ 1 (call-with-exit (lambda (rtn) (+ x (rtn #\\a))))), +'s second argument should be a number, but #\\a is a char?") (lint-test "(call-with-exit (lambda (p) (+ x 1)))" " call-with-exit: call-with-exit exit function p appears to be unused: (call-with-exit (lambda (p) (+ x 1))) call-with-exit: p not used, initially: :call/exit from call-with-exit") (lint-test "(call-with-exit (lambda (return) (display x) (return (+ x y))))" " call-with-exit: return is redundant here: (return (+ x y))") (lint-test "(call-with-exit (lambda (p) (+ p 1)))" " call-with-exit: p is a continuation, but + in (+ p 1) wants a number?") (lint-test "(begin (call-with-exit (lambda (quit) (if (< x 0) (quit (+ x 1))) (display x))) (+ x 2))" " begin: this call-with-exit return value will be ignored: (quit (+ x 1))") (lint-test "(define (k1) (call-with-exit (lambda (quit) (display 'start) (quit 32) (newline))))" " k1: (quit 32) makes this pointless: (newline)") (lint-test "(+ 1 (call/cc (lambda (c) (if x c (c 2)))))" "") (lint-test "(+ 1 (call/cc (lambda (c) (if x (c 1) 2))))" " +: perhaps call/cc could be call-with-exit: (call/cc (lambda (c) (if x (c 1) 2)))") (lint-test "(call/cc (lambda (p) (+ x (p 1))))" " call/cc: perhaps call/cc could be call-with-exit: (call/cc (lambda (p) (+ x (p 1))))") (lint-test "(call/cc (lambda (p) p))" "") (lint-test "(call/cc (lambda (p) (lambda () p)))" "") (lint-test "(call/cc (lambda (p) (+ p 1)))" " call/cc: p is a continuation, but + in (+ p 1) wants a number?") (lint-test "(call-with-output-file file (lambda (p) (+ x 1)))" " call-with-output-file: p not used, initially: (open-output-file) from call-with-output-file") (lint-test "(call-with-input-file \"file\" (lambda (p) (read-char p)))" " call-with-input-file: perhaps (call-with-input-file \"file\" (lambda (p) (read-char p))) -> (call-with-input-file \"file\" read-char)") (lint-test "(with-output-to-string (lambda () (display object)))" " with-output-to-string: perhaps (with-output-to-string (lambda () (display object))) -> (object->string object #f)") (lint-test "(with-output-to-string (lambda () (write (car defs)) (newline)))" " with-output-to-string: perhaps (with-output-to-string (lambda () (write (car defs)) (newline))) -> (format #f \"~S~%\" (car defs))") (lint-test "(with-output-to-string (lambda () (write answer)))" " with-output-to-string: perhaps (with-output-to-string (lambda () (write answer))) -> (object->string answer)") (lint-test "(call-with-output-string (lambda (p) (display object p)))" " call-with-output-string: perhaps (call-with-output-string (lambda (p) (display object p))) -> (object->string object #f)") (lint-test "(quasiquote 1 2)" " quasiquote: quasiquote has too many arguments: (quasiquote 1 2)") (lint-test "(apply + 1)" " apply: last argument should be a list: (apply + 1)") (lint-test "(apply (lambda (x) (abs x)) y)" " apply: perhaps (assuming y is a list of one element) (apply (lambda (x) (abs x)) y) -> (abs (car y)) apply: perhaps (lambda (x) (abs x)) -> abs") (lint-test "(apply (lambda (x) (f x)) y)" " apply: perhaps (assuming y is a list of one element) (apply (lambda (x) (f x)) y) -> (f (car y)) apply: perhaps (lambda (x) (f x)) -> f") (lint-test "(apply (lambda (x) x) y)" " apply: perhaps (assuming y is a list of one element) (apply (lambda (x) x) y) -> (car y)") (lint-test "(apply log (list x y))" " apply: perhaps (apply log (list x y)) -> (log x y)") (lint-test "(apply + 1 2 ())" " apply: perhaps (apply + 1 2 ()) -> (+ 1 2)") (lint-test "(apply + '(1 2 3))" " apply: perhaps (apply + '(1 2 3)) -> (+ 1 2 3)") (lint-test "(apply eq? '(a b))" " apply: perhaps (apply eq? '(a b)) -> (eq? 'a 'b)") (lint-test "(apply f '(a b (c)))" " apply: perhaps (apply f '(a b (c))) -> (f 'a 'b '(c))") (lint-test "(apply f ())" " apply: perhaps (apply f ()) -> (f)") (lint-test "(apply list x)" " apply: perhaps (apply list x) -> x") (lint-test "(apply real? 1 3 rest)" " apply: too many arguments for real?: (apply real? 1 3 rest)") (lint-test "(apply f)" " apply: perhaps (apply f) -> (f)") (lint-test "(apply + (cons a b))" " apply: perhaps (apply + (cons a b)) -> (apply + a b)") (lint-test "(apply string (reverse chars))" " apply: perhaps (apply string (reverse chars)) -> (reverse (apply string chars))") (lint-test "(apply + x y ())" " apply: perhaps (apply + x y ()) -> (+ x y)") (lint-test "(apply log x '())" " apply: perhaps (apply log x '()) -> (log x) apply: quote is not needed here: '()") (lint-test "(apply f (append (list y z) a b))" " apply: perhaps (apply f (append (list y z) a b)) -> (apply f y z (append a b))") (lint-test "(apply f (append (list y z)))" " apply: perhaps (apply f (append (list y z))) -> (apply f y z ()) apply: perhaps (append (list y z)) -> (list y z)") (lint-test "(apply f (append (list y z) a))" " apply: perhaps (apply f (append (list y z) a)) -> (apply f y z a) apply: perhaps (append (list y z) a) -> (cons y (cons z a))") (lint-test "(apply map f (list x y))" " apply: perhaps (apply map f (list x y)) -> (map f x y)") (lint-test "(apply string-append (map (lambda (x) (string-append x \" \")) input-files))" " apply: perhaps (apply string-append (map (lambda (x) (string-append x \" \")) input-files)) -> (format #f \"~{~A ~}\" input-files)") (lint-test "(apply string-append (map symbol->string args))" " apply: perhaps (apply string-append (map symbol->string args)) -> (format #f \"~{~A~}\" args)") (lint-test "(apply f y z (list a b))" " apply: perhaps (apply f y z (list a b)) -> (f y z a b)") (lint-test "(apply append (map vector->list args))" " apply: perhaps (apply append (map vector->list args)) -> (vector->list (apply append args))") (lint-test "(apply f (cons a (cons b c)))" " apply: perhaps (apply f (cons a (cons b c))) -> (apply f a b c)") (lint-test "(apply car x)" " apply: perhaps (apply car x) -> (car (car x))") (lint-test "(apply string (map char-downcase x))" " apply: perhaps, assuming x is a list, (apply string (map char-downcase x)) -> (string-downcase (apply string x))") (lint-test "(apply f `(x ,y ,@z))" " apply: perhaps (apply f (list-values 'x y (apply-values z))) -> (apply f 'x y z) apply: perhaps (list-values 'x y (apply-values z)) -> (cons 'x (cons y z))") (lint-test "(apply f `(,@(list x y)))" " apply: perhaps (apply f (list-values (apply-values (list x y)))) -> (apply f (list x y)) apply: perhaps (list-values (apply-values (list x y))) -> (list x y)") (lint-test "(apply f `(x (,y 1) ,z))" " apply: perhaps (apply f (list-values 'x (list-values y 1) z)) -> (f 'x (list y 1) z)") (lint-test "(apply make-string tcnt initializer)" "") (lint-test "(apply cons x y)" " apply: perhaps (apply cons x y) -> (cons x (car y))") (lint-test "(apply string (make-list pad #\\null))" " apply: perhaps (apply string (make-list pad #\\null)) -> (make-string pad #\\null)") (lint-test "(let ((v (vector 1 2 3))) (apply v (make-list 1 0)))" ; don't complain here that v is not a procedure! " let: perhaps (let ((v (vector 1 2 3))) (apply v (make-list 1 0))) -> (apply (vector 1 2 3) (make-list 1 0))") (lint-test "(apply (lambda (x) (+ x 1)) y ())" " apply: perhaps (apply (lambda (x) (+ x 1)) y ()) -> ((lambda (x) (+ x 1)) y)") (lint-test "(apply append (map list x))" " apply: perhaps (apply append (map list x)) -> x") (lint-test "(apply f (car x) (cdr x))" " apply: perhaps (apply f (car x) (cdr x)) -> (apply f x)") (lint-test "(eval '(+ 1 2))" " eval: perhaps (eval '(+ 1 2)) -> (+ 1 2)") (lint-test "(eval 32)" " eval: this eval is pointless; perhaps (eval 32) -> 32") (lint-test "(eval 'x)" " eval: perhaps (eval 'x) -> x") (lint-test "(eval (string->symbol \"x\"))" " eval: perhaps (eval (string->symbol \"x\")) -> x eval: perhaps (string->symbol \"x\") -> 'x") (lint-test "(eval 'x env)" " eval: perhaps (eval 'x env) -> (env 'x)") (lint-test "(eval (read (open-input-string expr)))" " eval: perhaps (eval (read (open-input-string expr))) -> (eval-string expr)") (lint-test "(eval (call-with-input-string port read))" " eval: perhaps (eval (call-with-input-string port read)) -> (eval-string port)") (lint-test "(eval '(begin (display (* x y)) z) env)" " eval: perhaps (eval '(begin (display (* x y)) z) env) -> (with-let env (display (* x y)) z)") (lint-test "(eval (list '* 2 x))" " eval: perhaps (eval (list '* 2 x)) -> (* 2 (eval x))") (lint-test "(eval (string->symbol str))" " eval: perhaps (eval (string->symbol str)) -> (eval-string str)") (lint-test "(write-char x (current-output-port))" " write-char: (current-output-port) is the default port for write-char: (write-char x (current-output-port))") (lint-test "(with-let 123 123)" " with-let: with-let: first argument should be an environment: (with-let 123 123)") (lint-test "(with-let (rootlet) 1)" "") (lint-test "(with-let e (define b (+ a 1)) (display a))" " with-let: b not used, initially: (+ a 1) from define") (lint-test "(string-length \"asdf\")" " string-length: perhaps (string-length \"asdf\") -> 4") (lint-test "(> 0 (string-length x))" " >: string-length can't be negative: (> 0 (string-length x))") (lint-test "(< (string-length x) 0)" " <: string-length can't be negative: (< (string-length x) 0)") (lint-test "(round '(1))" " round: in (round '(1)), round's argument should be real, but '(1) is a list?") (lint-test "(round '1.2)" " round: quote is not needed here: '1.2") (lint-test "(round (integer->char 96))" " round: in (round (integer->char 96)), round's argument should be real, but (integer->char 96) is a char? round: perhaps (integer->char 96) -> #\\`") (lint-test "(integer->char (+ (char->integer #\\space) 215))" " integer->char: perhaps (integer->char (+ (char->integer #\\space) 215)) -> #\\xf7") (let-temporarily ((*report-sloppy-assoc* #t)) (lint-test "(char->integer (read-char p))" " char->integer: in (char->integer (read-char p)), char->integer's argument should be a char, but (read-char p) might also be an eof-object? char->integer: perhaps (char->integer (read-char p)) -> (read-byte p)")) (lint-test "(write-char (integer->char c))" " write-char: perhaps (write-char (integer->char c)) -> (write-byte c)") (lint-test "(let ((v (make-vector 3))) (vector-set! v 3.14 #\\a))" "let: perhaps (let ((v (make-vector 3))) (vector-set! v 3.14 #\\a)) -> (vector-set! (make-vector 3) 3.14 #\\a) let: in (vector-set! v 3.14 #\\a), vector-set!'s second argument should be an integer, but 3.14 is a float?") (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 3.14 1))" "let: perhaps (let ((v (make-float-vector 3))) (float-vector-set! v 3.14 1)) -> (float-vector-set! (make-float-vector 3) 3.14 1) let: in (float-vector-set! v 3.14 1), float-vector-set!'s second argument should be an integer, but 3.14 is a float?") (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 1 3.14))" "let: perhaps (let ((v (make-float-vector 3))) (float-vector-set! v 1 3.14)) -> (float-vector-set! (make-float-vector 3) 1 3.14)") (lint-test "(let ((v (make-float-vector 3))) (float-vector-set! v 1 #\\a))" "let: perhaps (let ((v (make-float-vector 3))) (float-vector-set! v 1 #\\a)) -> (float-vector-set! (make-float-vector 3) 1 #\\a) let: in (float-vector-set! v 1 #\\a), float-vector-set!'s third argument should be real, but #\\a is a char?") (lint-test "(vector-set! (vector-ref a i) j x)" " vector-set!: perhaps (vector-set! (vector-ref a i) j x) -> (set! (a i j) x)") (lint-test "(vector-set! (vector-copy doc) i newval)" " vector-set!: (vector-copy doc) is simply discarded; perhaps (vector-set! (vector-copy doc) i newval) -> newval") (lint-test "(reverse! #i(1 2))" " reverse!: perhaps (reverse! #i(2 1)) -> #i(2 1) reverse!: #i(2 1) is a constant, so (reverse! #i(2 1)) is problematic") (lint-test "(sort! #r(0 1 2) <)" " sort!: #r(0.0 1.0 2.0) is a constant, so (sort! #r(0.0 1.0 2.0) <) is problematic") (lint-test "(string-fill! \"123\" #\\c)" " string-fill!: 123 is a constant, so (string-fill! \"123\" #\\c) is problematic") (lint-test "(list-fill! '(1 2 3) 1)" " list-fill!: '(1 2 3) is a constant, so (list-fill! '(1 2 3) 1) is problematic") (lint-test "(vector-fill! #(0 a) 2)" " vector-fill!: #(0 a) is a constant, so (vector-fill! #(0 a) 2) is problematic") (lint-test "(fill! #r(0 1 2) <)" " fill!: #r(0.0 1.0 2.0) is a constant, so (fill! #r(0.0 1.0 2.0) <) is problematic") (lint-test "(set-car! '(1 2) 3)" " set-car!: '(1 2) is a constant, so (set-car! '(1 2) 3) is problematic") (lint-test "(set-cdr! '(1 2) 3)" " set-cdr!: '(1 2) is a constant, so (set-cdr! '(1 2) 3) is problematic") (lint-test "(let ((x #r(1 2))) (vector-set! x 0 1))" " let: perhaps (let ((x #r(1.0 2.0))) (vector-set! x 0 1)) -> (vector-set! #r(1.0 2.0) 0 1) let: x's value, #r(1.0 2.0), is a literal constant, so this set! is trouble: (vector-set! x 0 1) let: x is a float-vector, so perhaps use float-vector-set!, not vector-set!") (lint-test "(int-vector-set! #i(0 1) 0 1)" " int-vector-set!: #i(0 1) is a constant, so int-vector-set! is problematic, and #i(0 1) is discarded; perhaps (int-vector-set! #i(0 1) 0 1) -> 1") (lint-test "(float-vector-set! #r(0 1) 0 1)" " float-vector-set!: #r(0.0 1.0) is a constant, so float-vector-set! is problematic, and #r(0.0 1.0) is discarded; perhaps (float-vector-set! #r(0.0 1.0) 0 1) -> 1") (lint-test "(list-set! '(1 2) 0 1)" " list-set!: '(1 2) is a constant, so list-set! is problematic, and '(1 2) is discarded; perhaps (list-set! '(1 2) 0 1) -> 1") (lint-test "(string-set! \"123\" 0 #\\c)" " string-set!: \"123\" is a constant, so string-set! is problematic, and \"123\" is discarded; perhaps (string-set! \"123\" 0 #\\c) -> #\\c") (lint-test "(vector-set! #(1 2) 0 32)" " vector-set!: #(1 2) is a constant, so vector-set! is problematic, and #(1 2) is discarded; perhaps (vector-set! #(1 2) 0 32) -> 32 vector-set!: #(1 2) could be #i(1 2)") (lint-test "(int-vector-set! #r(0 1) 0 1)" " int-vector-set!: in (int-vector-set! #r(0.0 1.0) 0 1), int-vector-set!'s first argument should be an int-vector, but #r(0.0 1.0) is a float-vector? int-vector-set!: #r(0.0 1.0) is a constant, so int-vector-set! is problematic, and #r(0.0 1.0) is discarded; perhaps (int-vector-set! #r(0.0 1.0) 0 1) -> 1") (lint-test "(float-vector-set! #i(0 1) 0 1)" " float-vector-set!: in (float-vector-set! #i(0 1) 0 1), float-vector-set!'s first argument should be a float-vector, but #i(0 1) is an int-vector? float-vector-set!: #i(0 1) is a constant, so float-vector-set! is problematic, and #i(0 1) is discarded; perhaps (float-vector-set! #i(0 1) 0 1) -> 1") (lint-test "(float-vector-set! #(0 1) 0 1)" " float-vector-set!: in (float-vector-set! #(0 1) 0 1), float-vector-set!'s first argument should be a float-vector, but #(0 1) is a vector? float-vector-set!: #(0 1) is a constant, so float-vector-set! is problematic, and #(0 1) is discarded; perhaps (float-vector-set! #(0 1) 0 1) -> 1 float-vector-set!: #(0 1) could be #i(0 1)") (lint-test "(vector-set! (make-vector 1) 0 1)" " vector-set!: (make-vector 1) is simply discarded; perhaps (vector-set! (make-vector 1) 0 1) -> 1") (lint-test "(vector-set! #(0) 1 2)" " vector-set!: index 1 is too large in (vector-set! #(0) 1 2) vector-set!: #(0) could be #i(0)") (lint-test "(int-vector-set! (float-vector 0 1) 0 1)" " int-vector-set!: in (int-vector-set! (float-vector 0 1) 0 1), int-vector-set!'s first argument should be an int-vector, but (float-vector 0 1) is a float-vector? int-vector-set!: (float-vector 0 1) is simply discarded; perhaps (int-vector-set! (float-vector 0 1) 0 1) -> 1") (lint-test "(set! (#(1 a) 0) 32)" " set!: #(1 a) is a constant so (set! (#(1 a) 0) 32) is problematic") (lint-test "(string-downcase \"SPEAK SOFTLY\")" " string-downcase: perhaps (string-downcase \"SPEAK SOFTLY\") -> \"speak softly\"") (lint-test "(vector-length (copy arr))" " vector-length: perhaps (vector-length (copy arr)) -> (vector-length arr)") (lint-test "(vector-length (copy src dest))" " vector-length: perhaps (vector-length (copy src dest)) -> (vector-length dest)") (lint-test "(vector-length (vector-copy arr start))" " vector-length: perhaps (vector-length (vector-copy arr start)) -> (- (vector-length arr) start)") (lint-test "(vector-length (vector-copy arr start end))" " vector-length: perhaps (vector-length (vector-copy arr start end)) -> (- end start)") (lint-test "(odd? (- x 1))" " odd?: perhaps (odd? (- x 1)) -> (even? x)") (lint-test "(even? (+ 2 x))" " even?: perhaps (even? (+ 2 x)) -> (even? x)") (lint-test "(even? (- 1 x))" " even?: perhaps (even? (- 1 x)) -> (odd? x)") (lint-test "(even? (- 1 2))" " even?: perhaps (even? (- 1 2)) -> #f even?: perhaps (- 1 2) -> -1") (lint-test "(string-append str (format () str arg))" "") ; 19-Mar-24 (lint-test "(not (peek-char))" " not: (not (peek-char)) can't be true (peek-char never returns #f) not: perhaps (not (peek-char)) -> #f") (lint-test "(number->string saturation 10)" " number->string: 10 is the default radix for number->string: (number->string saturation 10)") (lint-test "(<= (string-length m) 0)" " <=: string-length is never negative, so (<= (string-length m) 0) -> (= (string-length m) 0)") (lint-test "(>= (vector-length m) 0)" " >=: vector-length is never negative, so (>= (vector-length m) 0) -> #t") (lint-test "(<= 0 (string-length m))" " <=: string-length is never negative, so (<= 0 (string-length m)) -> #t") (lint-test "(>= 0 (vector-length m))" " >=: vector-length is never negative, so (>= 0 (vector-length m)) -> (= 0 (vector-length m))") (lint-test "(cdr (or (assq 'cpu annot) '(_ . 0)))" " cdr: perhaps (cdr (or (assq 'cpu annot) '(_ . 0))) -> (cond ((assq 'cpu annot) => cdr) (else 0))") (lint-test "(cdr (or (memv #\\. file) (cons #\\. file)))" " cdr: perhaps (cdr (or (memv #\\. file) (cons #\\. file))) -> (cond ((memv #\\. file) => cdr) (else file))") (lint-test "(number->string (cdr (or (assv i alist) (cons 0 0))))" " number->string: perhaps (cdr (or (assv i alist) (cons 0 0))) -> (cond ((assv i alist) => cdr) (else 0))") (lint-test "(cdr (or (assoc n oi) `(,n)))" " cdr: perhaps (cdr (or (assoc n oi) (list-values n))) -> (cond ((assoc n oi) => cdr) (else (list))) cdr: perhaps (list-values n) -> (list n)") (lint-test "(cdr (or (assoc n oi) (list n y)))" " cdr: perhaps (cdr (or (assoc n oi) (list n y))) -> (cond ((assoc n oi) => cdr) (else (list y)))") (lint-test "(cdr (or (assoc n oi) (list n y z)))" " cdr: perhaps (cdr (or (assoc n oi) (list n y z))) -> (cond ((assoc n oi) => cdr) (else (list y z)))") (lint-test "(cdr (or (find i alist) (error 'oops)))" " cdr: perhaps (cdr (or (find i alist) (error 'oops))) -> (cond ((find i alist) => cdr) (else (error 'oops)))") (lint-test "(cadr (or (find i alist) '(1 2 3)))" " cadr: perhaps (cadr (or (find i alist) '(1 2 3))) -> (cond ((find i alist) => cadr) (else 2))") (lint-test "(list->vector (reverse nts))" " list->vector: perhaps (list->vector (reverse nts)) -> (reverse (list->vector nts))") (lint-test "(cadr (reverse (f x)))" " cadr: perhaps (cadr (reverse (f x))) -> (let ((<1> (f x))) (list-ref <1> (- (length <1>) 2)))") (lint-test "(begin (if x (error 'oops)) (if x y))" " begin: x is #f in (if x y) begin: perhaps (... (if x (error 'oops)) (if x y) ...) -> (... (when x (error 'oops) y) ...)") (let-temporarily ((*report-sloppy-assoc* #t)) (lint-test "(round (char-position #\\a \"asb\"))" " round: in (round (char-position #\\a \"asb\")), round's argument should be real, but (char-position #\\a \"asb\") might also be #f")) (lint-test "(string-ref (char-position #\\a \"asb\") 1)" " string-ref: in (string-ref (char-position #\\a \"asb\") 1), string-ref's first argument should be a string, but (char-position #\\a \"asb\") is an integer or #f") (lint-test "(char-position \"xyz\" \"asb\")" "") (lint-test "(if (null? (cons x y)) 1.0 0.0)" " if: perhaps (null? (cons x y)) -> #f if: perhaps (if (null? (cons x y)) 1.0 0.0) -> 0.0") (lint-test "(if (null (cdr x)) 0)" " if: misspelled 'null? in (null (cdr x))?") (lint-test "(list-set x 1 y)" " list-set: misspelled 'list-set! in (list-set x 1 y)?") (lint-test "(string-index path #\\/)" " string-index: perhaps (string-index path #\\/) -> (char-position #\\/ path)") (lint-test "(string-index path #\\/ start end)" " string-index: perhaps (string-index path #\\/ start end) -> (char-position #\\/ path start end)") (lint-test "(cons* x y)" " cons*: perhaps (cons* x y) -> (cons x y)") (lint-test "(if (pair? (sin x)) 1.0 0.0)" " if: perhaps (pair? (sin x)) -> #f if: perhaps (if (pair? (sin x)) 1.0 0.0) -> 0.0") (lint-test "(if (number? (sin x)) 1.0)" " if: perhaps (number? (sin x)) -> #t if: perhaps (if (number? (sin x)) 1.0) -> 1.0") (lint-test "(if (number? (car x)) 1.0)" "") (lint-test "(if (real? (sin x)) 1.0)" "") (lint-test "(let ((list x)) (null? list))" " let: perhaps (let ((list x)) (null? list)) -> (null? x)") (lint-test "(set! x (real? (imag-part z)))" "set!: perhaps (real? (imag-part z)) -> #t set!: (real? (imag-part z)) is always #t") (lint-test "(let ((x (char? (string-ref z y)))) x)" " let: perhaps (char? (string-ref z y)) -> #t let: (char? (string-ref z y)) is always #t let: perhaps (let ((x (char? (string-ref z y)))) x) -> (char? (string-ref z y))") (lint-test "(case (number? (log x y)) ((#f) 0) ((#t) 1))" " case: perhaps (number? (log x y)) -> #t case: (number? (log x y)) is always #t") (lint-test "(let () (define (f9 x) (write x)) (f9 (vector? (vector))))" " let: perhaps (... (define (f9 x) (write x)) (f9 (vector? (vector)))) -> (... (let ((x (vector? (vector)))) (write x))) f9: leaving aside write's optional arg, f9 could be (define f9 write) let: perhaps (vector? (vector)) -> #t let: (vector? (vector)) is always #t") (lint-test "(display (string? (string)))" " display: perhaps (string? (string)) -> #t display: (string? (string)) is always #t display: (string) could be \"\"") (lint-test "(if (number? 1.0) 1.0 0.0)" " if: perhaps (number? 1.0) -> #t if: perhaps (if (number? 1.0) 1.0 0.0) -> 1.0") (lint-test "(if (pair? 1.0) 1.0 0.0)" " if: perhaps (pair? 1.0) -> #f if: perhaps (if (pair? 1.0) 1.0 0.0) -> 0.0") (lint-test "(if (symbol? (string->symbol x)) 0 1)" " if: perhaps (symbol? (string->symbol x)) -> #t if: perhaps (if (symbol? (string->symbol x)) 0 1) -> 0") (lint-test "(if (symbol? (symbol->string x)) 0 1)" " if: perhaps (symbol? (symbol->string x)) -> #f if: perhaps (if (symbol? (symbol->string x)) 0 1) -> 1") (lint-test "(and (symbol? x) (gensym? x))" " and: perhaps (and (symbol? x) (gensym? x)) -> (gensym? x)") (lint-test "(integer? (*s7* 'vector-print-length))" " integer?: unknown *s7* field: 'vector-print-length") (lint-test "(dynamic-wind (lambda () (+)) (lambda () (list)) (lambda () #f))" " dynamic-wind: this could be omitted: (+) in (lambda () (+)) dynamic-wind: this dynamic-wind is pointless, (dynamic-wind (lambda () (+)) (lambda () (list)) (lambda () #f)) -> (list) dynamic-wind: perhaps (lambda () (+)) -> + dynamic-wind: perhaps (+) -> 0 dynamic-wind: perhaps (lambda () (list)) -> list dynamic-wind: perhaps (list) -> (); there is only one nil") (lint-test "(lambda args (apply + args))" " lambda: perhaps (lambda args (apply + args)) -> +") (lint-test "(let ((x 1) (y '(1 2))) `(,x ,@y))" " let: perhaps (list-values x (apply-values y)) -> (cons x y)") (lint-test "(display #\\escape)" "") ;; these tickled a lint bug (lint-test "(define :xxx 321)" " define: keywords are constants :xxx") (lint-test "(define (:yyy a) a)" " define: keywords are constants :yyy") (lint-test "(cons ((pair? x) 2) y)" " cons: cons's argument ((pair? x) 2) looks odd: pair? returns boolean? which is not applicable") (lint-test "(cons ((g x) y) (else #f))" " cons: else (as car of second argument to cons) makes no sense: (cons ((g x) y) (else #f))") (lint-test "(let ((r (make-random-state 123 432))) (random 1.0 r))" " let: make-random-state is deprecated; use random-state let: perhaps (let ((r (make-random-state 123 432))) (random 1.0 r)) -> (random 1.0 (make-random-state 123 432))") (lint-test "(let ((c (current-environment))) (defined? 'x c))" " let: current-environment is deprecated; use curlet let: perhaps (let ((c (current-environment))) (defined? 'x c)) -> (defined? 'x (current-environment))") (lint-test "(let ((x 1) (y 2)) (if (= x 1) (begin (define (f1) x) (define (f2) (+ x 1)))) (f1 1))" " let: perhaps (if (= x 1) (begin (define (f1) x) (define (f2) (+ x 1)))) -> (when (= x 1) (define (f1) x) (define (f2) (+ x 1))) let: f1 has too many arguments: (f1 1) let: y not used, initially: 2 from let") ;; ideally we'd also point out that f2 is unused (lint-test "(let ((x 1) (y 2)) (when (= x 1) (begin (define (f1) x) (define (f2) (+ x 1)))) (f1 1))" " let: redundant begin: (begin (define (f1) x) (define (f2) (+ x 1))) let: f1 has too many arguments: (f1 1) let: y not used, initially: 2 from let") ;; and here also (lint-test "(define)" " define: (define) makes no sense") (lint-test "(define a)" " define: (define a) has no value?") (lint-test "(let () (define (f a) (+ a b)) (define b 21) (f 1))" " let: b is used before it is defined: (define b 21)") (lint-test "(define a . b)" " define: (define a . b) makes no sense") (lint-test "(define a b c)" " define: (define a b c) has too many values?") (lint-test "(define a a)" " define: this define is either not needed, or is an error: (define a a)") (lint-test "(define #(a) 2)" " define: strange form: (define #(a) 2)") (lint-test "(define (f1 a) (abs a))" " f1: f1 could be (define f1 abs)") (lint-test "(define (f1 a b) \"a docstring\" (log a b))" " f1: f1 could be (define f1 log)") (lint-test "(let () (define (f1 a b) (* 2 (log a b))) (define (f2 a b) (f1 a b)) (f2 1 2))" " let: perhaps change f2 to a let: (let () (define (f1 a b) (* 2 (log a b))) (define (f2 a b) (f1 a b)) (f2 1 2)) -> (... (let ((a 1) (b 2)) ...)) f2: f2 could be (define f2 f1) f1 is called only in f2") (lint-test "(define (f x) (define aaa 1) (define aaa 2) (+ aaa 1))" " f: perhaps (... (define aaa 1) (define aaa 2) (+ aaa 1)) -> (... (let ((aaa 1) (aaa 2)) ...)) f: define variable aaa is redefined in the define body. Perhaps use set! instead: (set! aaa 2) f: aaa not used, initially: 1 from define") (lint-test "(lambda ())" " lambda: lambda is messed up in (lambda ())") (lint-test "(lambda (a b a) a)" " lambda: lambda parameter is repeated: (a b a) lambda: lambda parameter a is declared twice") (lint-test "((lambda () 32) 0)" " (lambda () 32): perhaps ((lambda () 32) 0) -> 32") (lint-test "((lambda x x) 1 2 3)" " (lambda x x): perhaps ((lambda x x) 1 2 3) -> (list 1 2 3)") (lint-test "((lambda (a b) (+ a b)) 1)" " (lambda (a b) (+ a b)): perhaps (lambda (a b) (+ a b)) -> +") (lint-test "((lambda* ((a 1) b) (+ a b)) (values 2 3))" "") (lint-test "(lambda* (:key a :optional b :rest c :allow-other-keys) a)" " lambda*: :key is no longer accepted: (:key a :optional b :rest ...") (lint-test "(lambda* (a :rest) a)" " lambda*: :rest parameter needs a name: (a :rest)") (lint-test "(lambda* (a :rest (b 1)) b)" " lambda*: :rest parameter can't specify a default value: (a :rest (b 1))") (lint-test "(lambda* (a :allow-other-keys b) a)" " lambda*: :allow-other-keys should be at the end of the parameter list:(a :allow-other-keys b)") (lint-test "(lambda (a :b c) a)" " lambda: lambda arglist can't handle keywords (use lambda*)") (lint-test "(lambda (a b) (>= b a))" " lambda: perhaps (lambda (a b) (>= b a)) -> <=") (lint-test "(lambda (a b c) (/ a b c))" " lambda: perhaps (lambda (a b c) (/ a b c)) -> /") (lint-test "(lambda (a . b) (apply + a b))" " lambda: perhaps (lambda (a . b) (apply + a b)) -> +") (lint-test "(lambda args (apply and args))" "") (lint-test "(lambda (x y) (and x y))" "") (lint-test "((lambda (x) x) 32)" " (lambda (x) x): perhaps ((lambda (x) x) 32) -> 32") (lint-test "((lambda (x) (cdr (cdr (car x)))) z)" " (lambda (x) (cdr (cdr (car x)))): perhaps ((lambda (x) (cdr (cdr (car x)))) z) -> (let ((x z)) (cdr (cdr (car x)))) (lambda (x) (cdr (cdr (car x)))): perhaps (lambda (x) (cdr (cdr (car x)))) -> cddar (lambda (x) (cdr (cdr (car x)))): perhaps (cdr (cdr (car x))) -> (cddar x)") (lint-test "((lambda () (+ x y)))" " (lambda () (+ x y)): perhaps ((lambda () (+ x y))) -> (+ x y)") (lint-test "((lambda () (define (f123 x) (+ x 1)) (f123 32)))" " (lambda () (define (f123 x) (+ x 1)) (f123 32)): perhaps ((lambda () (define (f123 x) (+ x 1)) (f123 32))) -> (let () (define (f123 x) (+ x 1)) (f123 32)) (lambda () (define (f123 x) (+ x 1)) (f123 32)): the inner function f123 could be moved outside the lambda: (lambda () (define (f123 x) (+ x 1)) (f123 32)) -> (let () (define (f123 x) (+ x 1)) (lambda () ...)) (lambda () (define (f123 x) (+ x 1)) (f123 32)): perhaps (... (define (f123 x) (+ x 1)) (f123 32)) -> (... (let ((x 32)) (+ x 1)))") (lint-test "((lambda (x) (+ x 1)) y)" " (lambda (x) (+ x 1)): perhaps ((lambda (x) (+ x 1)) y) -> (let ((x y)) (+ x 1))") (lint-test "((lambda x (+ (car x) 1)) y)" " (lambda x (+ (car x) 1)): perhaps ((lambda x (+ (car x) 1)) y) -> (let ((x (list y))) (+ (car x) 1))") (lint-test "((lambda x (+ (car x) 1)) y z)" " (lambda x (+ (car x) 1)): perhaps ((lambda x (+ (car x) 1)) y z) -> (let ((x (list y z))) (+ (car x) 1))") (lint-test "((lambda x (+ (car x) 1)))" " (lambda x (+ (car x) 1)): perhaps ((lambda x (+ (car x) 1))) -> (let ((x (list))) (+ (car x) 1))") (lint-test "((lambda (x . y) (+ x (car y))) a b)" " (lambda (x . y) (+ x (car y))): perhaps ((lambda (x . y) (+ x (car y))) a b) -> (let ((x a) (y (list b))) (+ x (car y)))") (lint-test "((lambda* ((x 1)) (+ x 1)))" " (lambda* ((x 1)) (+ x 1)): perhaps ((lambda* ((x 1)) (+ x 1))) -> (let ((x 1)) (+ x 1))") (lint-test "((lambda* ((x 1)) (+ x 1)) y)" " (lambda* ((x 1)) (+ x 1)): perhaps ((lambda* ((x 1)) (+ x 1)) y) -> (let ((x y)) (+ x 1))") (lint-test "((lambda* (x (y 1)) (+ x y)) z)" " (lambda* (x (y 1)) (+ x y)): perhaps ((lambda* (x (y 1)) (+ x y)) z) -> (let* ((x z) (y 1)) (+ x y))") (lint-test "((lambda* (x (y 1)) (+ x y)) a b)" " (lambda* (x (y 1)) (+ x y)): perhaps ((lambda* (x (y 1)) (+ x y)) a b) -> (let* ((x a) (y b)) (+ x y))") (lint-test "((lambda* (x (y 1)) (+ x y)))" " (lambda* (x (y 1)) (+ x y)): perhaps ((lambda* (x (y 1)) (+ x y))) -> (let* ((x #f) (y 1)) (+ x y))") (lint-test "(lambda (i) (define (fdo x) (+ x 1)) (if (= i 3) (display (fdo i)) (loop (+ i 1))))" " lambda: the inner function fdo could be moved outside the lambda: (lambda (i) (define (fdo x) (+ x 1)) (if (= i 3) (display (fdo i)) (loop... -> (let () (define (fdo x) (+ x 1)) (lambda (i) ...)) lambda: perhaps (... (define (fdo x) (+ x 1)) (if (= i 3) (display (fdo i)) (loop (+ i 1)))) -> (... (if (= i 3) (display (let ((x i)) (+ x 1))) (loop (+ i 1))))") (lint-test "(lambda (i) (define (fdo x) (+ (fdi x) 1)) (define (fdi y) (* y 2)) (if (= i 3) (display (fdo i)) (loop (+ i 1))))" " lambda: the inner functions fdo, fdi could be moved outside the lambda: (lambda (i) (define (fdo x) (+ (fdi x) 1)) (define (fdi y) (* y 2)) (if (=... -> (let () (define (fdo x) (+ (fdi x) 1)) (define (fdi y) (* y 2)) (lambda (i) ...))") (lint-test "(lambda (i) (define (fdo x) (+ (fdi x) i)) (define (fdi y) (* y 2)) (if (= i 3) (display (fdo i)) (loop (+ i 1))))" " lambda: the inner function fdi could be moved outside the lambda: (lambda (i) (define (fdo x) (+ (fdi x) i)) (define (fdi y) (* y 2)) (if (=... -> (let () (define (fdi y) (* y 2)) (lambda (i) ...))") (lint-test "(lambda (i) (let ((y 32)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))))" " lambda: the inner function fdo could be moved outside the lambda: (lambda (i) (let ((y 32)) (define (fdo x) (+ x 1)) (if (= i y) (display... -> (let () (define (fdo x) (+ x 1)) (lambda (i) ...)) lambda: perhaps (... (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) -> (... (if (= i y) (display (let ((x i)) (+ x 1))) (loop (+ i 1)))) lambda: y can be moved to lambda's closure") (lint-test "(let ((y 33)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1))))" " let: the inner function fdo could be moved into the let: (let ((y 33)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop... -> (let ((y 33) (fdo (lambda (x) (+ x 1)))) ...) let: perhaps (... (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) -> (... (if (= i y) (display (let ((x i)) (+ x 1))) (loop (+ i 1))))") (lint-test "(let* ((y 34) (z (log y))) (define (fdo x) (+ x 1)) (if (= z y) (display (fdo y)) (loop (+ i 1))))" " let*: the inner function fdo could be moved out of the let*: (let* ((y 34) (z (log y))) (define (fdo x) (+ x 1)) (if (= z y) (display... -> (let ((fdo (lambda (x) (+ x 1)))) (let* ((y 34) (z (log y))) ...)) let*: perhaps (... (define (fdo x) (+ x 1)) (if (= z y) (display (fdo y)) (loop (+ i 1)))) -> (... (if (= z y) (display (let ((x y)) (+ x 1))) (loop (+ i 1))))") (lint-test "(define (fda y) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y))))" " define: the inner function fdo could be moved to fda's closure: (define (fda y) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) -> (define fda (let () (define (fdo x) (+ x 1)) (lambda (y) ...))) define: perhaps (define (fda y) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) -> (define (fda y) (if (= y 3) (display (let ((x y)) (+ x 1)))))") (lint-test "(define* (fda (y 32) :rest z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo z))))" " define*: the inner function fdo could be moved to fda's closure: (define* (fda (y 32) :rest z) (define (fdo x) (+ x 1)) (if (= y 3)... -> (define fda (let () (define (fdo x) (+ x 1)) (lambda* ((y 32) :rest z) ...))) define*: perhaps (define* (fda (y 32) :rest z) (define (fdo x) (+ x 1)) (if (= y 3)... -> (define* (fda (y 32) :rest z) (if (= y 3) (display (let ((x z)) (+ x 1)))))") (lint-test "(define (fda y . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y))))" " define: the inner function fdo could be moved to fda's closure: (define (fda y . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) -> (define fda (let () (define (fdo x) (+ x 1)) (lambda (y . z) ...))) define: perhaps (define (fda y . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) -> (define (fda y . z) (if (= y 3) (display (let ((x y)) (+ x 1)))))") (lint-test "(define (fda y z) (define (fdo . x) (list x 1)) (if (= y 3) (display (fdo y))))" " define: the inner function fdo could be moved to fda's closure: (define (fda y z) (define (fdo . x) (list x 1)) (if (= y 3) (display (fdo y)))) -> (define fda (let () (define (fdo . x) (list x 1)) (lambda (y z) ...)))") (lint-test "(define (fda z) (define (fdo x . y) (list x y)) (if (= z 3) (display (fdo z))))" " define: the inner function fdo could be moved to fda's closure: (define (fda z) (define (fdo x . y) (list x y)) (if (= z 3) (display (fdo z)))) -> (define fda (let () (define (fdo x . y) (list x y)) (lambda (z) ...)))") (lint-test "(define (fda . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y))))" " define: the inner function fdo could be moved to fda's closure: (define (fda . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) -> (define fda (let () (define (fdo x) (+ x 1)) (lambda z ...))) define: perhaps (define (fda . z) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y)))) -> (define (fda . z) (if (= y 3) (display (let ((x y)) (+ x 1)))))") (lint-test "(lambda (i) (let ((y 32)) (define (fdo i) (+ i 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))))" " lambda: the inner function fdo could be moved outside the lambda: (lambda (i) (let ((y 32)) (define (fdo i) (+ i 1)) (if (= i y) (display... -> (let () (define (fdo i) (+ i 1)) (lambda (i) ...)) lambda: perhaps (... (define (fdo i) (+ i 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) -> (... (if (= i y) (display (let ((i i)) (+ i 1))) (loop (+ i 1)))) lambda: y can be moved to lambda's closure") (lint-test "(lambda (i) (let ((y 32)) (define fdo (lambda (i) (+ i 1))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))" " lambda: the inner function fdo could be moved outside the lambda: (lambda (i) (let ((y 32)) (define fdo (lambda (i) (+ i 1))) (if (= i y)... -> (let () (define fdo (lambda (i) (+ i 1))) (lambda (i) ...)) lambda: y can be moved to lambda's closure") (lint-test "(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))" " define: the local function fdo could be moved to f's closure: (define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y)... -> (define f (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...))) f: y can be moved to f's closure") (lint-test "(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+ i 1)))))" " define: the inner function fdi could be moved to f's closure: (define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+... -> (define f (let () (define (fdi i) (+ i 2)) (lambda (x) ...))) define: the local function fdo could be moved to f's closure: (define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+... -> (define f (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...))) f: perhaps (... (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+... -> (... (if (= i y) (display (fdo (let ((i i)) (+ i 2)))) (loop (+ i 1)))) f: y can be moved to f's closure") (lint-test "(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))" " lambda: the local function fdo could be moved outside the lambda: (lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display... -> (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...)) lambda: y can be moved to lambda's closure") (lint-test "(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+ i 1)))))" " lambda: the inner function fdi could be moved outside the lambda: (lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i... -> (let () (define (fdi i) (+ i 2)) (lambda (x) ...)) lambda: the local function fdo could be moved outside the lambda: (lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i... -> (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...)) lambda: perhaps (... (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+... -> (... (if (= i y) (display (fdo (let ((i i)) (+ i 2)))) (loop (+ i 1)))) lambda: y can be moved to lambda's closure") (lint-test "(let () (define (f1 a) a) (f1 2 3))" " let: perhaps (... (define (f1 a) a) (f1 2 3)) -> (... (let ((a 2)) a)) let: f1 has too many arguments: (f1 2 3)") (lint-test "(let () (define-macro (m1 a) a) (m1 2 3))" " let: m1 has too many arguments: (m1 2 3)") (lint-test "(let () (define-macro (m2 b) `(let ((a 12)) (+ a ,b))) (let ((a 1) (+ *)) (+ a (m2 a))))" " let: possible problematic macro expansion: (m2 a) may collide with subsequently defined 'a, +") (lint-test "(let () (define-macro (m3 b) `(let ((a 12)) (+ (symbol->value ,b) a))) (let ((a 1)) (+ a (m3 'a))))" " let: possible problematic macro expansion: (m3 'a) could conceivably collide with subsequently defined 'a") (lint-test "(define-macro (f . x) `(+ ,@x))" " define-macro: perhaps (define-macro (f . x) (list-values '+ (apply-values x))) -> (define f +) f: perhaps (list-values '+ (apply-values x)) -> (cons '+ x)") (lint-test "(define-macro (f a . x) `(+ ,a ,@x))" " define-macro: perhaps (define-macro (f a . x) (list-values '+ a (apply-values x))) -> (define f +) f: perhaps (list-values '+ a (apply-values x)) -> (cons '+ (cons a x))") (lint-test "(define-macro (m1 a) `((,a b c)))" " m1: perhaps (list-values (list-values a 'b 'c)) -> (list (list a 'b 'c))") (lint-test "(define pi (acos -1))" " define: (acos -1) is one of its many names, but pi is a predefined constant pi: perhaps (acos -1) -> pi") (lint-test "(+ x (atan 0 -1))" " +: perhaps (+ x (atan 0 -1)) -> (+ x pi)") (lint-test "(define (f1) 32)" "") (lint-test "(define (f2 a) a)" "") (lint-test "(define (f3 . a) a)" "") (lint-test "(define (f4 a b) a)" "") (lint-test "(define (f5 a . b) a)" "") (lint-test "(define (f6 a b . c) a)" "") (lint-test "(define* (f1) 32)" " f1: define* could be define") (lint-test "(define* (f2 a) a)" "") (lint-test "(define* (f3 . a) a)" " f3: define* could be define") (lint-test "(define* (f4 a (b 2)) a)" "") (lint-test "(define* (f5 a :rest b) a)" "") (lint-test "(define* (f6 a b :allow-other-keys) a)" "") (lint-test "(define f1 (lambda () 32))" "") (lint-test "(define f2 (lambda (a) a))" "") (lint-test "(define f3 (lambda a a))" "") (lint-test "(define f4 (lambda (a b) a))" "") (lint-test "(define f5 (lambda (a . b) a))" "") (lint-test "(define-macro (f1) 32)" " define-macro: perhaps (define-macro (f1) 32) -> (define f1 32) or (define (f1) 32)") (lint-test "(define-macro (m1) 32)" " define-macro: perhaps (define-macro (m1) 32) -> (define m1 32) or (define (m1) 32)") (lint-test "(define-macro (m2) 'a)" "") (lint-test "(define-macro (m3) ''a)" " define-macro: perhaps (define-macro (m3) ''a) -> (define m3 'a) or (define (m3) 'a) m3: returns a list constant: ''a") (lint-test "(define-macro (m4 a) `(abs ,a))" " define-macro: perhaps (define-macro (m4 a) (list-values 'abs a)) -> (define m4 abs) m4: perhaps (list-values 'abs a) -> (list 'abs a)") (lint-test "(define-macro (m5 a) `(log ,a 2))" " define-macro: perhaps (define-macro (m5 a) (list-values 'log a 2)) -> (define (m5 a) (log a 2))") (lint-test "(define-macro (m6 a) `(+ ,a ,a))" "") ; here a might be (display 32) -- should happen twice (lint-test "(define-macro (m7 a b) `(set! ,a ,b))" " define-macro: perhaps (define-macro (m7 a b) (list-values 'set! a b)) -> (define m7 set!)") (lint-test "(define-macro (m8 a) `(lambda () ,a))" "") (lint-test "(define-macro (m8 a) `(let () ,a))" "") (lint-test "(define-macro (m9 a b) `(+ ,a (* ,b 2)))" "") (lint-test "(define-macro (m10 a) `(+ ,a x))" " define-macro: perhaps (define-macro (m10 a) (list-values '+ a 'x)) -> (define (m10 a) (+ a x))") (lint-test "(define-macro (m11) (- -1 (* -2 (expt 2 28))))" " define-macro: perhaps (define-macro (m11) (- -1 (* -2 (expt 2 28)))) -> (define m11 (- -1 (* -2 (expt 2 28)))) or (define (m11) (- -1 (* -2 (expt 2 28))))") (lint-test "(define-macro (f2 a) a)" "") (lint-test "(define-macro (f3 . a) a)" "") (lint-test "(define-macro (f4 a b) a)" "") (lint-test "(define-macro (f5 a . b) a)" "") (lint-test "(define-macro (f6 a b . c) a)" "") (unless (or pure-s7 immutable-unquote) (lint-test "(define-macro (mac a) `(+ ,,a 1))" (if immutable-unquote " mac: define-macro probably has too many unquotes: (list-values '+ ,a 1)" " mac: define-macro probably has too many unquotes: (list-values '+ (unquote a) 1)"))) (lint-test "(define-macro (m a) `(+ 1 a))" " define-macro: missing comma? (define-macro (m a) '(+ 1 a)) m: returns a list constant: '(+ 1 a)") (lint-test "(define-macro (m a) `(+ 1 ,a (* a 2)))" " define-macro: perhaps (define-macro (m a) (list-values '+ 1 a '(* a 2))) -> (define (m a) (+ 1 a (* a 2))) define-macro: missing comma? (define-macro (m a) (list-values '+ 1 a '(* a 2)))") (lint-test "(define-macro (m1 x) `(begin (vector-set! ,x 0 1)))" " m1: pointless begin: (list-values 'begin (list-values 'vector-set! x 0 1)) -> (list-values 'vector-set! x 0 1) m1: perhaps (list-values 'begin (list-values 'vector-set! x 0 1)) -> (list 'begin (list 'vector-set! x 0 1))") (lint-test "(let ((a 1)) (define (f1 b) (+ a b)) (f1 0))" " let: perhaps (... (define (f1 b) (+ a b)) (f1 0)) -> (... (let ((b 0)) (+ a b))) a is used only in f1") (lint-test "(let f1 ((a 1)) a)" " let: f1 not used, value: (let f1 ((a 1)) a) let: perhaps (let f1 ((a 1)) a) -> 1") (lint-test "(let f1 ((a 1)) (f1 a))" "") (lint-test "(let f1 ((a 1)) (+ a (f1)))" " let: f1 needs 1 argument: (f1)") (lint-test "(let f1 ((a 1)) (f1 a 2))" " let: f1 has too many arguments: (f1 a 2)") (lint-test "(define f7 (let ((a 1)) (lambda () a)))" "") (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7))" "") ; (lint-test "(let () (define f7 (let ((a 1)) (lambda () a))) (f7 1))" "...") (lint-test "(let () (define (f1) 32) (f1))" " let: perhaps (... (define (f1) 32) (f1)) -> (... 32)") (lint-test "(let () (define (f1) 32) (f1 32))" " let: perhaps (... (define (f1) 32) (f1 32)) -> (... 32) let: f1 has too many arguments: (f1 32)") (lint-test "(let () (define (f2 a) a) (f2))" " let: perhaps (... (define (f2 a) a) (f2)) -> (... (let () a)) let: f2 needs 1 argument: (f2)") (lint-test "(let () (define (f2 a) a) (f2 3))" " let: perhaps (... (define (f2 a) a) (f2 3)) -> (... (let ((a 3)) a))") (lint-test "(let () (define (f2 a) a) (f2 3 32))" " let: perhaps (... (define (f2 a) a) (f2 3 32)) -> (... (let ((a 3)) a)) let: f2 has too many arguments: (f2 3 32)") (lint-test "(let () (define (f3 . a) a) (f3))" "") (lint-test "(let () (define (f3 . a) a) (f3 1))" "") (lint-test "(let () (define (f3 . a) a) (f3 1 2 3))" "") (lint-test "(let () (define (f4 a b) a) (f4))" " let: perhaps (... (define (f4 a b) a) (f4)) -> (... (let () a)) let: f4 needs 2 arguments: (f4)") (lint-test "(let () (define (f4 a b) a) (f4 1))" " let: perhaps (... (define (f4 a b) a) (f4 1)) -> (... (let ((a 1)) a)) let: f4 needs 2 arguments: (f4 1)") (lint-test "(let () (define (f4 a b) a) (f4 1 2))" " let: perhaps (... (define (f4 a b) a) (f4 1 2)) -> (... (let ((a 1) (b 2)) a)) let: f4's parameter 2 is not used, but a value is passed: 2") (lint-test "(let () (define (f4 a b) a) (f4 1 2 3))" " let: perhaps (... (define (f4 a b) a) (f4 1 2 3)) -> (... (let ((a 1) (b 2)) a)) let: f4 has too many arguments: (f4 1 2 3) let: f4's parameter 2 is not used, but a value is passed: 2") (lint-test "(let () (define (f5 a . b) a) (f5))" " let: f5 needs 1 argument: (f5)") (lint-test "(let () (define (f5 a . b) a) (f5 1))" "") (lint-test "(let () (define (f5 a . b) a) (f5 1 2))" " let: f5's parameter 2 is not used, but a value is passed: 2") (lint-test "(let () (define (f5 a . b) a) (f5 1 2 3 4))" " let: f5's parameter 2 is not used, but a value is passed: 2") (lint-test "(let () (define (f6 a b . c) a) (f6))" " let: f6 needs 2 arguments: (f6)") (lint-test "(let () (define (f6 a b . c) a) (f6 1))" " let: f6 needs 2 arguments: (f6 1)") (lint-test "(let () (define (f6 a b . c) a) (f6 1 2))" " let: f6's parameter 2 is not used, but a value is passed: 2") (lint-test "(let () (define (f6 a b . c) a) (f6 1 2 3))" " let: f6's parameter 2 is not used, but a value is passed: 2 let: f6's parameter 3 is not used, but a value is passed: 3") (lint-test "(let () (define (f6 a b . c) a) (f6 1 2 3 4))" " let: f6's parameter 2 is not used, but a value is passed: 2 let: f6's parameter 3 is not used, but a value is passed: 3") (lint-test "(let () (define (f7 x) (+ x 1)) (f7 3) 4)" " let: perhaps (... (define (f7 x) (+ x 1)) (f7 3) 4) -> (... (let ((x 3)) (+ x 1)) 4) let: this could be omitted: (f7 3)") (lint-test "(let () (define* (f7 x) (+ x 1)) (f7 3) 4)" " let: perhaps (... (define* (f7 x) (+ x 1)) (f7 3) 4) -> (... (let ((x 3)) (+ x 1)) 4) let: this could be omitted: (f7 3)") (lint-test "(let () (define (f7 x) (display x)) (f7 3) 4)" " let: perhaps (... (define (f7 x) (display x)) (f7 3) 4) -> (... (let ((x 3)) (display x)) 4) f7: leaving aside display's optional arg, f7 could be (define f7 display)") (lint-test "(let () (define (f a b) (min b a)) (f x y))" " let: perhaps (... (define (f a b) (min b a)) (f x y)) -> (... (let ((a x) (b y)) (min b a))) f: leaving aside min's optional args, f could be (define f min)") (lint-test "(let () (define (f a b) (< b a)) (f x y))" " let: perhaps (... (define (f a b) (< b a)) (f x y)) -> (... (let ((a x) (b y)) (< b a))) f: leaving aside <'s optional args, f could be (define f >)") (lint-test "(let () (define (f a b) (eq? b a)) (f x y))" " let: perhaps (... (define (f a b) (eq? b a)) (f x y)) -> (... (let ((a x) (b y)) (eq? b a))) f: f could be (define f eq?)") (lint-test "(let () (define (f7 x) (+ x 1)) (f7 (display 3)) 4)" " let: perhaps (... (define (f7 x) (+ x 1)) (f7 (display 3)) 4) -> (... (let ((x (display 3))) (+ x 1)) 4)") (lint-test "(let () (define* (f7 x) (+ x 1)) (let ((y 3)) (f7 y) 4))" " let: perhaps (let ((y 3)) (f7 y) 4) -> (let () (f7 3) 4) let: this could be omitted: (f7 y)") (lint-test "(let () (define (f1 . x) (apply + x)) (f1 1 2))" " f1: f1 could be (define f1 +)") (lint-test "(let () (define (f1 a . b) (apply + a b)) (f1 1 2))" " f1: f1 could be (define f1 +)") (lint-test "(let () (define (f1 x) (abs x)) (f1 1))" " let: perhaps (... (define (f1 x) (abs x)) (f1 1)) -> (... (let ((x 1)) (abs x))) f1: f1 could be (define f1 abs)") (lint-test "(let () (define (f1 x) (cdr (car x))) (f1 z))" " let: perhaps (... (define (f1 x) (cdr (car x))) (f1 z)) -> (... (let ((x z)) (cdr (car x)))) f1: f1 could be (define f1 cdar) f1: perhaps (cdr (car x)) -> (cdar x)") (lint-test "(begin (define* (f1) 32) (f1))" " f1: define* could be define") (lint-test "(begin (define* (f1) 32) (f1 :a 1))" " f1: define* could be define begin: f1 has too many arguments: (f1 :a 1) begin: f1 keyword argument :a (in (f1 :a 1)) does not match any argument in ()") (lint-test "(begin (define* (f2 a) a) (f2))" "") (lint-test "(begin (define* (f2 a) a) (f2 1))" "") (lint-test "(begin (define* (f2 a) a) (f2 :a 1))" "") (lint-test "(begin (define* (f2 a) a) (f2 :b 1))" " begin: f2 keyword argument :b (in (f2 :b 1)) does not match any argument in (a)") (lint-test "(begin (define* (f2 a) a) (f2 :a 1 2))" " begin: f2 has too many arguments: (f2 :a 1 2) begin: non-keyword argument 2 follows previous keyword") (lint-test "(begin (define* (f2 a) a) (f2 :a 1 :a 2))" " begin: f2 has too many arguments: (f2 :a 1 :a 2) begin: :a is repeated in (:a 1 :a 2)") (lint-test "(begin (define* (f2 a) a) (f2 1 2))" " begin: f2 has too many arguments: (f2 1 2)") (lint-test "(begin (define* (f3 . a) a) (f3))" " f3: define* could be define") (lint-test "(let ((f3 (lambda* a a))) (f3 1))" " let: lambda* could be lambda let: perhaps (let ((f3 (lambda* a a))) (f3 1)) -> ((lambda* a a) 1)") (lint-test "(begin (define* (f3 . a) a) (f3 :a 1))" " f3: define* could be define") (lint-test "(begin (define* (f3 . a) a) (f3 1 2))" " f3: define* could be define") (lint-test "(begin (define* (f4 a (b 2)) a) (f4))" "") (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1))" "") (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :b 1))" "") (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :c 1))" " begin: f4 keyword argument :c (in (f4 :c 1)) does not match any argument in (a (b 2))") (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1 :c 2))" " begin: f4 keyword argument :c (in (f4 :a 1 :c 2)) does not match any argument in (a (b 2))") (lint-test "(begin (define* (f4 a (b 2)) a) (f4 :a 1 :b 2))" "") (lint-test "(begin (define* (f4 a (b 2)) a) (f4 1 :a 1 :b 2))" " begin: f4 has too many arguments: (f4 1 :a 1 :b 2)") (lint-test "(begin (define* (f5 a :rest b) a) (f5))" "") (lint-test "(begin (define* (f5 a :rest b) a) (f5 1))" "") (lint-test "(begin (define* (f5 a :rest b) a) (f5 1 2 3))" "") (lint-test "(begin (define* (f5 a :rest b) a) (f5 :b 1))" "") (lint-test "(begin (define* (f5 a :rest b) a) (f5 :a 1 2 3))" " begin: non-keyword argument 2 follows previous keyword") (lint-test "(begin (define* (f6 a b :allow-other-keys) a) (f6))" "") (lint-test "(begin (define* (f6 a b :allow-other-keys) a) (f6 :a 1 :b 2 :c 3))" "") (lint-test "(let () (define (f8 a) (+ a 1)) (string-ref (f8 1) 2))" " let: perhaps (... (define (f8 a) (+ a 1)) (string-ref (f8 1) 2)) -> (... (string-ref (let ((a 1)) (+ a 1)) 2)) let: in (string-ref (f8 1) 2), string-ref's first argument should be a string, but (f8 1) is a number?") (lint-test "(begin (define (f11 x) (+ x 1)) (f11 (integer->char 32)))" " begin: in (f11 (integer->char 32)), f11's argument should be a number, but (integer->char 32) is a char? begin: perhaps (integer->char 32) -> #\\space") (lint-test "(begin (define (f12 x) (log x 2)) (f12 \"asdf\"))" " begin: in (f12 \"asdf\"), f12's argument should be a number, but \"asdf\" is a string?") (lint-test "(+ a #\\a 2)" " +: in (+ a #\\a 2), +'s second argument should be a number, but #\\a is a char?") (lint-test "(begin (define (f13 x) (string-ref x 0)) (f13 #i(0 1 2)))" " begin: in (f13 #i(0 1 2)), f13's argument should be a string, but #i(0 1 2) is an int-vector?") (lint-test "(begin (define (f14 x) (float-vector-set! v x 1.0)) (f14 1+i))" " begin: in (f14 1.0+1.0i), f14's argument should be an integer, but 1.0+1.0i is complex?") (lint-test "(begin (define (f14 x) (float-vector-set! x 1 1.0)) (f14 1+i))" " begin: in (f14 1.0+1.0i), f14's argument should be a float-vector, but 1.0+1.0i is complex?") (lint-test "(begin (define (f14 x) (* 2 (float-vector-set! x 1 1.0))) (f14 1+i))" " begin: in (f14 1.0+1.0i), f14's argument should be a float-vector, but 1.0+1.0i is complex?") (lint-test "(begin (define (f15 x) (* 2 (+ x 1))) (f15 #()))" " begin: in (f15 #()), f15's argument should be a number, but #() is a vector?") (lint-test "(begin (define (f16 x) (vector-set! v 1 x)) (f16 #f))" "") (lint-test "(begin (define (f16 y x) (vector-set! v (f y) 2) (vector-set! v (f y) x)) (f16 0 #f))" "") (lint-test "(begin (define (f16 y x z) (vector-set! z (f y) x)) (f16 0 #f #()))" "") (lint-test "(let ((fv (float-vector 1 2 3))) (fv 1))" " let: perhaps (let ((fv (float-vector 1 2 3))) (fv 1)) -> ((float-vector 1 2 3) 1)") (lint-test "(let ((fv (inlet 'a 1))) (fv 'a))" " let: perhaps (let ((fv (inlet 'a 1))) (fv 'a)) -> ((inlet 'a 1) 'a)") (lint-test "(let ((fv (float-vector 1 2 3))) (fv -1))" " let: perhaps (let ((fv (float-vector 1 2 3))) (fv -1)) -> ((float-vector 1 2 3) -1) let: fv's index -1 is negative") (lint-test "(let ((fv (float-vector 1 2 3))) (fv 10))" " let: perhaps (let ((fv (float-vector 1 2 3))) (fv 10)) -> ((float-vector 1 2 3) 10) let: fv has length 3, but index is 10") (lint-test "(let ((fv (float-vector 1 2 3))) (set! (fv 1) #\\a))" " let: fv wants real, but the value in (set! (fv 1) #\\a) is a char?") (lint-test "(let ((fv (float-vector 1 2 3))) (set! (fv 10) 1.5))" " let: fv has length 3, but index is 10") (lint-test "(let ((fv (make-float-vector 3))) (set! (fv 10) 1.5))" " let: fv has length 3, but index is 10") (lint-test "(let ((fv (make-float-vector 3))) (set! (fv 0) (floor x)))" "") (lint-test "(let ((fv (make-float-vector 3))) (+ 1 (fv 3)))" " let: fv has length 3, but index is 3") (lint-test "(let ((fv (make-string 3))) (+ 1 (fv 1)))" "") ; someday... (lint-test "(let () (define (f8 a b) (+ 1 (f8 2 3))) (f8 1 2))" " let: perhaps (... (define (f8 a b) (+ 1 (f8 2 3))) (f8 1 2)) -> (... (let f8 ((a 1) (b 2)) (+ 1 (f8 2 3)))) let: f8's parameter 1 is not used, but a value is passed: 1 let: f8's parameter 2 is not used, but a value is passed: 2") (lint-test "(let () (define (f8 a b) ((lambda (c) (f8 c 3)) 1)) (f8 1 2))" " let: perhaps (... (define (f8 a b) ((lambda (c) (f8 c 3)) 1)) (f8 1 2)) -> (... (let f8 ((a 1) (b 2)) ((lambda (c) (f8 c 3)) 1))) f8: perhaps ((lambda (c) (f8 c 3)) 1) -> (let ((c 1)) (f8 c 3)) let: f8's parameter 1 is not used, but a value is passed: 1 let: f8's parameter 2 is not used, but a value is passed: 2") (lint-test "(let () (define (f1) 32) (set! f1 4) (+ 1 f1))" "") (lint-test "(let () (define (f1) 32) (+ 1 f1))" " let: f1 is a procedure, but + in (+ 1 f1) wants a number?") (lint-test "(let () (define f10 (lambda (a) a)) (set! f10 (lambda (a b) (+ a b))) (f10 1 2))" " let: perhaps (lambda (a b) (+ a b)) -> +") (lint-test "(begin (define (f20 x y) (+ y 1)) (f20 (+ z 1) z))" " begin: f20's parameter 1 is not used, but a value is passed: (+ z 1)") (lint-test "(begin (define (f21 x y) (set! x 3) (+ y 1)) (f21 (+ z 1) z))" " f21: perhaps (set! x 3) -> (let ((x 3)) ...) begin: f21's parameter 1's value is not used, but a value is passed: (+ z 1)") (lint-test "(begin (define (f22 x) (case y ((0) `(+ ,x 1)) (else #f))) (f22 2))" " f22: perhaps (case y ((0) (list-values '+ x 1)) (else #f)) -> (and (eqv? y 0) (list-values '+ x 1))") (lint-test "(begin (define (f23 x) (+ y 1)) (define (f24 x) (f23 (+ x 1))) (f24 0))" " f24: f23's parameter 1 is not used, but a value is passed: (+ x 1)") (unless (or pure-s7 immutable-unquote) (lint-test "(begin (define x 1) `#(,x))" ; this can be expanded: (lambda (x) #((unquote x))) (if immutable-unquote " begin: quasiquoted vectors are not supported: #(,x) perhaps use `(vector ...) rather than `#(...)" " begin: quasiquoted vectors are not supported: #((unquote x)) perhaps use `(vector ...) rather than `#(...)"))) (lint-test "(begin (define-macro (m1 x y) `(+ ,y 1)) (m1 a b))" " begin: perhaps (define-macro (m1 x y) (list-values '+ y 1)) -> (define (m1 x y) (+ y 1)) begin: m1's parameter 1 is not used, but a value is passed: a") (lint-test "(begin (define (f30 x) (if (> x 0) (f30 #() (- x 1)))) (f30 1))" " f30: f30 has too many arguments: (f30 #() (- x 1))") (lint-test "(let () (define plus (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args)))) (plus))" " plus: repeated parameter list? (x y) in (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args))) case-lambda: perhaps (lambda (x y) (+ x y)) -> + case-lambda: perhaps (lambda (x y z) (+ x y z)) -> + case-lambda: perhaps (lambda args (apply + args)) -> + let: perhaps (let () (define plus (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y... -> (let ((plus (case-lambda (() 0) ((x y) x) ((x y) (+ x y)) ((x y z) (+ x y z)) (args (apply + args))))) ...)") (lint-test "(case-lambda ((a b) (+ a b)))" " case-lambda: perhaps (lambda (a b) (+ a b)) -> + case-lambda: perhaps (case-lambda ((a b) (+ a b))) -> (lambda (a b) (+ a b))") (lint-test "(case-lambda \"a doc string\" ((a b) (+ a b)))" " case-lambda: perhaps (lambda (a b) (+ a b)) -> + case-lambda: perhaps (case-lambda \"a doc string\" ((a b) (+ a b))) -> (let ((+documentation+ \"a doc string\")) (lambda (a b) (+ a b)))") (lint-test "(case-lambda (() (display x #f)) ((y) (display x y)))" " case-lambda: (display x #f) could be x case-lambda: perhaps (case-lambda (() (display x #f)) ((y) (display x y))) -> (lambda* (y) (display x y))") (lint-test "(case-lambda (() (+ x 0)) ((y) (+ x y)))" " case-lambda: perhaps (+ x 0) -> x case-lambda: perhaps (case-lambda (() (+ x 0)) ((y) (+ x y))) -> (lambda* ((y 0)) (+ x y))") (lint-test "(case-lambda ((x) (log x 2)) ((x y) (log x y)))" " case-lambda: perhaps (lambda (x y) (log x y)) -> log case-lambda: perhaps (case-lambda ((x) (log x 2)) ((x y) (log x y))) -> (lambda* (x (y 2)) (log x y))") (lint-test "(case-lambda ((x) (log x 2)) ((y x) (log x y)))" "") (lint-test "(case-lambda ((x) (log x 2)) ((y x z) (log x y)))" "") (lint-test "(let loop ((pi 1.0) (+ pi 1)))" " let: can't bind a constant: (pi 1.0) let: let binding is messed up: (+ pi 1) let: loop not used, value: (let loop ((pi 1.0) (+ pi 1)))") (lint-test "(define (f12 pi) pi)" " define: f12 parameter can't be a constant: (f12 pi)") (lint-test "(define* (f12 (pi 1.0)) pi)" "f12: parameter can't be a constant: ((pi 1.0))") (lint-test "(define* (bpar1 lst) (set! (lst 2) (* 2 (lst 2))) lst)" "") ; default = #f (lint-test "(define* (bpar1 (lst '(0 1 2 3))) (set! (lst 2) (* 2 (lst 2))) lst)" "bpar1: lst's default value, '(0 1 2 3), is a literal constant, so this set! is trouble: (set! (lst 2) (* 2 (lst 2)))") (lint-test "(define (f12 :key) :key)" " define: f12 parameter can't be a keyword: (f12 :key)") (lint-test "(define :a 3)" " define: keywords are constants :a") (lint-test "(let () (define pi 3) pi)" " let: pi is a constant: (define pi 3) let: perhaps omit pi and return 3 let: perhaps (let () (define pi 3) pi) -> (let ((pi 3)) ...)") (lint-test "(let () (define-constant __lt1__ 32) (set! __lt1__ 3) (+ __lt1__ 1))" " let: can't set! __lt1__ in (set! __lt1__ 3) (it is a constant: 32)") (lint-test "(let () (define (f1 x) (+ x 1)) f1)" " let: perhaps omit f1, and change (define (f1 x) ...) -> (lambda (x) ...)") (lint-test "(let () (define (f1 x) (f2 (+ x 1))) (define (f2 x) x) (f1 3))" "") (lint-test "(let () (define (f1 a) (let ((a (vector->list a))) (car a))) (f1 #(a)))" " let: perhaps (... (define (f1 a) (let ((a (vector->list a))) (car a))) (f1 #(a))) -> (... (let ((a #(a))) (let ((a (vector->list a))) (car a)))) f1: perhaps (let ((a (vector->list a))) (car a)) -> (car (vector->list a))") (lint-test "(car (vector->list a))" " car: perhaps (car (vector->list a)) -> (vector-ref a 0)") (lint-test "(null? (list))" " null?: perhaps (null? (list)) -> #t null?: perhaps (list) -> (); there is only one nil") (lint-test "(null? (list 1))" " null?: perhaps (null? (list 1)) -> #f null?: perhaps (list 1) -> '(1)") (lint-test "(pair? (list 1))" " pair?: perhaps (pair? (list 1)) -> #t pair?: perhaps (list 1) -> '(1)") (lint-test "(proper-list? (list))" " proper-list?: perhaps (proper-list? (list)) -> #t proper-list?: (proper-list? (list)) is always #t proper-list?: perhaps (list) -> (); there is only one nil") (lint-test "(proper-list? (list 1))" " proper-list?: perhaps (proper-list? (list 1)) -> #t proper-list?: (proper-list? (list 1)) is always #t proper-list?: perhaps (list 1) -> '(1)") (lint-test "(or (list? e) (null? e))" " or: perhaps (or (list? e) (null? e)) -> (list? e)") (lint-test "(or (list? e) (pair? e))" " or: perhaps (or (list? e) (pair? e)) -> (list? e)") (lint-test "(or (proper-list? e) (null? e))" " or: perhaps (or (proper-list? e) (null? e)) -> (proper-list? e)") (lint-test "(or (proper-list? e) (pair? e))" "") (lint-test "(and (list? e) (null? e))" " and: perhaps (and (list? e) (null? e)) -> (null? e)") (lint-test "(and (list? e) (pair? e))" " and: perhaps (and (list? e) (pair? e)) -> (pair? e)") (lint-test "(and (proper-list? e) (null? e))" " and: perhaps (and (proper-list? e) (null? e)) -> (null? e)") (lint-test "(and (proper-list? e) (pair? e))" "") (lint-test "(let ((x 1/2)) (integer? x))" " let: perhaps (let ((x 1/2)) (integer? x)) -> (integer? 1/2) let: x is 1/2, so (integer? x) is #f") (lint-test "(let ((x 1/2)) (real? x))" " let: perhaps (let ((x 1/2)) (real? x)) -> (real? 1/2) let: x is rational, so (real? x) is #t") (lint-test "(let ((x 1/2)) (rational? x))" " let: perhaps (let ((x 1/2)) (rational? x)) -> (rational? 1/2) let: x is rational, so (rational? x) is #t") (lint-test "(let ((x 1/2)) (pair? x))" " let: perhaps (let ((x 1/2)) (pair? x)) -> (pair? 1/2) let: x is rational, so (pair? x) is #f") (lint-test "(let ((x ())) (list? x))" " let: perhaps (let ((x ())) (list? x)) -> (list? ())") (lint-test "(let ((x (list 1))) (list? x))" " let: perhaps (let ((x (list 1))) (list? x)) -> (list? (list 1))") (lint-test "(let ((x \"a\") (y \"\")) (eq? x y))" " let: perhaps (let ((x \"a\") (y \"\")) (eq? x y)) -> (eq? \"a\" \"\")") (lint-test "(let ((x 12)) (set! x 32) (integer? x))" " let: x is an integer, so (integer? x) is #t let: perhaps (let ((x 12)) (set! x 32) (integer? x)) -> (let ((x 32)) (integer? x))") (lint-test "(and (char-alphabetic? x) (char? x))" " and: perhaps (and (char-alphabetic? x) (char? x)) -> (char-alphabetic? x)") (lint-test "(or (char-numeric? x) (char? x))" " or: perhaps (or (char-numeric? x) (char? x)) -> (char? x)") (lint-test "(or (char-numeric? x) (char-whitespace? x))" "") (lint-test "(and (char-alphabetic? x) (pair? x))" " and: perhaps (and (char-alphabetic? x) (pair? x)) -> #f") (lint-test "(and (char? x) (char-numeric? x))" "") (let-temporarily ((*report-sloppy-assoc* #t)) (lint-test "(char=? #\\a (read-char p))" " char=?: in (char=? #\\a (read-char p)), char=?'s second argument should be a char, but (read-char p) might also be an eof-object?") (lint-test "(< (string->number x) 0)" " <: in (< (string->number x) 0), <'s first argument should be real, but (string->number x) might also be #f")) (lint-test "(vector-ref v (+ i 1))" "") (lint-test "(or (number? x) (nan? x))" " or: perhaps (or (number? x) (nan? x)) -> (number? x)") (lint-test "(and (infinite? x) (nan? x))" " and: perhaps (and (infinite? x) (nan? x)) -> #f") (lint-test "(and (real? x) (nan? x))" "") (lint-test "(and (< x 3) (< x 4))" " and: perhaps (and (< x 3) (< x 4)) -> (< x 3)") (lint-test "(and (inexact? x) (exact? x))" " and: perhaps (and (inexact? x) (exact? x)) -> #f") (lint-test "(and (inexact? x) (rational? x))" " and: perhaps (and (inexact? x) (rational? x)) -> #f") (lint-test "(and (inexact? x) (even? x))" " and: perhaps (and (inexact? x) (even? x)) -> #f") (lint-test "(and (integer? x) (even? x))" "") (lint-test "(and (odd? x) (integer? x))" " and: perhaps (and (odd? x) (integer? x)) -> (odd? x)") (lint-test "(and (odd? x) (even? x))" " and: perhaps (and (odd? x) (even? x)) -> #f") (lint-test "(and (inexact? x) (float? x))" " and: perhaps (and (inexact? x) (float? x)) -> (float? x)") (lint-test "(or (inexact? x) (float? x))" " or: perhaps (or (inexact? x) (float? x)) -> (inexact? x)") (lint-test "(or (float? x) (inexact? x))" " or: perhaps (or (float? x) (inexact? x)) -> (inexact? x)") (lint-test "(and (float? x) (inexact? x))" " and: perhaps (and (float? x) (inexact? x)) -> (float? x)") (lint-test "(and (symbol? x) (defined? x))" "") ; this avoids a type error if not a symbol, so can't be reduced (lint-test "(and (defined? x) (symbol? x))" " and: perhaps (and (defined? x) (symbol? x)) -> (defined? x)") (lint-test "(and (negative? x) (not (real? x)))" " and: perhaps (and (negative? x) (not (real? x))) -> #f") (lint-test "(and (positive? x) (real? x))" " and: perhaps (and (positive? x) (real? x)) -> (positive? x)") (lint-test "(or (real? x) (zero? x))" " or: perhaps (or (real? x) (zero? x)) -> (real? x)") (lint-test "(and (zero? x) (negative? x))" " and: perhaps (and (zero? x) (negative? x)) -> #f") (unless pure-s7 (lint-test "(and (real? x) (not (inexact? x)))" " and: perhaps (and (real? x) (not (inexact? x))) -> (rational? x)") (lint-test "(and (exact? x) (not (inexact? x)))" " and: perhaps (and (exact? x) (not (inexact? x))) -> (exact? x)")) (lint-test "(and (real? x) (not (zero? x)))" "") ; this is correct (lint-test "(and (even? x) (not (real? x)))" " and: perhaps (and (even? x) (not (real? x))) -> #f") (lint-test "(and (exact? x) (zero? x))" " and: perhaps (and (exact? x) (zero? x)) -> (eqv? x 0)") (lint-test "(and (zero? x) (inexact? x))" " and: perhaps (and (zero? x) (inexact? x)) -> (eqv? x 0.0)") (lint-test "(and (pair? x) (+ x 1))" "in (and (pair? x) (+ x 1)), x is a pair, but + wants a number?") (lint-test "(and (boolean? x) (not x))" " and: perhaps (and (boolean? x) (not x)) -> (not x)") (lint-test "(and (boolean? x) (eq? x #f))" " and: perhaps (and (boolean? x) (eq? x #f)) -> (eq? x #f) and: perhaps (eq? x #f) -> (not x)") (lint-test "(and (symbol? id) (not (member id x)))" " in (and (symbol? id) (not (member id x))), perhaps change (member id x) to (memq ...)") (lint-test "(and (symbol? id) (not (equal? id x)))" " in (and (symbol? id) (not (equal? id x))), perhaps change (equal? id x) to (eq? ...)") (lint-test "(and (boolean? id) (not (member id x)))" " in (and (boolean? id) (not (member id x))), perhaps change (member id x) to (memq ...)") (lint-test "(and (number? id) (not (equal? id x)))" " in (and (number? id) (not (equal? id x))), perhaps change (equal? id x) to (eqv? ...)") (lint-test "(and (symbol? id) (member id x))" " in (and (symbol? id) (member id x)), perhaps change (member id x) to (memq ...)") (lint-test "(and (symbol? id) (memq id x))" " and: perhaps (and (symbol? id) (memq id x)) -> (memq id x)") (lint-test "(and (symbol? id) (memv id x))" " in (and (symbol? id) (memv id x)), perhaps change (memv id x) to (memq ...)") (lint-test "(and (symbol? id) (equal? id x))" " in (and (symbol? id) (equal? id x)), perhaps change (equal? id x) to (eq? ...)") (lint-test "(and (boolean? id) (member id x))" " in (and (boolean? id) (member id x)), perhaps change (member id x) to (memq ...)") (lint-test "(and (number? id) (equal? id x))" " in (and (number? id) (equal? id x)), perhaps change (equal? id x) to (eqv? ...)") (lint-test "(and (integer? x) (number? y) (< y 3))" " in (and (integer? x) (number? y) (< y 3)), perhaps change (number? y) to (real? y)") (lint-test "(or (integer? x) (not (number? y)) (< y 3))" " in (or (integer? x) (not (number? y)) (< y 3)), perhaps change (not (number? y)) to (not (real? y))") (lint-test "(or (not (number? x)) (> x 2))" " in (or (not (number? x)) (> x 2)), perhaps change (not (number? x)) to (not (real? x))") (lint-test "(or (integer? x) (not (number? y)) (< y 3))" " in (or (integer? x) (not (number? y)) (< y 3)), perhaps change (not (number? y)) to (not (real? y))") (lint-test "(and (integer? x) (number? y) (< y 3))" " in (and (integer? x) (number? y) (< y 3)), perhaps change (number? y) to (real? y)") (lint-test "(and (string? (car c)) (string=? (car c) \" \"))" " and: perhaps (and (string? (car c)) (string=? (car c) \" \")) -> (equal? (car c) \" \")") (lint-test "(and (list? x) (equal? x '(1 2)))" " and: perhaps (and (list? x) (equal? x '(1 2))) -> (equal? x '(1 2))") (lint-test "(and (char? x) (char=? x #\\a))" " and: perhaps (and (char? x) (char=? x #\\a)) -> (eqv? x #\\a)") (lint-test "(if (number? x) (member x y) 0)" " in (if (number? x) (member x y) 0), perhaps change (member x y) to (memv ...)") (lint-test "(if (number? x) (< x y) 0)" " in (if (number? x) (< x y) 0), perhaps change (number? x) to (real? x)") (lint-test "(if (not (number? x)) 0 (< x y))" " in (if (not (number? x)) 0 (< x y)), perhaps change (not (number? x)) to (not (real? x))") (lint-test "(cond ((number? x) (< x y)) (else x))" " in (cond ((number? x) (< x y)) (else x)), perhaps change (number? x) to (real? x)") (lint-test "(list? (make-list 1))" " list?: perhaps (list? (make-list 1)) -> #t list?: (list? (make-list 1)) is always #t") (lint-test "(number? (+ 1 x))" " number?: perhaps (number? (+ 1 x)) -> #t number?: (number? (+ 1 x)) is always #t") (lint-test "(number? (make-list 1))" " number?: perhaps (number? (make-list 1)) -> #f number?: (number? (make-list 1)) is always #f") (lint-test "(pair? (member x y))" " pair?: member returns either #f or a pair, so (pair? (member x y)) -> (member x y)") (lint-test "(null? (member x y))" " null?: perhaps (null? (member x y)) -> #f null?: (null? (member x y)) is always #f") (lint-test "(integer? (char-position x y))" " integer?: char-position returns either #f or an integer, so (integer? (char-position x y)) -> (char-position x y)") (let-temporarily ((*report-sloppy-assoc* #t)) (lint-test "(car (member x y))" " car: in (car (member x y)), car's argument should be a pair, but (member x y) might also be #f car: (car (member x y)) is x, or an error")) (lint-test "(if (and x (pair? x) (symbol? (cadr x))) x)" " if: perhaps (and x (pair? x) (symbol? (cadr x))) -> (and (pair? x) (symbol? (cadr x)))") (lint-test "(catch #t (lambda () (char=? (read-char p) #\\newline)) (lambda arg 'error))" "") (lint-test "(if (and (<= 12 x) (<= x 15)) 2 3)" " if: perhaps (and (<= 12 x) (<= x 15)) -> (<= 12 x 15)") (lint-test "(and x (set! x (zero? (random 2))) (not x))" "") (lint-test "(string-append x , \"b\")" "") (unless (or pure-s7 immutable-unquote) (lint-test "(string-append x , y)" (if immutable-unquote " string-append: stray comma? ,y in (string-append x ,y)" " string-append: stray comma? (unquote y) in (string-append x (unquote y))"))) (lint-test "`(+ ,x 1)" "") (lint-test "(let ((x (list 23 1 3))) (sort! x <) x)" "") (lint-test "(let ((x (list 23 1 3))) (reverse! x) x)" " let: reverse! might leave x in an undefined state; perhaps (set! x (reverse! x))") (lint-test "(let () (define (f x) (if (pair? x) (reverse! x))) (f (vector 1 2)))" " let: perhaps (... (define (f x) (if (pair? x) (reverse! x))) (f (vector 1 2))) -> (... (let ((x (vector 1 2))) (if (pair? x) (reverse! x)))) f: if x (a function argument) is a pair, (reverse! x) is ill-advised") (lint-test "(if (and (list? x) (car x)) 3)" " in (and (list? x) (car x)), perhaps change (list? x) to (pair? x)") (lint-test "(if (and (list? x) (not (null? x)) (car x)) 3)" " if: perhaps (and (list? x) (not (null? x)) (car x)) -> (and (pair? x) (car x))") (lint-test "(and (pair? obj) (not (null? obj)) (pair? x))" " and: perhaps (and (pair? obj) (not (null? obj)) (pair? x)) -> (and (pair? obj) (pair? x))") (lint-test "(if x (map f x))" " in (if x (map f x)), perhaps change x to (sequence? x)") (lint-test "(let ((x 0)) (/ 21 x))" " let: perhaps (let ((x 0)) (/ 21 x)) -> (/ 21 0) let: x is 0, so (/ 21 x) is an error") (lint-test "(cond ((> x 0) => abs) (else y))" " cond: in ((> x 0) => abs), (> x 0) returns a a boolean, but abs expects real?") (lint-test "(for-each (lambda (x) (display x port)) (list y z 123))" " for-each: perhaps (for-each (lambda (x) (display x port)) (list y z 123)) -> (format port \"~{~A~}\" (list y z 123))") (lint-test "(for-each (lambda (x) (write-string x port)) (list y z \"123\"))" " for-each: perhaps (for-each (lambda (x) (write-string x port)) (list y z \"123\")) -> (format port \"~{~A~}\" (list y z \"123\"))") (lint-test "(map (cut a) (list packages))" " map: perhaps (map (cut a) (list packages)) -> (list ((cut a) packages))") (lint-test "(map abs (list packages))" " map: perhaps (map abs (list packages)) -> (list (abs packages))") (lint-test "(map string->symbol (list \"IOPAD\" \"IPAD\" \"OPAD\" \"HIGH\" \"LOW\"))" " map: perhaps (map string->symbol (list \"IOPAD\" \"IPAD\" \"OPAD\" \"HIGH\" \"LOW\")) -> '(IOPAD IPAD OPAD HIGH LOW) map: perhaps (list \"IOPAD\" \"IPAD\" \"OPAD\" \"HIGH\" \"LOW\") -> '(\"IOPAD\" \"IPAD\" \"OPAD\" \"HIGH\" \"LOW\")") (lint-test "(list->string (list h1 h2))" " list->string: perhaps (list->string (list h1 h2)) -> (string h1 h2)") (lint-test "(string-append (list->string (make-list indent #\\space)) str)" " string-append: perhaps (list->string (make-list indent #\\space)) -> (make-string indent #\\space)") (lint-test "(string-append (string #\\C) \"ZLl*()def\")" " string-append: perhaps (string-append (string #\\C) \"ZLl*()def\") -> \"CZLl*()def\" string-append: (string #\\C) could be \"C\"") (lint-test "(string-append \"USER \" user (string #\\return) (string #\\newline))" " string-append: perhaps (string-append \"USER \" user (string #\\return) (string #\\newline)) -> (string-append \"USER \" user (string #\\return #\\newline))") (lint-test "(define (indent->string indent) (string-append (make-string (quotient indent 8) #\\tab) (make-string (modulo indent 8) #\\space)))" " indent->string: perhaps (string-append (make-string (quotient indent 8) #\\tab) (make-string... -> (format #f \"~NC~NC\" (quotient indent 8) #\\tab (modulo indent 8) #\\space)") (lint-test "(string=? (string (string-ref file-line 0)) \"*\")" " string=?: perhaps (string=? (string (string-ref file-line 0)) \"*\") -> (char=? #\\* (string-ref file-line 0)) string=?: perhaps (string (string-ref file-line 0)) -> (substring file-line 0 1)") (lint-test "(string=? (symbol->string a) (symbol->string b))" " string=?: perhaps (string=? (symbol->string a) (symbol->string b)) -> (eq? a b)") (lint-test "(string=? (substring s 0 1) \"#\")" " string=?: perhaps (string=? (substring s 0 1) \"#\") -> (char=? #\\# (string-ref s 0))") (lint-test "(string=? \"#\" (string (string-ref s 0)))" " string=?: perhaps (string=? \"#\" (string (string-ref s 0))) -> (char=? #\\# (string-ref s 0)) string=?: perhaps (string (string-ref s 0)) -> (substring s 0 1)") (lint-test "(string=? \"\" (string-copy \"\"))" " string=?: perhaps (string=? \"\" (string-copy \"\")) -> (string=? \"\" \"\")") (lint-test "(char=? #\\a (char-downcase x))" " char=?: perhaps (char=? #\\a (char-downcase x)) -> (char-ci=? #\\a x)") (lint-test "(string=? x (string-downcase y))" "") (lint-test "(string=? (string-downcase x) (string-downcase y))" " string=?: perhaps (string=? (string-downcase x) (string-downcase y)) -> (string-ci=? x y)") (lint-test "(for-each display (list 1 a #\\newline))" " for-each: perhaps (for-each display (list 1 a #\\newline)) -> (format () \"~A~A~A\" 1 a #\\newline)") (lint-test "(for-each write-string (list a \"asdf\" (substring x 1)))" " for-each: perhaps (for-each write-string (list a \"asdf\" (substring x 1))) -> (format () \"~A~A~A\" a \"asdf\" (substring x 1))") (lint-test "(for-each write (append b (list 1 a #\\newline)))" " for-each: perhaps (for-each write (append b (list 1 a #\\newline))) -> (format () \"~{~S~}\" (append b (list 1 a #\\newline)))") (lint-test "(for-each write-char (append b (list a #\\newline)))" " for-each: perhaps (for-each write-char (append b (list a #\\newline))) -> (format () \"~{~A~}\" (append b (list a #\\newline)))") ;; recursion->for-each (lint-test "(let f ((v (list 0 1 2))) (if (pair? v) (begin (g (car v)) (f (cdr v)))))" " f: perhaps (let f ((v (list 0 1 2))) (if (pair? v) (begin (g (car v)) (f (cdr v))))) -> (for-each g (list 0 1 2)) let: perhaps (if (pair? v) (begin (g (car v)) (f (cdr v)))) -> (when (pair? v) (g (car v)) (f (cdr v)))") (lint-test "(define (f v) (if (pair? v) (begin (g (car v)) (f (cdr v)))))" " f: perhaps (define (f v) (if (pair? v) (begin (g (car v)) (f (cdr v))))) -> (define (f v) (for-each g v)) f: perhaps (if (pair? v) (begin (g (car v)) (f (cdr v)))) -> (when (pair? v) (g (car v)) (f (cdr v)))") (lint-test "(let f ((v (list 0 1 2))) (when (pair? v) (g (car v)) (f (cdr v))))" " f: perhaps (let f ((v (list 0 1 2))) (when (pair? v) (g (car v)) (f (cdr v)))) -> (for-each g (list 0 1 2))") (lint-test "(define (f v) (when (not (null? v)) (g (cadar v)) (f (cdr v))))" " f: perhaps (define (f v) (when (not (null? v)) (g (cadar v)) (f (cdr v)))) -> (define (f v) (for-each (lambda (<1>) (g (cadr <1>))) v)) f: perhaps (when (not (null? v)) (g (cadar v)) (f (cdr v))) -> (unless (null? v) (g (cadar v)) (f (cdr v)))") (lint-test "(let f ((v (list 0 1 2))) (when (pair? v) (let ((g (car v))) (display g) (f (cdr v)))))" " f: perhaps (let f ((v (list 0 1 2))) (when (pair? v) (let ((g (car v))) (display g)... -> (for-each (lambda (<1>) (let ((g <1>)) (display g))) (list 0 1 2)) let: perhaps (let ((g (car v))) (display g) (f (cdr v))) -> (let () (display (car v)) (f (cdr v)))") ;; recursion->do (lint-test "(let f ((v ()) (i 0)) (if (= i 3) (reverse v) (f (cons x v) (+ i 1))))" " f: perhaps (let f ((v ()) (i 0)) (if (= i 3) (reverse v) (f (cons x v) (+ i 1)))) -> (do ((v () (cons x v)) (i 0 (+ i 1))) ((= i 3) (reverse v)))") (lint-test "(define (lref lst ind) (if (zero? ind) (car lst) (lref (cdr lst) (- ind 1))))" " lref: perhaps (define (lref lst ind) (if (zero? ind) (car lst) (lref (cdr lst) (- ind 1)))) -> (define (lref lst ind) (do ((lst lst (cdr lst)) (ind ind (- ind 1))) ((zero? ind) (car lst))))") (lint-test "(let loop ((a b) (c d)) (if (> a 1) (begin (display c) (loop (- a 1) (cdr c))) (+ a 1)))" " loop: perhaps (let loop ((a b) (c d)) (if (> a 1) (begin (display c) (loop (- a 1) (cdr... -> (do ((a b (- a 1)) (c d (cdr c))) ((<= a 1) (+ a 1)) (display c))") (lint-test "(let loop ((a b) (c d)) (if (< a 1) (+ a 1) (begin (display c) (loop (- a 1) (cdr c)))))" " loop: perhaps (let loop ((a b) (c d)) (if (< a 1) (+ a 1) (begin (display c) (loop (- a... -> (do ((a b (- a 1)) (c d (cdr c))) ((< a 1) (+ a 1)) (display c))") (lint-test "(define (loop a) (if (< a 0) (car c) (loop (f1 a))))" " loop: perhaps (define (loop a) (if (< a 0) (car c) (loop (f1 a)))) -> (define (loop a) (do ((a a (f1 a))) ((< a 0) (car c))))") (lint-test "(let loop ((a b) (c d)) (if (> a 1) (begin (display c) (loop (- a 1) c)) (+ a 1)))" " loop: perhaps (let loop ((a b) (c d)) (if (> a 1) (begin (display c) (loop (- a 1) c))... -> (do ((a b (- a 1)) (c d)) ((<= a 1) (+ a 1)) (display c))") (lint-test "(let loop ((a b) (c d)) (if (< a 1) (+ a 1) (begin (display c) (loop (- a c) (abs c)))))" "") (lint-test "(define (f12 x y) (if (positive? x) (+ x y) (f12 1 x)))" "") (lint-test "(define loop (lambda (a . b) (if (< a 0) (car c) (loop (f11 a b)))))" "") (lint-test "(define loop (lambda (a) (if (< a 0) (car c) (loop (f1 a)))))" " loop: perhaps (lambda (a) (if (< a 0) (car c) (loop (f1 a)))) -> (lambda (a) (do ((a a (f1 a))) ((< a 0) (car c))))") (lint-test "(define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1))))" " f52: perhaps (define* (f52 (a 2)) (if (zero? a) x (f52 (- a 1)))) -> (define* (f52 (a 2)) (do ((a a (- a 1))) ((zero? a) x)))") (lint-test "(define (loop a) (if (< a 0) (car c) (or (pair? a) (loop (f1 a)))))" "") (lint-test "(define (loop a) (cond ((< a 0) (car c)) (else (loop (f1 a)))))" " loop: perhaps (define (loop a) (cond ((< a 0) (car c)) (else (loop (f1 a))))) -> (define (loop a) (do ((a a (f1 a))) ((< a 0) (car c))))") (lint-test "(define (loop a) (cond ((< a 0)) (else (loop (f1 a)))))" " loop: perhaps (define (loop a) (cond ((< a 0)) (else (loop (f1 a))))) -> (define (loop a) (do ((a a (f1 a))) ((< a 0) #t))) loop: perhaps (cond ((< a 0)) (else (loop (f1 a)))) -> (or (< a 0) (loop (f1 a)))") (lint-test "(define make-rectangular (lambda args 32))" " top-level redefinition of built-in function make-rectangular: (define make-rectangular (lambda args 32))") (lint-test "(define abs (lambda args 32))" " top-level redefinition of built-in function abs: (define abs (lambda args 32))") ;; this is a write.scm lint-pp bug regression test (lint-test "(define (any-random amount e) (letrec ((next-random (lambda () (let ((x 32)) (if (<= y (envelope-interp x e)) (next-random)))))) (next-random)))" " any-random: perhaps (letrec ((next-random (lambda () (let ((x 32)) (if (<= y (envelope-interp... -> (let next-random () (let ((x 32)) (if (<= y (envelope-interp x e)) (next-random)))) any-random: x can probably be moved to any-random's closure") (lint-test "(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 x y) (if (positive? x) (+ x y) y)) (+ (f11 1 2) (f14 1 2)))" " let: perhaps embed f14: (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 x y)... -> (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y)))) f14: f14 could be (define f14 f11)") (lint-test "(let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2)))) (define (f14 x y) (if (positive? x) (+ x y) y)) (+ x (f14 1 2)))" " let: perhaps (... (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2)) -> (... (let ((a 1) (b 2)) (if (positive? a) (+ a b) b))) let: the inner function f14 could be moved into the let: (let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1... -> (let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2))) (f14 (lambda (x y) (if (positive? x) (+ x y) y)))) ...) let: perhaps (... (define (f14 x y) (if (positive? x) (+ x y) y)) (+ x (f14 1 2))) -> (... (+ x (let ((x 1) (y 2)) (if (positive? x) (+ x y) y)))) f14: f14 is the same as f11") (lint-test "(let () (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) (define (f14 x y) (if (positive? x) (+ x y) y)) (+ (f11 1 2) (f14 1 2)))" " let: perhaps embed f14: (let () (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b))... -> (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y)))) let: the inner function f12 could be moved to f11's closure: (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) -> (define f11 (let () (define (f12 a b) (if (positive? a) (+ a b) b)) (lambda (a b)...))) let: perhaps (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) -> (define (f11 a b) (if (positive? a) (+ a b) b)) f14: f14 is the same as f12 (line 1)") (lint-test "(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 y x) (if (positive? x) (+ x y) y)) (+ (f11 1 2) (f14 1 2)))" " let: perhaps embed f14: (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 y x)... -> (... (+ (f11 1 2) (let ((y 1) (x 2)) (if (positive? x) (+ x y) y))))") ; f14: perhaps (if (positive? x) (+ x y) y) -> (f11 x y) (lint-test "(let () (define (f11 b a) (if (positive? a) (+ a b) b)) (define (f14 x y) (if (positive? x) (+ x y) y)) (+ (f11 1 2) (f14 1 2)))" " let: perhaps embed f14: (let () (define (f11 b a) (if (positive? a) (+ a b) b)) (define (f14 x y)... -> (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))") ; f14: perhaps (if (positive? x) (+ x y) y) -> (f11 y x) (lint-test "(let () (define (f1 x) (set! x 32) (log x 2.0)) (define (f2 y) (set! y 32) (log y 2.0)) (+ (f1 0) (f2 0)))" " let: perhaps embed f2: (let () (define (f1 x) (set! x 32) (log x 2.0)) (define (f2 y) (set! y 32)... -> (... (+ (f1 0) (let ((y 0)) (set! y 32) (log y 2.0)))) f1: perhaps (set! x 32) -> (let ((x 32)) ...) f2: f2 could be (define f2 f1) f2: perhaps (set! y 32) -> (let ((y 32)) ...)") (lint-test "(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (let ((z (if (positive? a1) (+ a1 b1) b1))) (+ z (f11 1 2))))" "") ;" perhaps (if (positive? a1) (+ a1 b1) b1) -> (f11 a1 b1)") -- code fragments turned off now (lint-test "(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define f14 (lambda (x y) (if (positive? x) (+ x y) y))) (+ (f11 1 2) (f14 1 2)))" " let: the scope of f14 could be reduced: (... (define f14 (lambda (x y) (if (positive? x) (+ x y) y))) (+ (f11 1 2) (f14 1 2))) -> (... (let ((f14 (lambda (x y) (if (positive? x) (+ x y) y)))) (+ (f11 1 2) (f14 1 2))))") ; f14: perhaps (if (positive? x) (+ x y) y) -> (f11 x y) (lint-test "(let () (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b)))) (define (f14 x y) (if (positive? x) (+ x y) y)) (+ (f11 1 2) (f14 1 2)))" " let: perhaps embed f14: (let () (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))... -> (... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y)))) f11: pointless let: (let () (lambda (a b) (if (positive? a) (+ a b) b)))") ; f14: f14 could be (define f14 f11) (lint-test "(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 x y) (if (positive? x) (+ x (log y)) (log y))) (+ (f11 1 2) (f14 1 2)))" "") ; f14: perhaps (if (positive? x) (+ x (log y)) (log y)) -> (f11 x (log y)) (lint-test "(let () (define union (let ((z 32)) (set! x (lambda (y) (+ z y))) (lambda args args))) (union 1 2))" "") (lint-test "(let () (define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b))) (define (f14 x y) (let ((w (+ x 1))) (if (positive? w) (+ x y) y))) (+ (f11 1 2) (f14 1 2)))" " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b) f14: f14 could be (define f14 f11) f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)") (lint-test "(let () (define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b))) (define (f14 x . y) (let ((w (+ x 1))) (if (positive? w) (+ x y) y))) (+ (f11 1 2) (f14 1 2)))" " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b) f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)") (lint-test "(let () (define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b))) (define (f14 x y z) (let ((w (+ x 1))) (if (positive? w) (+ x y) y))) (+ (f11 1 2) (f14 1 2 3)))" " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b) f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y) let: f14's parameter 3 is not used, but a value is passed: 3") ; f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (f11 x y) (lint-test "(let () (define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b))) (define (f14 x y) (let ((w (+ x 1)) (ww 1)) (if (positive? w) (+ x y) y))) (+ (f11 1 2) (f14 1 2)))" " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b) f14: ww not used, initially: 1 from let f14: ww can be moved to f14's closure") (lint-test "(let () (define (f12 a b) (let* ((z (+ a 1)) (zz z)) (if (positive? z) (+ a b) zz))) (define (f15 x y) (let* ((w (+ x 1)) (ww w)) (if (positive? w) (+ x y) ww))) (+ (f12 1 2) (f15 1 2)))" " f12: perhaps (let* ((z (+ a 1)) (zz z)) (if (positive? z) (+ a b) zz)) -> (let ((z (+ a 1))) (if (positive? z) (+ a b) z)) f15: f15 could be (define f15 f12) f15: perhaps (let* ((w (+ x 1)) (ww w)) (if (positive? w) (+ x y) ww)) -> (let ((w (+ x 1))) (if (positive? w) (+ x y) w))") (lint-test "(let () (define (f16 x) (do ((i 0 (+ i 1))) ((= i x)) (display i))) (define (f17 y) (do ((k 0 (+ k 1))) ((= k y)) (display k))) (f16 2) (f17 2))" " f17: f17 could be (define f17 f16)") (lint-test "(let () (define (f18 a b) (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+ a b) b))) (define (f19 x y) (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y))) (+ (f18 1 2) (f19 1 2)))" " let: the local function z could be moved to f18's closure: (define (f18 a b) (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+... -> (define f18 (let ((z (lambda (c) (+ c 1)))) (lambda (a b) ...))) f18: perhaps (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+ a b) b)) -> (if (positive? (let ((c 1)) (+ c 1))) (+ a b) b) let: the local function w could be moved to f19's closure: (define (f19 x y) (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+... -> (define f19 (let ((w (lambda (d) (+ d 1)))) (lambda (x y) ...))) f19: f19 could be (define f19 f18) f19: perhaps (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y)) -> (if (positive? (let ((d 1)) (+ d 1))) (+ x y) y)") (lint-test "(let () (define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a)) (define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x)) (+ (f20 1) (f21 2)))" " let: perhaps (define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a)) -> (define (f20 a) (let ((b a)) (+ (* 2 b) a))) let: perhaps (define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x)) -> (define (f21 x) (let ((c x)) (+ (* 2 c) x)))") ; f21: f21 could be (define f21 f20) (lint-test "(let () (define (f20 a) (define f20a (lambda (b) (+ (* 2 b) a))) (f20a a)) (define (f21 x) (define f21a (lambda (c) (+ (* 2 c) x))) (f21a x)) (+ (f20 1) (f21 2)))" "") ; f21: f21 could be (define f21 f20) (lint-test "(let () (define (f22 a) (lambda (b) (+ (* 2 b) a))) (define (f23 x) (lambda (c) (+ (* 2 c) x))) (+ ((f22 1) 2) ((f23 2) 3)))" "let: perhaps embed f23: (let () (define (f22 a) (lambda (b) (+ (* 2 b) a))) (define (f23 x)... -> (... (+ ((f22 1) 2) ((let ((x 2)) (lambda (c) (+ (* 2 c) x))) 3))) f23: f23 could be (define f23 f22)") (lint-test "(let () (define (f22 a) (lambda* ((b 21)) (+ (* 2 b) a))) (define (f23 x) (lambda* ((c 21)) (+ (* 2 c) x))) (+ ((f22 1) 2) ((f23 2) 3)))" "let: perhaps embed f23: (let () (define (f22 a) (lambda* ((b 21)) (+ (* 2 b) a))) (define (f23 x)... -> (... (+ ((f22 1) 2) ((let ((x 2)) (lambda* ((c 21)) (+ (* 2 c) x))) 3))) f23: f23 could be (define f23 f22)") (lint-test "(let () (define (f1 x) (abs (* 2 (+ (car x) 1)))) (define (f2 . x) (abs (* 2 (+ (car x) 1)))) (+ (f1 '(2)) (f2 3)))" "") ; these should not match! (lint-test "(let () (define (f1 . x) (abs (* 2 (+ (car x) 1)))) (define (f2 x) (abs (* 2 (+ (car x) 1)))) (+ (f1 2) (f2 '(3))))" ; these should not match! " let: perhaps embed f2: (let () (define (f1 . x) (abs (* 2 (+ (car x) 1)))) (define (f2 x) (abs (*... -> (... (+ (f1 2) (let ((x '(3))) (abs (* 2 (+ (car x) 1))))))") (lint-test "(let () (define (f24 aa) (let ((z (+ aa 1))) (if (positive? z) (f24 (+ aa 1)) 0))) (define (f25 x) (let ((w (+ x 1))) (if (positive? w) (f25 (+ x 1)) 0))) (+ (f24 2) (f25 2)))" " f25: f25 could be (define f25 f24)") (lint-test "(let () (define* (f26 (aa 1)) (let ((z (+ aa 1))) (if (positive? z) (f26 (+ aa 1)) 0))) (define* (f27 (x 1)) (let ((w (+ x 1))) (if (positive? w) (f27 (+ x 1)) 0))) (+ (f26 2) (f27 2)))" " f27: f27 could be (define f27 f26)") (lint-test "(let () (define (f31 a b) (if (> a 0) (+ a b) b)) (define (f32 x y) (if (< 0 y) (+ x y) y)) (+ (f31 1 2) (f32 1 2)))" "") (lint-test "(let () (define (f32) (let ((xx 1)) (set! xx 2) (+ xx 1))) (f32) 3)" " let: perhaps (... (define (f32) (let ((xx 1)) (set! xx 2) (+ xx 1))) (f32) 3) -> (... (let ((xx 1)) (set! xx 2) (+ xx 1)) 3) f32: perhaps (let ((xx 1)) (set! xx 2) (+ xx 1)) -> (let ((xx 2)) (+ xx 1)) let: this could be omitted: (f32)") (lint-test "(let ((xx 1)) (set! xx 2) (abs xx) xx)" " let: this could be omitted: (abs xx) let: perhaps (let ((xx 1)) (set! xx 2) (abs xx) xx) -> (let ((xx 2)) (abs xx) ...)") (lint-test "(let () (define (f32) (let ((xx 1)) (set! xxx 2) (+ xx 1))) (f32) 3)" " let: perhaps (... (define (f32) (let ((xx 1)) (set! xxx 2) (+ xx 1))) (f32) 3) -> (... (let ((xx 1)) (set! xxx 2) (+ xx 1)) 3) f32: xx can be moved to f32's closure") (lint-test "(let () (define (f32 x) (let ((xx (car x))) (vector-set! xx 0 2) xx)) (f32 (list (vector 1))) 3)" " let: perhaps (... (define (f32 x) (let ((xx (car x))) (vector-set! xx 0 2) xx)) (f32... -> (... (let ((x (list (vector 1)))) (let ((xx (car x))) (vector-set! xx 0 2) xx)) 3)") (lint-test "(let () (define* (f1 x (y 0)) (+ x y 1)) (+ (f1 2) (f1 2 3) (f1 3) (f1 4) (f1 5) (f1 6)))" "") (lint-test "(let () (define (f21 x) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)))) (f21 1))" " let: perhaps (... (define (f21 x) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1))))... -> (... (let f21 ((x 1)) (+ x (let ((f21 (lambda (y) (+ x y)))) (f21 x 1))))) f21: let variable f21 in (f21 (lambda (y) (+ x y))) shadows the current function? f21: perhaps (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)) -> ((lambda (y) (+ x y)) x 1) f21: f21 has too many arguments: (f21 x 1) f21: perhaps (let ((f21 (lambda (y) (+ x y)))) (f21 x 1)) -> (let ((y x)) (+ x y))") (lint-test "(let* ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx)))" " let*: fx needs 1 argument: (fx)") (lint-test "(let* ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx 1 2)))" " let*: fx has too many arguments: (fx 1 2)") (lint-test "(let ((x 32) (fx (lambda (z) (+ x z)))) (+ x (fx 1 2)))" " let: fx has too many arguments: (fx 1 2)") (lint-test "(define (f11 a b) (define (f120 a b) (if (positive? a) (+ a b) b)) (f120 a b))" " define: the inner function f120 could be moved to f11's closure: (define (f11 a b) (define (f120 a b) (if (positive? a) (+ a b) b)) (f120 a b)) -> (define f11 (let () (define (f120 a b) (if (positive? a) (+ a b) b)) (lambda (a b) ...))) define: perhaps (define (f11 a b) (define (f120 a b) (if (positive? a) (+ a b) b)) (f120 a b)) -> (define (f11 a b) (if (positive? a) (+ a b) b))") (lint-test "(define (f11 a b) (define (f121 a b) (if (positive? a) (+ a b) b)) (f121 b a))" " define: the inner function f121 could be moved to f11's closure: (define (f11 a b) (define (f121 a b) (if (positive? a) (+ a b) b)) (f121 b a)) -> (define f11 (let () (define (f121 a b) (if (positive? a) (+ a b) b)) (lambda (a b) ...))) define: perhaps (define (f11 a b) (define (f121 a b) (if (positive? a) (+ a b) b)) (f121 b a)) -> (define (f11 a b) (let ((a b) (b a)) (if (positive? a) (+ a b) b)))") (lint-test "(define (f11 a b) (define (f122 a b) (display a) (if (positive? a) (+ a b) b)) (f122 a b))" " define: the inner function f122 could be moved to f11's closure: (define (f11 a b) (define (f122 a b) (display a) (if (positive? a) (+ a b)... -> (define f11 (let () (define (f122 a b) (display a) (if (positive? a) (+ a b) b)) (lambda (a b) ...))) define: perhaps (define (f11 a b) (define (f122 a b) (display a) (if (positive? a) (+ a b)... -> (define (f11 a b) (display a) (if (positive? a) (+ a b) b))") (lint-test "(define (f11 a b) (define (f123) (if (positive? a) (+ a b) b)) (f123))" " define: perhaps (define (f11 a b) (define (f123) (if (positive? a) (+ a b) b)) (f123)) -> (define (f11 a b) (if (positive? a) (+ a b) b))") (lint-test "(define (f11 a b) (define (f124 x y) (if (positive? x) (+ x y) x)) (f124 (+ a 1) (* b 2)))" " define: the inner function f124 could be moved to f11's closure: (define (f11 a b) (define (f124 x y) (if (positive? x) (+ x y) x)) (f124... -> (define f11 (let () (define (f124 x y) (if (positive? x) (+ x y) x)) (lambda (a b) ...))) define: perhaps (define (f11 a b) (define (f124 x y) (if (positive? x) (+ x y) x)) (f124... -> (define (f11 a b) (let ((x (+ a 1)) (y (* b 2))) (if (positive? x) (+ x y) x)))") (lint-test "(define (f11 a b) (define (f125 x y) (if (positive? x) (+ x y) (f125 1 x))) (f125 (+ a 1) (* b 2)))" " define: the inner function f125 could be moved to f11's closure: (define (f11 a b) (define (f125 x y) (if (positive? x) (+ x y) (f125 1... -> (define f11 (let () (define (f125 x y) (if (positive? x) (+ x y) (f125 1 x))) (lambda (a b) ...))) define: perhaps (define (f11 a b) (define (f125 x y) (if (positive? x) (+ x y) (f125 1... -> (define (f11 a b) (let f125 ((x (+ a 1)) (y (* b 2))) (if (positive? x) (+ x y) (f125 1 x))))") (lint-test "(define (f11 a b) (define (f126 x y) (if (positive? x) (+ x y) (f126 1 x))) (+ a (f126 (+ a 1) (* b 2))))" " define: the inner function f126 could be moved to f11's closure: (define (f11 a b) (define (f126 x y) (if (positive? x) (+ x y) (f126 1... -> (define f11 (let () (define (f126 x y) (if (positive? x) (+ x y) (f126 1 x))) (lambda (a b) ...))) define: perhaps (define (f11 a b) (define (f126 x y) (if (positive? x) (+ x y) (f126 1... -> (define (f11 a b) (+ a (let f126 ((x (+ a 1)) (y (* b 2))) (if (positive? x) (+ x y) (f126 1 x)))))") (lint-test "(define (f11 a b) (define (f127 x y) (if (positive? x) (+ x y) (f127 1 x))) (display b) (+ a (f127 (+ a 1) (* b 2))))" " define: the inner function f127 could be moved to f11's closure: (define (f11 a b) (define (f127 x y) (if (positive? x) (+ x y) (f127 1... -> (define f11 (let () (define (f127 x y) (if (positive? x) (+ x y) (f127 1 x))) (lambda (a b) ...))) define: perhaps (define (f11 a b) (define (f127 x y) (if (positive? x) (+ x y) (f127 1... -> (define (f11 a b) (display b) (+ a (let f127 ((x (+ a 1)) (y (* b 2))) (if (positive? x) (+ x y) (f127 1 x)))))") (lint-test "(define (f11) (define (f128) (if (positive? a) (+ a b) (f128))) (f128))" " define: the inner function f128 could be moved to f11's closure: (define (f11) (define (f128) (if (positive? a) (+ a b) (f128))) (f128)) -> (define f11 (let () (define (f128) (if (positive? a) (+ a b) (f128))) (lambda () ...))) define: perhaps (define (f11) (define (f128) (if (positive? a) (+ a b) (f128))) (f128)) -> (define (f11) (if (positive? a) (+ a b) (f11)))") (lint-test "(lambda (y) (let ((z 3)) (+ z (f1 y))))" " lambda: z can probably be moved to lambda's closure") (lint-test "(lambda (y) (let ((z (lambda () 32))) (+ (z) (f1 y))))" " lambda: the local function z could be moved outside the lambda: (lambda (y) (let ((z (lambda () 32))) (+ (z) (f1 y)))) -> (let ((z (lambda () 32))) (lambda (y) ...)) lambda: perhaps (let ((z (lambda () 32))) (+ (z) (f1 y))) -> (+ (let () 32) (f1 y))") (lint-test "(lambda (y) (letrec ((z 3)) (+ z (f1 y))))" " lambda: letrec could be let: (letrec ((z 3)) (+ z (f1 y)))") (lint-test "(lambda (y) (letrec ((z (lambda () 32))) (+ (z) (f1 y))))" " lambda: the local function z could be moved outside the lambda: (lambda (y) (letrec ((z (lambda () 32))) (+ (z) (f1 y)))) -> (letrec ((z (lambda () 32))) (lambda (y) ...)) lambda: letrec could be let: (letrec ((z (lambda () 32))) (+ (z) (f1 y))) lambda: perhaps (letrec ((z (lambda () 32))) (+ (z) (f1 y))) -> (+ (let z () 32) (f1 y))") (lint-test "(define (lr1 y) (letrec ((z (lambda () 32))) (+ (z) (f1 y))))" " define: the local function z could be moved to lr1's closure: (define (lr1 y) (letrec ((z (lambda () 32))) (+ (z) (f1 y)))) -> (define lr1 (letrec ((z (lambda () 32))) (lambda (y) ...))) lr1: letrec could be let: (letrec ((z (lambda () 32))) (+ (z) (f1 y))) lr1: perhaps (letrec ((z (lambda () 32))) (+ (z) (f1 y))) -> (+ (let z () 32) (f1 y))") (lint-test "(define (lr1 y) (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y))))" " define: the local function z could be moved to lr1's closure: (define (lr1 y) (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y)))) -> (define lr1 (letrec ((z (lambda () (z 32)))) (lambda (y) ...))) lr1: perhaps (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y))) -> (+ (let z () (z 32)) (f1 y))") (lint-test "(define (lr1 y) (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y))))" " define: the local function z could be moved to lr1's closure: (define (lr1 y) (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y)))) -> (define lr1 (letrec ((z (lambda () (z 32)))) (lambda (y) ...))) lr1: perhaps (letrec ((z (lambda () (z 32)))) (+ (z) (f1 y))) -> (+ (let z () (z 32)) (f1 y))") (lint-test "(define (lr1 y) (letrec ((z1 (lambda () (z2 32))) (z2 (lambda () (z1 12)))) (+ (z1) (z2) (f1 y))))" " define: the local functions z2, z1 could be moved to lr1's closure: (define (lr1 y) (letrec ((z1 (lambda () (z2 32))) (z2 (lambda () (z1... -> (define lr1 (letrec ((z2 (lambda () (z1 12))) (z1 (lambda () (z2 32)))) (lambda (y) ...)))") (lint-test "(define (lr1 y) (letrec ((z1 (lambda () (z2 y))) (z2 (lambda () (z1 12)))) (+ (z1) (z2) (f1 y))))" "") (lint-test "(let () (define (f40 x) (+ x 1)) (define (f41 y z) (y (+ z 1))) (f41 f40 2))" " let: perhaps change f41 to a let: (let () (define (f40 x) (+ x 1)) (define (f41 y z) (y (+ z 1))) (f41 f40 2)) -> (... (let ((y f40) (z 2)) ...))") (lint-test "(let () (define (f41 y z) (y (+ z 1))) (f41 abs 2))" " let: perhaps (... (define (f41 y z) (y (+ z 1))) (f41 abs 2)) -> (... (let ((y abs) (z 2)) (y (+ z 1))))") (lint-test "(let () (define (f42 y z) (y (+ z 1))) (f42 (lambda (a) (+ a 1)) 2))" " let: perhaps (... (define (f42 y z) (y (+ z 1))) (f42 (lambda (a) (+ a 1)) 2)) -> (... (let ((y (lambda (a) (+ a 1))) (z 2)) (y (+ z 1))))") (lint-test "(define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1)))))" " define: perhaps (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1)))) -> (lambda (b) (let f0 ((a (+ b 1))) (+ a 1))) define: letrec could be let: (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1)))) define: perhaps (define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (f0 (+ b 1))))) -> (define (f43 b) (let f0 ((a (+ b 1))) (+ a 1)))") (lint-test "(define f43 (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b 0))))" " define: perhaps (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b 0))) -> (lambda (b) (let f0 ((a b) (b 0)) (+ (f0 a b) 1))) define: perhaps (define f43 (letrec ((f0 (lambda (a b) (+ (f0 a b) 1)))) (lambda (b) (f0 b... -> (define (f43 b) (let f0 ((a b) (b 0)) (+ (f0 a b) 1)))") (lint-test "(define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0) (f0 (+ b 1))))))" " define: perhaps (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0) (f0 (+ b 1))))) -> (lambda (b) (if (> b 0) (let f0 ((a (+ b 1))) (+ a 1)))) define: letrec could be let: (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0) (f0 (+ b 1))))) define: perhaps (define f43 (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (b) (if (> b 0)... -> (define (f43 b) (if (> b 0) (let f0 ((a (+ b 1))) (+ a 1))))") (lint-test "(lambda (c) (letrec ((f0 (lambda (a) (+ a 1)))) (f0 (+ c 1))))" " lambda: the local function f0 could be moved outside the lambda: (lambda (c) (letrec ((f0 (lambda (a) (+ a 1)))) (f0 (+ c 1)))) -> (letrec ((f0 (lambda (a) (+ a 1)))) (lambda (c) ...)) lambda: letrec could be let: (letrec ((f0 (lambda (a) (+ a 1)))) (f0 (+ c 1))) lambda: perhaps (letrec ((f0 (lambda (a) (+ a 1)))) (f0 (+ c 1))) -> (let f0 ((a (+ c 1))) (+ a 1))") (lint-test "(lambda (c) (letrec ((f0 (lambda (a) (+ a c 1)))) (let ((c 32)) (f0 (+ c 1)))))" " lambda: letrec could be let: (letrec ((f0 (lambda (a) (+ a c 1)))) (let ((c 32)) (f0 (+ c 1)))) lambda: perhaps (let ((c 32)) (f0 (+ c 1))) -> (f0 (+ 32 1))") (lint-test "(letrec ((auto-save-func (lambda () (if auto-saving (in 1.0 auto-save-func))))) (lambda () (in 1.0 auto-save-func)))" "") ; don't rewrite this one! (lint-test "(let ((x (lambda (y) (+ y (x (- y 1)))))) (x 2))" " let: let variable x is called in its binding? Perhaps let should be letrec: ((x (lambda (y) (+ y (x (- y 1)))))) let: perhaps (let ((x (lambda (y) (+ y (x (- y 1)))))) (x 2)) -> (let ((y 2)) (+ y (x (- y 1))))") (lint-test "(let () (define (f60 x) (* 2 x)) (+ 1 (f60 y)))" " let: perhaps (... (define (f60 x) (* 2 x)) (+ 1 (f60 y))) -> (... (+ 1 (let ((x y)) (* 2 x))))") (lint-test "(let () (define f60 (let ((a (lambda (x) (* 2 x)))) a)) (+ 1 (f60 y)))" " f60: perhaps (let ((a (lambda (x) (* 2 x)))) a) -> (lambda (x) (* 2 x))") (lint-test "(let ((x 2)) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)))" " loop: perhaps (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)) -> (do ((y x (- y 1))) ((not (positive? y)) 0)) let: perhaps (let ((x 2)) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0))) -> (let loop ((y 2)) (if (positive? y) (loop (- y 1)) 0))") (lint-test "(let ((f60 (lambda (x) (* 2 x)))) (+ 1 (f60 y)))" " let: perhaps (let ((f60 (lambda (x) (* 2 x)))) (+ 1 (f60 y))) -> (+ 1 (let ((x y)) (* 2 x)))") (lint-test "(define (f61 x) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)))" " define: perhaps (define (f61 x) (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0))) -> (define (f61 y) (if (positive? y) (f61 (- y 1)) 0)) loop: perhaps (let loop ((y x)) (if (positive? y) (loop (- y 1)) 0)) -> (do ((y x (- y 1))) ((not (positive? y)) 0))") (lint-test "(define (f61 x) (let loop ((x x)) (if (positive? x) (loop (- x 1)) 0)))" " define: perhaps (define (f61 x) (let loop ((x x)) (if (positive? x) (loop (- x 1)) 0))) -> (define (f61 x) (if (positive? x) (f61 (- x 1)) 0)) loop: perhaps (let loop ((x x)) (if (positive? x) (loop (- x 1)) 0)) -> (do ((x x (- x 1))) ((not (positive? x)) 0))") (lint-test "(define (f61) (let loop () (if (positive? x) (loop) 0)))" " define: perhaps (define (f61) (let loop () (if (positive? x) (loop) 0))) -> (define (f61) (if (positive? x) (f61) 0))") (lint-test "(define (rep x) (f x) (f x) (f x) (f x) (f x))" "rep: perhaps (f x)... -> (do ((i 0 (+ i 1))) ((= i 5)) (f x))") (lint-test "(define (rep1 lim) (let ((sum 0)) (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i))) (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i))) (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i))) (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i))) sum))" "rep1: perhaps (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i)))... -> (do ((<1> 0 (+ <1> 1))) ((= <1> 4)) (do ((i 0 (+ i 1))) ((= i lim)) (set! sum (+ sum i))))") (lint-test "(let () (define (get-xyzzy a) (+ 1 (car a))) (define (set-xyzzy a b) (cons (+ a 1) b)) (set-xyzzy x (get-xyzzy y)))" "let: perhaps change set-xyzzy to a let: (let () (define (get-xyzzy a) (+ 1 (car a))) (define (set-xyzzy a b) (cons... -> (... (let ((a x) (b (get-xyzzy y))) ...)) let: perhaps use dilambda and generalized set! for get-xyzzy and set-xyzzy: replace (get-xyzzy ...) with (xyzzy ...) and (set-xyzzy ... b) with (set! (xyzzy ...) b) (define xyzzy (dilambda (lambda (a) (+ 1 (car a))) (lambda (a b) (cons (+ a 1) b))))") (lint-test "(let () (define (xyzzy-ref a) (+ 1 (car a))) (define (xyzzy-set! a b) (cons (+ a 1) b)) (xyzzy-set! x (xyzzy-ref y)))" "let: perhaps change xyzzy-set! to a let: (let () (define (xyzzy-ref a) (+ 1 (car a))) (define (xyzzy-set! a b)... -> (... (let ((a x) (b (xyzzy-ref y))) ...)) let: perhaps use dilambda and generalized set! for xyzzy-ref and xyzzy-set!: replace (xyzzy-ref ...) with (xyzzy ...) and (xyzzy-set! ... b) with (set! (xyzzy ...) b) (define xyzzy (dilambda (lambda (a) (+ 1 (car a))) (lambda (a b) (cons (+ a 1) b))))") (lint-test "(let () (define (get-xyzzy) (+ 1 (car a))) (define (set-xyzzy b) (set! z b)) (set-xyzzy x) (get-xyzzy))" "let: perhaps use dilambda and generalized set! for get-xyzzy and set-xyzzy: replace (get-xyzzy) with (xyzzy) and (set-xyzzy b) with (set! (xyzzy) b) (define xyzzy (dilambda (lambda () (+ 1 (car a))) (lambda (b) (set! z b))))") (lint-test "(let () (define (xyzzy-ref xyzzy b) (+ b (car xyzzy))) (define (xyzzy-set! xyzzy b c) (list (+ xyzzy c) b)) (xyzzy-set! obj (xyzzy-ref obj y) z))" "let: perhaps change xyzzy-set! to a let: (let () (define (xyzzy-ref xyzzy b) (+ b (car xyzzy))) (define (xyzzy-set!... -> (... (let ((xyzzy obj) (b (xyzzy-ref obj y)) (c z)) ...)) let: perhaps use dilambda and generalized set! for xyzzy-ref and xyzzy-set!: replace (xyzzy-ref ...) with (xyzzy ...) and (xyzzy-set! ... c) with (set! (xyzzy ...) c) (define xyzzy (dilambda (lambda (<1> b) (+ b (car <1>))) (lambda (<1> b c) (list (+ <1> c) b))))") (lint-test "(let () (define (xyz-get-zy xyzzy b) (+ b (car xyzzy))) (define (xyz-set-zy xyzzy b c) (list (+ xyzzy c) b)) (xyz-set-zy obj (xyz-get-zy obj y) z))" "let: perhaps change xyz-set-zy to a let: (let () (define (xyz-get-zy xyzzy b) (+ b (car xyzzy))) (define... -> (... (let ((xyzzy obj) (b (xyz-get-zy obj y)) (c z)) ...)) let: perhaps use dilambda and generalized set! for xyz-get-zy and xyz-set-zy: replace (xyz-get-zy ...) with (xyz-zy ...) and (xyz-set-zy ... c) with (set! (xyz-zy ...) c) (define xyz-zy (dilambda (lambda (xyzzy b) (+ b (car xyzzy))) (lambda (xyzzy b c) (list (+ xyzzy c) b))))") (lint-test "(begin (define x (let ((y 0)) (dilambda (lambda () y) (lambda (z) (set! y z))))) (or (> (x) 0) (= (x) 0)))" " begin: perhaps (or (> (x) 0) (= (x) 0)) -> (>= (x) 0)") (lint-test "(let* ((x 32) (dx (dilambda (lambda (z) (+ x z)) (lambda (z) (set! x z))))) (set! (dx) 3) x)" "") (lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (f105 (f104 3)))" " let: perhaps change f105 to a let: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (f105... -> (... (let ((y (f104 3))) ...))") (lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f105 y))) (f105 (f104 3)))" " let: perhaps change f105 to a named let: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f105 y))) (f105... -> (... (let f105 ((y (f104 3))) ...))") (lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (+ 1 (f105 (f104 3))))" " let: perhaps embed f105: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f104 y))) (+ 1... -> (... (+ 1 (let ((y (f104 3))) (+ y (f104 y)))))") (lint-test "(let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f105 y))) (+ 1 (f105 (f104 3))))" " let: perhaps embed f105: (let () (define (f104 x) (log x 8)) (define (f105 y) (+ y (f105 y))) (+ 1... -> (... (+ 1 (let f105 ((y (f104 3))) (+ y (f105 y)))))") (lint-test "(define (f70 a b) (let ((a a) (b b)) (+ a b)))" " define: in (define (f70 a b) (let ((a a) (b b)) (+ a b))) this let binding is pointless: (a a) define: in (define (f70 a b) (let ((a a) (b b)) (+ a b))) this let binding is pointless: (b b) f70: perhaps (let ((a a) (b b)) (+ a b)) -> (+ a b)") (lint-test "(let () (define f74 (lambda (b) (let loop ((c b)) (loop (+ c 1))))) (f74 2))" " let: perhaps (define f74 (lambda (b) (let loop ((c b)) (loop (+ c 1))))) -> (define (f74 c) (f74 (+ c 1)))") (lint-test "(let () (define f74 (lambda (b) (let loop ((b b)) (loop (+ b 1))))) (f74 2))" " let: perhaps (define f74 (lambda (b) (let loop ((b b)) (loop (+ b 1))))) -> (define (f74 b) (f74 (+ b 1)))") (lint-test "(let () (define f74 (lambda (b) (let loop ((b b) (c 0)) (loop (+ b c))))) (f74 2))" " f74: loop needs 2 arguments: (loop (+ b c)) let: a toss-up -- perhaps (define f74 (lambda (b) (let loop ((b b) (c 0)) (loop (+ b c))))) -> (define* (f74 b (c 0)) (f74 (+ b c)))") (lint-test "(let () (define (f1 x) (+ x 1)) (define (f2 a) (+ (a 1) 1)) (let ((b (f1 2))) (f2 f1) (+ b (f1 2) (f1 2) (f1 2))))" "") (lint-test "(let () (define (f1 x) (+ x 1)) (let ((b (f1 2))) (+ b (f1 2) (f1 2) (f1 2))))" " let: f1's 'x parameter is always 2 (4 calls)") (lint-test "(let ((s s)) (- (expt s 3) (expt s 2)))" " let: perhaps omit this useless let: (let ((s s)) (- (expt s 3) (expt s 2))) -> (- (expt s 3) (expt s 2))") (lint-test "(let ((x x)) (vector-set! x 0 1) x)" " let: perhaps omit this useless let: (let ((x x)) (vector-set! x 0 1) x) -> (begin (vector-set! x 0 1) x)") (lint-test "(let ((abs abs)) (+ x y))" " let: perhaps omit this useless let: (let ((abs abs)) (+ x y)) -> (+ x y) let: abs not used, initially: abs from let") (lint-test "(let ((x y)) (display (abs x)) x)" "") (lint-test "(let ((v V)) (vector-set! v 0 1) v)" "") (lint-test "(let ((car car)) (lambda (x) (car x)))" " let: perhaps omit this useless let: (let ((car car)) (lambda (x) (car x))) -> (lambda (x) (car x)) let: perhaps (lambda (x) (car x)) -> car") (lint-test "(let ((abc 'abc)) (eq? x abc))" " let: perhaps (let ((abc 'abc)) (eq? x abc)) -> (eq? x 'abc) let: pointless local variable: abc, just use 'abc directly") (lint-test "(define (f x) (define y (g x)) (h (+ y x)))" "") (lint-test "(define (f x) (define y (g x)) (define z (h x)) (w (+ y x z)))" " f: perhaps (... (define y (g x)) (define z (h x)) (w (+ y x z))) -> (... (let ((y (g x)) (z (h x))) ...)) f: the scope of z could be reduced: (... (define z (h x)) (w (+ y x z))) -> (... (let ((z (h x))) (w (+ y x z))))") (lint-test "(define (f x) (define y (g x)) (define z (h y)) (w (+ y x z)))" " f: perhaps (... (define y (g x)) (define z (h y)) (w (+ y x z))) -> (... (let* ((y (g x)) (z (h y))) ...)) f: the scope of z could be reduced: (... (define z (h y)) (w (+ y x z))) -> (... (let ((z (h y))) (w (+ y x z))))") (lint-test "(define (f x) (define y (g x)) (define z (lambda (a) (if w (z (- a 1))))) (z (+ y x)))" " f: perhaps (... (define y (g x)) (define z (lambda (a) (if w (z (- a 1))))) (z (+ y x))) -> (... (let ((y (g x))) ...)) f: the scope of z could be reduced: (... (define z (lambda (a) (if w (z (- a 1))))) (z (+ y x))) -> (... (letrec ((z (lambda (a) (if w (z (- a 1)))))) (z (+ y x)))) z: perhaps (lambda (a) (if w (z (- a 1)))) -> (lambda (a) (do ((a a (- a 1))) ((not w))))") (lint-test "(define (f x) (define y (g x)) (define z (lambda (a) (if y (z (- a 1))))) (z (+ y x)))" " f: perhaps (... (define y (g x)) (define z (lambda (a) (if y (z (- a 1))))) (z (+ y x))) -> (... (let ((y (g x))) ...)) f: the scope of z could be reduced: (... (define z (lambda (a) (if y (z (- a 1))))) (z (+ y x))) -> (... (letrec ((z (lambda (a) (if y (z (- a 1)))))) (z (+ y x)))) z: perhaps (lambda (a) (if y (z (- a 1)))) -> (lambda (a) (do ((a a (- a 1))) ((not y))))") (lint-test "(lambda (a . opt) (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)))" " :lambda: perhaps (lambda (a . opt) (let ((ip (if (null? opt) (current-input-port) (car... -> (lambda* (a (ip (current-input-port))) ...) lambda: perhaps (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)) -> (read (if (null? opt) (current-input-port) (car opt)))") (lint-test "(lambda opt (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)))" " :lambda: perhaps (lambda opt (let ((ip (if (null? opt) (current-input-port) (car opt))))... -> (lambda* ((ip (current-input-port))) ...) lambda: perhaps (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)) -> (read (if (null? opt) (current-input-port) (car opt)))") (lint-test "(define (f204 b . opt) (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)))" " f204: perhaps (define (f204 b . opt) (let ((ip (if (null? opt) (current-input-port) (car... -> (define* (f204 b (ip (current-input-port))) ...) f204: perhaps (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)) -> (read (if (null? opt) (current-input-port) (car opt)))") (lint-test "(define (f205 b . opt) (let ((ip (if (null? opt) #f (car opt)))) (read ip)))" " f205: perhaps (define (f205 b . opt) (let ((ip (if (null? opt) #f (car opt)))) (read ip))) -> (define* (f205 b ip) ...) f205: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt)) f205: perhaps (let ((ip (if (null? opt) #f (car opt)))) (read ip)) -> (read (if (null? opt) #f (car opt)))") (lint-test "(define f206 (lambda (c . opt) (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip))))" " :lambda: perhaps (lambda (c . opt) (let ((ip (if (null? opt) (current-input-port) (car... -> (lambda* (c (ip (current-input-port))) ...) f206: perhaps (let ((ip (if (null? opt) (current-input-port) (car opt)))) (read ip)) -> (read (if (null? opt) (current-input-port) (car opt)))") (lint-test "(define (f207 b . opt) (let* ((ip (if (null? opt) #f (car opt))) (op (port? ip))) (read ip)))" " f207: perhaps (define (f207 b . opt) (let* ((ip (if (null? opt) #f (car opt))) (op... -> (define* (f207 b ip) (let ((op (port? ip))) ...)) f207: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt)) f207: op not used, initially: (port? ip) from let*") (lint-test "(define (f208 b . opt) (let* ((ip (if (null? opt) #f (car opt))) (op (port? ip)) (op2 op)) (read ip)))" " f208: perhaps (define (f208 b . opt) (let* ((ip (if (null? opt) #f (car opt))) (op... -> (define* (f208 b ip) (let* ((op (port? ip)) (op2 op)) ...)) f208: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt)) f208: op2 not used, initially: op from let* f208: perhaps restrict op which is not used in the let* body (let* ((ip (if (null? opt) #f (car opt))) (op (port? ip)) (op2 op)) (read ip)) -> (let* ((ip (if (null? opt) #f (car opt))) (op2 (let ((op (port? ip))) op))) ...)") (lint-test "(define (f210 b . opt) (let ((ip (if (null? opt) 0 (car opt)))) (g ip) (f ip)))" " f210: perhaps (define (f210 b . opt) (let ((ip (if (null? opt) 0 (car opt)))) (g ip) (f ip))) -> (define* (f210 b (ip 0)) ...)") (lint-test "(define (f210 b . opt) (let ((ip (if (not (pair? opt)) 0 (car opt)))) (g ip) (f ip)))" " f210: perhaps (define (f210 b . opt) (let ((ip (if (not (pair? opt)) 0 (car opt)))) (g... -> (define* (f210 b (ip 0)) ...)") (lint-test "(define (f210 b . opt) (let ((ip (if (pair? opt) (car opt) 0))) (g ip) (f ip)))" " f210: perhaps (define (f210 b . opt) (let ((ip (if (pair? opt) (car opt) 0))) (g ip) (f ip))) -> (define* (f210 b (ip 0)) ...)") (lint-test "(define (f210 b . opt) (let ((ip (if (not (null? opt)) (car opt) 0))) (g ip) (f ip)))" " f210: perhaps (define (f210 b . opt) (let ((ip (if (not (null? opt)) (car opt) 0))) (g... -> (define* (f210 b (ip 0)) ...) f210: perhaps (if (not (null? opt)) (car opt) 0) -> (if (null? opt) 0 (car opt))") (lint-test "(define (f210 . opt) (let ((ip (if (null? opt) 0 (car opt)))) (g ip) (f ip)))" " f210: perhaps (define (f210 . opt) (let ((ip (if (null? opt) 0 (car opt)))) (g ip) (f ip))) -> (define* (f210 (ip 0)) ...)") (lint-test "(define (f210 . opt) (let ((ip (if (null? opt) #f (car opt)))) (g ip) (f ip)))" " f210: perhaps (define (f210 . opt) (let ((ip (if (null? opt) #f (car opt)))) (g ip) (f ip))) -> (define* (f210 ip) ...) f210: perhaps (if (null? opt) #f (car opt)) -> (and (not (null? opt)) (car opt))") (lint-test "(define f230 (lambda* (:allow-other-keys) 1))" " lambda*: :allow-other-keys can't be the only parameter: (:allow-other-keys)") (lint-test "(define* (f230 :allow-other-keys) 1)" " f230: :allow-other-keys can't be the only parameter: (:allow-other-keys)") (lint-test "(define f230 (lambda* (:rest) 1))" " lambda*: :rest parameter needs a name: (:rest)") (lint-test "(define* (f230 :rest) 1)" " f230: :rest parameter needs a name: (:rest)") (let-temporarily ((*report-clobbered-function-return-value* #t)) (lint-test "(let ((v #f)) (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0 #\\a))" " let: perhaps (... (define (f80) (display v) \"a string\") (set! v (f80)) (string-set! v 0... -> (... (set! v (let () (display v) \"a string\")) (string-set! v 0 #\\a)) f80: returns a string constant: \"a string\" let: (set! v (f80)) returns a constant sequence, but (string-set! v 0 #\\a) appears to clobber it") (lint-test "(let ((v #f)) (define (f81) (display v) '(0 1 2 3)) (set! v (f81)) (list-set! v 0 32))" " let: perhaps (... (define (f81) (display v) '(0 1 2 3)) (set! v (f81)) (list-set! v 0 32)) -> (... (set! v (let () (display v) '(0 1 2 3))) (list-set! v 0 32)) f81: returns a list constant: '(0 1 2 3) let: (set! v (f81)) returns a constant sequence, but (list-set! v 0 32) appears to clobber it")) (let-temporarily ((*report-shadowed-variables* #t)) (lint-test "(let ((f33 33)) (define f33 4) (g f33 1))" " let: let variable f33 in (define f33 4) shadows an earlier declaration let: let variable f33 is redefined in the let body. Perhaps use set! instead: (set! f33 4) let: f33 not used, initially: 33 from let") (lint-test "(let ((f33 33)) (define (f33 x) (+ x 4)) (g f33 1))" " let: let variable f33 in (define (f33 x) (+ x 4)) shadows an earlier declaration let: let variable f33 is declared twice let: f33 not used, initially: 33 from let") (lint-test "(let ((f33 33)) (if (g x) (begin (define f33 4) (g f33)) 4))" " let: perhaps move the let to the true branch: (let ((f33 33)) (if (g x) (begin (define f33 4) (g f33)) 4)) -> (if (g x) (let ((f33 33)) (define f33 4) (g f33)) 4) let: begin variable f33 in (define f33 4) shadows an earlier declaration let: let variable f33 is redefined in the let body. Perhaps use set! instead: (set! f33 4) let: f33 not used, initially: 33 from let") ;; check built-in names (lint-test "(define abs 3)" " top-level redefinition of built-in function abs: (define abs 3)") (lint-test "(define* (abs (ab 1)) (+ ab 1))" " top-level redefinition of built-in function abs: (define* (abs (ab 1)) (+ ab 1))") (lint-test "(define (f x abs y) (+ x (- abs y)))" " define: f parameter abs shadows built-in abs") (lint-test "(let ((abs 3)) (f abs))" " let: let variable abs shadows built-in abs let: perhaps, assuming f is not a macro, (let ((abs 3)) (f abs)) -> (f 3)") (lint-test "(do ((abs 0 (+ abs 1))) ((= abs 3) 32) (display abs))" " do: do variable abs shadows built-in abs") (lint-test "(let abs ((i 10)) (if (positive? i) (abs (- i 1))))" " let: let named-let-function-name abs shadows built-in abs abs: perhaps (let abs ((i 10)) (if (positive? i) (abs (- i 1)))) -> (do ((i 10 (- i 1))) ((not (positive? i))))") (lint-test "(let* abs ((i 10) (j i)) (if (positive? i) (abs (- i j) j)))" " let*: let* named-let*-function-name abs shadows built-in abs") (lint-test "(f (lambda (abs) (+ abs 1)))" " lambda: :lambda parameter abs shadows built-in abs") (lint-test "(map (lambda (abs) (car abs)) lst)" " map: perhaps (lambda (abs) (car abs)) -> car lambda: :lambda parameter abs shadows built-in abs") (lint-test "(call-with-exit (lambda (abs) (abs 1)))" " call-with-exit: call-with-exit exit-function abs shadows built-in abs call-with-exit: abs is redundant here: (abs 1)") (lint-test "(call/cc (lambda (abs) (abs 1)))" " call/cc: call/cc continuation abs shadows built-in abs call/cc: perhaps call/cc could be call-with-exit: (call/cc (lambda (abs) (abs 1))) call/cc: abs is redundant here: (abs 1)") (lint-test "(call-with-output-file x (lambda (abs) (read abs)))" " call-with-output-file: call-with-output-file port abs shadows built-in abs call-with-output-file: perhaps (call-with-output-file x (lambda (abs) (read abs))) -> (call-with-output-file x read) call-with-output-file: abs is an output-port, but read in (read abs) wants an input-port?")) (lint-test "(call-with-input-file file (lambda (p) (write c p) (write-string str p)))" " call-with-input-file: p is an input-port, but write-string in (write-string str p) wants an output-port or #f call-with-input-file: p is an input-port, but write in (write c p) wants an output-port or #f") (lint-test "(call-with-input-string str (lambda (p) (write c p) (read p)))" " call-with-input-string: p is an input-port, but write in (write c p) wants an output-port or #f") (lint-test "(call-with-output-string (lambda (p) (write c p) (read p)))" " call-with-output-string: p is an output-port, but read in (read p) wants an input-port?") (lint-test "(call-with-output-file file (lambda (p) (read p) (write c p)))" " call-with-output-file: p is an output-port, but read in (read p) wants an input-port?") (let-temporarily ((*report-func-as-arg-arity-mismatch* #t)) (lint-test "(let () (define (f43 x) (+ x 1)) (define (f44 y z) (y (+ z 1) abs)) (f44 f43 2))" " let: perhaps change f44 to a let: (let () (define (f43 x) (+ x 1)) (define (f44 y z) (y (+ z 1) abs)) (f44... -> (... (let ((y f43) (z 2)) ...)) let: f44's parameter y is passed f43 and called (y (+ z 1) abs), but f43 takes only 1 argument") (lint-test "(let () (define (f45 x) (+ x 1)) (define (f46 y z) (if z (y))) (f46 f45 2))" " let: perhaps change f46 to a let: (let () (define (f45 x) (+ x 1)) (define (f46 y z) (if z (y))) (f46 f45 2)) -> (... (let ((y f45) (z 2)) ...)) let: f46's parameter y is passed f45 and called (y), but f45 needs 1 argument") (lint-test "(let () (define (f47 y z) (y (+ z 1) abs)) (f47 abs 2))" " let: perhaps (... (define (f47 y z) (y (+ z 1) abs)) (f47 abs 2)) -> (... (let ((y abs) (z 2)) (y (+ z 1) abs))) let: f47's parameter y is passed abs and called (y (+ z 1) abs), but abs takes only 1 argument") (lint-test "(let () (define (f48 y z) (if z (y))) (f48 abs 2))" " let: perhaps (... (define (f48 y z) (if z (y))) (f48 abs 2)) -> (... (let ((y abs) (z 2)) (if z (y)))) let: f48's parameter y is passed abs and called (y), but abs needs 1 argument") (lint-test "(let () (define (f49 y z) (y (+ z 1))) (f49 (lambda () (+ a 1)) 2))" " let: perhaps (... (define (f49 y z) (y (+ z 1))) (f49 (lambda () (+ a 1)) 2)) -> (... (let ((y (lambda () (+ a 1))) (z 2)) (y (+ z 1)))) let: f49's parameter y is passed (lambda () (+ a 1)) and called (y (+ z 1)), but (lambda () (+ a 1)) takes only 0 arguments") (lint-test "(let () (define (f50 y z) (y (+ z 1))) (f50 (lambda (a b) (+ a 1)) 2))" " let: perhaps (... (define (f50 y z) (y (+ z 1))) (f50 (lambda (a b) (+ a 1)) 2)) -> (... (let ((y (lambda (a b) (+ a 1))) (z 2)) (y (+ z 1)))) let: f50's parameter y is passed (lambda (a b) (+ a 1)) and called (y (+ z 1)), but (lambda (a b) (+ a 1)) needs 2 arguments")) (let-temporarily ((*report-boolean-functions-misbehaving* #t)) (lint-test "(let () (define (f80? x) (if z (display x) (string-append x y z))) (display x) f80?)" " let: f80? looks boolean, but it can return (string-append x y z)")) (let-temporarily ((*report-nested-if* 3)) (lint-test "(if (< x y) (display z) (if (> x y) (+ w 1) (when (= x y) 0)))" " if: perhaps (if (< x y) (display z) (if (> x y) (+ w 1) (when (= x y) 0))) -> (cond ((< x y) (display z)) ((> x y) (+ w 1)) (else (when (= x y) 0)))")) (lint-test "(let () (define x 2) (display x) (set! y 32) (display y) (* y (log y)))" " let: perhaps (... (define x 2) (display x) (set! y 32) (display y) (* y (log y))) -> (... (let ((x 2)) ...)) let: the scope of x could be reduced: (... (define x 2) (display x) ...) -> (... (let ((x 2)) (display x)) ...) let: perhaps (let () (define x 2) (display x) (set! y 32) (display y) (* y (log y))) -> (let ((x 2)) ...)") (lint-test "(let () (display 32) (define x 2) (define (f101 y) (+ x y)) (display 41) (f101 2))" " let: perhaps move x into f101's closure: (... (define x 2) (define (f101 y) (+ x y)) ...) -> (... (define f101 (let ((x 2)) (lambda (y) (+ x y)))) ...) let: (define x 2) occurs in the midst of the body; perhaps use let: (let ((x 2)) (define (f101 y) (+ x y)) (display 41) (f101 2)) x is used only in f101") (lint-test "(let () (display 33) (define x 2) (define x (+ x y)) (display 43))" " let: use set! to redefine x: (... (define x (+ x y)) ...) -> (... (set! x (+ x y)) ...) let: (define x 2) occurs in the midst of the body; perhaps use let: (let ((x 2)) (define x (+ x y)) (display 43)) let: let variable x is redefined in the let body. Perhaps use set! instead: (set! x (+ x y)) let: x not used, initially: (+ x y) from define") (lint-test "(let () (display 34) (define x 2) (define f101 (lambda (y) (+ x y))) (display 41) (f101 2))" " let: perhaps move x into f101's closure: (... (define x 2) (define f101 (lambda (y) (+ x y))) ...) -> (... (define f101 (let ((x 2)) (lambda (y) (+ x y)))) ...) let: the scope of f101 could be reduced: (... (define f101 (lambda (y) (+ x y))) (display 41) (f101 2)) -> (... (let ((f101 (lambda (y) (+ x y)))) (display 41) (f101 2))) let: (define x 2) occurs in the midst of the body; perhaps use let: (let ((x 2)) (define f101 (lambda (y) (+ x y))) (display 41) (f101 2))") (lint-test "(let ((x (read-byte)) (y (read-byte))) (- x y))" " let: order of evaluation of let's bindings is unspecified, so (let ((x (read-byte)) (y (read-byte))) (- x y)) is trouble let: perhaps (let ((x (read-byte)) (y (read-byte))) (- x y)) -> (- (read-byte) (read-byte)) let: in \"(let ((x (read-byte)) (y (read-byte))) (- x y))\", let should be let*") (lint-test "(list (read port) (read-char port))" " list: order of evaluation of list's arguments is unspecified, so (list (read port) (read-char port)) is trouble") (lint-test "(list (read port) (read-char))" "") (lint-test "(list (set! x 3) (+ x 1))" " list: order of evaluation of list's arguments is unspecified, so (list (set! x 3) (+ x 1)) is trouble") (lint-test "(list (throw 'oops) 1 2)" "") (lint-test "(list (throw 'oops) 1 (read-byte))" " list: order of evaluation of list's arguments is unspecified, so (list (throw 'oops) 1 (read-byte)) is trouble") (lint-test "(values (read) (read-char) (read-string 2))" " values: order of evaluation of values's arguments is unspecified, so (values (read) (read-char) (read-string 2)) is trouble") (lint-test "(letrec ((a (read)) (b (read-char)) (c (read-string 2))) (list a b c))" " letrec: order of evaluation of letrec's bindings is unspecified, so (letrec ((a (read)) (b (read-char)) (c (read-string 2))) (list a b c)) is trouble letrec: letrec could be let: (letrec ((a (read)) (b (read-char)) (c (read-string 2))) (list a b c))") (lint-test "(call-with-input-file caaaar)" " call-with-input-file: call-with-input-file needs 2 arguments: (call-with-input-file caaaar) call-with-input-file: in (call-with-input-file caaaar), call-with-input-file's argument should be a string, but caaaar is a procedure?") (lint-test "(and (< 0 x) (< x 1))" " and: perhaps (and (< 0 x) (< x 1)) -> (< 0 x 1)") (lint-test "(and (< 1 x) (< x 1))" " and: perhaps (and (< 1 x) (< x 1)) -> #f") (lint-test "(and (< 1 x) (< x 0))" " and: perhaps (and (< 1 x) (< x 0)) -> #f") (lint-test "(and (<= 0 x) (<= x 1))" " and: perhaps (and (<= 0 x) (<= x 1)) -> (<= 0 x 1)") (lint-test "(and (<= 1 x) (<= x 1))" " and: perhaps (and (<= 1 x) (<= x 1)) -> (= 1 x)") (lint-test "(and (<= 1 x) (<= x 0))" " and: perhaps (and (<= 1 x) (<= x 0)) -> #f") (lint-test "(and (< 0 x) (<= x 1))" "") (lint-test "(and (< 1 x) (<= x 1))" " and: perhaps (and (< 1 x) (<= x 1)) -> #f") (lint-test "(and (< 1 x) (<= x 0))" " and: perhaps (and (< 1 x) (<= x 0)) -> #f") (lint-test "(and (<= 0 x) (< x 1))" "") (lint-test "(and (<= 1 x) (< x 1))" " and: perhaps (and (<= 1 x) (< x 1)) -> #f") (lint-test "(and (<= 1 x) (< x 0))" " and: perhaps (and (<= 1 x) (< x 0)) -> #f") (lint-test "(or (< 0 x) (< x 1))" " or: perhaps (or (< 0 x) (< x 1)) -> #t") (lint-test "(or (< 1 x) (< x 1))" " or: perhaps (or (< 1 x) (< x 1)) -> (not (= x 1))") (lint-test "(or (< 1 x) (< x 0))" " or: perhaps (or (< 1 x) (< x 0)) -> (not (>= 1 x 0))") (lint-test "(or (<= 0 x) (<= x 1))" " or: perhaps (or (<= 0 x) (<= x 1)) -> #t") (lint-test "(or (<= 1 x) (<= x 1))" " or: perhaps (or (<= 1 x) (<= x 1)) -> #t") (lint-test "(or (<= 1 x) (<= x 0))" " or: perhaps (or (<= 1 x) (<= x 0)) -> (not (> 1 x 0))") (lint-test "(or (< 0 x) (<= x 1))" " or: perhaps (or (< 0 x) (<= x 1)) -> #t") (lint-test "(or (< 1 x) (<= x 1))" " or: perhaps (or (< 1 x) (<= x 1)) -> #t") (lint-test "(or (< 1 x) (<= x 0))" "") (lint-test "(or (<= 0 x) (< x 1))" " or: perhaps (or (<= 0 x) (< x 1)) -> #t") (lint-test "(or (<= 1 x) (< x 1))" " or: perhaps (or (<= 1 x) (< x 1)) -> #t") (lint-test "(or (<= 1 x) (< x 0))" "") (lint-test "(or (< x 0) (> x 9))" " or: perhaps (or (< x 0) (> x 9)) -> (not (<= 0 x 9))") (lint-test "(or (> 0 x) (> x 9))" " or: perhaps (or (> 0 x) (> x 9)) -> (not (<= 0 x 9))") (lint-test "(or (>= 0 x) (>= x 9))" " or: perhaps (or (>= 0 x) (>= x 9)) -> (not (< 0 x 9))") (lint-test "(or (> x 9) (< x 0))" " or: perhaps (or (> x 9) (< x 0)) -> (not (>= 9 x 0))") (lint-test "(or (< x 3.0) (> x 3.0))" " or: perhaps (or (< x 3.0) (> x 3.0)) -> (not (= x 3.0))") (lint-test "(or (< x 3.0) (= x 3.0))" " or: perhaps (or (< x 3.0) (= x 3.0)) -> (<= x 3.0) or: = can be troublesome with floats: (= x 3.0)") (lint-test "(and (< 0 x) (> x 0))" " and: perhaps (and (< 0 x) (> x 0)) -> (< 0 x)") (lint-test "(or (< 0 x) (> x 0))" " or: perhaps (or (< 0 x) (> x 0)) -> (> x 0)") (lint-test "(and (<= 0 x) (>= x 0))" " and: perhaps (and (<= 0 x) (>= x 0)) -> (<= 0 x)") (lint-test "(or (<= 0 x) (>= x 0))" " or: perhaps (or (<= 0 x) (>= x 0)) -> (>= x 0)") (lint-test "(and (<= 0 x) (> x 0))" " and: perhaps (and (<= 0 x) (> x 0)) -> (> x 0)") (lint-test "(or (<= 0 x) (> x 0))" " or: perhaps (or (<= 0 x) (> x 0)) -> (>= x 0)") (lint-test "(and (< 0 x) (>= x 0))" " and: perhaps (and (< 0 x) (>= x 0)) -> (> x 0)") (lint-test "(or (< 0 x) (>= x 0))" " or: perhaps (or (< 0 x) (>= x 0)) -> (>= x 0)") (lint-test "(and (< x 0) (> x 0))" " and: perhaps (and (< x 0) (> x 0)) -> #f") (lint-test "(or (< x 0) (> x 0))" " or: perhaps (or (< x 0) (> x 0)) -> (not (= x 0))") (lint-test "(and (<= x 0) (>= x 0))" " and: perhaps (and (<= x 0) (>= x 0)) -> (= x 0)") (lint-test "(or (<= x 0) (>= x 0))" " or: perhaps (or (<= x 0) (>= x 0)) -> #t") (lint-test "(and (<= x 0) (> x 0))" " and: perhaps (and (<= x 0) (> x 0)) -> #f") (lint-test "(or (<= x 0) (> x 0))" " or: perhaps (or (<= x 0) (> x 0)) -> #t") (lint-test "(and (< x 0) (>= x 0))" " and: perhaps (and (< x 0) (>= x 0)) -> #f") (lint-test "(or (< x 0) (>= x 0))" " or: perhaps (or (< x 0) (>= x 0)) -> #t") (lint-test "(< 0 x 1)" "") (lint-test "(< 1 x 1)" " <: it looks odd to have repeated arguments in (< 1 x 1) <: this comparison can't be true: (< 1 x 1) <: perhaps (< 1 x 1) -> #f") (lint-test "(< 1 x 0)" " <: this comparison can't be true: (< 1 x 0)") ; return #f! (lint-test "(<= 0 x 1)" "") (lint-test "(<= 1 x 1)" " <=: it looks odd to have repeated arguments in (<= 1 x 1) <=: perhaps (<= 1 x 1) -> (= 1 x)") (lint-test "(<= 1 x 0)" " <=: this comparison can't be true: (<= 1 x 0)") (lint-test "(if (>= (length x) 1) y z)" " if: perhaps (assuming x is a proper list), (>= (length x) 1) -> (pair? x)") ; (lint-test "(if (> (length x) 1) y z)" " if: perhaps (assuming x is a proper list), (> (length x) 1) -> (and (pair? x) (pair? (cdr x)))") (lint-test "(if (< (length x) 1) y z)" " if: perhaps (assuming x is a proper list), (< (length x) 1) -> (null? x)") (lint-test "(if (<= (length x) 1) y z)" " if: perhaps (assuming x is a proper list), (<= (length x) 1) -> (or (null? x) (null? (cdr x)))") (lint-test "(if (= (length x) 1) y z)" " if: perhaps (assuming x is a list), (= (length x) 1) -> (and (pair? x) (null? (cdr x)))") (lint-test "(if (>= (length x) 0) y z)" " if: perhaps (assuming x is a proper list), (>= (length x) 0) -> (list? x)") (lint-test "(if (> (length x) 0) y z)" " if: perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x)") (lint-test "(if (< (length x) 0) y z)" " if: perhaps (< (length x) 0) -> (and (pair? x) (not (proper-list? x)))") (lint-test "(if (<= (length x) 0) y z)" " if: perhaps (assuming x is a proper list), (<= (length x) 0) -> (null? x)") (lint-test "(if (= (length x) 0) y z)" " if: perhaps (assuming x is a list), (= (length x) 0) -> (null? x)") (lint-test "(if (>= 0 (length x)) y z)" " if: perhaps (assuming x is a proper list), (>= 0 (length x)) -> (null? x)") (lint-test "(if (> 0 (length x)) y z)" " if: perhaps (> 0 (length x)) -> (and (pair? x) (not (proper-list? x)))") (lint-test "(if (< 0 (length x)) y z)" " if: perhaps (assuming x is a proper list), (< 0 (length x)) -> (pair? x)") (lint-test "(if (<= 0 (length x)) y z)" " if: perhaps (assuming x is a proper list), (<= 0 (length x)) -> (list? x)") (lint-test "(if (= 0 (length x)) y z)" " if: perhaps (assuming x is a list), (= 0 (length x)) -> (null? x)") (lint-test "(if (>= 1 (length x)) y z)" " if: perhaps (assuming x is a proper list), (>= 1 (length x)) -> (or (null? x) (null? (cdr x)))") (lint-test "(if (> 1 (length x)) y z)" " if: perhaps (assuming x is a proper list), (> 1 (length x)) -> (null? x)") ; (lint-test "(if (< 1 (length x)) y z)" " if: perhaps (assuming x is a proper list), (< 1 (length x)) -> (and (pair? x) (pair? (cdr x)))") (lint-test "(if (<= 1 (length x)) y z)" " if: perhaps (assuming x is a proper list), (<= 1 (length x)) -> (pair? x)") (lint-test "(if (= 1 (length x)) y z)" " if: perhaps (assuming x is a list), (= 1 (length x)) -> (and (pair? x) (null? (cdr x)))") (lint-test "(if (null? x) () (map abs x))" " if: perhaps (if (null? x) () (map abs x)) -> (map abs x)") (lint-test "(< (vector-length x) 1)" " <: perhaps (< (vector-length x) 1) -> (equal? x #())") (lint-test "(> 1 (string-length x))" " >: perhaps (> 1 (string-length x)) -> (string=? x \"\")") (lint-test "(zero? (string-length x))" " zero?: perhaps (zero? (string-length x)) -> (string=? x \"\")") (lint-test " (string-length (make-string 3))" " string-length: perhaps (string-length (make-string 3)) -> 3") (lint-test " (vector-length (make-vector 10))" " vector-length: perhaps (vector-length (make-vector 10)) -> 10") (lint-test " (max (log x) :minlog)" " max: in (max (log x) :minlog), max's second argument should be real, but :minlog is a keyword?") (lint-test "(member outport (list *stderr* *stdout*))" "") ; not '(*stderr*...)! (lint-test "(define ((foo x) y) (list x y))" " define: perhaps (define ((foo x) y) (list x y)) -> (define (foo x) (lambda (y) (list x y)))") (lint-test "(let () (define ((foo x) y) (list x y)) (foo 1 2))" " let: perhaps (define ((foo x) y) (list x y)) -> (define (foo x) (lambda (y) (list x y)))") (lint-test "(define ((foo x) y) (+ (* -1 x) y))" " define: perhaps (define ((foo x) y) (+ (* -1 x) y)) -> (define (foo x) (lambda (y) (+ (* -1 x) y))) foo: perhaps (+ (* -1 x) y) -> (- y x)") ;; this needs work (never #f vars are tricky) (lint-test "(equal? x abs)" " equal?: equal? could be eq? in (equal? x abs)") (lint-test "(equal? x begin)" " equal?: equal? could be eq? in (equal? x begin)") (lint-test "(equal? x lint)" "") (lint-test "(string x #\\xd)" " #\\xd is #\\return") (lint-test "(let ((x ())) (set! x (cons 1 x)) (if x 3 2))" " let: x is never #f, so (if x 3 2) -> 3 let: perhaps (let ((x ())) (set! x (cons 1 x)) (if x 3 2)) -> (let ((x (cons 1 ()))) (if x 3 2))") (lint-test "(let ((x ())) (if x 3 2))" " let: perhaps (let ((x ())) (if x 3 2)) -> (if () 3 2) let: x is never #f, so (if x 3 2) -> 3") (lint-test "(let ((x ())) (if (pair? x) 3 2))" " let: perhaps (let ((x ())) (if (pair? x) 3 2)) -> (if (pair? ()) 3 2)") (lint-test "(let ((x 0)) (if x 3 2))" " let: perhaps (let ((x 0)) (if x 3 2)) -> (if 0 3 2) let: x is never #f, so (if x 3 2) -> 3") (lint-test "(let ((x 0)) (if (zero? x) 3 2))" " let: perhaps (let ((x 0)) (if (zero? x) 3 2)) -> (if (zero? 0) 3 2) let: x is 0, so (zero? x) is #t") (lint-test "(let ((x 0)) (set! x ()) (if x 3 2))" " let: perhaps (let ((x 0)) (set! x ()) (if x 3 2)) -> (let ((x ())) (if x 3 2))") (lint-test "(let ((x 0)) (set! x ()) (if (null? x) 3 2))" " let: perhaps (let ((x 0)) (set! x ()) (if (null? x) 3 2)) -> (let ((x ())) (if (null? x) 3 2))") (lint-test "(let ((x 0)) (display x) (set! x ()) (if (null? x) 3 2))" " let: perhaps combine these two lines: (set! x ()) (if (null? x) 3 2)") (lint-test "(let ((x 0)) (when x 3))" " let: perhaps (let ((x 0)) (when x 3)) -> (when 0 3) let: x is never #f, so (when x 3) -> 3") (lint-test "(let ((x 0)) (when (zero? x) 3))" " let: perhaps (let ((x 0)) (when (zero? x) 3)) -> (when (zero? 0) 3) let: x is 0, so (zero? x) is #t") (lint-test "(let ((x 0)) (set! x ()) (unless x 3))" " let: perhaps (let ((x 0)) (set! x ()) (unless x 3)) -> (let ((x ())) (unless x 3))") (lint-test "(let ((x 0)) (cond (x 3) (else 4)))" " let: perhaps (let ((x 0)) (cond (x 3) (else 4))) -> (cond (0 3) (else 4))") (lint-test "(let ((x 0)) (cond ((zero? x) 3) (else 4)))" " let: x is 0, so (zero? x) is #t") (lint-test "(let ((x 0)) (set! x ()) (cond (x 3) (else 4)))" " let: perhaps (let ((x 0)) (set! x ()) (cond (x 3) (else 4))) -> (let ((x ())) (cond (x 3) (else 4)))") (lint-test "(let ((x 0)) (case x ((0) 3) (else 4)))" " let: perhaps (case x ((0) 3) (else 4)) -> (if (eqv? x 0) 3 4)") (lint-test "(let ((x 0)) (do ((i x (+ i 1))) ((= i 0))))" " let: this do-loop could probably be replaced by the end test in a let: (do ((i x (+ i 1))) ((= i 0))) let: perhaps (let ((x 0)) (do ((i x (+ i 1))) ((= i 0)))) -> (do ((i 0 (+ i 1))) ...)") (lint-test "(let ((x 32)) (display x) (set! y (f x)) (g (+ x 1) y) (a y) (f y) (g y) (h y) (i y) (set! x 3) (display x) (h y x))" " let: perhaps add a new binding for x to replace (set! x 3): (let ((x 32)) (display x) (set! y (f x)) (g (+ x 1) y) (a y) (f y) (g y)... -> (let ... (let ((x 3)) ...))") (lint-test "(let ((x 32)) (set! y (f 1)) (a y) (f y) (g y) (h y) (i y) (set! x (+ x 1)) (display x) (h y x))" " let: perhaps move the x binding to replace (set! x (+ x 1)): (let ((x 32)) (set! y (f 1)) (a y) (f y) (g y) (h y) (i y) (set! x (+ x... -> (let () ... (let ((x (+ 32 1))) ...))") (lint-test "(let loop ((x y)) (if (null? x) () (cons (car x) (loop (cdr x)))))" " loop: perhaps (let loop ((x y)) (if (null? x) () (cons (car x) (loop (cdr x))))) -> (copy y)") (lint-test "(let loop ((x y)) (if (null? x) () (cons (string (car x)) (loop (cdr x)))))" " loop: perhaps (let loop ((x y)) (if (null? x) () (cons (string (car x)) (loop (cdr x))))) -> (map string y)") (lint-test "(let loop ((x y)) (cond ((null? x) ()) (else (cons (abs (car x)) (loop (cdr x))))))" " loop: perhaps (let loop ((x y)) (cond ((null? x) ()) (else (cons (abs (car x)) (loop... -> (map abs y)") (lint-test "(let loop ((x y)) (when (pair? x) (display (car x)) (loop (cdr x))))" " loop: perhaps (let loop ((x y)) (when (pair? x) (display (car x)) (loop (cdr x)))) -> (for-each display y)") (lint-test "(let loop ((x y)) (unless (null? x) (display (car x)) (loop (cdr x))))" " loop: perhaps (let loop ((x y)) (unless (null? x) (display (car x)) (loop (cdr x)))) -> (for-each display y)") (lint-test "(let loop ((x y)) (case x ((0 1) x) (else (loop (+ x 1)))))" " loop: perhaps (let loop ((x y)) (case x ((0 1) x) (else (loop (+ x 1))))) -> (do ((x y (+ x 1))) ((memv x '(0 1)) x)) let: perhaps (case x ((0 1) x) (else (loop (+ x 1)))) -> (if (memv x '(0 1)) x (loop (+ x 1))) let: in ((0 1) x), the result can be omitted") (lint-test "(if (or (eq? x abs) (eq? x case) (eq? x null?)) 3 2)" "") (lint-test "(cond ((eq? x begin) 1) ((eq? x reader-cond) 2) ((eq? x lint) 3))" "") (lint-test "(cond ((eq? x 'begin) 1) ((eq? x 'reader-cond) 2) ((eq? x 'lint) 3))" " cond: perhaps use case instead of cond: (cond ((eq? x 'begin) 1) ((eq? x 'reader-cond) 2) ((eq? x 'lint) 3)) -> (case x ((begin) 1) ((reader-cond) 2) ((lint) 3))") (lint-test "(let ((x (getenv \"HOME\"))) (if x (display x)))" " let: perhaps (let ((x (getenv \"HOME\"))) (if x (display x))) -> (cond ((getenv \"HOME\") => display))") (lint-test "(and-let* ((x (f y))) (abs x))" " and-let*: perhaps (and-let* ((x (f y))) (abs x)) -> (cond ((f y) => abs))") (lint-test "(let () (define* (f51 (a 3)) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1))" " let: perhaps (... (define* (f51 (a 3)) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1)) -> (... (let* f51 ((a -1)) (if (zero? a) 3 (f51 (- a 1))))) f51: perhaps (define* (f51 (a 3)) (if (zero? a) 3 (f51 (- a 1)))) -> (define* (f51 (a 3)) (do ((a a (- a 1))) ((zero? a) 3)))") (lint-test "(let () (define* (f51 (a 3) b) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1))" " let: perhaps (... (define* (f51 (a 3) b) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1)) -> (... (let* f51 ((a -1) (b #f)) (if (zero? a) 3 (f51 (- a 1)))))") (lint-test "(let () (define* (f51 (a 3) (b 32)) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1))" " let: perhaps (... (define* (f51 (a 3) (b 32)) (if (zero? a) 3 (f51 (- a 1)))) (f51 -1)) -> (... (let* f51 ((a -1) (b 32)) (if (zero? a) 3 (f51 (- a 1)))))") (lint-test "(let () (lambda (a b) (+ a (* 2 b))))" " let: pointless let: (let () (lambda (a b) (+ a (* 2 b))))") (lint-test "(let () (define (f x) x) (do ((i 0 (+ i 1))) ((= i 10)) (f i)))" " let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 10)) (f i)) let: this could be omitted: (f i) let: perhaps (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) i)") (lint-test "(let () (define (f x) (abs (* 2 x))) (do ((i 0 (+ i 1))) ((= i 10)) (f i)))" " let: this do-loop could probably be replaced by the end test in a let: (do ((i 0 (+ i 1))) ((= i 10)) (f i)) let: this could be omitted: (f i) let: perhaps (do ((i 0 (+ i 1))) ((= i 10)) (f i)) -> (do ((i 0 (+ i 1))) ((= i 10)) (abs (* 2 i)))") (lint-test "(let () (define (f202 x) (x 1 2)) (f202 (lambda (a b) a)) (f202 (lambda (a b) (+ a 1))))" " let: f202 parameter x is a function whose parameter 2 is never used") (lint-test "(let () (define (f202 x) (x 1 2)) (f202 (lambda (a b) a)) (f202 (lambda (c d) (+ c 1))))" " let: f202 parameter x is a function whose parameter 2 is never used") (lint-test "(let () (define (f202 x) (x 1 2)) (f202 (lambda (a b) a)) (f202 (lambda (c d) (+ d 1))))" "") (lint-test "(let () (define (f201 x) (g (f x))) (f201 1) (f201 1) (f201 1))" " let: f201's 'x parameter is always 1 (3 calls)") (lint-test "(string->symbol (let ((s (copy vstr))) (set! (s (+ pos 1)) #\\s) s))" " string->symbol: perhaps (string->symbol (let ((s (copy vstr))) (set! (s (+ pos 1)) #\\s) s)) -> (let ((s (copy vstr))) (set! (s (+ pos 1)) #\\s) (string->symbol s))") (lint-test "(apply env-channel (make-env :envelope '(0 0 1 1) :length (if (and (> (length args) 1) (number? (cadr args))) (cadr args) (framples (if (> (length args) 2) (caddr args) (selected-sound))))) args)" " apply: perhaps (apply env-channel (make-env ...) args) -> (let ((<1> (make-env ...))) (apply env-channel <1> args))") (let-temporarily ((*report-bloated-arg* 50)) (lint-test "(apply env-channel (make-env :envelope '(0 0 1 1) :length (if (and (> (length args) 1) (number? (cadr args))) (cadr args) (framples (if (> (length args) 2) (caddr args) (selected-sound))))) args)" "")) (lint-test "(let ((x 1)) (and x (< x 1)))" " in (and x (< x 1)), perhaps change x to (real? x) let: x is an integer, so (and x (< x 1)) -> (< x 1)") (lint-test "(let ((x 1)) (and (< x 1) x))" "") ; this is correct -- we want to return x so the trailing x is not redundant (lint-test "(let ((x 1)) (and x (< x 1) x))" " in (and x (< x 1)), perhaps change x to (real? x) let: x is an integer, so (and x (< x 1) x) -> (and (< x 1) x)") (lint-test "(let ((x 1)) (not x))" " let: perhaps (let ((x 1)) (not x)) -> (not 1) let: x is an integer, so (not x) -> #f") (lint-test "(gensym 'ok)" " gensym: in (gensym 'ok), gensym's argument should be a string, but 'ok is a symbol?") (lint-test "(string-ref 'ok 0)" " string-ref: in (string-ref 'ok 0), string-ref's first argument should be a string, but 'ok is a symbol? string-ref: (string-ref 'ok 0): string-ref first argument, ok, is a symbol but should be a string") (lint-test "(let ((l 1)) (+ l 1))" " let: perhaps (let ((l 1)) (+ l 1)) -> (+ 1 1) let: \"l\" is a really bad variable name") (lint-test "(let ((let 1)) (+ let 1))" " let: perhaps (let ((let 1)) (+ let 1)) -> (+ 1 1) let: let variable named let is asking for trouble") (lint-test "(define (f12 l) (log (abs l)))" " f12: \"l\" is a really bad variable name") (let-temporarily ((*report-bad-variable-names* '(info data))) (lint-test "(let ((data 1)) (+ data 32))" " let: perhaps (let ((data 1)) (+ data 32)) -> (+ 1 32) let: surely there's a better name for this variable than data") (lint-test "(let ((info1 32) (info-1 31)) (+ info1 info-1))" " let: perhaps (let ((info1 32) (info-1 31)) (+ info1 info-1)) -> (+ 32 31) let: surely there's a better name for this variable than info-1 let: surely there's a better name for this variable than info1") (lint-test "(let ((compute-x 32)) (+ compute-x x))" " let: perhaps (let ((compute-x 32)) (+ compute-x x)) -> (+ 32 x) let: surely there's a better name for this variable than compute-x")) (lint-test "(set! else #f)" " set!: bad idea: (set! else #f)") (lint-test "(define (f12 else) (log (abs else)))" " f12: surely there's a better name for this variable than else") (lint-test "(define (f12 => else) (+ => else))" " f12: leaving aside +'s optional args, f12 could be (define f12 +) f12: surely there's a better name for this variable than else") (lint-test "(let ((else #f)) (or 3 else))" " let: perhaps, ignoring short-circuit issues, (let ((else #f)) (or 3 else)) -> (or 3 #f) let: perhaps (or 3 else) -> 3 let: surely there's a better name for this variable than else") (lint-test "(define else 32)" " define: redefinition of else is a bad idea: (define else 32)") (let-temporarily ((*report-built-in-functions-used-as-variables* #t)) (lint-test "(let ((list 3)) (display list))" " let: perhaps (let ((list 3)) (display list)) -> (display 3) let: let variable named list is asking for trouble") (lint-test "(let ((cond 3)) (display cond))" " let: perhaps (let ((cond 3)) (display cond)) -> (display 3) let: let variable named cond is asking for trouble") (lint-test "(let () (define (f50 abs) (abs -1)) (f50 positive?))" " let: perhaps (... (define (f50 abs) (abs -1)) (f50 positive?)) -> (... (let ((abs positive?)) (abs -1))) let: f50's parameter abs is called (abs -1) : find a less confusing parameter name! f50: f50 parameter named abs is asking for trouble") (lint-test "(let () (define (f50 abs) (positive? abs)) (f50 -1))" " let: perhaps (... (define (f50 abs) (positive? abs)) (f50 -1)) -> (... (let ((abs -1)) (positive? abs))) f50: f50 could be (define f50 positive?) f50: f50 parameter named abs is asking for trouble") (lint-test "(let append ((x y)) (if (null? x) () (append (cdr y))))" " append: perhaps (let append ((x y)) (if (null? x) () (append (cdr y)))) -> (do ((x y (cdr y))) ((null? x) ())) let: let variable named append is asking for trouble") (lint-test "(let () (define (f list) (+ list 1)) (f list))" " let: perhaps (... (define (f list) (+ list 1)) (f list)) -> (... (let ((list list)) (+ list 1))) f: f parameter named list is asking for trouble let: in (f list), f's argument should be a number, but list is a procedure?")) (lint-test "(error 'error \"ERROR SOMEWHERE UP TO HERE\")" " error: There's no need to shout: (error 'error \"ERROR SOMEWHERE UP TO HERE\")") (lint-test "(display \"ERROR: oops\" port)" " display: There's no need to shout: (display \"ERROR: oops\" port)") (lint-test "(throw 'oops \"throw: ~A~%\" x)" "") (lint-test "(throw 'oops \"throw: ~A~%\" x y)" " throw: throw has too many arguments: (throw 'oops \"throw: ~A~%\" x y)") (lint-test "(error 'oops \"error: ~A ~A~%\" x)" " error: error has too few arguments: (error 'oops \"error: ~A ~A~%\" x)") (lint-test "(catch #f (lambda () 1) (lambda args 2))" " catch: catch tag #f makes this catch a no-op") (lint-test "(define (f75) \"a string\")" " f75: returns a string constant: \"a string\"") (lint-test "(define (f75) #i(0 1 2 3))" " f75: returns an int-vector constant: #i(0 1 2 3)") (lint-test "(define (f75) '(0 1 2 3))" " f75: returns a list constant: '(0 1 2 3)") (lint-test "(define (f75 x) (if x '(0 1 2 3) (+ x 1)))" " f75: returns a list constant: '(0 1 2 3)") (lint-test "(define (f73 x) (let ((result 0)) (if (positive? x) (set! result 32) (set! result -1))))" " f73: perhaps (if (positive? x) (set! result 32) (set! result -1)) -> (set! result (if (positive? x) 32 -1)) f73: result set, but not used: (set! result -1) (set! result 32)") (lint-test "(do ((res 0 (+ res 1))) ((= res 3)) (set! res (+ res 32)))" " do: perhaps move (set! res (+ res 32)) to res's step expression: (res 0 (+ 33 res))") (lint-test "(begin (define res 0) (set! res (+ res 32)))" "") (lint-test "(cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2)((string=? x \"c\") 3) ((string=? \"a\" x) 4))" " cond: cond test (string=? \"a\" x) is never true: (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)... cond: cond test is always false: ((string=? \"a\" x) 4) cond: perhaps (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)... -> (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3))") (lint-test "(cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2)((string=? x \"c\") 3) ((string=? x \"a\") 4))" " cond: cond test (string=? x \"a\") is never true: (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)... cond: cond test repeated: ((string=? x \"a\") 4) cond: cond test is always false: ((string=? x \"a\") 4) cond: perhaps (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3)... -> (cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3))") (lint-test "(cond ((< x 3) 1) ((> 2 x) 2) ((< x 1) 3))" "") (let-temporarily ((*report-unused-parameters* #t)) (lint-test "(define (f74 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2)))" " f74: perhaps (list-ref lst 2) -> (caddr lst) f74: lst can be moved to f74's closure f74: x not used") (lint-test "(let () (define (f75 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2))) (f75 2))" " let: perhaps (... (define (f75 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst... -> (... (let ((x 2)) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2)))) f75: perhaps (list-ref lst 2) -> (caddr lst) f75: lst can be moved to f75's closure f75: x not used let: f75's parameter 1 is not used, but a value is passed: 2")) (let-temporarily ((*report-loaded-files* #t)) (call-with-output-file "tmp1.r5rs" (lambda (p) (format p "(define (f x) (and (< x 3) (> x 0)))~%"))) (lint-test "(load \"tmp1.r5rs\")" " --------------------- ;tmp1.r5rs f: perhaps (and (< x 3) (> x 0)) -> (< 0 x 3)")) (lint-test "(or (< x 3) (> 3 x))" " or: perhaps (or (< x 3) (> 3 x)) -> (< x 3)") (lint-test "(and (< x 3) (> 3 x))" " and: perhaps (and (< x 3) (> 3 x)) -> (< x 3)") (lint-test "(case x ((1) (f 1)) ((2) (f 2)) (else (f 3)))" " case: perhaps (case x ((1) (f 1)) ((2) (f 2)) (else (f 3))) -> (f (case x ((1) 1) ((2) 2) (else 3))) case: perhaps use => here: (case x ((1) (f 1)) ((2) (f 2)) (else (f 3))) -> (case x ((1 2) => f) ...)") (lint-test "(case x ((1) (f 1)) ((2) (f 2)) (else (error 'oops)))" " case: perhaps (case x ((1) (f 1)) ((2) (f 2)) (else (error 'oops))) -> (f (case x ((1) 1) ((2) 2) (else (error 'oops)))) case: perhaps use => here: (case x ((1) (f 1)) ((2) (f 2)) (else (error 'oops))) -> (case x ((1 2) => f) ...)") (lint-test "(cond ((< x a) (f 1)) ((< x b) (f 2)) (else (f 3)))" " cond: perhaps (cond ((< x a) (f 1)) ((< x b) (f 2)) (else (f 3))) -> (f (cond ((< x a) 1) ((< x b) 2) (else 3)))") (let-temporarily ((*report-sloppy-assoc* #t)) (lint-test "(- (cond ((char-position c dline id-pos)) (else 0)) 1)" " -: in (- (cond ((char-position c dline id-pos)) (else 0)) 1), -'s first argument should be a number, but (char-position c dline id-pos) might also be #f -: perhaps (cond ((char-position c dline id-pos)) (else 0)) -> (or (char-position c dline id-pos) 0)")) (lint-test "(begin (cond ((find-sound v) => close-sound)) (display x))" "") ; check for side-effect confusion (lint-test "(let ((p (open-output-file str))) (display 32 p) x)" " let: in (let ((p (open-output-file str))) (display 32 p) x) perhaps p is opened via (open-output-file str), but never closed") (lint-test "(let ((p #f)) (if x (set! p (open-output-file str))) (display 32 p) x)" " let: in (let ((p #f)) (if x (set! p (open-output-file str))) (display 32 p) x) perhaps p is opened via (set! p (open-output-file str)), but never closed") (lint-test "(define (listtail x k) (if (zero? k) x (listtail (cdr x) (- k 1))))" " listtail: perhaps (define (listtail x k) (if (zero? k) x (listtail (cdr x) (- k 1)))) -> (define (listtail x k) (do ((x x (cdr x)) (k k (- k 1))) ((zero? k) x))) listtail: listtail is the same as the built-in function list-tail") ;; too tricky! (lint-test "(define (mdi) (define reader1 (lambda* (quit) (reader1))))" "") (lint-test "(truncate (/ x y))" " truncate: perhaps (truncate (/ x y)) -> (quotient x y)") (lint-test "(- x (* y (quotient x y)))" "-: perhaps (- x (* y (quotient x y))) -> (remainder x y)") (lint-test "(- x (* (quotient x y) y))" "-: perhaps (- x (* (quotient x y) y)) -> (remainder x y)") (lint-test "(cdr '(a))" " cdr: perhaps (cdr '(a)) -> ()") (lint-test "(char-upcase #\\a)" " char-upcase: perhaps (char-upcase #\\a) -> #\\A") (lint-test "(char-upper-case? #\\a)" " char-upper-case?: perhaps (char-upper-case? #\\a) -> #f") (lint-test "(load \"\")" " load: load needs a real file name, not the empty string: (load \"\")") (lint-test "(load)" " load: load needs at least 1 argument: (load)") (lint-test "(write-byte 300)" " write-byte: in (write-byte 300), write-byte's argument should be a byte, but 300 is an integer? write-byte: write-byte argument must be (<= 0 byte 255): (write-byte 300)") (lint-test "(write-byte 95 (current-output-port))" " write-byte: (current-output-port) is the default port for write-byte: (write-byte 95 (current-output-port))") (lint-test "(peek-char (current-input-port))" "peek-char: (current-input-port) is the default port for peek-char: (peek-char (current-input-port))") (lint-test "(write-char #\\newline)" " write-char: perhaps (write-char #\\newline) -> (newline)") (lint-test "(write-char #\\newline port)" " write-char: perhaps (write-char #\\newline port) -> (newline port)") (lint-test "(write-string \"\n\")" " write-string: perhaps (write-string \"\n\") -> (newline)") (lint-test "(write-string \"\")" " write-string: (write-string \"\") is pointless") (lint-test "(char? #\\a)" " char?: perhaps (char? #\\a) -> #t") (lint-test "(symbol->string (keyword->symbol :hi))" " symbol->string: perhaps (keyword->symbol :hi) -> 'hi") (lint-test "(string->keyword (string-append \":\" z))" " string->keyword: string->keyword prepends #\\: for you: (string->keyword (string-append \":\" z))") (lint-test "(string->keyword (symbol->string sym))" " string->keyword: perhaps (string->keyword (symbol->string sym)) -> (symbol->keyword sym)") (lint-test "(keyword->symbol (string->keyword str))" " keyword->symbol: perhaps (keyword->symbol (string->keyword str)) -> (string->symbol str)") (lint-test "(symbol->keyword (string->symbol str))" " symbol->keyword: perhaps (symbol->keyword (string->symbol str)) -> (string->keyword str)") (lint-test "(keyword->symbol :hi)" " keyword->symbol: perhaps (keyword->symbol :hi) -> 'hi") (lint-test "(symbol->keyword 'hiho)" " symbol->keyword: perhaps (symbol->keyword 'hiho) -> :hiho") (lint-test "(positive? 1.0)" " positive?: perhaps (positive? 1.0) -> #t") (lint-test "(list? 'a)" " list?: perhaps (list? 'a) -> #f") (lint-test "(pair? 'a)" " pair?: perhaps (pair? 'a) -> #f") (lint-test "(proper-list? '(this - that))" " proper-list?: perhaps (proper-list? '(this - that)) -> #t") (lint-test "(symbol? 'let)" " symbol?: perhaps (symbol? 'let) -> #t") (lint-test "(keyword? :rest)" " keyword?: perhaps (keyword? :rest) -> #t") (lint-test "(char? 'a)" " char?: perhaps (char? 'a) -> #f") (lint-test "(lcm 3/4 2)" " lcm: perhaps (lcm 3/4 2) -> 6") (lint-test "(string->list \"12345\" 2 1)" " string->list: these string->list indices make no sense: (string->list \"12345\" 2 1)") (lint-test "(list->vector '(1 2 3))" " list->vector: perhaps (list->vector '(1 2 3)) -> #(1 2 3)") (lint-test "(port-filename *stdout*)" " port-filename: (port-filename *stdout*): \"*stdout*\"") (lint-test "(call-with-input-string \"(+ 1 2 3)\" (lambda () (*s7* 'version)))" " call-with-input-string: call-with-input-string argument should be a function of one argument: (lambda () (*s7* 'version))") (lint-test "(call-with-input-file tmp-output-file (lambda () (*s7* 'version)))" " call-with-input-file: call-with-input-file argument should be a function of one argument: (lambda () (*s7* 'version))") (lint-test "(vector? vector?)" " vector?: perhaps (vector? vector?) -> #f") (lint-test "(vector? begin)" " vector?: perhaps (vector? begin) -> #f") (lint-test "(procedure? apply)" " procedure?: perhaps (procedure? apply) -> #t") (lint-test "(dilambda? quasiquote)" " dilambda?: perhaps (dilambda? quasiquote) -> #f") (lint-test "(number? most-negative-fixnum)" " number?: perhaps (number? most-negative-fixnum) -> #t") (lint-test "(complex? pi)" " complex?: perhaps (complex? pi) -> #t") (lint-test "(vector-ref #(hi) 0)" " vector-ref: perhaps (vector-ref #(hi) 0) -> 'hi") (lint-test "(hash-table 'a 3 'b)" " hash-table: key with no value? (hash-table 'a 3 'b)") (lint-test "(hash-table 'a 1 'b 2 'a 3)" " hash-table: repeated key a in (hash-table 'a 1 'b 2 'a 3)") (lint-test "(hash-table :a 1 'b 2 'a 3)" " hash-table: repeated key a in (hash-table :a 1 'b 2 'a 3)") (lint-test "(inlet 'a 1 'b 2 'a 3)" " inlet: repeated key a in (inlet 'a 1 'b 2 'a 3)") (lint-test "(inlet 'a 1 'b)" "inlet: no value for last entry 'b in (inlet 'a 1 'b)") ;(lint-test "(sublet (curlet) 'a 1 'b 2 'a 3)" " sublet: repeated key a in (sublet (curlet) 'a 1 'b 2 'a 3)") (lint-test "(sublet (curlet) 'a 1)" "") (lint-test "(sublet 'a 1)" " sublet: in (sublet 'a 1), sublet's first argument should be a let, but 'a is a symbol? sublet: in (sublet 'a 1), sublet's second argument should be a pair or a symbol, but 1 is an integer?") (lint-test "(close-output-port (current-output-port))" " close-output-port: (current-output-port) is the default port for close-output-port: (close-output-port (current-output-port))") (lint-test "(string-ref \"\" 0)" " string-ref: (string-ref \"\" 0) is an error") (lint-test "(string-ref \"abc\" -1)" " string-ref: (string-ref \"abc\" -1): string-ref second argument, -1, is out of range (it is negative)") (lint-test "(vector-ref #() 0)" " vector-ref: (vector-ref #() 0) is an error") (lint-test "(string-ref \"abc\" 1)" " string-ref: perhaps (string-ref \"abc\" 1) -> #\\b") (lint-test " (dilambda 1 2)" " dilambda: in (dilambda 1 2), dilambda's first argument should be a procedure, but 1 is an integer? dilambda: in (dilambda 1 2), dilambda's second argument should be a procedure, but 2 is an integer?") (lint-test "(let ((v (float-vector 1 2 3))) (vector-set! v 0 12) v)" " let: v is a float-vector, so perhaps use float-vector-set!, not vector-set!") (lint-test "(let ((v (int-vector 1 2 3))) (+ (vector-ref v 1) (int-vector-ref v 0)))" " let: v is an int-vector, so perhaps use int-vector-ref, not vector-ref") (lint-test "(let ((v (vector 1 2 3))) (float-vector-set! v 0 12) v)" " let: v is a vector, so use vector-set!, not float-vector-set!") (lint-test "(nth 1 lst)" " nth: perhaps (nth 1 lst) -> (list-ref lst 1)") (lint-test "(sort lst <)" " sort: perhaps (sort lst <) -> (sort! (copy lst) <)") (lint-test "(sort (map car lst) (lambda (a b) (< (car a) (car b))))" " sort: use sort! here: (sort (map car lst) (lambda (a b) (< (car a) (car b))))") (lint-test "(display x (newline))" " display: in (display x (newline)), display's second argument should be an output-port or #f, but (newline) is a char?") (lint-test "(let ((p (open-input-string str))) (display x))" " let: in (let ((p (open-input-string str))) (display x)) perhaps p is opened via (open-input-string str), but never closed let: p not used, initially: (open-input-string str) from let") (lint-test "(let ((p (open-output-string))) (display x))" " let: in (let ((p (open-output-string))) (display x)) perhaps p is opened via (open-output-string), but never closed let: p not used, initially: (open-output-string) from let") (lint-test "(let ((p (open-input-string str))) (display x) (close-output-port p))" " let: in (let ((p (open-input-string str))) (display x) (close-output-port p)) p is opened and closed, but never used let: p is an input-port, but close-output-port in (close-output-port p) wants an output-port or #f") (lint-test "(let ((p (open-output-string))) (display x) (close-input-port p))" " let: in (let ((p (open-output-string))) (display x) (close-input-port p)) p is opened and closed, but never used let: p is an output-port, but close-input-port in (close-input-port p) wants an input-port?") (lint-test "(let ((p (open-output-string))) (display x) (close-output-port p))" " let: in (let ((p (open-output-string))) (display x) (close-output-port p)) p is opened and closed, but never used") (lint-test "(let ((p (open-input-string str))) (display x) (close-input-port p))" " let: in (let ((p (open-input-string str))) (display x) (close-input-port p)) p is opened and closed, but never used") (lint-test "(let ((p (open-output-string))) (display val p) (close-output-port p))" " p: (let ((p (open-output-string))) (display val p) (close-output-port p)) is missing get-output-string") (lint-test "(let ((p (open-output-string))) (display val p) (fos val (close-output-port p)))" " p: (let ((p (open-output-string))) (display val p) (fos val... is missing get-output-string") (lint-test "(let ((s (open-output-string))) (write obj s) (let ((result (get-output-string s))) (close-output-port s) result))" " s: perhaps (let ((s (open-output-string))) (write obj s) (let ((result... -> (object->string obj)") (lint-test "(let ((x '(1 2 3))) (display (car x)) (display (list-ref x y)) (list-ref x 1))" " let: x could be a vector, rather than a list") (lint-test "(let ((x '(1 2 3))) (display (car x)) (display (x y)) (x 1))" " let: x could be a vector, rather than a list") (lint-test "(display 123 #f)" " display: (display 123 #f) could be 123") (lint-test "(write 123 #f)" " write: (write 123 #f) could be 123") (lint-test "(newline #f)" " newline: (newline #f) is a no-op, returning #") (unless with-bignums (lint-test "(define (func x) (if (or x 1/0+i) 3))" " func: perhaps (or x +nan.0+1.0i) -> (or x +nan.0+1.0i)") ; infinite loop (lint-test "(if (and x 1/0) 3)" " if: perhaps (and x +nan.0) -> (and x +nan.0)")) ; nan payload mismatch (lint-test "(cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1))" " cond: (number? x) makes (integer? x) pointless in (cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1)) cond: (list? x) makes (pair? x) pointless in (cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1)) (r5rs list? is proper-list? in s7)") (lint-test "(cond-expand (s7 (define (f x) (* x 23))) (else))" "") (lint-test "(cond-expand (s7))" " cond-expand: pointless cond-expand: (cond-expand (s7))") (lint-test "(cond-expand ((or s7 guile)))" " cond-expand: pointless cond-expand: (cond-expand ((or s7 guile)))") (lint-test "(macroexpand (abs x))" " macroexpand: macroexpand's argument should be an expression whose car is a macro: (macroexpand (abs x))") (lint-test "(macroexpand macroexpand)" " macroexpand: macroexpand's argument should be an expression whose car is a macro: (macroexpand macroexpand)") (lint-test "(let () (define-macro (f1 x) `(g ,x ,x)) (macroexpand (f1 a)))" "") (lint-test "(let ((fv (float-vector 1.0 2.0))) (equal? fv X))" " let: perhaps (let ((fv (float-vector 1.0 2.0))) (equal? fv X)) -> (equal? (float-vector 1.0 2.0) X) let: perhaps use equivalent? in (equal? fv X)") (lint-test "(let ((fv (float-vector 1.0 2.0)) (iv (int-vector 1 2))) (equal? fv iv))" " let: perhaps (let ((fv (float-vector 1.0 2.0)) (iv (int-vector 1 2))) (equal? fv iv)) -> (equal? (float-vector 1.0 2.0) (int-vector 1 2)) let: perhaps use equivalent? in (equal? fv iv)") (lint-test "(begin (let loop ((x y)) (if (null? x) 1 (loop (cdr x)))) x)" " begin: this could be omitted: (let loop ((x y)) (if (null? x) 1 (loop (cdr x)))) loop: perhaps (let loop ((x y)) (if (null? x) 1 (loop (cdr x)))) -> (do ((x y (cdr x))) ((null? x) 1))") (lint-test "(begin (do ((x y (cdr x))) ((null? x) 1)) x)" " begin: this could be omitted: (do ((x y (cdr x))) ((null? x) 1)) begin: this do-loop could be replaced by 1: (do ((x y (cdr x))) ((null? x) 1))") (lint-test "(begin (do ((x y (cdr x)) (i 0 ( i 1)) (j 1 (+ j i))) ((null? x) 1)) j)" " begin: (do ((x y (cdr x)) (i 0 (i 1)) (j 1 (+ j i))) ((null? x) 1)): result 1 is not used begin: perhaps (do ((x y (cdr x)) (i 0 (i 1)) (j 1 (+ j i))) ((null? x) 1)) -> (do ((x y (cdr x)) (i 0 (i 1)) (j 1)) ((null? x) 1) (set! j (+ j i))) begin: j set, but not used: 1 from do") (lint-test "(begin (define (f300 x) (if (null? x) 0 (f300 (cdr x)))) (display x) (f300 '(1)) x)" " f300: perhaps (define (f300 x) (if (null? x) 0 (f300 (cdr x)))) -> (define (f300 x) (do ((x x (cdr x))) ((null? x) 0)))") (lint-test "(let ((is-running? (f x))) (g is-running? 0))" " let: perhaps (let ((is-running? (f x))) (g is-running? 0)) -> (g (f x) 0) let: 'is-running? is redundant: perhaps use 'running?") (lint-test "(begin (for-each f (list x y)) (values))" " begin: (values) is redundant; for-each returns #") (lint-test "(begin (map f x) #t)" " begin: map could be for-each: (for-each f x) begin: #t is probably redundant; map can't return #f") (lint-test "(begin (set! y (map f x)) #t)" " begin: #t is probably redundant; map can't return #f") (lint-test "(cond (A =>) (else B))" " cond: cond => target is messed up: (A =>)") (lint-test "(case x ((A) =>) (else B))" " case: perhaps (case x ((A) =>) (else B)) -> (if (eq? x 'A) => B) case: case => target is messed up: ((A) =>)") (lint-test "(do ((i 0 (+ i 1))) (i =>))" " do: do-result => target is messed up: (i =>) do: do is a no-op because i is true at the start: (do ((i 0 (+ i 1))) (i =>))") (lint-test "(cond (A => . B) (else B))" " cond: cond => target is messed up: (A => . B)") (lint-test "(case x ((A) => . B) (else B))" " case: case => target is messed up: ((A) => . B)") (lint-test "(do ((i 0 (+ i 1))) (i => . B))" " do: do is messed up: (do ((i 0 (+ i 1))) (i => . B))") (when (provided? 'snd) (lint-test "(begin (cond ((find-sound \"test.snd\") => close-sound)) (display x))" "") (lint-test "(if (real? (oscil x)) 1.0 0.0)" " if: perhaps (real? (oscil x)) -> #t if: perhaps (if (real? (oscil x)) 1.0 0.0) -> 1.0") (lint-test "(if (pair? (oscil x)) 1.0 0.0)" " if: perhaps (pair? (oscil x)) -> #f if: perhaps (if (pair? (oscil x)) 1.0 0.0) -> 0.0") (lint-test "(if (float? (oscil x)) 1.0 0.0)" " if: perhaps (float? (oscil x)) -> #t if: perhaps (if (float? (oscil x)) 1.0 0.0) -> 1.0") (lint-test "(radians->hz 3.4+i)" " radians->hz: in (radians->hz 3.4+1.0i), radians->hz's argument should be real, but 3.4+1.0i is complex?") (lint-test "(string-ref (radians->hz x) 3)" " string-ref: in (string-ref (radians->hz x) 3), string-ref's first argument should be a string, but (radians->hz x) is a float?") (lint-test "(set! (print-length) \"asd\")" " set!: print-length: new value should be an integer?: string?: (set! (print-length) \"asd\")") (lint-test "(set! (print-length) 9)" "") (lint-test "(set! (show-indices) 32)" " set!: show-indices: new value should be a boolean?: integer?: (set! (show-indices) 32)") (lint-test "(set! (show-indices) #t)" "") (lint-test "(mus-header-type-name 121)" " mus-header-type-name: mus-header-type-name's argument, 121, should be an integer between 1 and 70") (lint-test "(mus-header-type-name 2)" "") (lint-test "(mus-header-type-name 3.5)" " mus-header-type-name: in (mus-header-type-name 3.5), mus-header-type-name's argument should be an integer, but 3.5 is a float?") (lint-test "(mus-header-type-name mus-aiff)" "")) ;; lint regression tests (lint-test "(define (func x) (if (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1(/ )) (iterator-sequence 1-)))" " func: if test is never false: (if (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1 (/))... func: in (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1 (/)), *'s second argument should be a number, but '((1 (2)) (((3) 4))) is a list? func: perhaps (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1 (/)) -> (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4)))) func: perhaps call/cc could be call-with-exit: (call/cc (lambda (go) (go 9) 0)) func: (go 9) makes this pointless: 0 func: / needs at least 1 argument: (/)") (lint-test "(define (func x) (if (string-position -) (begin . 0) (hash-table //(round))))" " func: string-position needs at least 2 arguments: (string-position -) func: in (string-position -), string-position's argument should be a string, but - is a procedure? func: stray dot in begin? (begin . 0) func: round needs 1 argument: (round)") (lint-test "(define (func x) (if (string->symbol) (cond . 3/4)))" " func: if test is never false: (if (string->symbol) (cond . 3/4)) func: string->symbol needs 1 argument: (string->symbol) func: cond is messed up: (cond . 3/4)") (lint-test "(define (func x) (if (expt 2) (cond 0 1/1.2 when . and)))" " func: if test is never false: (if (expt 2) (cond 0 1/1.2 when . and)) func: expt needs 2 arguments: (expt 2) func: cond is messed up: (cond 0 1/1.2 when . and)") (lint-test "(define (func x) (if (imag-part (define-macro `(((+ x 1))) '((x . 1) . 2) 1.2.3)) (cond (list 1 2) `(1) . =>)))" " func: if test is never false: (if (imag-part (define-macro '(((+ x 1))) '((x . 1) . 2) 1.2.3)) (cond... #_quote: strange parameter for define-macro: (((+ x 1))) func: cond is messed up: (cond (list 1 2) '(1) . =>)") (unless pure-s7 (lint-test "(define (func x) (if (inexact->exact /i-) (defined? +--) (cond . else)))" " func: if test is never false: (if (inexact->exact /i-) (defined? +--) (cond . else)) func: cond is messed up: (cond . else)")) (lint-test "(define (func x) (if (let-set! /+0) (begin .(cdddar . and)) (port-line-number 2(exp 1))))" " func: let-set! needs 3 arguments: (let-set! /+0) func: stray dot in begin? (begin cdddar . and) func: in (port-line-number 2 (exp 1)), port-line-number's first argument should be an input-port, but 2 is an integer?") (unless with-bignums (lint-test "(define (func x) (if (charlist -)) (hash-table? (define-macro* + (list ()) `(x 1) :hi 1+0/0i))))" " func: charlist -), random-state->list's argument should be a random-state, but - is a procedure? func: + in (define-macro* + (list ()) '(x 1) :hi 1.0+nan.0i) is already a constant, defined (random-state->list -) func: (define-macro* + (list ()) '(x 1) :hi 1.0+nan.0i) is messed up func: + not used, initially: (random-state->list -) from define-constant") (lint-test "(define (func x) (if (or . 1+0/0i) (caaddr (caaadr /)))) (define (hi) (func (make-hook '(0 0 #f))))" " func: unexpected dot: (or . 1.0+nan.0i) func: in (caaadr /), caaadr's argument should be a pair, but / is a procedure? hi: func's parameter 1 is not used, but a value is passed: (make-hook '(0 0 #f))") (lint-test "(define (func x) (when 0 1+0/0i `((+ x 1)) => . with-let))" " func: when is messed up: (when 0 1.0+nan.0i '((+ x 1)) => . with-let)") (lint-test "(define (func x) (if (ceiling (denominator)) (with-let .0+) (cdaadr (floor (random 0/0+0i +inf.0)))))" " func: if test is never false: (if (ceiling (denominator)) (with-let .0+) (cdaadr (floor (random +nan.0... func: denominator needs 1 argument: (denominator) func: with-let is messed up: (with-let .0+) func: in (cdaadr (floor (random +nan.0 +inf.0))), cdaadr's argument should be a pair, but (floor (random +nan.0 +inf.0)) is an integer? func: in (random +nan.0 +inf.0), random's second argument should be a random-state, but +inf.0 is a float?") (lint-test "(define (func x) (if (begin 2(caaar 2)) (make-list (unless +)) (char-upper-case? 0i2 0+1/0i `(((x 1))) (cons 1 2) (string (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)))))" " func: this could be omitted: 2 func: in (caaar 2), caaar's argument should be a pair, but 2 is an integer? func: unless is messed up: (unless +) func: char-upper-case? has too many arguments: (char-upper-case? 0i2 0.0+nan.0i '(((x 1))) (cons 1 2) (string (or / (let... func: missing quote? (or / (let ((x 3)) (lambda (y) (+ x y))) . =>) in (string (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)) func: unexpected dot: (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)") (lint-test "(define (func x) (if (arity (apply +)) (caaadr /) (begin .. when `((x . 1)) . 0/0+0/0i)))" " func: perhaps (apply +) -> (+) func: in (caaadr /), caaadr's argument should be a pair, but / is a procedure? func: stray dot in begin? (begin .. when (list-values ( (list-values 'x) 1)) . +nan.0+nan.0i)")) (lint-test "(define (func x) (if (even? (asinh .0)) (when (real?))))" " func: perhaps (if (even? (asinh 0.0)) (when (real?))) -> (when (and (even? (asinh 0.0)) (real?))) func: in (even? (asinh 0.0)), even?'s argument should be an integer, but (asinh 0.0) is a number? func: perhaps (asinh 0.0) -> 0.0 func: when is messed up: (when (real?))") (lint-test "(define (func x) (if (boolean?) (unless /)))" " func: perhaps (if (boolean?) (unless /)) -> (when (and (boolean?) (not /))) func: boolean? needs 1 argument: (boolean?) func: unless is messed up: (unless /)") (lint-test "(define (func x) (cond ((output-port? i) (char-numeric? /i(denominator))) (else (if +/ 1 . #f))))" " func: char-numeric? has too many arguments: (char-numeric? /i (denominator)) func: denominator needs 1 argument: (denominator) func: if has too few clauses: (if +/ 1 . #f)") (lint-test "(define (func x) (do . unless))" " func: do is messed up: (do . unless)") (lint-test "(define (func x) (lambda* (lambda args args) . -1))" " func: lambda* is messed up in (lambda* (lambda args args) . -1)") (lint-test "(define (func x) (if (or . set!) (sublet 2)))" " func: unexpected dot: (or . set!) func: in (sublet 2), sublet's argument should be a let, but 2 is an integer?") (lint-test "(define (func x) (case x ((else) (char>? 11/(setter))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))" " func: in (char>? 11/ (setter)), char>?'s second argument should be a char, but (setter) is #f or a procedure? func: setter needs at least 1 argument: (setter) func: load has too many arguments: (load - -1 3/4) func: in (load - -1 3/4), load's first argument should be a string, but - is a procedure? func: in (load - -1 3/4), load's second argument should be a let, but -1 is an integer? func: perhaps (- -1 3/4) -> -7/4 func: in (positive? (format 0 (inlet (make-list)))), positive?'s argument should be real, but (format 0 (inlet (make-list))) is a string? func: in (format 0 (inlet (make-list))), format's first argument should be an output-port or a boolean, but 0 is an integer? func: make-list needs at least 1 argument: (make-list)") (lint-test "(zero? (system str))" "") (lint-test "(define (func x) (if (- 2(+)) (lambda 1.)))" " func: if test is never false: (if (- 2 (+)) (lambda 1.0)) func: perhaps (- 2 (+)) -> 2 func: lambda is messed up in (lambda 1.0)") (unless (or pure-s7 with-bignums) (lint-test "(define (func x) (if (string-ci>=?) (dilambda? (char-numeric? 20+)) (* 1 enver quasiquote 0+0/0i /0/01(/))))" " func: string-ci>=? needs at least 2 arguments: (string-ci>=?) func: (dilambda? (char-numeric? 20+)) is always #f func: perhaps (* 1 enver quasiquote 0.0+nan.0i /0/01 (/)) -> (* enver quasiquote 0.0+nan.0i /0/01) func: / needs at least 1 argument: (/)")) (lint-test "(define (func x) (if (continuation?) (when (continuation? 0-2))))" " func: perhaps (if (continuation?) (when (continuation? 0-2))) -> (when (and (continuation?) (continuation? 0-2))) func: continuation? needs 1 argument: (continuation?) func: when is messed up: (when (continuation? 0-2))") (lint-test "(define (func x) (if (close-input-port) (caaddr /) (with-input-from-file 0(let (make-dilambda (lambda () 1) (lambda (a) a)) (set! i01+)))))" " func: if test is never false: (if (close-input-port) (caaddr /) (with-input-from-file 0 (let... func: close-input-port needs 1 argument: (close-input-port) func: in (caaddr /), caaddr's argument should be a pair, but / is a procedure? func: in (with-input-from-file 0 (let (make-dilambda (lambda () 1) (lambda (a) a))..., with-input-from-file's first argument should be a string, but 0 is an integer? func: let is messed up: (let (make-dilambda (lambda () 1) (lambda (a) a)) (set! i01+))") (lint-test "(define (func x) (cond ((byte-vector-ref) (iterator? 12.)) (else (unless .+2 '((x 1) y . 2) 1 - or case quote . __asdf__))))" " func: cond test (byte-vector-ref) is never false: (cond ((byte-vector-ref) (iterator? 12.0)) (else (unless .+2 '((x 1) y .... func: byte-vector-ref needs at least 2 arguments: (byte-vector-ref) func: unless is messed up: (unless .+2 '((x 1) y . 2) 1 - or case quote . __asdf__)") (lint-test "(define (func x) (lambda* .(lcm . do)))" " func: lambda* is messed up in (lambda* lcm . do)") (lint-test "(define (func x) (let . `(((x 1))) ))" "func: let is messed up: (let #_quote (((x 1))))") (lint-test "(define (func x) (do . 1))" " func: do is messed up: (do . 1)") (lint-test "(define (func x) (unless 1 (let ((x 3)) (lambda (y) (+ x y))) let* `(+ x 1) . \"\"))" " func: unless is messed up: (unless 1 (let ((x 3)) (lambda (y) (+ x y))) let* '(+ x 1) . \"\")") (lint-test "(define (func x) (when `((x)) when '((())) and . case))" "func: when is messed up: (when '((x)) when '((())) and . case)") (lint-test "(define (func x) (do . 0)) (define (hi) (func (define-macro (_m1_ a) `(+ ,a 1)))) (hi)" " func: do is messed up: (do . 0) hi: func's parameter 1 is not used, but a value is passed: (define-macro (_m1_ a) (list-values '+ a 1)) hi: perhaps (define-macro (_m1_ a) (list-values '+ a 1)) -> (define (_m1_ a) (+ a 1))") (lint-test "(define (func x) (unless .(atan . __asdf__)))" " func: unless is messed up: (unless atan . __asdf__)") (lint-test "(define (func x) (floor (* +.(inexact->exact))))" " func: inexact->exact needs 1 argument: (inexact->exact)") (lint-test "(define (func x) (if (proper-list? ) (and / when '((())) () begin) (call-with-input-string (stacktrace +0 -1 1 20100))))" " func: proper-list? needs 1 argument: (proper-list?) func: call-with-input-string needs 2 arguments: (call-with-input-string (stacktrace 0 -1 1 20100))") (lint-test "(define (func x) (if (lambda* +i . begin ) (symbol->value i-/)))" " func: lambda* is messed up in (lambda* +i . begin)") (lint-test "(define (func x) (let . '((())) ))" "func: let is messed up: (let #_quote ((())))") (lint-test "(define (func x) (if (defined? +) (when (string=? +))))" " func: perhaps (if (defined? +) (when (string=? +))) -> (when (and (defined? +) (string=? +))) func: in (defined? +), defined?'s argument should be a symbol, but + is a procedure? func: when is messed up: (when (string=? +))") (unless pure-s7 (lint-test "(define (func x) (if (asinh /(inexact? 1)) (cos (string-ci>? 1)) (int-vector 1(set! .--(cond .(char-alphabetic? .+))))))" " func: if test is never false: (if (asinh / (inexact? 1)) (cos (string-ci>? 1)) (int-vector 1 (set! .--... func: asinh has too many arguments: (asinh / (inexact? 1)) func: in (asinh / (inexact? 1)), asinh's first argument should be a number, but / is a procedure? func: in (cos (string-ci>? 1)), cos's argument should be a number, but (string-ci>? 1) is a boolean? func: string-ci>? needs at least 2 arguments: (string-ci>? 1) func: in (string-ci>? 1), string-ci>?'s argument should be a string, but 1 is an integer? func: cond is messed up: (cond char-alphabetic? .+)")) (lint-test "(define (func x) (if (help 11) (make-iterator (letrec* 2)) (byte-vector (case -(dilambda i let +i (list (list 1)) let . cons )))))" " func: perhaps (help 11) -> #f func: perhaps (if (help 11) (make-iterator (letrec* 2)) (byte-vector (case - (dilambda i... -> (byte-vector (case - (dilambda i let +i (list (list 1)) let . cons))) func: in (make-iterator (letrec* 2)), make-iterator's argument should be a sequence, but 2 is an integer? func: letrec* is messed up: (letrec* 2) func: bad case key dilambda in (dilambda i let +i (list (list 1)) let . cons) func: stray dot? (i let +i (list (list 1)) let . cons)") (lint-test "(cddr (cddar :hi))" " cddr: :hi can't be a pair cddr: in (cddar :hi), cddar's argument should be a pair, but :hi is a keyword?") (lint-test "(subvector v 0)" " subvector: perhaps (subvector v 0) -> (subvector v)") (lint-test "(subvector v 0 (length v))" " subvector: perhaps (subvector v 0 (length v)) -> (subvector v)") (lint-test "(subvector v 0 6 '(6))" " subvector: perhaps (subvector v 0 6 '(6)) -> (subvector v 0 6)") (lint-test "(subvector v 1 5 '(4))" " subvector: perhaps (subvector v 1 5 '(4)) -> (subvector v 1 5)") ;; this tickles an infinite recursion bug that is still in lint, but hacked around for now (lint-test "(let* ((seed 0) (hashfn (lambda (obj) (cond ((string? obj) (let ((sl (string-length obj))) (+ (if (> sl 0) (hashfn obj) seed) (if (> sl 1) (hashfn obj) seed)))) ((else #f)))))) (modulo (hashfn obj) size))" " let*: perhaps restrict seed which is not used in the let* body (let* ((seed 0) (hashfn (lambda (obj) (cond ((string? obj) (let ((sl... -> (let ((hashfn (let ((seed 0)) (lambda (obj) (cond ((string? obj) (let ((sl (string-length obj))) (+ (if (> sl 0) (hashfn obj) seed) (if (> sl 1) (hashfn obj) seed)))) ((else #f))))))) ...)") (let-temporarily ((*report-combinable-lets* #f)) (lint-test "(define (f) (let ((div 0)) (do ((i 0 (+ i 1))) ((= i div)) (display i))))" "")) (lint-test "(define (f scheme-name i len) (do () ((>= i len)) (let ((c (string-ref scheme-name i))) (if (alphanumeric? c) (display c)))))" "") (lint-test "(let ((sv (subvector v 0 0))) (vector-ref sv 1))" "let: perhaps (let ((sv (subvector v 0 0))) (vector-ref sv 1)) -> (vector-ref (subvector v 0 0) 1)") (lint-test "(let ((iter (make-iterator '(1 2 3)))) (iterator-at-end? iter))" "let: perhaps (let ((iter (make-iterator '(1 2 3)))) (iterator-at-end? iter)) -> (iterator-at-end? (make-iterator '(1 2 3)))") ; TODO: ; (lint-test "(and (string? x) (= (length x) 0))" "") ; " and: perhaps (assuming x is a list), (= (length x) 0) -> (null? x) which is ridiculous ; (lint-test "(and (vector? x) (zero? (length x)))" "") ; same as above, should be -> (equal? x #()) ; (lint-test "(and (list? x) (= 0 (length x)))" "") ; same as above (so the parenthetical remark is ridiculous) ; (lint-test "(and (list? x) (> (length x) 0))" "") ; " and: perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x) ; (lint-test "(or (list? x) (> (length x) 0))" "") ; " or: perhaps (assuming x is a proper list), (> (length x) 0) -> (pair? x) ; (lint-test "(if (integer? x) (rational? x))" "") ; -> (or (integer? x) #)?? #| ;; these are currently special cases (lint-test "(pair? (cons 1 2))" "") (lint-test "(number? (cons x y))" "") (lint-test "(not (cons x y))" "") |# (lint-test "(not (and (file-exists? x) (directory? x)))" " not: perhaps (not (and (file-exists? x) (directory? x))) -> (not (directory? x))") (lint-test "(and (openlet? x) (defined? 'y x))" "") (lint-test "(or (= x y) (not (= x y 0)))" "") ; -> #t? (either x=y(incl 0) or x!=y) (lint-test "(and (= x1 x2) (or (not (= y1 y2)) (= y1 y2 0)))" "") (lint-test "(or (float? x) (not (real? x)))" "") (lint-test "(or (real? x) (not (float? x)))" " or: perhaps (or (real? x) (not (float? x))) -> #t") (let () (define (glint str1) (let ((result (call-with-output-string (lambda (op) (call-with-input-string str1 (lambda (ip) (lint ip op))))))) (if (string=? result "") (format *stderr* ";(glint ~S) -> ~S~%" str1 result)))) (glint "(define (func x) (if (string-position -) (begin . 0) (hash-table //(round))))") (glint "(define (func x) (if (* (call/cc (lambda (go) (go 9) 0)) '((1 (2)) (((3) 4))) 1(/)) (iterator-sequence 1-)))") (glint "(define (func x) (if (string->symbol) (cond . 3/4)))") (glint "(define (func x) (if (expt 2) (cond 0 1/1.2 when . and)))") (glint "(define (func x) (if (imag-part (define-macro `(((+ x 1))) '((x . 1) . 2) 1.2.3)) (cond (list 1 2) `(1) . =>)))") (glint "(define (func x) (if (inexact->exact /i-) (defined? +--) (cond . else)))") (glint "(define (func x) (if (let-set! /+0) (begin .(cdddar . and)) (port-line-number 2(exp 1))))") (glint "(define (func x) (if (charlist -)) (hash-table? (define-macro* + (list ()) `(x 1) :hi 1+0/0i))))") (glint "(define (func x) (if (arity (apply +)) (caaadr /) (begin .. when `((x . 1)) . 0/0+0/0i)))") (glint "(define (func x) (if (even? (asinh .0)) (when (real?))))") (glint "(define (func x) (if (boolean?) (unless /)))") (glint "(define (func x) (cond ((output-port? i) (char-numeric? /i(denominator))) (else (if +/ 1 . #f))))") (glint "(define (func x) (do . unless))") (glint "(define (func x) (lambda* (lambda args args) . -1))") (glint "(define (func x) (if (or . set!) (sublet 2)))") (glint "(define (func x) (if (or . 1+0/0i) (caaddr (caaadr /)))) (define (hi) (func (make-hook '(0 0 #f))))") (glint "(define (func x) (case x ((else) (char>? 11/(setter))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))") (glint "(define (func x) (if (- 2(+)) (lambda 1.)))") (glint "(define (func x) (when 0 1+0/0i `((+ x 1)) => . with-let))") (glint "(define (func x) (if (string-ci>=?) (dilambda? (char-numeric? 20+)) (* 1 enver quasiquote 0+0/0i /0/01(/))))") (glint "(define (func x) (if (continuation?) (when (continuation? 0-2))))") (glint "(define (func x) (if (close-input-port) (caaddr /) (with-input-from-file 0(let (make-dilambda (lambda () 1) (lambda (a) a)) (set! i01+)))))") (glint "(define (func x) (cond ((byte-vector-ref) (iterator? 12.)) (else (unless .+2 '((x 1) y . 2) 1 - or case quote . __asdf__))))") (glint "(define (func x) (lambda* .(lcm . do)))") (glint "(define (func x) (let . `(((x 1)))))") (glint "(define (func x) (do . 1))") (glint "(define (func x) (unless 1 (let ((x 3)) (lambda (y) (+ x y))) let* `(+ x 1) . \"\"))") (glint "(define (func x) (when `((x)) when '((())) and . case))") (glint "(define (func x) (do . 0)) (define (hi) (func (define-macro (_m1_ a) `(+ ,a 1)))) (hi)") (glint "(define (func x) (unless .(atan . __asdf__)))") (glint "(define (func x) (floor (* +.(inexact->exact))))") (glint "(define (func x) (if (proper-list?) (and / when '((())) () begin) (call-with-input-string (stacktrace +0 -1 1 20100))))") (glint "(define (func x) (if (ceiling (denominator)) (with-let .0+) (cdaadr (floor (random 0/0+0i +inf.0)))))") (glint "(define (func x) (if (begin 2(caaar 2)) (make-list (unless +)) (char-upper-case? 0i2 0+1/0i `(((x 1))) (cons 1 2) (string (or / (let ((x 3)) (lambda (y) (+ x y))) . =>)))))") (glint "(define (func x) (if (lambda* +i . begin) (symbol->value i-/)))") (glint "(define (func x) (let . '((()))))") (glint "(define (func x) (if (defined? +) (when (string=? +))))") (glint "(define (func x) (if (asinh /(inexact? 1)) (cos (string-ci>? 1)) (int-vector 1(set! .--(cond .(char-alphabetic? .+))))))") (glint "(define (func x) (if (help 11) (make-iterator (letrec* 2)) (byte-vector (case -(dilambda i let +i (list (list 1)) let . cons)))))") (glint "(define (func x) (cond ((log) (*s7* (quote))) (else (string-ci>? 01(* (numerator (memq 1i(proper-list? (cdr 1)))))))))") (glint "(define (func x) (define* pi))") (glint "(define (func x) (if (char=? 2) (string->number (string>=? 21 1/1.2 -1)) (hash-table? /+(assoc 2i(list . or)))))") (glint "(define (func x) (if (char-downcase) (float-vector-set! (setter)) (signature -(do `((1)) (string #\\a #\\null #\\b) i+ \"hi\" (do define-bacro* -(length))))))") (glint "(define (func x) (if (apply -+) (floor ii.) (eval (string->symbol \"\" 1.2.3 i))))") (glint "(define (func x) (if (string>=? 0i) (number->string 2(real? 1)) (/ +2(logand))))") (glint "(define (func x) (case x ((define-macro) (list? 01)) ((`((+ x 1))) (/ 2 -1)) (else (char-downcase +00+(eval)))))") (glint "(define (func x) (cond ((byte-vector-set! 1) (multiple-value-bind -0 (values) 2)) (else (car 1+ `(x) '((x 1) (y) . 2) +nan.0))))") (glint "(define (func x) (case x ((define*) (current-input-port .1+)) (((values #\\c 3 1.2)) (symbol .2/)) (else (documentation 2-2i(char=? (+ (reverse (list-tail (reverse /)))))))))") (glint "(define (func x) (if (values i-(caaaar)) (cdaddr ++) (assv +(list (quote 2)))))") (glint "(define (func x) (/ 0(/ 0 (let-temporarily))))") (glint "(define (func x) (cond ((when 1/1.2 #2d((1 2) (3 4)) /1) (openlet (caadar 0))) (else (let*-values (string-ci=? 0-(min //))))))") (glint "(define (func x) (cond ((let* 'hi (let)) (make-rectangular +)) (else (cutlet 002 define-bacro # i(list-ref '((x 1) 2) macroexpand #t)))))") (glint "(if x (int-vector-set! z 0 1) (begin .1 (let ((x 3)) (lambda (y) (+ x y))) . #t))") (glint "(define (func x) (if (real?) (string-ci<=? 0 1/0+i 1.5 '(1 2 . 3) '(- 1) '((x 1) (y) . 2) (values #\\c 3 1.2) 0) (string-ci>=? . macroexpand)))") (glint "(define (func x) (if (call-with-input-file (string #\\a #\\null #\\b) '((x 1 . 2) . 3) -1 (>= /)) (let . +inf.0) (let ..(let? 0(cddr (procedure?))))))") (glint "(define (func x) (if (caadar 2) (make-list i)))") (glint "(define (func x) (cond ((for-each `(x) `(((+ x 1))) 3/4 2) (cddadr 02)) (else (let / :hi (lambda args args) define-bacro))))") (glint "(define (func x) (if (cyclic-sequences .i/) (string-set! i) (proper-list? - (getenv 0 +nan.0 (values) '((1 (2)) (((3) 4))) 'hi (symbol->keyword (cond . '((x 1) y . 2)))))))") (glint "(define (func x) (case x ((#t) (dynamic-wind -1-)) (((values \"hi\")) (input-port? +/)) (else (or +i (memq define-macro '((x 1) y . 2))))))") (glint "(define (func x) (if (and -(not)) (input-port? .i abs +inf.0 define-macro*) (quote 0///i.)))") (glint "(define (func x) (let* '((x 1) (y) . 2) (let* 0)))") (glint "(define (func x) (char-ci>? (inexact->exact (/ 1 3/4))))") (glint "(define (func x) (cond ((number?) (1- #t lambda* '(- 1) let* i(let-values))) (else (cdaaar -(char? (append `((x)) `((set! x (+ x 1)) (* x 2)) (cons)))))))") (glint "(define (func x) (if (cons / `(x 1) '((()))) (get-output-string -(file-exists? -i)) (case 1(int-vector-set! (not 1)))))") (glint "(define (func x) (if (char-cibyte-vector 0/0+0i let (values #\\c 3 1.2) (make-dilambda (lambda () 1) (lambda (a) a)) (sublet /))) (hook-functions 20120i 0+0/0i)))") (glint "(define (func x) (if (string-copy (ash 2(unless))) (caddr `(x 1) /) (length /(with-output-to-string (lambda ())))))") (glint "(define (func x) (if (vector-append 210) (port-closed? / (define-macro (_m1_ a) `(+ ,a 1)) .-) (define-constant .-(gensym . 1+1/0i))))") (glint "(define (func x) (if (number? +) (when (= ..)))) ") (glint "(define (func x) (cond ((tan) (denominator -+0 begin `((x . 1)))) (else (let `((set! x (+ x 1)) (* x 2)) (let ii. (list 1) '(- 1) \"hi\" or -)))))") (glint " (define (func x) (if (boolean? i(let)) (when (eq? ++.))))") (glint "(define (func x) (if (immutable?) (complex do 0+0/0i (cons 1 2) /2.) (not (immutable?))))") (glint "(define (func x) (case x (('(- 1)) (string-position 2)) ((#) (caar 0 (iterator-sequence))) (else (do '((1 (2)) (((3) 4))) (call/cc (lambda (go) (go 9) 0)) (let (system `(1) 0/0+0i 1+1/0i '((x 1) (y . 2)) 0))))))") (glint "(define (func x) (if (not) (not) (car '((x 1) . 2) '((x 1) 2) `(x 1) (char-numeric? +2))))") (glint "(define (func x) (if (zero?) (zero?) (zero? (floor -+2+))))") (glint "(define (func x) (if (not) (not) (not i/))) (define (hi) (func 1/0+i))") (glint "(define (func x) (if (not) (not) (or .(or -+/ 1/1.2 '((x 1) (y . 2)) `((set! x (+ x 1)) (* x 2)) let* (define-macro (_m1_ a) `(+ ,a 1)) unless))))") (glint "(define (func x) (if (string? 1i0) (string? 1i0) (and . else)))") (glint "(define (func x) (case x (((values 1 2)) (sort! (string-set! .2))) (((call/cc (lambda (go) (go 9) 0))) (sort! (string-set! .2))) (else (sort! /- 3/4 :hi '(()) if . 1+0/0i))))") (glint "(let () (define (func x) (if (integer? 1 '((x 1) (y . 2))) (integer? 1 '((x 1) (y . 2))) (= 1))))") (glint "(define (func x) (if (number? +) (number? +) (nan? . ())))") (glint "(define (func x) (if (boolean? .(varlet)) (boolean? .(varlet)) (if . and)))") (glint "(define (func x) (if (complex? i-) (complex? i-) (or (positive?))))") (glint "(define (func x) (if (case 0/0+i (values) 1+1/0i (integer-decode-float)) (case 0/0+i (values) 1+1/0i (integer-decode-float))))") (glint "(define (func x) (catch case 1 1.0+1.0i (values) 0/0+i (hash-table)))") (glint "(define (func x) (if (string? +.) (string? +.) (string=? +.)))") (glint "(define (func x) (if (real? -) (real? -) (= -)))") (glint "(define (func x) (if (memq) (memq) (round 0+0/0i (set! _x1_ 3) (list (list 1)) (make-hook '(0 0 #f)) 2 else 0(int-vector 2 letrec - quasiquote (set! _x1_ 3) quote #))))") (glint "(define (func x) (if (char-ci=? 1 0) (char-ci=? 1 0) (case 0(immutable? '((x 1) 2) -1 1.0+1.0i macroexpand i(logbit? (output-port? (char-whitespace? .2)))))))") (glint "(define (func x) (if (sqrt 0.1) (sqrt 0.1) (with-baffle + (define _h1_ 3) (let))))") (glint "(define (func x) (case x (((values)) (sqrt 0.1)) ((`((x 1))) (sqrt 0.1)) (else (with-baffle + (define _h1_ 3) (let)))))") (glint "(define (func x) (if (copy 0+) (copy 0+) (length (values #\\c 3 1.2) (set! _x1_ 3) if ++i (gensym? and (set! _x1_ 3) (integer->char 255) let* 0(integer? i.))))) ") (glint "(define (func x) (if (char->integer 1.) (char->integer 1.) (reverse 0 \"hi\" 0+0/0i (set! _x1_ 3) (integer->char 255) 1+0/0i '(- 1) => (let* 1 +nan.0 (set! _x1_ 3) `(x) 0(peek-char 2))))) ") (glint "(define (func x) (if (list-tail (equivalent?)) (list-tail (equivalent?)) (lcm 20 (set! _x1_ 3) (integer-length (set! _x1_ 3) let* begin ii))))") (glint "(define (func x) (case x ((`(+ x 1)) (list-tail (equivalent?))) (('((x 1) . 2)) (list-tail (equivalent?))) (else (lcm 20 (set! _x1_ 3) (integer-length (set! _x1_ 3) let* begin ii)))))") (glint "(define (func x) (if (letrec - '((x 1) y . 2) '((x 1) . 2) # (define _h1_ 3) (do)) (letrec - '((x 1) y . 2) '((x 1) . 2) # (define _h1_ 3) (do))))") (glint "(define (func x) (case x (((values \"hi\")) (letrec - '((x 1) y . 2) '((x 1) . 2) # (define _h1_ 3) (do))) ((`(x . 1)) (letrec - '((x 1) y . 2) '((x 1) . 2) # (define _h1_ 3) (do))) (else (keyword? ./(char-position .(varlet 2-..))))))") (glint "(define (func x) (if (vector-set! 1+(string->list)) (vector-set! 1+(string->list)) (make-string (set! _x1_ 3) (floor i0/ let* 0/0+i -1 (set! _x1_ 3) `(x 1)))))") (glint "(define (func x) (case x ((#f) (vector-set! 1+(string->list))) (('((x 1 . 2) . 3)) (vector-set! 1+(string->list))) (else (make-string (set! _x1_ 3) (floor i0/ let* 0/0+i -1 (set! _x1_ 3) `(x 1))))))") (glint "(define (func x) (if (char-ci=? 0(provided?)) (char-ci=? 0(provided?)) (if else)))") (glint "(define (func x) (let* `(x 1) (do (list (list 1 2)) quote 0/0+i (define _h1_ 3))))") (glint "(define (func x) (if (list->vector (list-tail (vector->list 0))) (list->vector (list-tail (vector->list 0)))))") (glint "(define (func x) (case x ((''2) (list->vector (list-tail (vector->list 0)))) ((`((+ x 1))) (list->vector (list-tail (vector->list 0)))) (else (/ /1-+))))") (glint "(define (func x) (if (not -) (not -) (and (and))))") (glint "(define (func x) (reverse (cdr (reverse))))") (glint "(define (func x) (if (cdr) (cdr) (format +i0/(outlet (do `(x) (string (integer->char 255)) -1 (define _h1_ 3) (do 0-))))))") (glint "(define (func x) (if (string-append (string-append . 1/0+i)) (string-append (string-append . 1/0+i))))") (glint "(map 2(list-tail (string->list i)))") (glint "(for-each +(list-tail (string->list -)))") (glint "(char-alphabetic? (letrec (list (list 1)) (values 1 2) (*s7* 'print-length) (define _h1_ 3) (let* 2 begin 0+1/0i (define* (_d1_ (a 1)) (+ a 1)) 0+0/0i 1212)))") (glint "(with-baffle 1i 0+0/0i '((1 (2)) (((3) 4))) '((x . 1) . 2) 3/4 -1 unless (define _h1_ 3) (let 1))") (glint "(when 00/(cond . +i))") (glint "(letrec* - (define _h1_ 3) 1.5 (define _h1_ 3) (do '((()))))") (glint "(map +(list-tail (vector->list //1(port-line-number ./))))") (glint "(asin (procedure-source (string-append (string-append . when))))") (glint "(for-each 1(list-tail (string->list (funclet (with-input-from-file .(signature))))))") (glint "(eval (list 02(quote)))") (glint "(string-append +0 (integer->char 255) (string-append . 1))") (glint "(vector-append (vector-append . 1.2.3))") (glint "(reverse! (map 0(sort!)))") (glint "(append i2(append . #))") (glint "(cadr (do (list (list 1)) `((+ x 1)) '(()) (list (list 1 2)) (do 00- #(1 2) or (lambda* ((a 1)) (+ a 1)) #() /100(number? (dilambda 1/)))))") (glint "(do (list (list 1)) '((x 1) . 2) ..(case i/ 1.5 let . '(1 2 . 3)))") (glint "(pair-line-number i2(outlet (c-pointer? (for-each if +nan.0 `(1) (quote \"\" #2d((1 2) (3 4)) '((x 1) (y . 2)) (let ((x 3)) (lambda (y) (+ x y))) i/(char-downcase (logior 2(hash-table))))))))") (glint "(when -(cond 2/1 (lambda args args) . 0))") (glint "(string-ci>=? (cdaadr 1/+ `(x 1) `(1) #f case --+/-0(number? 0 1 '((x . 1) . 2) .-(eval (read (open-input-string))))))") (glint "(make-hash-table ++0.(string-append \"hi\" (string)))") (glint "(map (*s7* 'print-length) '((x 1) . 2) letrec* `(((x 1))) 0/0+i '(- 1) (quote #() # 1/1.2 +inf.0 i020))") (glint "(multiple-value-bind 0(expt (map 2(quote))))") (glint "(documentation (do () `((x 1)) (integer->char 255) . =>))") (glint "(let*-values ((x)) (list ()) do -/(proper-list? -0(iterator? .-.-0(input-port? i0))))") (glint "(logand .-0+11 'hi (1) i12(let-values ((1) . x)))") (glint "(let-values ((x . 1) . 2) (make-dilambda (lambda () 1) (lambda (a) a)) 2.(cons* .210/))") (glint "(/ i0+(let*-values ((x 1 . 2) . 3) #(1 2) '((1 (2)) (((3) 4))) and ((set! x (+ x 1)) (* x 2)) (proper-list?)))") (glint "(let ((x 1) (y) . 2) (define _h1_ 3) (list 1 2) 2)") (glint "(case .. ((x 1) 2) quasiquote -1234 (x 1) 10(abs 2))") (glint "(let + (((x 1))) (unless 01001/i(outlet 2 (string (integer->char 255)) (lambda args args) (define-macro (_m1_ a) `(+ ,a 1)) 'hi (append (do +)))))") (glint "(let? i0..-(let* '((())) (do ((set! x (+ x 1)) (* x 2)) (char-upper-case? (memq (string->symbol (proper-list? -)))))))") (glint "(eqv? i.(write-byte (symbol-table (string>=? (call-with-exit i0(> 12+.(multiple-value-bind 2 -1 ((x 1) . 2))))))))") (glint "(case .2i1./ ((x 1) 2) (x 1) (complex? 2))") (glint "(let ((x #f)) (*s7* 'print-length) . else)") (glint "(int-vector (let ((x . 1) . 2) (do (float-vector? -))))") (glint "(when 0(let (((+ x 1))) +i :hi --(get-output-string #(#(0)) ((1)) (- 1) 1.0+1.0i (cddadr))))") (glint "(let* + (((+ x 1))) (if ((x 1) (y . 2)) letrec* 0/0+i or))") (glint "(caddr (letrec* i+ (((x 1) 2) 3) '((1 2) (3 4)) (define _h1_ 3) (do ((x . 1) . 2) 221.)))") (glint "(let* (define-macro (_m1_ a) `(+ ,a 1)) (do (((+ x 1))) #() \"hi\" 0i #() let #2d((1 2) (3 4)) 0 /1))") (glint "(eof-object? 0-+(let and ((x 1) (y . 2)) (unless +2+0(read -0(do (vector? 1 1.0+1.0i (pi 0) and .0))))))") (glint "(aritable? +02(not (begin 1i __asdf__ (make-dilambda (lambda () 1) (lambda (a) a)) -1 ((x 1) (y) . 2) . 1234)))") (glint "(let* + ((set! x (+ x 1)) (* x 2)) (when))") (glint "(catch (lambda* ((a 1)) (+ a 1)) + (cons 1 2) (integer->char 255) lambda -.2.1++.(lambda*))") (glint "(number? i0(cadr /(help (do ((x . 1)) (((x 1))) #2d((1 2) (3 4)) letrec*))))") (glint "(do (+ x 1) 'hi (- 1) case ((x . 1) . 2) (integer->char 255) letrec .(string-downcase .(keyword? i)))") (glint "(set-current-error-port (let i (((+ x 1))) #f ((x . 1) . 2) i+1.i(string-ci>? let* -1 -1 ((x)) (current-output-port (abs x) 1.5 #() (x (y 1)) '((1 (2)) (((3) 4)))))))") (glint "(string-downcase (open-input-file i(let /12 (((+ x 1))) __asdf__ do (*s7* 'print-length))))") (glint "(read-char /2(equivalent? /(c-pointer? (iterate (let i. (((+ x 1))) ((x 1) y . 2) do (set-current-input-port .11))))))") (glint "(do 'hi () 1/1.2 - or ((x 1) 2) most-negative-fixnum (cddaar /1(cosh do (list (list 1 2)) () '((())) begin 1 and 00.(length .i))))") (glint "(expt .+/+(call-with-exit (lambda (x) ((x 1 . 2) . 3) -+)))") (glint "(cdr -(lambda (define _h1_ 3) (not)))") (glint "(zero? (- . (x . y)))") (glint "(vector? 1./.1(int-vector-ref 1/(list-ref .(string-upcase -.(make-rectangular (let (pi 0) (do ((set! x (+ x 1)) (* x 2)) pi 1)))))))") (glint "(if 0.(if (not 00.)))") (glint "(let + (((+ x 1))) (when 2))") (glint "(vector-length (copy .(gensym . pi)))") (glint "(lambda 1-1/.0i/-i(let))") (glint "(angle i+.(let ((x 1) (y) . 2) (define* (_d1_ (a 1)) (+ a 1)) 1(logxor)))") (glint "(open-output-string (logxor ((x . 1)) ((set! x (+ x 1)) (* x 2)) pi # (define-macro (_m1_ a) `(+ ,a 1)) 1(call-with-values (values) (lambda))))") (glint "(proper-list? (lambda* ..2(let ((x 1) . 2) (string #\\a #\\null #\\b) i1)))") (glint "(lognot -(case i quote 00 (x y) => (set! _x1_ 3) .(string-ci>=? -/0 #2d((1 2) (3 4)) (((x 1) 2) 3) (- 1) 0/0+0/0i (float-vector-ref =>))))") (glint "(string-append +(let* ''2 (define-macro (_m1_ a) `(+ ,a 1)) +inf.0 ((x 1) 2) 21 case -1234 (define _h1_ 3) 0 +-(eval 02-(float-vector 2 (values \"hi\") (list (list 1)) ((x 1) . 2) +inf.0 -+2.))))") (glint "(or -1i1 (or . 0))") (glint "(caaaar '((1 2) (3 4)) (list 1 2) (char-lower-case? /+/. \"hi\" (pi 0) ((x . 1)) i/(make-list (set-current-error-port 12(when .1(when (not)))))))") (glint "(cond (#t ()) 'hi ((x . 1)) i.1.)") (glint "(cond (#t ()) ((x . 1) . 2) define x (cons 1 2) /-/(port-filename (x 1) ((set! x (+ x 1)) (* x 2)) (- 1) (- 1) .ii1(hash-table-entries 10)))") (glint "(cond /2 (#t ()))") (glint "(assv /2(map i (x 1) (make-dilambda (lambda () 1) (lambda (a) a)) 12+i1+/1(make-rectangular /2(cond (x . 1) (#t ()) (cdddar)))))") (glint "(gc i/(case 1 (integer->char 255) (else ())))") (glint "(list->string +(flush-output-port (case //2- (list 1) (else ()))))") (glint "(cond (((+ x 1))) (else ()) (flush-output-port))") (glint "(even? /(subvector 0-(list->string 1(cond ((i 0 (+ i 1))) ((x . 1) . 2) (#t ())))))") (glint "(cond ((x 1) (y) . 2) (else (f x) B) ((x 1) (y) . 2))") (glint "(cons +1.(list 02/ (pi 0) `(+ ,a ,@b) ((null? i) i) 2201))") (glint "(let* / ((1)) (unless (unless '((())) x y z 1+0/0i most-negative-fixnum /)))") (glint "(define* ((x . 1)) letrec ((1)) (pi 0) let (+ x 1) (x . 1) set! x quasiquote (f x) i `(+ ,a ,@b) )") (glint "(define* , `(+ ,a ,b ,@c) (define* macroexpand macroexpand \"\"))") (glint "(define* ((i 0 (+ i 1))) (define* 3/4 unless (call/cc (lambda (go) (go 9) 0)) or ' `(+ ,a ,@b) 1.0+1.0i abs (abs x) (A (f x) B) () ((1) . x) ))") (glint "(define* , (else ()) ,(lambda))") (glint "(cond ` (#t ()) (abs x) (= i 2) ((+ x 1)) (else (f x) B) ((x 1) (y) . 2) (A (f x) B))") (glint "(unless (set! _x1_ 3) `(+ ,a ,@b) `(+ ,a ,@b) `(+ ,a ,@b) `(+ ,a ,b) (((x 1))) (vector 1 '(3)) (else (f x) B) +nan.0 ((x 1)))") (glint "(lambda* .(:allow-other-keys (integer->char 255) define x (lambda args args) \" \"))") (glint "(begin (define* (_d1_ (a 1)) (+ a 1)) (f x) (define* (_d1_ (a 1)) (+ a 1)) (else (f x) B) (- 1) ' ((x 1) 2) (A (f x) B) `(+ ,a ,b ,@c) #(1 2) .\" ` ` \")") (glint "(cond `(+ ,a ,@b) ((x 1) (y) . 2) (else (f x) B) ((x 1) (y) . 2))") (glint "(lambda* lambda* -1 (= i 2) (- i 1) cons \" \")") (glint "(define-macro (pi) (quote))") (glint "(cond (1) (else))") (glint "(list-values (apply-values))") (glint "(list-values (begin (f x) B) +nan.0 (apply-values))") (glint "(symbol->value (vector->list quasiquote (list-values -1.3 (apply-values))))") (glint "(define-macro (list (list 1 2)) (list-values))") (glint "(define-bacro (x => y) (cond ((x 1) . 2) ))") (glint "(int-vector-set! ((+ x 1)) \"hi\" '(string #\\a #\\null #\\b) 3/4 (((+ x 1))) (1) (do (#t ()) #() (= i 2)))") (glint "(list-values (list-values . -1))") (glint "(lambda* `(string>? +inf.0 ((set! x (+ x 1)) (* x 2)) macroexpand `(+ ,a ,b ,@c) (()) pi (pi 0) (= i 2) let (1) begin (1 2 . 3) if cond (begin (f x) B) (()) (define-macro (_m1_ a) `(+ ,a 1)) (x y) (values \"hi\") ((+ x 1)) :hi ((set! x (+ x 1)) (* x 2)) +inf.0 (()) (pi 0) ((x 1 . 2) . 3) (x y) (x . 1) ((x . 1) . 2) +nan.0 (if x y) `(+ ,a b ,@c ',d) (make-dilambda (lambda () 1) (lambda (a) a)) with-let ))") ) (let ((out-vars (*lint* 'out-vars))) (test (out-vars 'hi '(a b) '(+ a b)) '(() ())) (test (out-vars 'hi '(a b) '(set! a b)) '(() ())) (test (out-vars 'hi '(a b) '(set! c (+ a b))) '(() (c))) (test (out-vars 'hi '(a b) '(set! a (+ b c))) '((c) ())) (test (out-vars 'hi '(a b) '(set! c (+ (* a b) c))) '((c) (c))) (test (out-vars 'hi '(a b) '(set! (c 0) (+ (* a b) c))) '((c) (c))) (test (out-vars 'hi '(a b) '(let ((c 1)) (+ (* a b) c))) '(() ())) (test (out-vars 'hi '(a b) '(let ((c (+ a b))) (set! c (* a b)))) '(() ())) (test (out-vars 'hi '(a b) '(let loop ((c (+ a b))) (set! c (loop a)))) '(() ())) (test (out-vars 'hi '(a b) '(let loop ((c (+ a b))) (set! c (loop d)))) '((d) ())) (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! c (loop d)))) '((loop) ())) (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! e d) (+ a b c d))) '(() (e))) (test (out-vars 'hi '(a b) '(let ((c (+ a b)) (d 1)) (set! e d) (+ a b c d e f g))) '((g f e) (e))) (test (out-vars 'hi '(a b) '(let ((c 1) (d (+ c 1))) (+ (* a b) c))) '((c) ())) (test (out-vars 'hi '(a b) '(let* ((c 1) (d (+ c 1))) (+ (* a b) c))) '(() ())) (test (out-vars 'hi '(a b) '(let ((g 1)) (let ((c g)) (* c g)))) '(() ())) (test (out-vars 'hi '(a b) '(let ((g 1)) (letrec ((c g)) (* c g)))) '(() ())) (test (out-vars 'hi '(a b) '(do ((i 0 (+ i 1))) ((= i 10) i) (display i))) '(() ())) (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j))) ((= i 10) i) (display i))) '((j) ())) (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) i) (display i))) '(() ())) (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) k) (display i))) '((k) ())) (test (out-vars 'hi '(a b) '(do ((i 0 (+ i j)) (j 2)) ((= i 10) k) (set! n i))) '((k) (n))) (test (out-vars 'hi '(a b) '(lambda () (+ a b))) '(() ())) (test (out-vars 'hi '(a b) '(lambda (c) (+ a b c))) '(() ())) (test (out-vars 'hi '(a b) '(lambda c (+ a b c))) '(() ())) (test (out-vars 'hi '(a b) '(lambda (c . d) (+ a b c d))) '(() ())) (test (out-vars 'hi '(a b) '(lambda (c . d) (set! e (+ a b c d)))) '(() (e))) (test (out-vars 'hi '(a b) '(lambda* ((c 1) (d 2)) (+ a b c d))) '(() ())) (test (out-vars 'hi '(a b) '(let () (define c 1) (+ a b c))) '(() ())) (test (out-vars 'hi '(a b) '(let () (define c 1) (+ a b c d))) '((d) ())) (test (out-vars 'hi '(a b) '(let* () (define c 1) (+ a b c d))) '((d) ())) (test (out-vars 'hi '(a b) '(let () (define (c s) (* s 2)) (+ a b (c d)))) '((d) ()))) ; (define fmatch (*lint* 'function-match)) ; (define walkfunc (*lint* 'lint-walk-function)) ; (define (f1 x) (if (< x 3) (+ x 1) (+ x 2))) ; (let ((e (walkfunc 'define 'f1 '(x) '((if (< x 3) (+ x 1) (+ x 2))) '(define (f1 x) (if (< x 3) (+ x 1) (+ x 2))) ()))) ; (fmatch 'tester '(if (< y 3) (+ y 1) (+ y 2)) e)) ; (define sequal? (*lint* 'structures-equal?)) ; (sequal? '(if (< y 3) (+ y 1) (+ y 2)) '(if (< x 3) (+ x 1) (+ x 2)) '((y . :unset)) () ()) ; (sequal? '(and x y) '(and a b) '((x . a) (y . b)) () ()) (define f321 (let ((+signature+ '(float? integer?))) (lambda (int) (if (integer? int) (* 1.0 int) (error 'wrong-type-arg "~A: ~A is not an integer" f321 int))))) (lint-test "(string-ref (f321 3) 2)" " string-ref: in (string-ref (f321 3) 2), string-ref's first argument should be a string, but (f321 3) is a float?") (when full-s7test (let ((result (call-with-output-string (lambda (op) (catch #t (lambda () (lint "lint.scm" op)) (lambda (type info) (format *stderr* "~A: ~S~%" type (apply format #f info)))))))) (when (string? result) (format *stderr* "lint(lint): ~S~%" (length result))));) ; 77629 11-Sep-23 (set! reader-cond #f) (set! *#readers* ())) ;;; end lint (set! (hook-functions *read-error-hook*) ()) (set! *#readers* ()) ;;; shouldn't lint clear these? (set! ((funclet pretty-print) '*pretty-print-spacing*) 2) (set! ((funclet pretty-print) '*pretty-print-left-margin*) 2) ;(if (defined? 'pp-testing) (exit)) ;;; -------------------------------------------------------------------------------- (test (let ((else #f)) (cond ((= 1 2) 1) (else 3))) #) (test (let ((else #f)) (cond ((= 1 2) 1) (#_else 3))) 3) (test (let ((else 1)) (let ((otherwise else)) (case 0 (otherwise 1)))) 'error) (test (let ((else 3)) (cond ((= else 3) 32) (#t 1))) 32) (test (let ((else #f)) (cond (else 32) (#t 1))) 1) (test (let ((else #f)) (cond ((< 2 1) 3) (else 4))) #) ; same (test (let ((else #f)) (case 3 ((2 1) 3) (else 4))) 4) ; chibi says #f (its choice for the unspecified value), Guile 4, chicken error (test (let ((else #f)) (cond ((< 2 1) 1) (else 3) (#t 4))) 4) ; ! (same for chibi) (test (let ((=> 3) (else 4)) (cond (else => abs))) abs) ;; to run chibi repl, goto /home/bil/test/chibi-scheme-master, setenv LD_LIBRARY_PATH /home/bil/test/chibi-scheme-master, chibi-scheme ;; to run chicken, goto /home/bil/test/chicken-4.7.0.6/, csi (test (let ((else #f) (x 1)) (cond ((= x 0) 32) (else 12))) #) (test (let ((else #f) (x 1)) (define (f) (cond ((= x 0) 32) (else 12))) (f)) #) (test (let ((else #f) (x 1)) (define (f) (cond ((= x 0) 32) (#_else 12))) (f) (f)) 12) (test (let ((else #f) (x 1)) (define (f) (do ((i 0 (+ i 1))) ((= i 1) (cond ((= x 0) 32) (else 12))))) (f)) #) (let ((else #f)) (define (tc-cond-a-z-la-1 x) (cond ((zero? x) 3) (else (tc-cond-a-z-la-1 (- x 1))))) (test (tc-cond-a-z-la-1 10) #)) (let ((else #f)) (define (tc-cond-a-la-z-1 x) (cond ((positive? x) (tc-cond-a-la-z-1 (- x 1))) (else 3))) (test (tc-cond-a-la-z-1 10) #)) (test (let ((else 3)) (case 0 ((1) 2) (else 3))) 3) ; changed my mind about this -- else is not evaluated here unless it's some other symbol (test (let ((else 3)) (case else ((3) else))) 3) (test (case 0 ((1) 2) (else (let ((else 3)) else))) 3) (test (let ((else #f) (x 1)) (case x ((0) 32) (else 12))) 12) (test (let ((else #f) (x 1)) (define (f) (case x ((0) 32) (else 12))) (f)) 12) (test (let () (define (f) (write (vector 1.0) (openlet (inlet 'write for-each)))) (f)) 'error) ; fx_c_aa unstack gc_protect bug ;; gets error "vector-ref second argument, (write . for-each), is a pair but should be an integer" because it's iterating over the let (test (write (vector 1.0) (openlet (inlet 'write for-each))) 'error) ; same as above without the fx_c_aa call but pointless since 'write is no longer global (define _x3x3_ with-baffle) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (vector) (_x3x3_ (reverse (caaar (+ i 1)))))) (func)) 'error) ; fx_c_optcq bug (let () (define (func) (catch #t (lambda () (let ((x (list (newline (open-output-function #_+))))) x)) (lambda (type info) 'error))) (test (func) (list #\newline))) ; function_write* unstack+save sc->args|code (let-temporarily (((setter quasiquote) (lambda args args))) (test (let () (define (f) (set! (quasiquote 1) (setter 'i))) (f) (f)) '(1 #f)) ; set_opsaq_a -> set_pair3 c_macro branch */ (test (let () (define (f) (set! (quasiquote 'a 0) 3)) (f) (f)) '(a 0 3))) ; op_set_opsaaq_a -> set_pair4 same */ (test (c-pointer? (coverlet (c-pointer 1 2 (inlet 'aaa 1)))) #t) ;;; next two redefine let-ref and let-set! which messes up lint optimization above (test (#_eval '(define x 3) (null-environment)) 3) (test (#_eval '(< x 4) (null-environment)) 'error) (test (object->string (null-environment)) "(inlet 'x 3)") (test (#_eval '(let ((y 2)) ((lambda z z) x y)) (null-environment)) '(3 2)) (test (let ((equal? #f)) (member 3 '(1 2 3))) '(3)) (test (let ((eqv? #f)) (case 1 ((1) 1))) 1) ; scheme wg (test (let ((eqv? equal?)) (case "asd" (("asd") 1) (else 2))) 2) (test (let ((eq? #f)) (memq 'a '(a b c))) '(a b c)) (test (let () (define (func) ((lambda (if) (if (> 3 2) + -)) 3)) (func)) 'error) (test (let () (define (func) ((lambda (list) (list (> 3 2) + -)) 3)) (func)) 'error) (test (let ((if #t)) (or if)) #t) (test (let ((if +)) (if 1 2 3)) 6) (test (if (let ((if 3)) (> 2 if)) 4 5) 5) (test (let ((quote 1)) (+ quote 1)) 2) ;(test (let ((quote -)) '32) -32) ; this doesn't work in general (op_quote_unchecked and quote->fx_q elsewhere) (test (do ((do 1)) (#t do)) 1) (test (do ((do 1 (+ do do))) ((> do 3) do)) 4) (test (do ((do 1 do) (j do do)) (do do)) 1) (test (do ((do do do)) (do do)) do) (test (do ((do do do)) (do do do)) do) ; ok ok! (test (or (let ((or #t)) or)) #t) (test (and (let ((and #t)) and)) #t) (test (let ((=> 3) (cond 4)) (+ => cond)) 7) (test (case 1 ((1 2) (let ((case 3)) (+ case 1))) ((3 4) 0)) 4) (test (let ((lambda 4)) (+ lambda 1)) 5) (test (let ((define 1)) define) 1) ;; define => tests (let ((=> 32)) (test (cond (1 =>)) 32)) (let () (test (cond (1 => abs)) 1)) (let () (define => 32) (test (cond (1 => abs)) abs)) (let () (test (cond (1 => abs)) 1)) (define => 32) (test (cond (1 =>)) 32) (set! => #) (test (cond (1 => abs)) 1) (test (let () (define (hi a) (let ((pair? +)) (pair? a 1))) (hi 2)) 3) (test ((lambda (let) (let* ((letrec 1)) (+ letrec let))) 123) 124) ;(test (member quasiquote (list 1) (lambda 'ho '(1 2))) 'error) ; 29-May-21 qq uses #_quote if quote is not a global (test (let ((begin 3)) (+ begin 1)) 4) (test ((lambda (let*) (let ((letrec 1)) (+ letrec let*))) 123) 124) (test ((lambda (quote) (+ quote 1)) 2) 3) (test ((lambda (quote . args) (list quote args)) 1 2 3) '(1 (2 3))) (test (let ((do 1) (map 2) (for-each 3) (quote 4)) (+ do map for-each quote)) 10) (test ((lambda lambda lambda) 'x) '(x)) (test ((lambda (begin) (begin 1 2 3)) (lambda lambda lambda)) '(1 2 3)) (test (let* ((let 3) (x let)) (+ x let)) 6) (test (((lambda case lcm))) 1) (test (((lambda let* *))) 1) (test (do ((i 0 1) '(list)) (#t quote)) 'error) (test ((lambda (let) (+)) 0) 0) (test (let () (define (hi cond) (+ cond 1)) (hi 2)) 3) (test (let () (define* (hi (cond 1)) (+ cond 1)) (hi 2)) 3) (test (let () (define* (hi (cond 1)) (+ cond 1)) (hi)) 2) (test (let () ((lambda (cond) (+ cond 1)) 2)) 3) (test (let () ((lambda* (cond) (+ cond 1)) 2)) 3) (test (let () (define-macro (hi cond) `(+ 1 ,cond)) (hi 2)) 3) (test (let () (define-macro* (hi (cond 1)) `(+ 1 ,cond)) (hi)) 2) (test (let () (define (hi abs) (+ abs 1)) (hi 2)) 3) (test (let () (define (hi if) (+ if 1)) (hi 2)) 3) (test (let () (define* (hi (lambda 1)) (+ lambda 1)) (hi)) 2) (test (do ((i 0 0) '(+ 0 1)) ((= i 0) i)) 'error) (test (let () (define (cond a) a) (cond 1)) 1) (test (let ((cond 1)) (+ cond 3)) 4) (test (let () (define (tst cond) (if cond 0 1)) (tst #f)) 1) (test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (tst cond)) 3) (test (let () (define (tst fnc) (fnc ((> 0 1) 2) (#t 3))) (define (val) cond) (tst (val))) 3) (test (let () (define-macro (hi a) `(let ((lambda +)) (lambda ,a 1))) (hi 2)) 3) (test ((let ((do or)) do) 1 2) 1) (test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi)) 8) (test (let () (define (hi) (let ((oscil *)) (if (< 3 2) (+ 1 2) (oscil 4 2)))) (hi) (hi) (hi) (hi)) 8) (test (let ((x 12)) (define (hi env) (set! x (env 0)) x) (hi '(1 2 3)) (hi '(1 2 3))) 1) (test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3))) 14) (test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3))) 14) (test (let ((x 12)) (define (hi env) (set! x (+ x (env 0))) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15) (test (let ((x 12)) (define (hi env) (set! x (+ (env 0) x)) x) (hi '(1 2 3)) (hi '(1 2 3)) (hi '(1 2 3))) 15) (test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i (env 1 2)))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6) (test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x (env 1)))) (hi) (hi)) 6) (test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i (env 4 5)) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6) (test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (env 1 2 3)) (+ x 1))) (hi) (hi)) 6) (test (let ((env +) (x 0)) (define (hi) (do ((i 0 (+ i 3))) ((> i 9) (+ 1 2 3)) (+ x 1))) (hi) (hi)) 6) (test (let * ((i 0)) (if (< i 1) (* (+ i 1))) i) 0) (test (let ((car if)) (car #t 0 1)) 0) (test (call-with-exit (lambda (abs) (abs -1))) -1) (test (let ((sqrt (lambda (a) (* a a)))) `(+ ,@(map sqrt '(1 4 9)) 2)) '(+ 1 16 81 2)) (test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(sqrt 9) 4)) '(+ 81 4)) (test `(+ ,(let ((sqrt (lambda (a) (* a a)))) (sqrt 9)) 4) '(+ 81 4)) (test `(+ (let ((sqrt (lambda (a) (* a a)))) ,(sqrt 9)) 4) '(+ (let ((sqrt (lambda (a) (* a a)))) 3) 4)) (test (let ((sqrt (lambda (a) (* a a)))) `(+ ,(apply values (map sqrt '(1 4 9))) 2)) '(+ 1 16 81 2)) (unless immutable-unquote (test (let ((sqrt (lambda (a) (* a a)))) `(+ (unquote (apply values (map sqrt '(1 4 9)))) 2)) '(+ 1 16 81 2))) (test ((((eval lambda) lcm gcd))) 0) (test ((((lambda - -) -) 0) 1) -1) (test (let () (define (hi) (let ((oscil >)) (or (< 3 2) (oscil 4 2)))) (hi) (hi)) #t) (test (let () (define (hi) (let ((oscil >)) (and (< 2 3) (oscil 4 2)))) (hi) (hi)) #t) (test (procedure? (let () (let* cons () (lambda* (a . b) (cons a b))))) #t) ; fixup_closure_star_aa bug (needed arity check) (test ((lambda* ((- 0)) -) :- 1) 1) (let () (define-macro (i_ arg) `(with-let (unlet) ,arg)) (define-bacro* (mac b) `((i_ let) ((a 12)) ((i_ +) a ,(symbol->value b)))) ;; this assumes the 'b' value is a symbol: (let ((a 1)) (mac (* a 2))) is an error -- see s7.html for a better version (test (let ((a 32) (+ *)) (mac a)) 44)) ;(define (hi) (do ((i 0 (+ i 1))) ((= i 200000) i) (abs i))) ;(test (hi) 200000) (let () (define-macro (cube x) `(with-let (inlet :x ,x) (* x x x))) (test (cube 2) 8) (let ((x 2)) (test (cube (set! x (+ x 1))) 27)) (define-macro (pop! sym) `(with-let (#_inlet :e (#_curlet) :result (#_car ,sym)) (with-let e (#_set! ,sym (#_cdr ,sym))) result)) (test (let ((lst '(1 2 3))) (list (pop! lst) lst)) '(1 (2 3))) (test (let ((lst (vector (list 1 2 3)))) (list (pop! (lst 0)) lst)) '(1 #((2 3)))) (test (let ((result '(1 2 3))) (list (pop! result) result)) '(1 (2 3))) (test (let ((cdr '(1 2 3))) (list (pop! cdr) cdr)) '(1 (2 3))) (define-macro (pushnew! val lst) `(set! ,lst (with-let (inlet :val ,val :lst ,lst) (if (not (member val lst)) (cons val lst) lst)))) (test (let ((lst (list 1 2))) (pushnew! 3 lst)) '(3 1 2)) (test (let ((val (list 1 2)) (lst 3)) (pushnew! lst val)) '(3 1 2)) (test (let ((lst (list 1 2)) (val 3)) (pushnew! val lst)) '(3 1 2)) (test (let ((lst (list 1 2)) (member 3)) (pushnew! member lst)) '(3 1 2)) ) (test (let ((x 2) (display 3)) (with-let (sublet (curlet) (unlet)) (display x))) 2) ; (unlet () ...) -- curlet but with globals in original values (test (let ((y 2)) (let ((x 1)) (let ((display 3)) (with-let (sublet (curlet) (unlet)) (display (+ x y)))))) 3) (test (let () (define-immaculo (hi a) `(let ((b 23)) (+ b ,a))) (let ((+ *) (b 12)) (hi b))) 35) #| (test (let () (define-clean-macro (hi a) `(+ ,a 1)) (let ((+ *) (a 12)) (hi a))) 13) |# (test (let () (define-immaculo (hi a) `(+ ,a 1)) (let ((+ *) (a 12)) (hi a))) 13) #| (test (let () (define-clean-macro (mac a . body) `(+ ,a ,@body)) (let ((a 2) (+ *)) (mac a (- 5 a) (* a 2)))) 9) |# (test (let () (define-macro (mac b) `(let ((a 12)) (,+ a ,b))) (let ((a 1) (+ *)) (mac a))) 24) (test (let () (define-macro (mac b) `(let ((a 12)) (+ a ,b))) (let ((a 1) (+ *)) (mac a))) 144) (test (let () (define-immaculo (mac c d) `(let ((a 12) (b 3)) (+ a b ,c ,d))) (let ((a 21) (b 10) (+ *)) (mac a b))) 46) (let () (define-macro (pure-let bindings . body) `(with-let (unlet) (let ,bindings ,@body))) (test (let ((+ *) (lambda abs)) (pure-let ((x 2)) ((lambda (y) (+ x y)) 3))) 5)) (test (let ((name '+)) (let ((+ *)) (eval (list name 2 3)))) 6) (test (let ((name +)) (let ((+ *)) (eval (list name 2 3)))) 5) ;; why is this considered confusing? It has nothing to do with eval! (test (let ((call/cc (lambda (x) (let ((c (call/cc x))) c)))) (call/cc (lambda (r) (r 1)))) 1) ; (test (with-let (sublet (curlet) (cons '+ (lambda args (apply * args)))) (+ 1 2 3 4)) 24) ; not sure about this -- the inner '+ might be optimized (let () (define-macro (when1 expr . body) `(#_if ,expr (#_begin ,@body))) (let ((if 32) (begin +)) (test (when1 (> 2 1) 1 2 3) 3) (test (when1 (> 1 2) 3 4 5) #)) (test (when1 (> 2 1) 3) 3)) (test (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list))) 5) (test (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2)) 3) (test (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3))) 2) (test (let () (define (hi) (let ((car 1) (cdr 2) (list '(1 2 3))) (+ car cdr (cadr list)))) (hi)) 5) (test (let () (define (hi) (letrec ((null? (lambda (car cdr) (+ car cdr)))) (null? 1 2))) (hi)) 3) (test (let () (define (hi) (letrec ((append (lambda (car list) (car list)))) (append cadr '(1 2 3)))) (hi)) 2) (let () (test ((lambda 'a (eval-string "1")) (curlet) 1) 'error) (test ((lambda 'a (eval-string "a")) (curlet) 1) 'error)) ;;; check optimizer (let ((lst (list 1 2 3)) (old-lambda lambda) (ho #f) (val #f)) (let* ((lambda 1)) (define (hi) (for-each (lambda (a) (display a)) lst)) (set! val (+ lambda 2)) (set! ho hi)) (test val 3) (test (ho) #)) (when with-block ; optimize_safe_c_func_three_args[71842]: overwrite has_fx: opt2_sym (fvset1 '((x 1)) imh111) (let () (define (func) (do () ((not #f) (make-string 3 #\space) (with-let (block) (let ((fvset1 float-vector-set!)) (define-constant imh111 (hash-table)) (subsequence fvset1 `((x 1)) imh111)))))) (test (func) 'error)) (let ((block-ref 123)) (test (#_block-ref (block 1 2) 0) 1.0) (test (block-ref (block 1 2) 0) 'error))) (let () (define mac (let ((var (gensym))) (define-macro (mac-inner b) `(#_let ((,var 12)) (#_+ ,var ,b))) mac-inner)) (test (let ((a 1) (+ *) (let /)) (mac a)) 13) (test (let ((a 1) (+ *) (let /)) (mac (mac a))) 25)) (let () ; from Kjetil Matheussen (define-expansion (push2! list el) `(set! ,list (cons ,el ,list))) (define aa '()) (define (afunction) (define a 'a) (push2! aa a)) (define (<_>2 a b) (string->symbol (string-append (symbol->string a) (symbol->string b)))) (define-expansion ( command . args) `( ,(<_>2 'ra2: (keyword->symbol command)) ,@args)) (define (get-all-lines-in-file2 wfilename) ( :open-file-for-reading2 wfilename))) (test ((lambda () ((let () cond) (call-with-exit 32)))) 32) (test (let ((begin +)) (with-let (unlet) (begin 1 2))) 2) (test (let () (define (f x) (let > (begin (vector-dimensions 22)))) (f 0)) 'error) (test (let () (define (f x) (let asd ())) (f 1)) 'error) (test (let () (define (f x) (hook *)) (f #f)) 'error) (test (let ((e (sublet (rootlet) '(a . 1)))) (define (f x) (e *)) (f 1)) 'error) (test (let () (define (f) (eval (lambda 2.(hash-table-ref 1-)))) (f)) 'error) (test (let () (eval (lambda 2.(hash-table-ref 1-)))) 'error) (test (let () (define (f) (eval (lambda 2 #f))) (f)) 'error) (test (let () (define (f) (eval (lambda #f))) (f)) 'error) (test (let () (define (f) (eval (lambda))) (f)) 'error) (test (let () ((lambda () (eval (lambda 2 #f))))) 'error) (test (let () (define (f x) (help (lambda `(x 1) 12))) (f (string #\a))) 'error) (test (let () (define (func x) (* +(quote (vector? )))) (func '((x 1) (y) . 2))) 'error) (test (let () (define (func x) (* +(quote i))) (func cond)) 'error) (test (let ((i 1)) (define (func x) (begin i(let -))) (func macroexpand)) 'error) (test (let ((i 1)) (define (func x) (if (* i '((x 1) (y) . 2) ) (atan (procedure? 2(sin ))))) (func '(values #\c 3 1.2))) 'error) (test (let ((i 1)) (define (func x) (* 1- '(values #\c 3 1.2) )) (func set!)) 'error) (test (let ((dynamic-wind 1)) (+ dynamic-wind 2)) 3) (test (list (call-with-exit (lambda quote ((car quote) 1 2 3)))) '(1 2 3)) (test (call-with-exit (lambda* (quote (ho 1)) (quote ho))) 1) (test (lambda 'ho (hash-table 'a 1) . #) 'error) ; stray dot check (test (let () (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (for-each or #((define x 3))))) (func)) #f) ;fx_tree problem ;; same problem but uncaught currently: ;; (let ((arg #((define x 3))) (asdf or) (fdsa for-each)) (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (fdsa asdf arg))) (func)) ;; the problem is several-fold: ;; (map or #((+ 1 2))) -> '(3) ;; but (map + #((1 2))) -> error: + argument, (1 2), is a pair but should be a number ;; so syntax is special in this context because we want things like ;; (define-macro (enum . args) `(for-each define ',args (iota (length ',args)))) ; stuff.scm ;; to work in for-each, which means the list is evaluated, or more clear: ;; (apply or '((define asdf 4))) -> 4, and (map or '((define asdf 4))) -> '(4) and (map (macro (x) x) '((define xx 3))) -> '(3) ;; (let () (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (for-each or #((provide 'snd-dsp.scm))))) (func)) ;; (let () (define (func) (do ((var #f) (i 0 (+ i 1))) ((= i 1) var) (for-each or #((define x 3))))) (func)) ;; the "solution" is to use pairs, not vectors in cases like this, and don't get cute with names ;; another possibility: if syntax seen as map/for-each first arg, make sure any additions to curlet are at end of slot list (let-temporarily (((setter abs) catch)) (define (func) (set! (abs x) 1)) (catch #t func (lambda args 'error)) (test (func) 'error)) (test (let ((var begin)) (abs (+ 1 (var 2)))) 3) (test (let ((var begin)) (define (f) (abs (+ 1 (var 2)))) (define (hi) (f)) (hi) (hi)) 3) (test (let ((var begin)) (define (f) (abs (+ 1 (apply var '(2))))) (define (hi) (f)) (hi) (hi)) 3) (test (let () (define var begin) (define (f a) (a 0)) (f var)) 0) (test (let () (define var begin) (define (f a) (a #t 0)) (f var)) 0) (test (let ((x cond)) (define (f a) (a (#t 2))) (f cond)) 2) (test (let ((x cond)) (define (f a) (a (#t 2))) (f x)) 2) (test (let ((x cond)) (define (f a) (a ((> 3 2) 1))) (f cond)) 1) (test (let ((x cond)) (define (f a) (a ((> 3 2) 1))) (f x)) 1) (test (let ((x when)) (define (f a) (a #t 2)) (f x)) 2) (test (let ((x or)) (define (f a) (a #t)) (f x)) #t) (test (let ((x begin)) (define (f a) (a #t 2)) (f x)) 2) (test (let ((x begin)) (define (f a) (a #t)) (f x)) #t) (test (let ((x #f)) (define (f a) (a 3)) (set! x begin) (f x)) 3) (test (let () (define var cond) (define (f a) (a (#t 0))) (f var)) 0) (test (let () (define var when) (define (f a) (a #t 0)) (f var)) 0) (test (let () (define (f x) (x 12)) (f begin)) 12) (test (let () (define (f x) (x 12)) (f values)) 12) ;;; quote stuff (when full-s7test ; try to call with quote still global (test (system "./repl -e '(let ((quote 32)) (+ quote 1))'" #t) "33\n") (test (system "./repl -e '(let ((quote 32)) (define (f) (+ quote 1)) (f)))'" #t) "33\n") (test (system "./repl -e '(let ((quote 32)) (define (f z) (+ z 1)) (f quote))'" #t) "33\n") (test (system "./repl -e '(let ((quote (lambda (x) (+ x 1)))) (quote 32))'" #t) "33\n") (test (system "./repl -e '(let ((quote (lambda (x) (+ x 1)))) (define (f) (quote 32)) (f))'" #t) "33\n") (test (system "./repl -e '(let () (define (f) (let ((quote 32)) (+ quote 1))) (f))'" #t) "33\n") (test (system "./repl -e '(let () (define (f) (let ((quote 32)) (+ quote 1))) (define (g) (f)) (g) (g))'" #t) "33\n") (test (system "./repl -e '((lambda (quote) (+ quote 1)) 32)'" #t) "33\n")) (test (let ((when -)) (when 32)) -32) ;(test (let ((quote -)) '32) -32) ;(test (let () (define (f) (let ((quote -)) '32)) (f)) -32) (test (apply (apply apply lambda (quote '(1)))) 'error) (test (let ('a 3) 1) 'error) (test (let (' 1) quote) 'error) (test (let () (define (func x) (let () (define _x_ (lambda* '((x 1 . 2) . 3) `((x)) (reverse! /))))) (define (hi) (func #f)) (hi)) 'error) (test (call-with-output-file "/dev/null" (lambda* '(- 1) (vector 1 '(3)) '((1)))) 'error) ;(test (let ((x #f) (i 0)) (call/cc (lambda* quote `((1) . x)))) 'error) ;(test (let () (define (func) (let ((x #f) (i 0)) (call/cc (lambda* quote `((1) . x) (begin))))) (define (hi) (func)) (hi)) 'error) (let () (define (func x) (let () (define _x_ (lambda* '((x 1 . 2) . 3) `((x)) (reverse! /))))) (define (hi) (func #f)) (test (hi) 'error)) (let () (define (func) (with-output-to-string (lambda* (if) ((if (> 3 2) + -) 3 2)))) (test (func) 'error)) ;(if (< 3 2) + -)... within lambda* (if) in with-output-to-string (let () (define (func) (with-output-to-file "/dev/null" (macro* (if) ((if (> 3 2) + -) 3 2)))) (test (func) 'error)) (test (let ((max min) (min max)) (min 10 (max 100 5))) 10) (test (let ((max min) (min max)) (min 10 (max 12 15))) 12) (test ((let ((mx max)) (lambda* ((max min) (min mx)) (min 10 (max 100 5))))) 10) (test ((let ((mx max)) (lambda* ((max min) (min mx)) (min 10 (max 12 15))))) 12) (test (let ((max min) (min max)) (define (func) (min 10 (max 100 5))) (define (hi) (func)) (hi)) 10) (test (let ((max min) (min max)) (define (func) (min 10 (max 12 15))) (define (hi) (func)) (hi)) 12) (test (let ((f +)) (f 3 (let () (set! f -) 4))) 7) (let ((f #_abs)) (test (set! #_abs +) 'error) (set! abs +) (test (eq? f abs) #f) (test (eq? f #_abs) #t) (set! abs #_abs)) (when (zero? (*s7* 'debug)) (test (let ((+ *)) (define (f x) (#_+ x 1)) (object->string f :readable)) "(lambda (x) (#_+ x 1))")) (let () (define-macro (q x) `(symbol? ',x)) (let ((quote "Friends, Romans, countrymen")) (test (q 123) #f))) ; an error in Guile ("Friends..." is applied to 123) ;; if 123 -> quote, returns #t (let ((quote "Friends, Romans, countrymen")) (test 'x 'x)) (test (let ((quote 32)) (+ quote 1)) 33) (test (let (' 32) (+ quote 1)) 'error) (test (let ((quote 32)) (define (f) (+ quote 1)) (f)) 33) (test (let ((quote 32)) (define (f z) (+ z 1)) (f quote)) 33) (test (let ((quote (lambda (x) (+ x 1)))) (quote 32)) 33) (test (let ((quote (lambda (x) (+ x 1)))) (define (f) (quote 32)) (f)) 33) (test (let ((quote (lambda (x) (+ x 1)))) (define (f) (do ((i 0 (+ i 1))) ((= i 1) (quote 32)))) (f)) 33) (test (let () (define (f) (let ((quote 32)) (+ quote 1))) (f)) 33) (test (let () (define (f) (let ((quote 32)) (+ quote 1))) (define (g) (f)) (g) (g)) 33) (test ((lambda (quote) (+ quote 1)) 32) 33) (test (let () (define quote 32) (+ quote 1)) 33) (test (apply quote '(33)) 33) (test (let ((quote length)) (apply quote (list (make-list 33 1)))) 33) (test (let () (+ (let () (define quote 32) quote) '1)) 33) (test (catch #t (lambda () ((lambda quote (abs (quote __a__))))) (lambda (type info) type)) 'unbound-variable) (test (catch #t (lambda () ((lambda quote (+ (quote __a__ 1))))) (lambda (type info) type)) 'unbound-variable) (test (catch #t (lambda () ((lambda quote (+ 1 (quote __a__))))) (lambda (type info) type)) 'unbound-variable) (test (catch #t (lambda () ((lambda quote (+ (quote __a__) (quote __a__))))) (lambda (type info) type)) 'unbound-variable) (test (catch #t (lambda () ((lambda quote (+ 1 (quote __a__) (quote __a__))))) (lambda (type info) type)) 'unbound-variable) (test (catch #t (lambda () ((lambda quote (+ 1 (quote __a__) 3)))) (lambda (type info) type)) 'unbound-variable) (test (catch #t (lambda () ((lambda quote (+ 1 2 (quote __a__) 3)))) (lambda (type info) type)) 'unbound-variable) (test (catch #t (lambda () ((lambda quote (vector (quote __a__) 1 2)))) (lambda (type info) type)) 'unbound-variable) (test (catch #t (lambda () ((lambda* 'x (abs (quote __a__))))) (lambda (type info) type)) 'syntax-error) (test (catch #t (lambda () ((lambda* 'x (+ (quote __a__) 1)))) (lambda (type info) type)) 'syntax-error) (test (catch #t (lambda () ((lambda* 'x (+ 1 (quote __a__))))) (lambda (type info) type)) 'syntax-error) (test (catch #t (lambda () ((lambda* 'x (vector (quote __a__) 1 2)))) (lambda (type info) type)) 'syntax-error) ;(test (catch #t (lambda () (test (call-with-exit (lambda* (quote value) (let ((i 32)) (set! (setter 'i) integer?) (curlet)) 100)) 100) (let () (define (func) (call-with-exit (lambda* (quote value) (let ((i 32)) (set! (setter (quote i)) integer?) (curlet)) 100))) (func) (test (func) 32)) (test (cond (call-with-exit 32)) 32) ;; error from unrecognized float-vector-set! (define fvset float-vector-set!) (define undef #) (catch #t (lambda () (s7-optimize (list (catch #t (lambda () (with-input-from-string "(fvset undef 0 12345)" read)) (lambda args ()))))) (lambda arg 'error)) (define htset hash-table-set!) (let ((a1 (immutable! (hash-table 'a 1)))) (test (let () (define (func) (do ((i 0 (+ i 1))) ((= i 1)) (htset a1 'asdf 32))) (func)) 'error)) ;;; these 4 lines go together (define-expansion (_mem2_ . args) `(begin (format #f "~S~%" args) ((lambda (a b) ,@args) 1 3) ((lambda (a b) ,@args) 1 2) #f)) (let ((args #(1 2))) (define (func) (_mem2_ 1 2)) (define (hi) (func)) (hi)) (let ((args #(1 2))) (define (func) (_mem2_ 1 2)) (define (hi) (func)) (hi)) (let () (define-macro (mc0 x) `(cond ((= ,x 0) 0) (else 1))) (let ((else #f)) (test (mc0 1) #)) (define-macro (mc1 x) `(with-let (rootlet) (cond ((= ,x 0) 0) (else 1)))) (let ((else #f)) (test (mc1 1) 1)) (define-macro (mc2 x) `(with-let (unlet) (cond ((= ,x 0) 0) (else 1)))) (let ((else #f)) (test (mc2 1) 1)) (define-macro (mc3 x) `(with-let (inlet :y (+ y 1)) (cond ((= ,x 0) y) (else (+ y 1))))) (let ((else #f) (y 2)) (test (mc3 1) 4)) (define-macro (mc4 x) `(#_cond ((#_= ,x 0) 0) (#_else 1))) (let ((else #f)) (test (mc4 1) 1)) (test (let ((else 1)) #_else) :else) ; #t or :else = initial value, 'else = global_value (test (let-temporarily ((else #f)) (mc1 1)) #) ; we set the global slot (test (mc1 (let-temporarily ((else #f)) 1)) 1) (test (let-temporarily ((else #f)) (mc4 1)) 1)) (let () (define (cwv p c) (c (p))) (cwv (lambda () #f) and) (define (g) (sort! (make-vector 3) cwv)) (test (g) 'error) (call-with-values (lambda () #f) and) (define (f) (sort! (make-hash-table) call-with-values)) (test (f) 'error)) (test (let () (define (f) (let ((apply cons)) (apply abs -1))) (f)) (cons abs -1)) (let () ; s7.html examples (define-macro (my-unless condition . body) `(with-let (inlet (unlet) :condition ,condition) ; here unlet protects body (format below) (if (not condition) (begin ,@body)))) (let ((not (lambda (x) x)) (begin 32) (format abs)) (test (my-unless #t (format #f "oops")) #) (test (my-unless #f (format #f "ok")) "ok")) (let ((format abs)) (let ((not (lambda (x) x))) (test (my-unless #t (format #f "oops")) #) (test (my-unless #f (format #f "ok")) "ok"))) (define my-unless-2 (let ((op1 (lambda (x) (not x)))) (define-macro (_ condition . body) `(with-let (inlet (unlet) (funclet my-unless-2) :condition ,condition) ; funclet to get my-unless-2's version of op1 (if (op1 condition) (begin ,@body)))))) (let ((op1 (lambda (x) x))) (test (my-unless-2 #t (format #f "oops")) #) (test (my-unless-2 #f (format #f "ok")) "ok")) (define my-unless-3 (let ((op1 (lambda (x) x))) (define-macro (_ condition . body) `(with-let (inlet (unlet) :condition ,condition :local-env (curlet)) ; curlet to get local version of op1 (if ((with-let local-env op1) condition) (begin ,@body)))))) (let ((op1 (lambda (x) (not x)))) (test (my-unless-3 #t (format #f "oops")) #) (test (my-unless-3 #f (format #f "ok")) "ok")) ) (test (map when (vector #f #t #f) (list 1 2 3)) '(# 2 #)) ;; (for-each with-let (list (inlet 'x 1) (inlet 'x 2)) (list '(display x) '(display x))): "12" ;;; various ways to define an 'or' macro ;;; too easy: ;;; (define-macro (or1 . args) `(#_or ,@args)) ;;; (define or2 #_or) #| ;;; Clinger and Wand, "Hygienic Macro Technology" say this is "a perfectly reliable or macro": (define-syntax or (syntax-rules () ((or) #false) ; #f ((or ?e) ?e) ((or ?e1 ?e2 ?e3 ...) ; ?e3 looks pointless to me (or even wrong -- what about the (or ?e1 ?e2) case?) (let ((temp ?e1)) (if temp temp (or ?e2 ?e3 ...)))))) ;;; but how is that better than: (define-macro (or3 . args) (and (not (null? args)) (let ((temp (gensym))) `(let ((,temp ,(car args))) (if ,temp ,temp (or3 ,@(cdr args))))))) ;;; they say they want "automatic translation", but define-syntax defines its own (very special and tricky) ;;; language, where words like "identifier" have a meaning that is not that of Scheme, and utter ;;; kludges like "...". I'm happier with code that is simply Scheme where I know what is happening ;;; as opposed to opaque renaming as in define-syntax where the developer of the syntax-* macros has ;;; to intuit what I want. What if the top-level value of abs is not the built-in value? What ;;; if a variable should be taken from a specific environment (i.e. it is not "free") that is not ;;; the top-level, the current, or the macro definition environment? But the whole approach of syntax-* macros ;;; strikes me as funny: the problem is names; we'll fix that by conjuring up more names! ;;; Even C has dynamic loading, and in Scheme it's the norm; there's no notion of a "whole program" ;;; so how can they guarantee their conjured-up names won't become ambiguous? Rather than going back to ;;; the start, they decided to include time-stamps ("wraps"?) and (I think) syntax-objects (I'm going by the ;;; article mentioned above), and more kludges like a list of "identifiers", and datum->syntax; their "automatic translation" ;;; is leaking at every pore. To fix the original ambiguity, don't invent some write-only, ;;; intricate, special language; fix the ambiguity! That is, either place the values (not ;;; the names) in the code tree, or include the environment (as a value, if necessary) and specify ;;; the variable name within that environment as a normal symbol. See below for examples. ;;; The macros below are inspired by the "or" and "loop" macros in the article mentioned, and ;;; other random examples (the "local" and "global" example, etc). ;;; currently s7 guarantees that the symbol returned by gensym is unique, but doesn't check for a subsequent ;;; explicit use of that symbol, even one that adds it to some other environment (thus making it ambiguous). ;;; The idea of gensym is that the user agrees not to deliberately use its style of names, so maybe this ;;; is not problematic -- at least the renaming is explicit. |# (let ((or7 (macro args (and (not (null? args)) (let ((temp (gensym))) `(let ((,temp ,(car args))) (if ,temp ,temp (or7 ,@(cdr args)))))))) (or7-rd (macro (val) (let ((temp (gensym))) `(let ((,temp ,val)) (or7 (< ,temp 0) (> ,temp 100))))))) (test (or7) #f) (test (or7 (or7-rd 1)) #f) (test (or7 (or7-rd -1)) #t) (test (or7 (or7-rd 1) (or7-rd -1)) #t) (test (or7 (or7-rd -1) (or7-rd 1)) #t)) (let ((or6 32)) (let* ((e #f) (or6 (macro args (and (not (null? args)) (let ((temp (gensym))) `(#_let ((,temp ,(car args))) (if ,temp ,temp ((,e 'or6) ,@(cdr args)))))))) ; or6 not defined yet, so use let-ref (or6-rd (macro (val) (let ((temp (gensym))) `(#_let ((,temp ,val)) (,or6 (< ,temp 0) (> ,temp 100))))))) ;here or6 is defined so we can use "," directly (set! e (curlet)) (let ((e 12)) (test (or6 (or6-rd -1) (or6-rd 1)) #t)) ;; (let (({gensym}-18 (or6-rd -1))) (if {gensym}-18 {gensym}-18 ((#1=(inlet 'or6-rd #) 'or6) (or6-rd 1)))) (let ((or6 32) (let 1)) (test ((e 'or6)) #f) (test ((e 'or6) (or6-rd 1)) #f) (test ((e 'or6) (or6-rd -1)) #t) (test ((e 'or6) (or6-rd 1) (or6-rd -1)) #t) (test ((e 'or6) (or6-rd -1) (or6-rd 1)) #t)))) (let () (define-macro (or4 . args) (let ((e (#_curlet))) (#_and (#_not (#_null? args)) (#_let ((or4 (#_gensym))) ; local or4 `(#_let ((,or4 ,(#_car args))) (#_if ,or4 ,or4 ((,e 'or4) ,@(#_cdr args)))))))) (define-macro (or4-rd val) (let ((temp (gensym))) `(let ((,temp ,val) (car 1) (cdr 2) (let 3) (and 4) (e 5)) (or4 (< ,temp 0) (> ,temp 100))))) (test (or4) #f) (test (or4 (or4-rd 1)) #f) (test (or4 (or4-rd 1) (or4-rd -1)) #t) (test (or4 (or4-rd -1) (or4-rd 1)) #t)) (let ((or8 32)) (let ((for8 (let* ((e #f) (or8 (macro args (and (not (null? args)) (let ((temp (gensym))) `(let ((,temp ,(car args))) (if ,temp ,temp ((,e 'or8) ,@(cdr args))))))))) (set! e (curlet)) (let ((or8 12)) (lambda (val) ((e 'or8) (< val 0) (> val 100))))))) (let ((or8 12)) (test (for8 1) #f) (test (for8 -1) #t)))) (let ((free-var #f)) (define-macro (mac1 val) `(or ,val free-var)) (test (mac1 #f) #f) (let ((free-var #t)) (test (mac1 #f) #t))) (let () ; while loop with exit and continue (from stuff.scm) (define-macro (while test . body) (let ((loop (gensym))) `(#_call-with-exit (#_lambda (exit) (#_let ,loop () (#_call-with-exit (#_lambda (continue) (#_do () ((#_not ,test) (exit)) ,@body))) (,loop)))))) (let ((i 0) (j 0) (loop 3)) (while (< i 5) (set! i (+ i 1)) (when (> i 3) (exit)) (when (= i 2) (continue)) (set! loop 32) (let ((k 0)) (while (< k 5) (set! k (+ k 1)) (when (> k 3) (exit)) (when (= k 2) (continue)) (set! j (+ j 1))))) (test (list i j loop) '(4 4 32)) )) (let () ; or maybe easier to read -- use (with-let (unlet) to get rid of the #_'s (define-macro (while test . body) (with-let (sublet (unlet) :test test :body body) (let ((loop (gensym))) `(call-with-exit (lambda (exit) (let ,loop () (call-with-exit (lambda (continue) (do () ((not ,test) (exit)) ,@body))) (,loop))))))) (let ((i 0) (j 0) (loop 3)) (while (< i 5) (set! i (+ i 1)) (when (> i 3) (exit)) (when (= i 2) (continue)) (set! loop 32) (let ((k 0)) (while (< k 5) (set! k (+ k 1)) (when (> k 3) (exit)) (when (= k 2) (continue)) (set! j (+ j 1))))) (test (list i j loop) '(4 4 32)) )) (let ((global 100)) (define-macro (tst x y) (let ((local (gensym))) `(let ((,local ,x)) ; arg 'x (+ ,global ,y ,local)))) ; definition-time 'global, arg 'y, local 'local (let ((local 10) (global 1000) (x 10000)) (test (+ x (tst 1 local)) 10111))) (let ((mac (macro x `(+ ,@x 4)))) (test (macroexpand (mac 1 2 3)) '(+ 1 2 3 4)) (let ((list-values 'oops) (apply-values 32) (quote 12)) (test (object->string (procedure-source mac)) "(macro x (#_list-values '+ (#_apply-values x) 4))") (test (mac 1 2 3) 10))) ;; (curlet) is (rootlet) here (immutable! 'abs) (test (immutable? 'abs) #t) (test (with-let (rootlet) (immutable? 'abs)) #t) (test (set! abs 3) 'error) (test (with-let (rootlet) (define (abs x) 1)) 'error) ; here and below this check is confused by the test macro's local let (test (with-let (rootlet) (define-macro (abs x) 1)) 'error) (test (copy (inlet 'abs (lambda (x) 1)) (rootlet)) 'error) ; abs set immutable above (test (with-let (rootlet) (define abs (lambda (x) 1))) 'error) (test (with-let-(rootlet) (apply define (list 'abs 1))) 'error) (test (cutlet (rootlet) 'abs) 'error) (test (set! ((unlet) 'abs) 2) 'error) ;; optimize_expression ca 75594 hop = 0 choice via direct_memq(car_expr, e)! (test (let () (define (func) (define + *) (#_aritable? (map (lambda (x) (vector->list x)) (list #(1 2))) ((lambda (a) (+ a 1)) 1))) (func)) #t) (test (let () (define (func) (define + *) (#_aritable? (map vector->list (list #(1 2))) ((lambda (a) (+ a 1)) 1))) (func)) #t) (unless with-bignums (test (let () (define (func) (define + -) (log (+ (cos (gcd))))) (func)) (complex 0.0 pi))) ; (gcd):0, (cos 0): 1, (- 1): -1, (log -1): 0+3.14...i (test (let () (define + *) (with-let (unlet) (+ (openlet (unlet)) 2))) 'error) (test (let () (define (func) (let ((i 0)) (define + *) (quotient 10001 (+ i 1)))) (func)) 'error) ; division by zero, func 2 args op_safe_c_c_opscq (test (let () (define (func) (let ((i 0)) (define + *) (remainder (+ i 1) 101))) (func)) 0) (test (varlet (rootlet) 'abs 1) 'error) (test (let-set! (rootlet) 'abs 3) 'error) (test (set! (with-let (rootlet) abs) 3) 'error) (test (cutlet (rootlet) 'abs) 'error) (test (cutlet (rootlet) 'cosh) (rootlet)) (test ((rootlet) 'cosh) #) (define cosh #_cosh) (when full-s7test (let ((port (open-input-string (format #f "~W" (let->list (rootlet)))))) (let ((res (read port))) (close-input-port port) res))) ;read-error if string trouble #| ;;; built-in C functions have an aggressive take ;;; on "lexical scope": if gcd appears as the car of an expression in a function, and ;;; at that point in the overall s7 process gcd has not been redefined, then the function ;;; can embed the actual gcd function in that part of its source (as if it was (#_gcd ...)). ;;; Hence a subsequent (set! gcd +) has no effect on any call that lexically (textually) ;;; preceded that set!. This is different from the handling of scheme-defined functions ;;; where (define (a) 0) (define (b) (a)) (define (c) 1) (set! a c) (b) -> 1. ;;; The decision as to when to replace the 'gcd with the gcd function is up to the optimizer, so ;;; consistency here is considered of no importance compared to speed -- either don't (set! gcd +) ;;; or do it before using gcd in any way. (test (let () (define (gset-test) (let-temporarily ((gcd +)) (do ((sum 0) (x 12) (y 4) (i 0 (+ i 1))) ((= i 3) sum) (set! sum (+ sum (gcd x y))) (set! gcd +)))) (define (gset-test-1) (gset-test)) (gset-test-1)) 36 or 12 -- who knows) (let () (define %gcd gcd) (define (gset-test-x) (let ((sum 0) (x 12) (y 4)) (do ((i 0 (+ i 1))) ((= i 3) sum) (set! sum (+ sum (%gcd x y)))))) (define (gset-test-1x) (gset-test-x)) (define (gset-test-a) (let ((sum 0) (x 12) (y 4)) (do ((i 0 (+ i 1))) ((= i 3) sum) (set! sum (+ sum (gcd x y)))))) (define (gset-test-1a) (gset-test-a)) (define (gset-test-b) (let ((sum 0) (x 12) (y 4)) (do ((i 0 (+ i 1))) ((= i 3) sum) (set! sum (+ sum (gcd x y))) (set! gcd +)))) (define (gset-test-1b) (gset-test-b)) (define (gset-test-c) (let ((sum 0) (x 12) (y 4)) (do ((i 0 (+ i 1))) ((= i 3) sum) (set! sum (+ sum (gcd x y)))))) (define (gset-test-1c) (gset-test-c)) (let* ((x (gset-test-1x)) (a (gset-test-1a)) (b (gset-test-1b)) (c (gset-test-1c)) (a (gset-test-1a))) (set! %gcd +) (let ((xx (gset-test-1x))) (display (list x a b c a xx)) (newline)))) ;;; s7: 12 12 12 12 12 12 12 ;;; guile: 12 12 36 48 48 12 48 |# ;;; -------------------------------------------------------------------------------- (when full-s7test (set! + #_+) ; could be - in some cases when we get here ;; here's a reasonably complete test of part of the 'or handling (let ((ops #(not = null? eof-object? boolean? eq? eqv? equal? memq memv member char=? string=? char-ci=? string-ci=? zero?)) (op-args #(2 3 2 2 2 3 3 3 3 3 3 3 3 3 3 2)) (xvals #(0 10000 1.0 10000.0 1+i 1/2 #\a #\A "a" "A" "" #() #(#f) # () #f #t a b (1 10000))) (yvals #(0 10000 1.0 10000.0 1+i 1/2 #\a #\A "a" "A" "" #() #(#f) # () #f #t a b (1 10000))) ;; val list must be repeated else we'll get bogus eq? -> #t hits (val-quoted #(#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #t #t #t))) (for-each (lambda (t1 t1-args) (for-each (lambda (t2 t2-args) (for-each (lambda (x) (for-each (lambda (y q) (catch #t (lambda () (let ((f1 (if (= t1-args 2) `(,t1 x) (if q `(,t1 x ',y) `(,t1 x ,y)))) (f2 (if (= t2-args 2) `(,t2 x) (if q `(,t2 x ',y) `(,t2 x ,y)))) (x1 (if q `(x ',x) `(x ,x)))) (let ((result (eval `(let (,x1) (or ,f1 ,f2))))) ; check for errors in basic expr (let ((val (call-with-output-string (lambda (op) (call-with-input-string (format #f "(let (~S) (or ~S ~S))" x1 f1 f2) (lambda (ip) (lint ip op))))))) (when (positive? (length val)) (let ((pos (and (not (string-position "let: " val)) ; ignore various eqx problems that lint will report (string-position " -> " val)))) (when pos (let ((form (with-input-from-string (substring val (+ pos 3)) read))) (let ((new-val (eval form))) (when (not (eq? (not result) (not new-val))) (format *stderr* "(let (~S) (or ~S ~S)) -> ~S~% ~A -> ~S~%" x1 f1 f2 result (substring val (+ pos 3)) new-val))))))))))) (lambda (type info) 'error))) yvals val-quoted)) xvals)) ops op-args)) ops op-args))) (unless (defined? 'aux-counter) ;; these confuse t101.scm test suite do loops using + (let ((old+ +)) (define (f x) (with-let (unlet) (+ x 1))) (set! + -) (test (+ 1 1) 0) (test (f 1) 2) (set! + old+)) (let ((old+ +)) (let ((f #f)) (let ((+ *)) (set! f (lambda (a) (+ 1 a)))) (test (f 2) 2) (set! + *) (test (f 2) 2) (set! + old+))) ;(display integer?) (newline) (display (eq? integer? #_integer?)) (newline) ; integer? #t ) #| (define (mu) ; infinite loop if bignums (let* ((x 1) (xp (+ x 1))) (do () ((<= xp 1) (list (* 2 x) (* 2.0 x))) (set! x (/ x 2)) (set! xp (+ x 1))))) ; (1/1152921504606846976 8.673617379884e-19) smallest positive normalized fp 2-1022 = 2.225 10-308 largest normalized fp 2+1023 (2 - 2-52) 2+1024 - 2+971 = 1.798 10+308 smallest positive denormal 2-1023 2-52 2-1075 = 2.470 10-324 largest denormal 2-1023 (1 - 2-52) 2-1023 - 2-1075 = 1.113 10-308 largest fp integer 2+1024 - 2+971 = 1.798 10+308 gap from largest fp integer to previous fp integer 2+971 = 1.996 10+292 largest fp integer with a predecessor 2+53 - 1 = 9,007,199,254,740,991 #x7ff0000000000000 +inf #xfff0000000000000 -inf #x7ff8000000000000 nan #xfff8000000000000 -nan ;; this works but has the same results as (let () (load "s7test.scm" (curlet))) ;; some minor (*function* (curlet)) mis-assumption at 27547 (let () (call-with-input-file "s7test.scm" (lambda (p) (do ((form (read p) (read p))) ((eq? form #)) (eval form))))) (when full-s7test (for-each (lambda (s) (if (and (setter s) (not (char=? #\* ((symbol->string s) 0)))) (format *stderr* "~A " s))) (symbol-table)) (for-each (lambda (s) (if (and (procedure? (symbol->value s)) (let ((p (signature (symbol->value s)))) (and (pair? p) (pair? (car p)) (memq 'boolean? (car p))))) (format *stderr* "~A " s))) (symbol-table)) (for-each (lambda (s) (if (and (dilambda? (symbol->value s)) (defined? (symbol "*" (symbol->string s) "*"))) (format *stderr* "~A " s))) (symbol-table)) (let ((vars (make-vector 32 0))) (for-each (lambda (s) (let ((len (min (length (symbol->string s)) 31))) (set! (vars len) (+ (vars len) 1)))) (symbol-table)) (do ((i 0 (+ i 1))) ((= i 32)) (format *stderr* "~D: ~D~%" i (vars i)))) (let ((st (symbol-table))) (for-each (lambda (s) (if (and (keyword? s) (not (eq? s (symbol->value s)))) (format *stderr* "~S: ~S~%" s (symbol->value s)))) st)) |# (if (provided? 'debugging) (format #t "~%;all done! (debugging flag is on)~%") (format #t "~%;all done!~%")) ;(close-output-port error-port) (when (> (*s7* 'profile) 0) (set! (profile-port) *stderr*) (show-profile 200)) (when (provided? 'debugging) ;(define full-s7test #t) ; (let ((usage (*s7* 'memory-usage))) ; (display (usage :wrappers)) (newline) ; 27-Sep-24: 'strings 15834 'integers 4516 'reals 306865 'complexs 331432 'lets 8625 'slots 8625 'c_pointers 182 ; (display (usage :safe-lists)) (newline) ; (18 0 (152 252 1626 8083 1584 728 419 639 138 164 16 94 5 1 0 1 0 0 1 0 0 0 0 0 2 0 0 0 0 2 0)) ; ) (when full-s7test ; show memory usage (do ((x 0.0) (i 0 (+ i 1))) ((= i 256)) (set! x (complex i i))) ; clear temps (gc) (gc) (set! (current-output-port) *stdout*) (set! (*s7* 'safety) 1) ;; (display (*s7* 'memory-usage)) (newline) (pretty-print (*s7* 'memory-usage) *stderr*) (newline)) (when full-s7test ; analyze some type (35=input-string-port) (do ((x 0.0) (i 0 (+ i 1))) ((= i 256)) (set! x (complex i i))) ; clear temps (gc) (gc) (set! (current-output-port) *stdout*) (set! (*s7* 'safety) 1) (heap-analyze) (heap-scan 36))) ; 35=output port, 20-string, 34=c-pointer, 36=input port ;; finally make *features* circular (let ((old-features (copy *features*))) (set-cdr! *features* *features*) (provide 'xyz) (provided? 'xyz) (test (provided? 'xyz) #t) (set! *features* old-features)) (if s7test-exits (exit)) #| ;; here's a C program that checks that (exit) calls dynamic-wind "after" funcs and atexit C funcs: #include #include #include #include #include "s7.h" static void bye(void) {fprintf(stderr, "all done\n");} int main(void) { s7_scheme *sc = s7_init(); atexit(bye); s7_eval_c_string(sc, "(dynamic-wind \ (lambda () (display 'init) (newline)) \ (lambda () (display 'exit) (newline) (exit #t)) \ (lambda () (display 'quit) (newline)))"); } /* gcc -o exiter exit.c s7.o -Wl,-export-dynamic -lm -I. -ldl */ |#