Changeset 26606 in project


Ignore:
Timestamp:
04/29/12 21:30:06 (8 years ago)
Author:
sjamaan
Message:

numbers: Merge latest trunk changes into schemification branch

Location:
release/4/numbers/branches/schemification
Files:
10 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/numbers/branches/schemification

  • release/4/numbers/branches/schemification/numbers-c.h

    r24617 r26606  
    9393static bignum_type bignum_posneg_bitwise_op(int, bignum_type, bignum_type);
    9494static bignum_type bignum_negneg_bitwise_op(int, bignum_type, bignum_type);
    95 static void bignum_negate_magnitude(bignum_type arg);
     95static void bignum_negate_magnitude(bignum_type);
    9696
    9797#define BIGNUM_OUT_OF_BAND NULL
  • release/4/numbers/branches/schemification/numbers.scm

    r26182 r26606  
    3939       bitwise-and bitwise-ior bitwise-xor bitwise-not arithmetic-shift
    4040       equal? ; From scheme. Structural & bytevector comparisons Just Work
    41        exp log sin cos tan atan acos asin expt sqrt conj
     41       exp log sin cos tan atan acos asin conj
     42       expt sqrt exact-integer-sqrt exact-integer-nth-root
    4243       quotient modulo remainder quotient&modulo quotient&remainder
    4344       numerator denominator
     
    4950       floor ceiling truncate round
    5051       inexact->exact exact->inexact
    51        number? complex? real? rational? integer?
     52       number? complex? real? rational? integer? exact-integer?
    5253       make-rectangular make-polar real-part imag-part magnitude angle
    5354       bignum? ratnum? cflonum? rectnum? compnum? cintnum? cplxnum?
     
    139140(define (bad-ratnum loc x) (##sys#signal-hook #:type-error loc "bad argument type - not a rational number" x))
    140141(define (bad-integer loc x) (##sys#signal-hook #:type-error loc "bad argument type - not an integer" x))
     142(define (bad-natural loc x) (##sys#signal-hook #:type-error loc "bad argument type - must be an nonnegative integer" x))
    141143(define (bad-complex/o loc x) (##sys#signal-hook #:type-error loc "bad argument type - complex number has no ordering" x))
    142144(define (bad-base loc x) (##sys#signal-hook #:type-error loc "bad argument type - not a valid base" x))
    143145(define (bad-inexact loc x) (##sys#signal-hook #:type-error loc "bad argument type - inexact number has no exact representation" x))
    144 (define (bad-exact loc x) (##sys#signal-hook #:type-error loc "bad argument type - exact number cannot be represented by a flonum" x))
     146(define (bad-exact loc x) (##sys#signal-hook #:type-error loc "bad argument type - must be an exact number" x))
    145147(define (log0 loc x) (##sys#signal-hook #:arithmetic-error loc "log of exact 0 is undefined" x))
     148(define (expt0 loc x y) (##sys#signal-hook #:arithmetic-error loc "exponent of exact 0 with complex argument is undefined" x y))
    146149(define (div/0 loc x y) (##sys#signal-hook #:arithmetic-error loc "division by zero" x y))
    147150
     
    186189
    187190(define-inline (%flonum? x) (##core#inline "flonump" x))
    188 (define-inline (%flo-integer? x) (##core#inline "C_i_integerp" x))
     191(define-inline (%flo-integer? x) (##core#inline "C_u_i_fpintegerp" x))
    189192
    190193(define-inline (complex-real c) (##sys#slot c 1))
     
    624627    [RAT
    625628     (switchq (%check-number y)
    626        [RAT (rat+/- x y %+)]
     629       [RAT (rat+/- '+ %+ x y)]
    627630       [COMP (%comp+comp (%make-complex x 0) y)]
    628631       [NONE (bad-number '+ y)]
     
    695698    [RAT
    696699     (switchq (%check-number y)
    697        [RAT (rat+/- x y %-)]
    698        [COMP (%comp+comp (%make-complex x 0) y)]
     700       [RAT (rat+/- '- %- x y)]
     701       [COMP (%comp-comp (%make-complex x 0) y)]
    699702       [NONE (bad-number '- y)]
    700703       ;; a/b - c/d = (a*d - b*c)/(b*d)  [with d = 1]
     
    734737  ;; With   g = gcd(a, d)   and  a = x   [Knuth, 4.5.1]
    735738  (let* ((d (rat-denominator y))
    736          (g (%gcd-0 x d)))
    737     (ratnum (%* (%quotient x g) (rat-numerator y))
    738             (%quotient d g))))
     739         (g (%gcd-0 '* x d)))
     740    (ratnum (%* (%quotient '* x g) (rat-numerator y))
     741            (%quotient '* d g))))
    739742
    740743(define (%* x y)
     
    772775       [RAT (let* ((a (rat-numerator x)) (b (rat-denominator x))
    773776                   (c (rat-numerator y)) (d (rat-denominator y))
    774                    (g1 (%gcd-0 a d)) (g2 (%gcd-0 b c)))
    775               (ratnum (%* (%quotient a g1) (%quotient c g2))
    776                       (%* (%quotient b g2) (%quotient d g1))))]
     777                   (g1 (%gcd-0 '* a d)) (g2 (%gcd-0 '* b c)))
     778              (ratnum (%* (%quotient '* a g1) (%quotient '* c g2))
     779                      (%* (%quotient '* b g2) (%quotient '* d g1))))]
    777780       [COMP (%comp*comp (%make-complex x 0) y)]
    778781       ;; TODO: This can be incorrect when the ratnum consists of bignums
     
    809812  ;; With   g1 = gcd(a, c)   and   a = x  [Knuth, 4.5.1 ex. 4]
    810813  (let* ((c (rat-numerator y))
    811          (g (%gcd-0 x c)))
    812     (%/ (%* (%quotient x g) (rat-denominator y))
    813         (%quotient c g))))
     814         (g (%gcd-0 '/ x c)))
     815    (%/ (%* (%quotient '/ x g) (rat-denominator y))
     816        (%quotient '/ c g))))
    814817
    815818(define (%/ x y)
     
    820823              (ratnum (fx/ x g) (fx/ y g)))]
    821824       [FLO (fp/ (%fix->flo x) y)]
    822        [BIG (let ((g (%gcd-0 x y)))
    823               (ratnum (%quotient x g) (%quotient y g)))]
     825       [BIG (let ((g (%gcd-0 '/ x y)))
     826              (ratnum (%quotient '/ x g) (%quotient '/ y g)))]
    824827       [RAT (%nonrat/rat x y)]
    825828       [COMP (%comp/comp (%make-complex x 0) y)]
     
    836839    [BIG
    837840     (switchq (%check-number y)
    838        [FIX (let ((g (%gcd-0 x (fix-div/0 x y '/))))
    839               (ratnum (%quotient x g) (%quotient y g)))]
     841       [FIX (let ((g (%gcd-0 '/ x (fix-div/0 x y '/))))
     842              (ratnum (%quotient '/ x g) (%quotient '/ y g)))]
    840843       [FLO (fp/ (%big->flo x) y)]
    841        [BIG (let ((g (%gcd-0 x y)))
    842               (ratnum (%quotient x g) (%quotient y g)))]
     844       [BIG (let ((g (%gcd-0 '/ x y)))
     845              (ratnum (%quotient '/ x g) (%quotient '/ y g)))]
    843846       [RAT (%nonrat/rat x y)]
    844847       [COMP (%comp/comp (%make-complex x 0) y)]
     
    851854       [RAT (let* ((a (rat-numerator x)) (b (rat-denominator x))
    852855                   (c (rat-numerator y)) (d (rat-denominator y))
    853                    (g1 (%gcd-0 a c)) (g2 (%gcd-0 b d)))
    854               (%/ (%* (%quotient a g1) (%quotient d g2))
    855                   (%* (%quotient b g2) (%quotient c g1))))]
    856        [COMP (%comp-comp (%make-complex x 0) y)]
     856                   (g1 (%gcd-0 '/ a c)) (g2 (%gcd-0 '/ b d)))
     857              (%/ (%* (%quotient '/ a g1) (%quotient '/ d g2))
     858                  (%* (%quotient '/ b g2) (%quotient '/ c g1))))]
     859       [COMP (%comp/comp (%make-complex x 0) y)]
    857860       ;; TODO: This can be incorrect when the ratnum consists of bignums
    858861       [FLO (fp/ (%exact->inexact x) y)]
     
    862865       ;; With   g = gcd(a, c)   and  c = y  [Knuth, 4.5.1 ex. 4]
    863866       [else (let* ((a (rat-numerator x))
    864                     (g (%gcd-0 a y))) ;; TODO: Improve error message if /0
    865                (%/ (%quotient a g)
    866                    (%* (rat-denominator x) (%quotient y g))))] ) ]
     867                    (g (%gcd-0 '/ a y))) ;; TODO: Improve error message if /0
     868               (%/ (%quotient '/ a g)
     869                   (%* (rat-denominator x) (%quotient '/ y g))))] ) ]
    867870    [COMP
    868871     (switchq (%check-number y)
     
    890893     (switchq (%check-number y)
    891894       [FIX (fx= x y)]
    892        [FLO (fp= (%fix->flo x) y)]
     895       [FLO (and (finite? y)
     896                 (%= x (%flo->rat '= y)))] ; Compare as ratnums (overflow)
    893897       [BIG #f] ;; Needs bignum representation?  Can't be equal to a fixnum!
    894898       [RAT #f] ;; Rats are never x/1, because those are normalised to just x
     
    897901    [FLO
    898902     (switchq (%check-number y)
    899        [FIX (fp= x (%fix->flo y))]
     903       [FIX (and (finite? x)
     904                 (%= (%flo->rat '= x) y))] ; Compare as ratnums (overflow)
    900905       [FLO (fp= x y)]
    901906       [BIG (and (%flo-integer? x) (= (%flo->integer x) y))]
     
    972977     (switchq (%check-number y)
    973978       (FIX (fx> x y))
    974        (FLO (fp> (%fix->flo x) y))
     979       ;; Compare as ratnum, to prevent overflows
     980       (FLO (or (fp= y -inf)
     981                (and (not (fp= y +inf)) (fp= y y)
     982                     (%> x (%flo->rat loc y) loc))))
    975983       ;;   x neg?   y neg?   x > y?   reason
    976984       ;;  ---------------------------------------------------------------
     
    989997    (FLO
    990998     (switchq (%check-number y)
    991        (FIX (fp> x (%fix->flo y)))
    992999       (FLO (fp> x y))
    993        (BIG (or (fp= x +inf)
    994                 (and (not (fp= x -inf))
    995                      (%> (%flo->rat loc x) y loc)))) ; Compare as ratnums
    996        ;; a/b > c/d  when  a*d > b*c  [with b = 1]
    997        (RAT (%> (%* x (rat-denominator y))
    998                 (rat-numerator y) loc))
    9991000       (COMP (bad-complex/o loc y))
    1000        (else (bad-number loc y)) ) )
     1001       (NONE (bad-number loc y))
     1002       ;; Compare as ratnums, to avoid errors when overflowing
     1003       ;; (this can happen for bignums, but also for fixnums on 64-bit)
     1004       (else (or (fp= x +inf)
     1005                 (and (not (fp= x -inf)) (fp= x x)
     1006                      (%> (%flo->rat loc x) y loc)))) ) )
    10011007    (BIG
    10021008     (switchq (%check-number y)
     
    10111017       (FIX (not (%big-negative? x)))
    10121018       (FLO (or (fp= y -inf)
    1013                 (and (not (fp= y +inf))
     1019                (and (not (fp= y +inf)) (fp= y y)
    10141020                     (%> x (%flo->rat loc y) loc)))) ; Compare as ratnums
    10151021       (BIG (fx> (%big-comp-big x y) 0))
     
    10241030       (RAT (%> (%* (rat-numerator x) (rat-denominator y))
    10251031                (%* (rat-denominator x) (rat-numerator y)) loc))
     1032       (FLO (or (fp= y -inf)
     1033                (and (not (fp= y +inf)) (fp= y y)
     1034                     (%> x (%flo->rat loc y) loc)))) ; Compare as ratnums
    10261035       (COMP (bad-complex/o loc y))
    10271036       (NONE (bad-number loc y))
     
    10481057     (switchq (%check-number y)
    10491058       (FIX (fx< x y))
    1050        (FLO (fp< (%fix->flo x) y))
     1059       ;; Compare as ratnum, to prevent overflows
     1060       (FLO (or (fp= y +inf)
     1061                (and (not (fp= y -inf)) (fp= y y)
     1062                     (%< x (%flo->rat loc y) loc))))
    10511063       ;;   x neg?   y neg?   x < y?   reason
    10521064       ;;  ---------------------------------------------------------------
     
    10651077    (FLO
    10661078     (switchq (%check-number y)
    1067        (FIX (fp< x (%fix->flo y)))
    10681079       (FLO (fp< x y))
    1069        (BIG (or (fp= x -inf)
    1070                 (and (not (fp= x +inf))
    1071                      (%< (%flo->rat loc x) y loc)))) ; Compare as ratnums
    1072        ;; a/b < c/d  when  a*d < b*c  [with b = 1]
    1073        (RAT (%< (%* x (rat-denominator y))
    1074                 (rat-numerator y) loc))
    10751080       (COMP (bad-complex/o loc y))
    1076        (else (bad-number loc y)) ) )
     1081       (NONE (bad-number loc y))
     1082       ;; Compare as ratnums, to avoid errors when overflowing
     1083       ;; (this can happen for bignums, but also for fixnums on 64-bit)
     1084       (else (or (fp= x -inf)
     1085                (and (not (fp= x +inf)) (fp= x x)
     1086                     (%< (%flo->rat loc x) y loc))))) )
    10771087    (BIG
    10781088     (switchq (%check-number y)
     
    10871097       (FIX (%big-negative? x))
    10881098       (FLO (or (fp= y +inf)
    1089                 (and (not (fp= y -inf))
     1099                (and (not (fp= y -inf)) (fp= y y)
    10901100                     (%< x (%flo->rat loc y) loc)))) ; Compare as ratnums
    10911101       (BIG (fx< (%big-comp-big x y) 0))
     
    11011111                (%* (rat-denominator x) (rat-numerator y)) loc))
    11021112       (COMP (bad-complex/o loc y))
     1113       (FLO (or (fp= y +inf)
     1114                (and (not (fp= y -inf)) (fp= y y)
     1115                     (%< x (%flo->rat loc y) loc)))) ; Compare as ratnums
    11031116       (NONE (bad-number loc y))
    11041117       ;; a/b < c/d  when  a*d < b*c  [with d = 1]
     
    11171130         (or (null? xs)
    11181131             (let ([h (##sys#slot xs 0)])
    1119                (and (not (%< x h '>=))
     1132               (and (not (nan? h))
     1133                    (not (%< x h '>=))
    11201134                    (loop h (##sys#slot xs 1)) ) ) ) ) ) )
    11211135
     
    11261140         (or (null? xs)
    11271141             (let ([h (##sys#slot xs 0)])
    1128                (and (not (%> x h '<=))
     1142               (and (not (nan? h))
     1143                    (not (%> x h '<=))
    11291144                    (loop h (##sys#slot xs 1)) ) ) ) ) ) )
    11301145
     
    11681183(define (imag-part x)
    11691184  (switchq (%check-number x)
     1185    (NONE (bad-number 'imag-part x))
    11701186    (COMP (complex-imag x))
    1171     (NONE (bad-number 'imag-part x))
     1187    (FLO 0.0)
    11721188    (else 0) ) )
    11731189
    11741190(define (%magnitude x)
    11751191  (switchq (%check-number x)
    1176     (COMP (##core#inline_allocate
    1177            ("C_a_i_sqrt" 4)
    1178            (let ((r (complex-real x))
    1179                  (i (complex-imag x)) )
    1180              (%+ (%* r r) (%* i i)) ) ) )
     1192    (COMP (let ((r (complex-real x))
     1193                (i (complex-imag x)) )
     1194            (%sqrt 'magnitude (%+ (%* r r) (%* i i))) ) )
    11811195    (NONE (bad-number 'magnitude x))
    11821196    (else (%abs x)) ) )
     
    11861200(define (%angle x)
    11871201  (switchq (%check-number x)
    1188     (COMP (##core#inline_allocate ("C_a_i_atan2" 4) (complex-imag x) (complex-real x)))
    11891202    (NONE (bad-number 'angle x))
    1190     (else (##core#inline_allocate ("C_a_i_atan2" 4) 0 x)) ) )
     1203    (COMP (##core#inline_allocate ("C_a_i_atan2" 4)
     1204                                  (%exact->inexact (complex-imag x))
     1205                                  (%exact->inexact (complex-real x))))
     1206    (else (##core#inline_allocate ("C_a_i_atan2" 4) 0.0 (%exact->inexact x))) ) )
    11911207
    11921208(define angle %angle)
     
    12031219
    12041220;; Knuth, 4.5.1
    1205 (define (rat+/- x y op)
     1221(define (rat+/- loc op x y)
    12061222  (let ((a (rat-numerator x)) (b (rat-denominator x))
    12071223        (c (rat-numerator y)) (d (rat-denominator y)))
    1208     (let ((g1 (%gcd-0 b d)))
     1224    (let ((g1 (%gcd-0 loc b d)))
    12091225      (cond
    12101226       ((eq? g1 1) (%make-rat (op (%* a d) (%* b c)) (%* b d)))
     
    12121228       ;; to one of the denominators since quotient of b or d and g1 = 1
    12131229       ;; TODO: Check properties of the gcd to see if g2 and t are needed
    1214        ((%= g1 b) (let* ((t (op (%* a (%quotient d g1)) c))
    1215                          (g2 (%gcd-0 t g1)))
    1216                     (ratnum (%quotient t g2) (%quotient d g2))))
    1217        ((%= g1 d) (let* ((b/g1 (%quotient b g1))
     1230       ((%= g1 b) (let* ((t (op (%* a (%quotient loc d g1)) c))
     1231                         (g2 (%gcd-0 loc t g1)))
     1232                    (ratnum (%quotient loc t g2) (%quotient loc d g2))))
     1233       ((%= g1 d) (let* ((b/g1 (%quotient loc b g1))
    12181234                         (t (op a (%* c b/g1))) ;; Is this worth it?
    1219                          (g2 (%gcd-0 t g1)))
    1220                     (ratnum (%quotient t g2)
    1221                             (%* b/g1 (%quotient d g2)))))
    1222        (else (let* ((b/g1 (%quotient b g1))
    1223                     (t (op (%* a (%quotient d g1))
     1235                         (g2 (%gcd-0 loc t g1)))
     1236                    (ratnum (%quotient loc t g2)
     1237                            (%* b/g1 (%quotient loc d g2)))))
     1238       (else (let* ((b/g1 (%quotient loc b g1))
     1239                    (t (op (%* a (%quotient loc d g1))
    12241240                           (%* c b/g1)))
    1225                     (g2 (%gcd-0 t g1)))
    1226                (%make-rat (%quotient t g2)
    1227                           (%* b/g1 (%quotient d g2)))))))))
     1241                    (g2 (%gcd-0 loc t g1)))
     1242               (%make-rat (%quotient loc t g2)
     1243                          (%* b/g1 (%quotient loc d g2)))))))))
    12281244
    12291245(define (numerator x)
     
    12841300(set! ##sys#integer? %integer?)
    12851301(define integer? %integer?)
     1302
     1303(define (exact-integer? x)
     1304  (switchq (%check-number x)
     1305    (FIX #t)
     1306    (BIG #t)
     1307    (else #f) ) )
    12861308
    12871309(define (%exact? x)
     
    13531375            (loop (if (%< h m 'min) h m) (##sys#slot xs 1)) ) ) ) ) )
    13541376
    1355 (define (%quotient x y)
     1377(define (%quotient loc x y)
    13561378  (switchq (%check-number x)
    13571379    (FIX (switchq (%check-number y)
     
    13591381           ;; But take care of MOST_NEGATIVE_FIXNUM (grrr!)
    13601382           (BIG (if (bignum? (- x)) -1 0))
    1361            (RAT (bad-integer 'quotient y)) ; Perhaps convert to flonum?
    1362            (NONE (bad-number 'quotient y))
     1383           (RAT (bad-integer loc y)) ; Perhaps convert to flonum?
     1384           (NONE (bad-number loc y))
    13631385           (else (%quotient-0 x y))))
    13641386    (BIG (switchq (%check-number y)
    1365            (FIX (%big-quotient-fix x (fix-div/0 x y 'quotient)))
     1387           (FIX (%big-quotient-fix x (fix-div/0 x y loc)))
    13661388           (BIG (%big-quotient-big x y))
    13671389           (FLO (if (not (%flo-integer? y))
    13681390                    (%quotient-0 (%big->flo x) y) ; Could overflow
    13691391                    (%exact->inexact
    1370                      (%quotient x (%flo->integer y)))))
    1371            (NONE (bad-number 'quotient y))
    1372            (else (bad-integer 'quotient y))))
     1392                     (%quotient loc x (%flo->integer y)))))
     1393           (NONE (bad-number loc y))
     1394           (else (bad-integer loc y))))
    13731395    (FLO (switchq (%check-number y)
    13741396           (BIG (if (%flo-integer? x)
    1375                     (%exact->inexact (%quotient (%flo->integer x) y))
     1397                    (%exact->inexact (%quotient loc (%flo->integer x) y))
    13761398                    (%quotient-0 x (%big->flo y)))) ; Will probably overflow
    1377            (RAT (bad-integer 'quotient y))
    1378            (NONE (bad-number 'quotient y))
     1399           (RAT (bad-integer loc y))
     1400           (NONE (bad-number loc y))
    13791401           (else (%quotient-0 x y))))
    1380     (NONE (bad-number 'quotient x))
    1381     (else (bad-integer 'quotient x))))
    1382 
    1383 (define quotient %quotient)
    1384 
    1385 (define (%remainder x y)
     1402    (NONE (bad-number loc x))
     1403    (else (bad-integer loc x))))
     1404
     1405(define (quotient x y) (%quotient 'quotient x y))
     1406
     1407(define (%remainder loc x y)
    13861408  (switchq (%check-number x)
    13871409    [FIX (switchq (%check-number y)
    13881410           [FIX (fx- x (fx* (fx/ x y) y))]
    13891411           [FLO (let ((flx (%fix->flo x)))
    1390                   (fp- flx (fp* (##sys#truncate (fp/ flx y)) y)))]
     1412                  (if (%flo-integer? y)
     1413                      (fp- flx (fp* (##sys#truncate (fp/ flx y)) y))
     1414                      (bad-integer loc y)))]
    13911415           ;; If abs(x) < abs(y), then remainder is always just x
    13921416           ;; But again, take care of MOST_NEGATIVE_FIXNUM
    13931417           [BIG (if (bignum? (- x)) 0 x)]
    1394            [else (bad-integer 'remainder y)])]
    1395     [FLO (switchq (%check-number y)
    1396            [FLO (fp- x (fp* (##sys#truncate (fp/ x y)) y))]
    1397            [FIX (let ((fly (%fix->flo (fix-div/0 x y 'remainder))))
     1418           [else (bad-integer loc y)])]
     1419    [FLO (unless (%flo-integer? x)
     1420           (bad-integer loc x))
     1421         (switchq (%check-number y)
     1422           [FLO (if (%flo-integer? y)
     1423                    (fp- x (fp* (##sys#truncate (fp/ x y)) y))
     1424                    (bad-integer loc y))]
     1425           [FIX (let ((fly (%fix->flo (fix-div/0 x y loc))))
    13981426                  (fp- x (fp* (##sys#truncate (fp/ x fly)) fly)))]
    1399            [BIG (if (%flo-integer? x)
    1400                     (%exact->inexact (%remainder (%flo->integer x) y))
    1401                     (%remainder x (%big->flo y)))] ; Could overflow
    1402            [else (bad-integer 'remainder y)])]
     1427           [BIG (%exact->inexact (%remainder loc (%flo->integer x) y))]
     1428           [else (bad-integer loc y)])]
    14031429    [BIG (switchq (%check-number y)
    1404            [FIX (%big-remainder-fix x (fix-div/0 x y 'remainder))]
     1430           [FIX (%big-remainder-fix x (fix-div/0 x y loc))]
    14051431           [FLO (if (%flo-integer? y)
    1406                     (%exact->inexact (%remainder x (%flo->integer y)))
    1407                     (%remainder (%big->flo x) y))] ; Could overflow
     1432                    (%exact->inexact (%remainder loc x (%flo->integer y)))
     1433                    (bad-integer loc y))]
    14081434           [BIG (%big-remainder-big x y)]
    1409            [else (bad-integer 'remainder y)])]
    1410     [else (bad-integer 'remainder x)]) )
    1411 
    1412 (define remainder %remainder)
     1435           [else (bad-integer loc y)])]
     1436    [else (bad-integer loc x)]) )
     1437
     1438(define (remainder x y) (%remainder 'remainder x y))
    14131439
    14141440;; Modulo's sign follows y  (whereas remainder's sign follows x)
    14151441(define (modulo x y)
    1416    (let ((r (%remainder x y)))
     1442   (let ((r (%remainder 'modulo x y)))
    14171443      (if (%> y 0 'modulo)
    14181444          (if (%< r 0 'modulo)
     
    14261452  (switchq (%check-number x)
    14271453    [FIX (switchq (%check-number y)
    1428            [FIX (values (fx/ x y) (remainder x y))]
    1429            [FLO (values (quotient x y) (remainder x y))]
     1454           [FIX (values (fx/ x y) (%remainder 'quotient&remainder x y))]
     1455           [FLO (values (quotient x y) (%remainder 'quotient&remainder x y))]
    14301456           ;; If abs(x) < abs(y), then remainder is always just x
    14311457           ;; But again, take care of MOST_NEGATIVE_FIXNUM
     
    14331459           [else (bad-integer 'quotient&remainder y)])]
    14341460    [FLO (switchq (%check-number y)
    1435            [FLO (values (quotient x y) (remainder x y))]
    1436            [FIX (values (quotient x y) (remainder x y))]
     1461           [FLO (values (%quotient 'quotient&remainder x y)
     1462                        (%remainder 'quotient&remainder x y))]
     1463           [FIX (values (%quotient 'quotient&remainder x y)
     1464                        (%remainder 'quotient&remainder x y))]
    14371465           [BIG (if (%flo-integer? x)
    14381466                    (receive (div rem)
    14391467                      (quotient&remainder (%flo->integer x) y)
    14401468                      (values (%exact->inexact div) (%exact->inexact rem)))
    1441                     (quotient&remainder x (%big->flo y)))] ; Probably overflows
     1469                    (bad-integer 'quotient&remainder x))]
    14421470           [else (bad-integer 'quotient&remainder y)])]
    14431471    [BIG (switchq (%check-number y)
    1444            [FIX (%big-divrem-fix x (fix-div/0 x y 'remainder))]
     1472           [FIX (%big-divrem-fix x (fix-div/0 x y 'quotient&remainder))]
    14451473           [FLO (if (%flo-integer? y)
    14461474                    (receive (div rem)
    14471475                      (quotient&remainder x (%flo->integer y))
    14481476                      (values (%exact->inexact div) (%exact->inexact rem)))
    1449                     (quotient&remainder (%big->flo x) y))] ; Probably overflows
     1477                    (bad-integer 'quotient&remainder y))]
    14501478           [BIG (%big-divrem-big x y)]
    14511479           [else (bad-integer 'quotient&remainder y)])]
     
    15611589(define ##sys#exact->inexact %exact->inexact)
    15621590
    1563 (define (%gcd-0 x y)
     1591(define (%gcd-0 loc x y)
    15641592  (switchq (%check-number x)
    15651593    [FIX (switchq (%check-number y)
     
    15671595           [FLO (if (%flo-integer? y)
    15681596                    (fpgcd (%fix->flo x) y)
    1569                     (bad-integer 'gcd y))]
    1570            [BIG (if (eq? x 0) y (fxgcd x (%remainder y x)))]
    1571            [else (bad-integer 'gcd y)])]
     1597                    (bad-integer loc y))]
     1598           [BIG (if (eq? x 0) y (fxgcd x (%remainder loc y x)))]
     1599           [else (bad-integer loc y)])]
    15721600    [FLO (switchq (%check-number y)
    15731601           [FIX (if (%flo-integer? x)
    15741602                    (fpgcd x (%fix->flo y))
    1575                     (bad-integer 'gcd x))]
     1603                    (bad-integer loc x))]
    15761604           [FLO (if (%flo-integer? x)
    15771605                    (if (%flo-integer? y)
    1578                         (fpgcd x (%fix->flo y))
    1579                         (bad-integer 'gcd x))
    1580                     (bad-integer 'gcd x))]
    1581            [BIG (if (fp= x 0.0) y (fpgcd x (%remainder y x)))]
    1582            [else (bad-integer 'gcd y)])]
     1606                        (fpgcd x y)
     1607                        (bad-integer loc x))
     1608                    (bad-integer loc x))]
     1609           [BIG (if (fp= x 0.0) y (fpgcd x (%remainder loc y x)))]
     1610           [else (bad-integer loc y)])]
    15831611    [BIG (switchq (%check-number y)
    1584            [FIX (if (eq? y 0) x (fxgcd y (%remainder x y)))]
    1585            [FLO (if (fp= y 0.0) x (fpgcd y (%remainder x y)))]
     1612           [FIX (if (eq? y 0) x (fxgcd y (%remainder loc x y)))]
     1613           [FLO (if (fp= y 0.0) x (fpgcd y (%remainder loc x y)))]
    15861614           [BIG (biggcd x y)]
    1587            [else (bad-integer 'gcd y)])]
    1588     [else (bad-integer 'gcd x)]) )
     1615           [else (bad-integer loc y)])]
     1616    [else (bad-integer loc x)]) )
    15891617
    15901618(define (gcd . ns)
     
    15951623              [next (##sys#slot ns 1)] )
    15961624          (if (null? next)
    1597               (%abs head)
     1625              (if f (%abs (%->integer 'gcd head)) (%abs head))
    15981626              (let ([n2 (##sys#slot next 0)])
    1599                 (loop (cons (%gcd-0 head n2) (##sys#slot next 1)) #f) ) ) ) ) ) )
    1600 
    1601 (define (%lcm-0 x y)
    1602   (%quotient (%* x y) (%gcd-0 x y)) )
     1627                (loop (cons (%gcd-0 'gcd head n2) (##sys#slot next 1)) #f) ) ) ) ) ) )
     1628
     1629(define (%lcm-0 loc x y)
     1630  (%quotient loc (%* x y) (%gcd-0 loc x y)) )
    16031631
    16041632(define (lcm . ns)
     
    16091637              [next (##sys#slot ns 1)] )
    16101638          (if (null? next)
    1611               (%abs head)
     1639              (if f (%abs (%->integer 'lcm head)) (%abs head))
    16121640              (let ([n2 (##sys#slot next 0)])
    1613                 (loop (cons (%lcm-0 head (##sys#slot next 0)) (##sys#slot next 1)) #f) ) ) ) ) ) )
     1641                (loop (cons (%lcm-0 'lcm head (##sys#slot next 0)) (##sys#slot next 1)) #f) ) ) ) ) ) )
    16141642
    16151643(define (%floor x)
     
    16471675    (BIG x)
    16481676    ;; (rational-truncate x) = integer of largest magnitude <= (abs x)
    1649     (RAT (%quotient (rat-numerator x) (rat-denominator x)))
     1677    (RAT (%quotient 'truncate (rat-numerator x) (rat-denominator x)))
    16501678    (else (bad-real 'truncate x))) )
    16511679
     
    16851713(define (find-ratio x e) (find-ratio-between (%- x e) (%+ x e)))
    16861714
    1687 (define (rationalize x e) (apply %/ (find-ratio x e))) ; doesn't preserve exactness
     1715(define (rationalize x e)
     1716  (let ((result (apply %/ (find-ratio x e))))
     1717    (if (or (inexact? x) (inexact? e))
     1718        (exact->inexact result)
     1719        result)))
    16881720
    16891721(define (%exp n)
     
    17081740      (log0 'log x))
    17091741     ((eq? type NONE)
    1710       (bad-number 'exp x))
     1742      (bad-number 'log x))
    17111743     (else                             ; Simple real number case
    17121744      (##core#inline_allocate ("C_a_i_log" 4) (%exact->inexact x))))))
     
    17421774    (else (##core#inline_allocate ("C_a_i_tan" 4) (%exact->inexact n)) ) ))
    17431775
     1776;; General case: sin^{-1}(z) = -i\ln(iz + \sqrt{1-z^2})
    17441777(define (%asin n)
    1745   (switchq (%check-number n)
    1746     (NONE (bad-number 'asin n))
    1747     (COMP (%* %-i (%log (%+ (%* %i n) (%sqrt (%- 1 (%* n n)))))))
    1748     (else (##core#inline_allocate ("C_a_i_asin" 4) (%exact->inexact n)) ) ))
     1778  (let ((t (%check-number n)))
     1779    (cond ((eq? t NONE) (bad-number 'asin n))
     1780          ((and (eq? t FLO) (fp>= n -1.0) (fp<= n 1.0))
     1781           (##core#inline_allocate ("C_a_i_asin" 4) n))
     1782          ((and (eq? t FIX) (fx>= n -1) (fx<= n 1))
     1783           (##core#inline_allocate ("C_a_i_asin" 4) (%fix->flo n)))
     1784          ;; General definition can return compnums
     1785          (else (%* %-i (%log (%+ (%* %i n) (%sqrt 'asin (%- 1 (%* n n))))))))))
    17491786
    17501787(define asin %asin)
    17511788
    1752 (define acos
     1789;; General case:
     1790;; cos^{-1}(z) = 1/2\pi + i\ln(iz + \sqrt{1-z^2}) = 1/2\pi - sin^{-1}(z) = sin(1) - sin(z)
     1791(define %acos
    17531792  (let ((asin1 (##core#inline_allocate ("C_a_i_asin" 4) 1)))
    17541793    (lambda (n)
    1755       (switchq (%check-number n)
    1756         (NONE (bad-number 'acos n))
    1757         (COMP (%- asin1 (%asin n)))
    1758         (else (##core#inline_allocate ("C_a_i_acos" 4) (%exact->inexact n)) ) ) ) ) )
     1794      (let ((t (%check-number n)))
     1795        (cond ((eq? t NONE) (bad-number 'acos n))
     1796              ((and (eq? t FLO) (fp>= n -1.0) (fp<= n 1.0))
     1797               (##core#inline_allocate ("C_a_i_acos" 4) n))
     1798              ((and (eq? t FIX) (fx>= n -1) (fx<= n 1))
     1799               (##core#inline_allocate ("C_a_i_acos" 4) (%fix->flo n)))
     1800              ;; General definition can return compnums
     1801              (else (%- asin1 (%asin n)))) ) ) ) )
     1802
     1803(define acos %acos)
    17591804
    17601805(define (atan n #!optional b)
     
    17661811                (%/ (%- (%log (%+ 1 in)) (%log (%- 1 in))) %i2) ) ) )
    17671812    (else (if b
    1768               (##core#inline_allocate ("C_a_i_atan2" 4) (%exact->inexact n) b)
     1813              (##core#inline_allocate ("C_a_i_atan2" 4) (%exact->inexact n) (%exact->inexact b))
    17691814              (##core#inline_allocate ("C_a_i_atan" 4) (%exact->inexact n))))) )
    17701815
    1771 (define (%sqrt n)
     1816(define (%exact-integer-sqrt loc k)
     1817  (if (or (eq? 0 k) (eq? 1 k))
     1818      (values k 0)
     1819      ;; Hacker's Delight, figure 11-1 (Newton's method - see also SICP 1.1.7)
     1820      (let* ((len (integer-length k))
     1821             (g0 (arithmetic-shift 1 len)))
     1822        (let lp ((g0 g0)
     1823                 (g1 (arithmetic-shift
     1824                      (%+ g0 (arithmetic-shift k (fxneg len))) -1)))
     1825          (if (%< g1 g0 loc)
     1826              (lp g1 (arithmetic-shift (%+ g1 (quotient k g1)) -1))
     1827              (values g0 (%- k (%* g0 g0))))))))
     1828
     1829(define (exact-integer-sqrt x)
     1830  (switchq (%check-number x)
     1831    (NONE (bad-number 'exact-integer-sqrt x))
     1832    (FIX (if (fx< x 0)
     1833             (bad-natural 'exact-integer-sqrt x)
     1834             (%exact-integer-sqrt 'exact-integer-sqrt x)))
     1835    (BIG (if (%big-negative? x)
     1836             (bad-natural 'exact-integer-sqrt x)
     1837             (%exact-integer-sqrt 'exact-integer-sqrt x)))
     1838    (else (bad-natural 'exact-integer-sqrt x))))
     1839
     1840(define (%sqrt loc n)
    17721841  (switchq (%check-number n)
    17731842    (NONE (bad-number 'sqrt n))
     
    17751844                (m (##core#inline_allocate ("C_a_i_sqrt" 4) (%magnitude n))) )
    17761845            (make-complex (%* m (%cos p)) (%* m (%sin p)) ) ) )
     1846    (RAT (let ((num (rat-numerator n))
     1847               (den (rat-denominator n)))
     1848           (if (and (>= num 0) (>= den 0))
     1849               (receive (ns^2 nr)
     1850                 (%exact-integer-sqrt loc num)
     1851                 (if (eq? nr 0)
     1852                     (receive (ds^2 dr)
     1853                       (%exact-integer-sqrt loc den)
     1854                       (if (eq? dr 0)
     1855                           (%/ ns^2 ds^2)
     1856                           (%sqrt loc (%exact->inexact n))))
     1857                     (%sqrt loc (%exact->inexact n))))
     1858               (%sqrt loc (%exact->inexact n)))))
    17771859    (else
    1778      (if (negative? n)
     1860     (cond
     1861      ((negative? n)
    17791862       (make-complex
    17801863        0.0
    1781         (##core#inline_allocate ("C_a_i_sqrt" 4) (%exact->inexact (- n))))
    1782        (##core#inline_allocate ("C_a_i_sqrt" 4) (%exact->inexact n)) ) )))
    1783 
    1784 (define sqrt %sqrt)
     1864        (##core#inline_allocate ("C_a_i_sqrt" 4) (%exact->inexact (- n)))))
     1865      ((integer? n)
     1866       (receive (s^2 r)
     1867         (%exact-integer-sqrt loc (%->integer loc n))
     1868         (if (eq? 0 r)
     1869             (if (exact? n) s^2 (%exact->inexact s^2))
     1870             (##core#inline_allocate ("C_a_i_sqrt" 4) (%exact->inexact n)))))
     1871      (else (##core#inline_allocate ("C_a_i_sqrt" 4) (%exact->inexact n))) ) )))
     1872
     1873(define (sqrt x) (%sqrt 'sqrt x))
    17851874
    17861875(define (square x) (%* x x))
     1876
     1877;; Generalized Newton's algorithm for positive integers, with a little help
     1878;; from Wikipedia ;)  https://en.wikipedia.org/wiki/Nth_root_algorithm
     1879(define (%exact-integer-nth-root loc k n)
     1880  (if (or (eq? 0 k) (eq? 1 k) (eq? 1 n))       ; Maybe call exact-integer-sqrt on n=2?
     1881      (values k 0)
     1882      (let ((len (integer-length k)))
     1883        (if (fx< len n)        ; Idea from Gambit: 2^{len-1} <= k < 2^{len}
     1884            (values 1 (- k 1)) ; Since we know x >= 2, we know x^{n} can't exist
     1885            (let ((g0 (arithmetic-shift 1 len))
     1886                  (n-1 (%- n 1)))
     1887              (let lp ((g0 g0)
     1888                       (g1 (%quotient loc (%+ (%* n-1 g0) (%quotient loc k (%integer-power g0 n-1))) n)))
     1889                (if (%< g1 g0 loc)
     1890                    (lp g1 (%quotient loc (%+ (%* n-1 g1) (%quotient loc k (%integer-power g1 n-1))) n))
     1891                    (values g0 (%- k (%integer-power g0 n))))))))))
     1892
     1893(define (exact-integer-nth-root k n)
     1894  (unless (exact-integer? n)
     1895    (bad-natural 'exact-integer-nth-root n))
     1896  (switchq (%check-number k)
     1897    (NONE (bad-number 'exact-integer-nth-root k))
     1898    (FIX (if (fx< k 0)
     1899             (bad-natural 'exact-integer-nth-root k)
     1900             (%exact-integer-nth-root 'exact-integer-nth-root k n)))
     1901    (BIG (if (%big-negative? k)
     1902             (bad-natural 'exact-integer-nth-root k)
     1903             (%exact-integer-nth-root 'exact-integer-nth-root k n)))
     1904    (else (bad-natural 'exact-integer-nth-root k))))
    17871905
    17881906(define (%integer-power base e)
     
    17981916
    17991917(define (expt a b)
    1800   (define (slow-expt a b) (%exp (%* b (%log a))))
     1918  (define (slow-expt a b)
     1919    (if (eq? 0 a)
     1920        (expt0 'expt a b)
     1921        (%exp (%* b (%log a)))))
    18011922  (let ((ta (%check-number a))
    18021923        (tb (%check-number b)) )
    18031924    (cond ((eq? NONE ta) (bad-number 'expt a))
    18041925          ((eq? NONE tb) (bad-number 'expt b))
    1805           ((eq? FLO ta)
    1806            (switchq tb
    1807              (FIX (%expt-0 a b))
    1808              (FLO (%expt-0 a b))
    1809              (BIG (%expt-0 a (%big->flo b)))
    1810              (RAT (%expt-0 a (%exact->inexact b)))
    1811              (else (slow-expt a b)) ) )
    1812           ((eq? FLO tb)
    1813            (switchq ta
    1814              (FIX (%expt-0 a b))
    1815              (FLO (%expt-0 a b))
    1816              (BIG (%expt-0 (%big->flo a) b))
    1817              (RAT (%expt-0 (%exact->inexact a) b))
    1818              (else (slow-expt a b)) ) )
    1819           ;; is there a better way
     1926          ((and (eq? RAT ta) (not (inexact? b)))
     1927           ;; (n*d)^b = n^b * d^b = n^b * x^{-b}  | x = 1/b
     1928           ;; Hopefully faster than integer-power
     1929           (%* (expt (rat-numerator a) b) (expt (rat-denominator a) (- b))))
     1930          ;; x^{a/b} = (x^{1/b})^a
    18201931          ((eq? RAT tb)
    1821            (let ((e (%exact->inexact b)))
    1822              (switchq ta
    1823                (FIX (%expt-0 a e))
    1824                (FLO (%expt-0 a e))
    1825                (BIG (%expt-0 (%big->flo a) e))
    1826                (RAT (%expt-0 (%exact->inexact a) e))
    1827                (else (slow-expt a b)))))
    1828           ((or (eq? COMP ta) (eq? COMP tb)) (slow-expt a b))
     1932           (switchq ta
     1933             (FIX (if (fx< a 0)
     1934                      (%expt-0 (%fix->flo a) (%rat->flo b))
     1935                      (receive (ds^n r)
     1936                        (%exact-integer-nth-root 'expt a (rat-denominator b))
     1937                        (if (eq? r 0)
     1938                            (expt ds^n (rat-numerator b))
     1939                            (%expt-0 (%fix->flo a) (%rat->flo b))))))
     1940             (BIG (if (%big-negative? a)
     1941                      (%expt-0 (%big->flo a) (%rat->flo b))
     1942                      (receive (ds^n r)
     1943                        (%exact-integer-nth-root 'expt a (rat-denominator b))
     1944                        (if (eq? r 0)
     1945                            (expt ds^n (rat-numerator b))
     1946                            (%expt-0 (%big->flo a) (%rat->flo b))))))
     1947             (FLO (%expt-0 a (%rat->flo b)))
     1948             (else (slow-expt a b))))
     1949          ((or (eq? COMP tb) (and (eq? COMP ta) (not (integer? b))))
     1950           (slow-expt a b))
     1951          ((or (eq? FLO ta) (and (eq? FLO tb) (not (%flo-integer? b))))
     1952           (%expt-0 (%exact->inexact a) (%exact->inexact b)))
    18291953          ;; this doesn't work that well, yet...
    1830           (else (%integer-power a b)) ) ) )
     1954          ;; (XXX: What does this mean? why not? I do know this is ugly... :P)
     1955          (else (if (or (inexact? a) (inexact? b))
     1956                    (%exact->inexact (%integer-power a b))
     1957                    (%integer-power a b))) ) ) )
    18311958
    18321959(define (conj n)
     
    19102037
    19112038(define (arithmetic-shift n m)
    1912   (let ((n (%->integer 'arithmetic-shift n))
    1913         (m (%->integer 'arithmetic-shift m)))
    1914     (if (bignum? m)
    1915         (##sys#signal-hook #:type-error 'arithmetic-shift
    1916                            "can not shift by bignum amounts" n m)
    1917         (%int-shift-fix n m))) )
     2039  (let ((n (%->integer 'arithmetic-shift n)))
     2040    (switchq (%check-number m)
     2041      (FIX (%int-shift-fix n m))
     2042      (BIG (##sys#signal-hook #:type-error 'arithmetic-shift
     2043                              "can not shift by bignum amounts" n m))
     2044      (else (bad-exact 'arithmetic-shift m)))) )
    19182045
    19192046(define %number->string
     
    19452072(define ##sys#number->string %number->string) ; for printer
    19462073
    1947 (define (%string->compnum radix str offset force-exact?)
     2074;; We try to prevent memory exhaustion attacks by limiting the
     2075;; maximum exponent value.
     2076;; TODO: Make this a parameter?  Would probably slow things down even more...
     2077(define-constant +maximum-allowed-exponent+ 10000)
     2078
     2079(define (%string->compnum radix str offset exactness)
     2080  (define (go-inexact!)
     2081    ;; Go inexact unless exact was requested (with #e prefix)
     2082    (unless (eq? exactness 'e) (set! exactness 'i)))
     2083  (define (safe-exponent value e)
     2084    (and e (if (not value)
     2085               0
     2086               (cond
     2087                 ((> e +maximum-allowed-exponent+)
     2088                  (and (eq? exactness 'i)
     2089                       (cond ((zero? value) 0.0)
     2090                             ((> value 0.0) +inf.0)
     2091                             (else -inf.0))))
     2092                 ((< e (- +maximum-allowed-exponent+))
     2093                  (and (eq? exactness 'i) +0.0))
     2094                 (else (%* value (expt 10 e)))))))
    19482095  (let* ((len (##sys#size str))
    19492096         (r..9 (integer->char (fx+ (char->integer #\0) radix)))
    19502097         (r..a (integer->char (fx+ (char->integer #\a) (fx- radix 10))))
    19512098         (r..A (integer->char (fx+ (char->integer #\A) (fx- radix 10))))
    1952          ;; Two ugly as hell flags which we unfortunately need.
     2099         ;; Ugly flag which we need (note that "exactness" is mutated too!)
    19532100         ;; Since there is (almost) no backtracking we can do this.
    1954          (inexact? #f)
    19552101         (seen-hashes? #f)
    19562102         ;; All these procedures return #f or an object consed onto an end
     
    19912137                         (num (%digits->number str start (car end) radix neg?)))
    19922138                (when hashes            ; Eeewww. Feeling dirty yet?
    1993                   (set! inexact? #t)
    1994                   (set! seen-hashes? #t))
     2139                  (set! seen-hashes? #t)
     2140                  (go-inexact!))
    19952141                (cons num (cdr end))))))
    19962142         (scan-exponent
     
    20012147                   (and-let* ((start (if sign (fx+ start 1) start))
    20022148                              (end (scan-digits start)))
    2003                      (set! inexact? #t)
     2149                     (go-inexact!)
    20042150                     (cons (%digits->number
    20052151                            str start (car end) radix (eq? sign 'neg))
     
    20182164                                      (ee (scan-exponent (fx+ next 1)))
    20192165                                      (e (car ee))
    2020                                       (n (%* (expt 10 e) (or decimal-head 0))))
     2166                                      (h (safe-exponent decimal-head e)))
    20212167                             (let* ((te (and tail (fx- e (fx- (cdr tail) start))))
    2022                                     (t (and te (%* (car tail) (expt 10 te)))))
    2023                                (cons (if t (%+ n t) n) (cdr ee)))))
     2168                                    (num (and tail (car tail)))
     2169                                    (t (safe-exponent num te)))
     2170                               (cons (if t (%+ h t) h) (cdr ee)))))
    20242171                          (else (let* ((last (or next len))
    20252172                                       (te (and tail (fx- start last)))
    2026                                        (t (and te (%* (expt 10 te) (car tail))))
    2027                                        (n (or decimal-head 0)))
    2028                                   (cons (if t (%+ n t) n) next)))))))))
     2173                                       (num (and tail (car tail)))
     2174                                       (t (safe-exponent num te))
     2175                                       (h (or decimal-head 0)))
     2176                                  (cons (if t (%+ h t) h) next)))))))))
    20292177         (scan-ureal
    20302178          (lambda (start neg?)
     
    20322180                     (eq? (%subchar str start) #\.))
    20332181                (begin
    2034                   (set! inexact? #t)
     2182                  (go-inexact!)
    20352183                  (scan-decimal-tail (fx+ start 1) neg? #f))
    20362184                (and-let* ((end (scan-digits+hashes start neg? #f)))
    20372185                  (case (and (cdr end) (%subchar str (cdr end)))
    20382186                    ((#\.)
    2039                      (set! inexact? #t)
     2187                     (go-inexact!)
    20402188                     (and (eq? radix 10)
    20412189                          (if (fx> len (fx+ (cdr end) 1))
     
    20472195                                ((fx> len (cdr end)))
    20482196                                (ee (scan-exponent (fx+ (cdr end) 1)))
    2049                                 (e (car ee))
    2050                                 (num (car end)))
    2051                        (cons (* num (expt 10 e)) (cdr ee))))
     2197                                (num (car end))
     2198                                (val (safe-exponent num (car ee))))
     2199                       (cons val (cdr ee))))
    20522200                    ((#\/)
    20532201                     (set! seen-hashes? #f) ; Reset flag for denominator
     
    20552203                                (d (scan-digits+hashes (fx+ (cdr end) 1) #f #f))
    20562204                                (num (car end))
    2057                                 (denom (car d))
    2058                                 ((not (eq? denom 0))))
    2059                        (cons (%/ num denom) (cdr d))))
     2205                                (denom (car d)))
     2206                       (if (not (eq? denom 0))
     2207                           (cons (%/ num denom) (cdr d))
     2208                           ;; Hacky: keep around an inexact until we decide we
     2209                           ;; *really* need exact values, then fail at the end.
     2210                           (and (not (eq? exactness 'e))
     2211                            (case (signum num)
     2212                              ((-1) (cons -inf.0 (cdr d)))
     2213                              ((0)  (cons +nan.0 (cdr d)))
     2214                              ((+1) (cons +inf.0 (cdr d))))))))
    20602215                    (else end))))))
    20612216         (scan-real
     
    20742229                                     ((and (fx<= (fx+ next 5) len)
    20752230                                           (string-ci=? (substring str next (fx+ next 5)) "inf.0"))
     2231                                      (go-inexact!)
    20762232                                      (cons (fp/ (if (eq? sign 'neg) -1.0 1.0) 0.0)
    20772233                                            (and (fx< (fx+ next 5) len)
     
    20832239                                    (fx<= (fx+ next 5) len)
    20842240                                    (string-ci=? (substring str next (fx+ next 5)) "nan.0")
    2085                                     (cons (fp/ 0.0 0.0)
    2086                                           (and (fx< (fx+ next 5) len)
    2087                                                (fx+ next 5))))
     2241                                    (begin (go-inexact!)
     2242                                           (cons (fp/ 0.0 0.0)
     2243                                                 (and (fx< (fx+ next 5) len)
     2244                                                      (fx+ next 5)))))
    20882245                               (scan-ureal next (eq? sign 'neg))))
    20892246                          (else (scan-ureal next (eq? sign 'neg)))))))))
     
    21092266                        (make-polar (car r1) (car r2))))
    21102267                     (else #f)))))
    2111     (and number (if (and inexact? (not force-exact?))
     2268    (and number (if (eq? exactness 'i)
    21122269                    (exact->inexact number)
    2113                     number))))
     2270                    ;; Ensure we didn't encounter +inf or +nan with #e
     2271                    (and (finite? number) number)))))
    21142272
    21152273(define (%string->number str #!optional (base 10))
    21162274  (##sys#check-string str 'string->number)
    21172275  (##sys#check-exact base 'string->number)
    2118   (unless (< 0 base 37)           ; We only have 0-9 and the alphabet!
     2276  (unless (< 1 base 37)           ; We only have 0-9 and the alphabet!
    21192277    (bad-base 'string->number base))
    21202278  (let scan-prefix ((i 0)
     
    21242282    (if (and (fx< (fx+ i 2) len) (eq? (%subchar str i) #\#))
    21252283        (case (%subchar str (fx+ i 1))
    2126           ((#\i #\I) (and (not exness) (scan-prefix (fx+ i 2) 'inexact radix len)))
    2127           ((#\e #\E) (and (not exness) (scan-prefix (fx+ i 2) 'exact radix len)))
     2284          ((#\i #\I) (and (not exness) (scan-prefix (fx+ i 2) 'i radix len)))
     2285          ((#\e #\E) (and (not exness) (scan-prefix (fx+ i 2) 'e radix len)))
    21282286          ((#\b #\B) (and (not radix) (scan-prefix (fx+ i 2) exness 2 len)))
    21292287          ((#\o #\O) (and (not radix) (scan-prefix (fx+ i 2) exness 8 len)))
     
    21312289          ((#\x #\X) (and (not radix) (scan-prefix (fx+ i 2) exness 16 len)))
    21322290          (else #f))
    2133         (and-let* ((number (%string->compnum (or radix base) str i (eq? exness 'exact))))
    2134           (if (eq? exness 'inexact) (exact->inexact number) number)))))
     2291        (%string->compnum (or radix base) str i exness))))
    21352292
    21362293(define (randomize #!optional (seed (##sys#fudge 2)))
     
    21502307;;; Reader hook
    21512308(define (##sys#string->number str #!optional (radix 10) exactness)
    2152   (let ((num (%string->compnum radix str 0 (eq? exactness 'e))))
    2153     (if (eq? exactness 'i) (exact->inexact num) num)))
     2309  (%string->compnum radix str 0 exactness))
    21542310
    21552311
  • release/4/numbers/branches/schemification/numbers.setup

    r26169 r26606  
    22
    33(compile -s -O3 -d1 numbers.scm -j numbers)
     4(compile -s -O3 -d0 numbers.import.scm)
    45
    5 (compile -s -O3 -d0 numbers.import.scm)
     6(compile -s -d1 numbers-syntax.scm -j numbers)
    67
    78(install-extension
    89  'numbers
    9   `("numbers.so" "numbers.import.so"
     10  `("numbers.so" "numbers.import.so" "numbers-syntax.scm"
    1011    ;; The types database uses syntax unsupported by 4.7.0
    1112    ,@(if (version>=? (chicken-version) "4.7.4") '("numbers.types") '()))
  • release/4/numbers/branches/schemification/numbers.types

    r26182 r26606  
    3232                  ((float) (##core#inline "C_u_i_fpintegerp" #(1))))
    3333
     34(numbers#exact-integer? (#(procedure #:pure) numbers#exact-integer? (*) boolean)
     35                  (((or fixnum (struct bignum))) (let ((#(tmp) #(1))) '#t))
     36                  (((not (or fixnum (struct bignum)))) (let ((#(tmp) #(1))) '#f)))
     37
    3438(numbers#exact? (#(procedure #:pure #:enforce) numbers#exact? ((or fixnum float number (struct bignum) (struct ratnum) (struct compnum))) boolean)
    3539                (((or fixnum (struct bignum) (struct ratnum)))
     
    5155                   ((fixnum) (let ((#(tmp) #(1))) '#t))) ;XXX more?
    5256
     57(numbers#bignum? (#(procedure #:pure #:predicate (struct bignum)) numbers#bignum? (*) boolean))
     58(numbers#ratnum? (#(procedure #:pure #:predicate (struct ratnum)) numbers#ratnum? (*) boolean))
     59(numbers#cplxnum? (#(procedure #:pure #:predicate (struct compnum)) numbers#cplxnum? (*) boolean))
     60
     61(numbers#nan? (#(procedure #:clean #:enforce) numbers#nan? ((or fixnum float number (struct bignum) (struct ratnum) (struct compnum))) boolean)
     62              (((or fixnum (struct bignum) (struct ratnum)))
     63               (let ((#(tmp) #(1))) '#f)))
     64
     65(numbers#infinite? (#(procedure #:clean #:enforce) numbers#infinite? ((or fixnum float number (struct bignum) (struct ratnum) (struct compnum))) boolean)
     66                   (((or fixnum (struct bignum) (struct ratnum)))
     67                    (let ((#(tmp) #(1))) '#f)))
     68
     69(numbers#finite? (#(procedure #:clean #:enforce) numbers#finite? ((or fixnum float number (struct bignum) (struct ratnum) (struct compnum))) boolean)
     70                 (((or fixnum (struct bignum) (struct ratnum)))
     71                  (let ((#(tmp) #(1))) '#t)))
     72
     73(numbers#rectnum? (#(procedure #:pure) numbers#rectnum? (*) boolean)
     74                  (((or fixnum float number (struct bignum) (struct ratnum)))
     75                   (let ((#(tmp) #(1))) '#f)))
     76
     77(numbers#compnum? (#(procedure #:pure) numbers#compnum? (*) boolean)
     78                  (((or fixnum float number (struct bignum) (struct ratnum)))
     79                   (let ((#(tmp) #(1))) '#f)))
     80
     81(numbers#cintnum? (#(procedure #:pure) numbers#cintnum? (*) boolean)
     82                  (((or fixnum float number (struct bignum)))
     83                   (let ((#(tmp) #(1))) '#t))
     84                  (((struct ratnum))
     85                   (let ((#(tmp) #(1))) '#f)))
     86
     87(numbers#cflonum? (#(procedure #:pure) numbers#cflonum? (*) boolean)
     88                  ((float) (let ((#(tmp) #(1))) '#t))
     89                  (((or fixnum number (struct bignum) (struct ratnum)))
     90                   (let ((#(tmp) #(1))) '#f)))
     91
    5392(numbers#zero? (#(procedure #:clean #:enforce) numbers#zero? ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) boolean)
    5493               ((fixnum) (eq? #(1) '0))
     
    91130           ((float float) (float)
    92131            (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2))))
     132
     133(numbers#add1 (#(procedure #:clean #:enforce) numbers#add1 ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum)))
     134           ((float) (float)
     135            (##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0)))
    93136
    94137(numbers#- (#(procedure #:clean #:enforce) numbers#- ((or fixnum float (struct bignum) (struct compnum) (struct ratnum)) #!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum)))
     
    112155            (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1))))
    113156
     157(numbers#sub1 (#(procedure #:clean #:enforce) numbers#sub1 ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum)))
     158           ((float) (float)
     159            (##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) '1.0)))
     160
     161(numbers#signum (#(procedure #:clean #:enforce) numbers#signum ((or fixnum float (struct bignum) (struct ratnum))) (or fixnum float)))
     162
    114163(numbers#* (#(procedure #:clean #:enforce) numbers#* (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum)))
    115164           ((float fixnum) (float)
     
    142191(numbers#= (#(procedure #:clean #:enforce) numbers#= (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) boolean)
    143192           ((fixnum fixnum) (eq? #(1) #(2)))
    144            ((float fixnum) (##core#inline
     193           ;; These are incorrect on 64 bit-platforms (fixnums > 2^53)
     194           #;((float fixnum) (##core#inline
    145195                            "C_flonum_equalp"
    146                             #(1) 
     196                            #(1)
    147197                            (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
    148            ((fixnum float) (##core#inline
     198           #;((fixnum float) (##core#inline
    149199                            "C_flonum_equalp"
    150200                            (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
     
    154204(numbers#> (#(procedure #:clean #:enforce) numbers#> (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) boolean)
    155205           ((fixnum fixnum) (fx> #(1) #(2)))
    156            ((float fixnum) (##core#inline
     206           ;; These are incorrect on 64 bit-platforms (fixnums > 2^53)
     207           #;((float fixnum) (##core#inline
    157208                            "C_flonum_greaterp"
    158209                            #(1)
    159210                            (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
    160            ((fixnum float) (##core#inline
     211           #;((fixnum float) (##core#inline
    161212                            "C_flonum_greaterp"
    162213                            (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
     
    166217(numbers#< (#(procedure #:clean #:enforce) numbers#< (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) boolean)
    167218           ((fixnum fixnum) (fx< #(1) #(2)))
    168            ((float fixnum) (##core#inline
     219           ;; These are incorrect on 64 bit-platforms (fixnums > 2^53)
     220           #;((float fixnum) (##core#inline
    169221                            "C_flonum_lessp"
    170222                            #(1)
    171223                            (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
    172            ((fixnum float) (##core#inline
     224           #;((fixnum float) (##core#inline
    173225                            "C_flonum_lessp"
    174226                            (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
     
    178230(numbers#>= (#(procedure #:clean #:enforce) numbers#>= (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) boolean)
    179231            ((fixnum fixnum) (fx>= #(1) #(2)))
    180             ((float fixnum) (##core#inline
     232            ;; These are incorrect on 64 bit-platforms (fixnums > 2^53)
     233            #;((float fixnum) (##core#inline
    181234                             "C_flonum_greater_or_equal_p"
    182235                             #(1)
    183236                             (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
    184             ((fixnum float) (##core#inline
     237            #;((fixnum float) (##core#inline
    185238                             "C_flonum_greater_or_equal_p"
    186239                             (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
     
    190243(numbers#<= (#(procedure #:clean #:enforce) numbers#<= (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) boolean)
    191244            ((fixnum fixnum) (fx<= #(1) #(2)))
    192             ((float fixnum) (##core#inline
     245            ;; These are incorrect on 64 bit-platforms (fixnums > 2^53)
     246            #;((float fixnum) (##core#inline
    193247                             "C_flonum_less_or_equal_p"
    194248                             #(1)
    195249                             (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(2))))
    196             ((fixnum float) (##core#inline
     250            #;((fixnum float) (##core#inline
    197251                             "C_flonum_less_or_equal_p"
    198252                             (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))
     
    234288                  (##core#inline_allocate ("C_a_i_flonum_ceiling" 4) #(1))))
    235289
    236 (numbers#truncate (#(procedure #:clean #:enforce) numbers#truncate ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum)))
     290(numbers#truncate (#(procedure #:clean #:enforce) numbers#truncate ((or fixnum float (struct bignum) (struct ratnum))) (or fixnum float (struct bignum)))
    237291                  ((fixnum) (fixnum) #(1))
     292                  (((struct bignum)) ((struct bignum)) #(1))
    238293                  ((float) (float)
    239294                   (##core#inline_allocate ("C_a_i_flonum_truncate" 4) #(1))))
    240295
    241 (numbers#round (#(procedure #:clean #:enforce) numbers#round ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum)))
     296(numbers#round (#(procedure #:clean #:enforce) numbers#round ((or fixnum float (struct bignum) (struct ratnum))) (or fixnum float (struct bignum)))
    242297               ((fixnum) (fixnum) #(1))
     298               (((struct bignum)) ((struct bignum)) #(1))
    243299               ((float) (float)
    244300                (##core#inline_allocate ("C_a_i_flonum_round_proper" 4) #(1))))
     301
     302(numbers#numerator (#(procedure #:clean #:enforce) numbers#numerator ((or fixnum float (struct bignum) (struct ratnum))) (or fixnum float (struct bignum)))
     303                   (((struct bignum)) ((struct bignum)) #(1))
     304                   ((fixnum) (fixnum) #(1))
     305                   (((struct ratnum)) (##sys#slot #(1) '1)))
     306
     307(numbers#denominator (#(procedure #:clean #:enforce) numbers#denominator ((or fixnum float (struct bignum) (struct ratnum))) (or fixnum float (struct bignum)))
     308                     (((or fixnum (struct bignum))) (fixnum) (let ((#(tmp) #(1))) '1))
     309                     (((struct ratnum)) (##sys#slot #(1) '2)))
    245310
    246311(numbers#exact->inexact (#(procedure #:clean #:enforce) numbers#exact->inexact ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) float)
     
    274339             ((float) (float) (##core#inline_allocate ("C_a_i_flonum_tan" 4) #(1))))
    275340
    276 (numbers#asin (#(procedure #:clean #:enforce) numbers#asin ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or float (struct compnum)))
    277               ((float) (float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1))))
     341(numbers#asin (#(procedure #:clean #:enforce) numbers#asin ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or float (struct compnum)))
     342              ;; Unfortunately this doesn't work when the number is > 1.0 (returns compnum)
     343              #;((float) (float) (##core#inline_allocate ("C_a_i_flonum_asin" 4) #(1))))
    278344
    279345(numbers#acos (#(procedure #:clean #:enforce) numbers#acos ((or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or float (struct compnum)))
    280               ((float) (float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1))))
     346              ;; Unfortunately this doesn't work when the number is > 1.0 (returns compnum)
     347              #;((float) (float) (##core#inline_allocate ("C_a_i_flonum_acos" 4) #(1))))
    281348
    282349(numbers#atan (#(procedure #:clean #:enforce) numbers#atan ((or fixnum float (struct bignum) (struct compnum) (struct ratnum)) #!optional number) (or float (struct compnum)))
     
    284351              ((float float) (float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1) #(2))))
    285352
    286 (numbers#angle (#(procedure #:clean #:enforce) numbers#angle ((or float (struct compnum))) float))
     353(numbers#angle (#(procedure #:clean #:enforce) numbers#angle ((or float fixnum (struct compnum) (struct bignum) (struct ratnum))) float)
     354               ((float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) '0.0 #(1)))
     355               ((fixnum) (##core#inline_allocate
     356                          ("C_a_i_flonum_atan2" 4)
     357                          '0.0
     358                          (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1)))))
     359
     360(numbers#magnitude (#(procedure #:clean #:enforce) numbers#magnitude ((or float fixnum (struct compnum) (struct bignum) (struct ratnum))) (or float fixnum (struct bignum) (struct ratnum)))
     361                   (((or float fixnum (struct bignum) (struct ratnum))) (numbers#abs #(1))))
    287362
    288363(numbers#number->string
    289  (#(procedure #:clean #:enforce) numbers#number->string ((or fixnum float (struct bignum) (struct compnum) (struct ratnum)) #!optional (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) string)
     364 (#(procedure #:clean #:enforce) numbers#number->string ((or fixnum float (struct bignum) (struct compnum) (struct ratnum)) #!optional fixnum) string)
    290365 ((fixnum) (##sys#fixnum->string #(1))))
    291366
    292367(numbers#string->number
    293  ;;XXX add specialization for float?
    294  (#(procedure #:clean #:enforce) numbers#string->number (string #!optional (or fixnum float (struct bignum) (struct compnum) (struct ratnum)))
     368 (#(procedure #:clean #:enforce) numbers#string->number (string #!optional fixnum)
    295369  (or fixnum float (struct bignum) (struct compnum) (struct ratnum) boolean)))
  • release/4/numbers/branches/schemification/tests/numbers-test-ashinn.scm

    r26169 r26606  
    3737
    3838(test-group "overflows into bignums"
    39   (test (string->number "1073741824") (expt 2 30))
    40   (test (string->number "2147483648") (expt 2 31))
    41   (test (string->number "4294967296") (expt 2 32))
    42   (test (string->number "4611686018427387904") (expt 2 62))
    43   (test (string->number "9223372036854775808") (expt 2 63))
    44   (test (string->number "18446744073709551616") (expt 2 64)))
     39  (test 1073741824 (expt 2 30))
     40  (test 2147483648 (expt 2 31))
     41  (test 4294967296 (expt 2 32))
     42  (test 4611686018427387904 (expt 2 62))
     43  (test 9223372036854775808 (expt 2 63))
     44  (test 18446744073709551616 (expt 2 64)))
    4545
    4646(define (one-followed-by-n-zeros n)
  • release/4/numbers/branches/schemification/tests/numbers-test-gauche.scm

    r26169 r26606  
    9696
    9797(test "around 2^28"
    98        (list (read-from-string "268435456") (read-from-string "536870911")
    99              (read-from-string "536870912") (read-from-string "-268435456")
    100              (read-from-string "-536870911") (read-from-string "-536870912")
    101              (read-from-string "-536870913"))
    102        (i-tester (exp2 28)))
     98      '(268435456 536870911 536870912
     99         -268435456 -536870911 -536870912 -536870913)
     100      (i-tester (exp2 28)))
    103101
    104102(test "around 2^31"
    105        (list (read-from-string "2147483648") (read-from-string "4294967295")
    106              (read-from-string "4294967296") (read-from-string "-2147483648")
    107              (read-from-string "-4294967295") (read-from-string "-4294967296")
    108              (read-from-string "-4294967297"))
     103      '(2147483648 4294967295 4294967296
     104         -2147483648 -4294967295 -4294967296 -4294967297)
    109105       (i-tester (exp2 31)))
    110106
    111107(test "around 2^60"
    112       (list (read-from-string "1152921504606846976")
    113             (read-from-string "2305843009213693951")
    114             (read-from-string "2305843009213693952")
    115             (read-from-string "-1152921504606846976")
    116             (read-from-string "-2305843009213693951")
    117             (read-from-string "-2305843009213693952")
    118             (read-from-string "-2305843009213693953"))
     108       '(1152921504606846976 2305843009213693951 2305843009213693952
     109         -1152921504606846976 -2305843009213693951 -2305843009213693952
     110         -2305843009213693953)
    119111       (i-tester (exp2 60)))
    120112
    121113(test "around 2^63"
    122       (list (read-from-string "9223372036854775808")
    123             (read-from-string "18446744073709551615")
    124             (read-from-string "18446744073709551616")
    125             (read-from-string "-9223372036854775808")
    126             (read-from-string "-18446744073709551615")
    127             (read-from-string "-18446744073709551616")
    128             (read-from-string "-18446744073709551617"))
     114       '(9223372036854775808 18446744073709551615 18446744073709551616
     115         -9223372036854775808 -18446744073709551615 -18446744073709551616
     116         -18446744073709551617)
    129117       (i-tester (exp2 63)))
    130118
    131119(test "around 2^127"
    132       (list (read-from-string "170141183460469231731687303715884105728")
    133             (read-from-string "340282366920938463463374607431768211455")
    134             (read-from-string "340282366920938463463374607431768211456")
    135             (read-from-string "-170141183460469231731687303715884105728")
    136             (read-from-string "-340282366920938463463374607431768211455")
    137             (read-from-string "-340282366920938463463374607431768211456")
    138             (read-from-string "-340282366920938463463374607431768211457"))
     120       '(170141183460469231731687303715884105728
     121         340282366920938463463374607431768211455
     122         340282366920938463463374607431768211456
     123         -170141183460469231731687303715884105728
     124         -340282366920938463463374607431768211455
     125         -340282366920938463463374607431768211456
     126         -340282366920938463463374607431768211457)
    139127       (i-tester (exp2 127)))
    140128
     
    143131      4772267290 (* 477226729 10))
    144132
    145 (test "radix" (list 43605 342391
    146                     (read-from-string "718048024785")
    147                     (read-from-string "123456789")
    148                     (read-from-string "123456789987654321")
    149                     (read-from-string "1193046")
    150                     (read-from-string "3735928559")
    151                     (read-from-string "3735928559"))
    152        (list (read-from-string "#b1010101001010101")
    153              (read-from-string "#o1234567")
    154              (read-from-string "#o12345677654321")
    155              (read-from-string "#d123456789")
    156              (read-from-string "#d123456789987654321")
     133(test "radix" '(43605 342391 718048024785
     134                 123456789 123456789987654321
     135                 1193046 3735928559 3735928559)
     136      (list #b1010101001010101
     137             #o1234567
     138             #o12345677654321
     139             #d123456789
     140             #d123456789987654321
    157141             #x123456
    158142             #xdeadbeef
    159143             #xDeadBeef))
    160144
    161 (test "exactness" #t (exact? (read-from-string "#e10")))
    162 (test "exactness" #t (exact? (read-from-string "#e10.0")))
    163 (test "exactness" #t (exact? (read-from-string "#e10e10")))
    164 (test "exactness" #t (exact? (read-from-string "#e12.34")))
    165 (test "inexactness" #f (exact? (read-from-string "#i10")))
    166 (test "inexactness" #f (exact? (read-from-string "#i10.0")))
    167 (test "inexactness" #f (exact? (read-from-string "#i12.34")))
     145(test "exactness" #t (exact? #e10))
     146(test "exactness" #t (exact? #e10.0))
     147(test "exactness" #t (exact? #e10e10))
     148(test "exactness" #t (exact? #e12.34))
     149(test "inexactness" #f (exact? #i10))
     150(test "inexactness" #f (exact? #i10.0))
     151(test "inexactness" #f (exact? #i12.34))
    168152
    169153(test "exactness & radix" '(#t 3735928559 #t 3735928559)
    170        (list (exact? (read-from-string "#e#xdeadbeef"))
    171              (read-from-string "#e#xdeadbeef")
    172              (exact? (read-from-string "#x#edeadbeef"))
    173              (read-from-string "#x#edeadbeef")))
     154      (list (exact? #e#xdeadbeef)
     155             #e#xdeadbeef
     156             (exact? #x#edeadbeef)
     157             #x#edeadbeef))
    174158(test "inexactness & radix" '(#f 3735928559.0 #f 3735928559.0)
    175        (list (exact? #i#xdeadbeef)
    176              (read-from-string "#i#xdeadbeef")
    177              (exact? (read-from-string "#x#ideadbeef"))
    178              (read-from-string "#x#ideadbeef")))
    179 
    180 ;; TODO: Fix this and then get the behaviour synchronised with Chicken core
    181 #;
     159      (list (exact? #i#xdeadbeef)
     160             #i#xdeadbeef
     161             (exact? #x#ideadbeef)
     162             #x#ideadbeef))
     163
    182164(test "invalid exactness/radix spec" #f
    183165       (or (string->number "#e")
     
    251233  (if (number? v) (list v (exact? v)) v))
    252234
    253 (test "rational reader" '(1234 #t) (rational-test (string->number "1234/1")))
    254 (test "rational reader" '(-1234 #t) (rational-test (string->number "-1234/1")))
    255 (test "rational reader" '(1234 #t) (rational-test (string->number "+1234/1")))
     235(test "rational reader" '(1234 #t) (rational-test '1234/1))
     236(test "rational reader" '(-1234 #t) (rational-test '-1234/1))
     237(test "rational reader" '(1234 #t) (rational-test '+1234/1))
    256238;; The following is invalid R5RS syntax, so it's commented out (it fails, too)
    257 #;(test "rational reader" '(-1234 #t) (rational-test (string->number "1234/-1")))
    258 (test "rational reader" '(1234 #t) (rational-test (string->number "2468/2")))
    259 (test "rational reader" `(,(/ 1 2) #t) (rational-test (string->number "1/2")))
    260 (test "rational reader" `(,(/ -1 2) #t) (rational-test (read-from-string "-1/2")))
    261 (test "rational reader" `(,(/ 1 2) #t) (rational-test (read-from-string "+1/2")))
    262 (test "rational reader" `(,(/ 1 2) #t) (rational-test (read-from-string "751/1502")))
     239#;(test "rational reader" '|1234/-1| (rational-test '1234/-1))
     240(test "rational reader" '(1234 #t) (rational-test '2468/2))
     241(test "rational reader" '(1/2 #t) (rational-test '1/2))
     242(test "rational reader" '(-1/2 #t) (rational-test '-1/2))
     243(test "rational reader" '(1/2 #t) (rational-test '+1/2))
     244(test "rational reader" '(1/2 #t) (rational-test '751/1502))
    263245
    264246(test "rational reader" '(1 #t)
     
    279261
    280262(test "rational reader w/#e" '(1234 #t)
    281        (rational-test (read-from-string "#e1234/1")))
     263       (rational-test '#e1234/1))
    282264(test "rational reader w/#e" '(-1234 #t)
    283        (rational-test (read-from-string "#e-1234/1")))
    284 (test "rational reader w/#e" (read-from-string "(32/7 #t)")
    285        (rational-test (read-from-string "#e32/7")))
    286 (test "rational reader w/#e" (read-from-string "(-32/7 #t)")
    287        (rational-test (read-from-string "#e-32/7")))
     265       (rational-test '#e-1234/1))
     266(test "rational reader w/#e" '(32/7 #t)
     267       (rational-test '#e32/7))
     268(test "rational reader w/#e" '(-32/7 #t)
     269       (rational-test '#e-32/7))
    288270(test "rational reader w/#i" '(1234.0 #f)
    289        (rational-test (read-from-string "#i1234/1")))
     271       (rational-test '#i1234/1))
    290272(test "rational reader w/#i" '(-1234.0 #f)
    291        (rational-test (read-from-string "#i-1234/1")))
     273       (rational-test '#i-1234/1))
    292274(test "rational reader w/#i" '(-0.125 #f)
    293        (rational-test (read-from-string "#i-4/32")))
     275       (rational-test '#i-4/32))
    294276
    295277(test "rational reader w/radix" '(15 #t)
    296        (rational-test (read-from-string "#e#xff/11")))
     278       (rational-test '#e#xff/11))
    297279(test "rational reader w/radix" '(56 #t)
    298        (rational-test (read-from-string "#o770/11")))
     280       (rational-test '#o770/11))
    299281(test "rational reader w/radix" '(15.0 #f)
    300        (rational-test (read-from-string "#x#iff/11")))
     282       (rational-test '#x#iff/11))
    301283
    302284(test "rational reader edge case" #t (symbol? (read-from-string "/1")))
     
    346328(test "flonum reader (exp)" '(314.0 #t) (flonum-test +3140000.000e-4))
    347329
    348 #|
    349 
    350 ;; TODO: What about this?
    351330(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314E3))
    352331(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314s3))
     
    358337(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314d3))
    359338(test "flonum reader (exp)" '(314.0 #t) (flonum-test .314D3))
    360 |#
    361339
    362340(test "flonum reader (minimum denormalized number 5.0e-324)" #t
     
    376354(test "padding" '(1.0 #t) (flonum-test '1.#))
    377355
    378 ;; TODO: Fix this and then get the behaviour synchronised with Chicken core
    379 #|
    380356(test "padding" '|1#1| (flonum-test '1#1))
    381357(test "padding" '|1##1| (flonum-test '1##1))
     
    383359(test "padding" '|1.#1| (flonum-test '1.#1))
    384360
    385 ;; The space here should be removed
    386 (test "padding" '|.# | (flonum-test '.#))
    387 |#
    388 
     361(test "padding" '|.#| (flonum-test '.#))
    389362(test "padding" '(0.0 #t) (flonum-test '0.#))
    390363(test "padding" '(0.0 #t) (flonum-test '.0#))
    391364(test "padding" '(0.0 #t) (flonum-test '0#))
    392365(test "padding" '(0.0 #t) (flonum-test '0#.#))
    393 
    394 ;; Another part of the above TODO
    395 #|
    396366(test "padding" '|0#.0| (flonum-test '0#.0))
    397367
     
    402372(test "padding" '(0.0 #t) (flonum-test '.0#e2))
    403373(test "padding" '|.##e2| (flonum-test '.##e2))
    404 |#
    405374
    406375(test "padding (exactness)" '(100 #f) (flonum-test '#e1##))
     
    411380(test "padding (exactness)" '(120.0 #t) (flonum-test '#i12#.#))
    412381
    413 #|
    414 
    415 ;; TODO: Should this be the behaviour?
    416382(test "exponent out-of-range 1" '(+inf.0 #t) (flonum-test '1e309))
    417383(test "exponent out-of-range 2" '(+inf.0 #t) (flonum-test '1e10000))
    418 (test "exponent out-of-range 3" '(+inf.0 #t) (flonum-test '1e1000000000000000000000000000000000000000000000000000000000000000))
     384;; TODO: Figure out what goes wrong here
     385;(test "exponent out-of-range 3" '(+inf.0 #t) (flonum-test '1e1000000000000000000000000000000000000000000000000000000000000000))
    419386(test "exponent out-of-range 4" '(-inf.0 #t) (flonum-test '-1e309))
    420387(test "exponent out-of-range 5" '(-inf.0 #t) (flonum-test '-1e10000))
    421 (test "exponent out-of-range 6" '(-inf.0 #t) (flonum-test '-1e1000000000000000000000000000000000000000000000000000000000000000))
     388;(test "exponent out-of-range 6" '(-inf.0 #t) (flonum-test '-1e1000000000000000000000000000000000000000000000000000000000000000))
    422389(test "exponent out-of-range 7" '(0.0 #t) (flonum-test '1e-324))
    423390(test "exponent out-of-range 8" '(0.0 #t) (flonum-test '1e-1000))
    424 (test "exponent out-of-range 9" '(0.0 #t) (flonum-test '1e-1000000000000000000000000000000000000000000000000000000000000000000))
    425 |#
     391;(test "exponent out-of-range 9" '(0.0 #t) (flonum-test '1e-1000000000000000000000000000000000000000000000000000000000000000000))
    426392
    427393(test "no integral part" 0.5 (read-from-string ".5"))
     
    435401(test "exact fractonal number" 12345
    436402       (string->number "#e1.2345e4"))
    437 (test "exact fractonal number" (read-from-string "123450000000000")
     403(test "exact fractonal number" 123450000000000
    438404       (string->number "#e1.2345e14"))
    439 (test "exact fractonal number" (read-from-string "12345/100")
     405(test "exact fractonal number" 12345/100
    440406       (string->number "#e1.2345e2"))
    441 (test "exact fractonal number" (read-from-string "12345/1000000")
     407(test "exact fractonal number" 12345/1000000
    442408       (string->number "#e1.2345e-2"))
    443409(test "exact fractonal number" -12345
    444410       (string->number "#e-1.2345e4"))
    445 (test "exact fractonal number" (read-from-string "-123450000000000")
     411(test "exact fractonal number" -123450000000000
    446412       (string->number "#e-1.2345e14"))
    447 (test "exact fractonal number" (read-from-string "-12345/100")
     413(test "exact fractonal number" -12345/100
    448414       (string->number "#e-1.2345e2"))
    449 (test "exact fractonal number" (read-from-string "-12345/1000000")
     415(test "exact fractonal number" -12345/1000000
    450416       (string->number "#e-1.2345e-2"))
    451417
     
    455421       (string->number "#e-0.0001e300"))
    456422
    457 (test "exact fractonal number" (expt 10 330) (read-from-string "#e1e330"))
    458 (test "exact fractonal number" (expt 10 -330) (read-from-string "#e1e-330"))
     423(test "exact fractonal number" (expt 10 330)
     424      (read-from-string "#e1e330"))
     425(test "exact fractonal number" (expt 10 -330)
     426      (read-from-string "#e1e-330"))
    459427
    460428(test-end)
     
    470438
    471439;; Fixed for exactness (Gauche's complex numbers are always inexact)
    472 (test "complex reader" '(1 1) (decompose-complex (read-from-string "1+i")))
    473 (test "complex reader" '(1 1) (decompose-complex (read-from-string "1+1i")))
    474 (test "complex reader" '(1 -1) (decompose-complex (read-from-string "1-i")))
    475 (test "complex reader" '(1 -1) (decompose-complex (read-from-string "1-1i")))
    476 (test "complex reader" '(1.0 1.0) (decompose-complex (read-from-string "1.0+1i")))
    477 (test "complex reader" '(1.0 1.0) (decompose-complex (read-from-string "1.0+1.0i")))
    478 (test "complex reader" '(1e-5 1.0) (decompose-complex (read-from-string "1e-5+1i")))
    479 (test "complex reader" '(1e+5 1.0) (decompose-complex (read-from-string "1e+5+1i")))
    480 (test "complex reader" '(1.0 1e-5) (decompose-complex (read-from-string "1+1e-5i")))
    481 (test "complex reader" '(1.0 1e+5) (decompose-complex (read-from-string "1+1e+5i")))
    482 (test "complex reader" '(0.1 1e+4) (decompose-complex (read-from-string "0.1+0.1e+5i")))
    483 (test "complex reader" '(0 1) (decompose-complex (read-from-string "+i")))
    484 (test "complex reader" '(0 -1) (decompose-complex (read-from-string "-i")))
    485 (test "complex reader" '(0 1) (decompose-complex (read-from-string "+1i")))
    486 (test "complex reader" '(0 -1) (decompose-complex (read-from-string "-1i")))
    487 (test "complex reader" '(0.0 1.0) (decompose-complex (read-from-string "+1.i")))
    488 (test "complex reader" '(0.0 -1.0) (decompose-complex (read-from-string "-1.i")))
    489 (test "complex reader" '(0.0 1.0) (decompose-complex (read-from-string "+1.0i")))
    490 (test "complex reader" '(0.0 -1.0) (decompose-complex (read-from-string "-1.0i")))
    491 (test "complex reader" 1.0 (decompose-complex (read-from-string "1+0.0i")))
    492 (test "complex reader" 1.0 (decompose-complex (read-from-string "1+.0i")))
    493 (test "complex reader" 1.0 (decompose-complex (read-from-string "1+0.i")))
    494 (test "complex reader" 1.0 (decompose-complex (read-from-string "1+0.0e-43i")))
    495 (test "complex reader" 100.0 (decompose-complex (read-from-string "1e2+0.0e-43i")))
    496 
    497 (test "complex reader" 'i (decompose-complex (read-from-string "i")))
     440(test "complex reader" '(1 1) (decompose-complex '1+i))
     441(test "complex reader" '(1 1) (decompose-complex '1+1i))
     442(test "complex reader" '(1 -1) (decompose-complex '1-i))
     443(test "complex reader" '(1 -1) (decompose-complex '1-1i))
     444(test "complex reader" '(1.0 1.0) (decompose-complex '1.0+1i))
     445(test "complex reader" '(1.0 1.0) (decompose-complex '1.0+1.0i))
     446(test "complex reader" '(1e-5 1.0) (decompose-complex '1e-5+1i))
     447(test "complex reader" '(1e+5 1.0) (decompose-complex '1e+5+1i))
     448(test "complex reader" '(1.0 1e-5) (decompose-complex '1+1e-5i))
     449(test "complex reader" '(1.0 1e+5) (decompose-complex '1+1e+5i))
     450(test "complex reader" '(0.1 1e+4) (decompose-complex '0.1+0.1e+5i))
     451(test "complex reader" '(0 1) (decompose-complex '+i))
     452(test "complex reader" '(0 -1) (decompose-complex '-i))
     453(test "complex reader" '(0 1) (decompose-complex '+1i))
     454(test "complex reader" '(0 -1) (decompose-complex '-1i))
     455(test "complex reader" '(0.0 1.0) (decompose-complex '+1.i))
     456(test "complex reader" '(0.0 -1.0) (decompose-complex '-1.i))
     457(test "complex reader" '(0.0 1.0) (decompose-complex '+1.0i))
     458(test "complex reader" '(0.0 -1.0) (decompose-complex '-1.0i))
     459(test "complex reader" 1.0 (decompose-complex '1+0.0i))
     460(test "complex reader" 1.0 (decompose-complex '1+.0i))
     461(test "complex reader" 1.0 (decompose-complex '1+0.i))
     462(test "complex reader" 1.0 (decompose-complex '1+0.0e-43i))
     463(test "complex reader" 100.0 (decompose-complex '1e2+0.0e-43i))
     464
     465(test "complex reader" 'i (decompose-complex 'i))
    498466(test "complex reader" #f (decompose-complex (string->number ".i")))
    499467(test "complex reader" #f (decompose-complex (string->number "+.i")))
    500468(test "complex reader" #f (decompose-complex (string->number "-.i")))
    501 (test "complex reader" '33i (decompose-complex (read-from-string "33i")))
    502 (test "complex reader" 'i+1 (decompose-complex (read-from-string "i+1")))
    503 (test "complex reader" '|++i| (decompose-complex (read-from-string "++i")))
    504 (test "complex reader" '|--i| (decompose-complex (read-from-string "--i")))
    505 
    506 (test "complex reader" (list (/ 1 2) (/ 1 2)) (decompose-complex (read-from-string "1/2+1/2i")))
    507 (test "complex reader" (list 0 (/ 1 2)) (decompose-complex (read-from-string "0+1/2i")))
    508 (test "complex reader" (list 0 (/ -1 2)) (decompose-complex (read-from-string "-1/2i")))
    509 (test "complex reader" (read-from-string "1/2") (decompose-complex (read-from-string "1/2-0/2i")))
     469(test "complex reader" '33i (decompose-complex '33i))
     470(test "complex reader" 'i+1 (decompose-complex 'i+1))
     471(test "complex reader" '|++i| (decompose-complex '++i))
     472(test "complex reader" '|--i| (decompose-complex '--i))
     473
     474(test "complex reader" '(1/2 1/2) (decompose-complex 1/2+1/2i))
     475(test "complex reader" '(0 1/2) (decompose-complex 0+1/2i))
     476(test "complex reader" '(0 -1/2) (decompose-complex -1/2i))
     477(test "complex reader" 1/2 (decompose-complex 1/2-0/2i))
    510478;; The following is also invalid R5RS syntax, so it's commented out
    511479#;(test "complex reader" '(0.5 -inf.0) (decompose-complex (string->number "1/2-1/0i")))
    512480
    513 (test "complex reader (polar)" (read-from-string "1.0@1.0") (make-polar 1.0 1.0))
    514 (test "complex reader (polar)" (read-from-string "1.0@-1.0") (make-polar 1.0 -1.0))
    515 (test "complex reader (polar)" (read-from-string "1.0@+1.0") (make-polar 1.0 1.0))
    516 (test "complex reader (polar)" (read-from-string "-7@-3.0") (make-polar -7.0 -3.0))
    517 (test "complex reader (polar)" (read-from-string "7/2@-3.0") (make-polar 3.5 -3.0))
     481(test "complex reader (polar)" 1.0@1.0 (make-polar 1.0 1.0))
     482(test "complex reader (polar)" 1.0@-1.0 (make-polar 1.0 -1.0))
     483(test "complex reader (polar)" 1.0@+1.0 (make-polar 1.0 1.0))
     484(test "complex reader (polar)" -7@-3.0 (make-polar -7.0 -3.0))
     485(test "complex reader (polar)" 7/2@-3.0 (make-polar 3.5 -3.0))
    518486(test "complex reader (polar)" #f (string->number "7/2@-3.14i"))
    519487
     
    571539(test "exact expt" 9765625 (expt 5 10))
    572540(test "exact expt" 1220703125 (expt 5 13))
    573 (test "exact expt" (string->number "94039548065783000637498922977779654225493244541767001720700136502273380756378173828125") (expt 5 123))
    574 (test "exact expt" (string->number "1/94039548065783000637498922977779654225493244541767001720700136502273380756378173828125") (expt 5 -123))
     541(test "exact expt" 94039548065783000637498922977779654225493244541767001720700136502273380756378173828125 (expt 5 123))
     542(test "exact expt" 1/94039548065783000637498922977779654225493244541767001720700136502273380756378173828125 (expt 5 -123))
    575543(test "exact expt" 1 (expt -5 0))
    576544(test "exact expt" 9765625 (expt -5 10))
    577545(test "exact expt" -1220703125 (expt -5 13))
    578 (test "exact expt" (string->number "-94039548065783000637498922977779654225493244541767001720700136502273380756378173828125") (expt -5 123))
    579 (test "exact expt" (string->number "-1/94039548065783000637498922977779654225493244541767001720700136502273380756378173828125") (expt -5 -123))
     546(test "exact expt" -94039548065783000637498922977779654225493244541767001720700136502273380756378173828125 (expt -5 123))
     547(test "exact expt" -1/94039548065783000637498922977779654225493244541767001720700136502273380756378173828125 (expt -5 -123))
    580548(test "exact expt" 1 (expt 1 720000))
    581549(test "exact expt" 1 (expt -1 720000))
    582550(test "exact expt" -1 (expt -1 720001))
    583551
    584 (test "exact expt (ratinoal)" (read-from-string "8589934592/5559060566555523")
    585        (expt (read-from-string "2/3") 33))
    586 (test "exact expt (rational)" (read-from-string "-8589934592/5559060566555523")
    587        (expt (read-from-string "-2/3") 33))
    588 (test "exact expt (ratinoal)" (read-from-string "5559060566555523/8589934592")
    589        (expt (read-from-string "2/3") -33))
     552(test "exact expt (ratinoal)" 8589934592/5559060566555523
     553       (expt 2/3 33))
     554(test "exact expt (rational)" -8589934592/5559060566555523
     555       (expt -2/3 33))
     556(test "exact expt (ratinoal)" 5559060566555523/8589934592
     557       (expt 2/3 -33))
    590558
    591559(test-end)
     
    593561(parameterize ((current-test-epsilon 10e7))
    594562  (test "expt (coercion to inexact)" 1.4142135623730951
    595         (expt 2 (read-from-string "1/2")))) ;; NB: pa$ will be tested later
     563        (expt 2 1/2))) ;; NB: pa$ will be tested later
    596564
    597565(test-begin "exact<->inexact")
     
    659627(parameterize ((current-test-epsilon 10e12))
    660628  (test "expt (ratnum with large denom and numer) with inexact conversion 1"
    661         (expt (read-from-string "8/9") 342.0)
    662         (exact->inexact (expt (read-from-string "8/9") 342)))
     629        (expt 8/9 342.0)
     630        (exact->inexact (expt 8/9 342)))
    663631
    664632  (test "expt (ratnum with large denom and numer) with inexact conversion 2"
    665         (expt (read-from-string "-8/9") 343.0)
    666         (exact->inexact (expt (read-from-string "-8/9") 343))))
     633        (expt -8/9 343.0)
     634        (exact->inexact (expt -8/9 343))))
    667635
    668636;; The following few tests covers RATNUM paths in Scm_GetDouble
     
    690658
    691659(test "integer?" #t (integer? 0))
    692 (test "integer?" #t (integer? (read-from-string "85736847562938475634534245")))
     660(test "integer?" #t (integer? 85736847562938475634534245))
    693661(test "integer?" #f (integer? 85736.534245))
    694662(test "integer?" #f (integer? 3.14))
    695 (test "integer?" #f (integer? (read-from-string "3+4i")))
    696 (test "integer?" #t (integer? (read-from-string "3+0i")))
     663(test "integer?" #f (integer? 3+4i))
     664(test "integer?" #t (integer? 3+0i))
    697665(test "integer?" #f (integer? #f))
    698666
    699667(test "rational?" #t (rational? 0))
    700 (test "rational?" #t (rational? (read-from-string "85736847562938475634534245")))
    701 (test "rational?" #t (rational? (read-from-string "1/2")))
     668(test "rational?" #t (rational? 85736847562938475634534245))
     669(test "rational?" #t (rational? 1/2))
    702670(test "rational?" #t (rational? 85736.534245))
    703671(test "rational?" #t (rational? 3.14))
    704 (test "rational?" #f (rational? (read-from-string "3+4i")))
    705 (test "rational?" #t (rational? (read-from-string "3+0i")))
     672(test "rational?" #f (rational? 3+4i))
     673(test "rational?" #t (rational? 3+0i))
    706674(test "rational?" #f (rational? #f))
    707675(test "rational?" #f (rational? +inf.0))
     
    710678
    711679(test "real?" #t (real? 0))
    712 (test "real?" #t (real? (read-from-string "85736847562938475634534245")))
     680(test "real?" #t (real? 85736847562938475634534245))
    713681(test "real?" #t (real? 857368.4756293847))
    714 (test "real?" #t (real? (read-from-string "3+0i")))
    715 (test "real?" #f (real? (read-from-string "3+4i")))
    716 (test "real?" #f (real? (read-from-string "+4.3i")))
     682(test "real?" #t (real? 3+0i))
     683(test "real?" #f (real? 3+4i))
     684(test "real?" #f (real? +4.3i))
    717685(test "real?" #f (real? '()))
    718686(test "real?" #t (real? +inf.0))
     
    721689
    722690(test "complex?" #t (complex? 0))
    723 (test "complex?" #t (complex? (read-from-string "85736847562938475634534245")))
     691(test "complex?" #t (complex? 85736847562938475634534245))
    724692(test "complex?" #t (complex? 857368.4756293847))
    725 (test "complex?" #t (complex? (read-from-string "3+0i")))
    726 (test "complex?" #t (complex? (read-from-string "3+4i")))
    727 (test "complex?" #t (complex? (read-from-string "+4.3i")))
     693(test "complex?" #t (complex? 3+0i))
     694(test "complex?" #t (complex? 3+4i))
     695(test "complex?" #t (complex? +4.3i))
    728696(test "complex?" #f (complex? '()))
    729697
    730698(test "number?" #t (number? 0))
    731 (test "number?" #t (number? (read-from-string "85736847562938475634534245")))
     699(test "number?" #t (number? 85736847562938475634534245))
    732700(test "number?" #t (number? 857368.4756293847))
    733 (test "number?" #t (number? (read-from-string "3+0i")))
    734 (test "number?" #t (number? (read-from-string "3+4i")))
    735 (test "number?" #t (number? (read-from-string "+4.3i")))
     701(test "number?" #t (number? 3+0i))
     702(test "number?" #t (number? 3+4i))
     703(test "number?" #t (number? +4.3i))
    736704(test "number?" #f (number? '()))
    737705
    738706(test "exact?" #t (exact? 1))
    739 (test "exact?" #t (exact? (read-from-string "4304953480349304983049304953804")))
    740 (test "exact?" #t (exact? (read-from-string "430495348034930/4983049304953804")))
     707(test "exact?" #t (exact? 4304953480349304983049304953804))
     708(test "exact?" #t (exact? 430495348034930/4983049304953804))
    741709(test "exact?" #f (exact? 1.0))
    742710(test "exact?" #f (exact? 4304953480349304983.049304953804))
    743 (test "exact?" #f (exact? (read-from-string "1.0+0i")))
    744 (test "exact?" #f (exact? (read-from-string "1.0+5i")))
     711(test "exact?" #f (exact? 1.0+0i))
     712(test "exact?" #f (exact? 1.0+5i))
    745713(test "inexact?" #f (inexact? 1))
    746 (test "inexact?" #f (inexact? (read-from-string "4304953480349304983049304953804")))
    747 (test "inexact?" #f (inexact? (read-from-string "430495348034930/4983049304953804")))
     714(test "inexact?" #f (inexact? 4304953480349304983049304953804))
     715(test "inexact?" #f (inexact? 430495348034930/4983049304953804))
    748716(test "inexact?" #t (inexact? 1.0))
    749717(test "inexact?" #t (inexact? 4304953480349304983.049304953804))
    750 (test "inexact?" #t (inexact? (read-from-string "1.0+0i")))
    751 (test "inexact?" #t (inexact? (read-from-string "1.0+5i")))
     718(test "inexact?" #t (inexact? 1.0+0i))
     719(test "inexact?" #t (inexact? 1.0+5i))
    752720
    753721(test "odd?" #t (odd? 1))
     
    759727(test "even?" #f (even? 1.0))
    760728(test "even?" #t (even? 2.0))
    761 (test "odd?" #t (odd? (read-from-string "10000000000000000000000000000000000001")))
    762 (test "odd?" #f (odd? (read-from-string "10000000000000000000000000000000000002")))
    763 (test "even?" #f (even? (read-from-string "10000000000000000000000000000000000001")))
    764 (test "even?" #t (even? (read-from-string "10000000000000000000000000000000000002")))
     729(test "odd?" #t (odd? 10000000000000000000000000000000000001))
     730(test "odd?" #f (odd? 10000000000000000000000000000000000002))
     731(test "even?" #f (even? 10000000000000000000000000000000000001))
     732(test "even?" #t (even? 10000000000000000000000000000000000002))
    765733
    766734(test "zero?" #t (zero? 0))
    767735(test "zero?" #t (zero? 0.0))
    768736(test "zero?" #t (zero? (- 10 10.0)))
    769 (test "zero?" #t (zero? (read-from-string "0+0i")))
     737(test "zero?" #t (zero? 0+0i))
    770738(test "zero?" #f (zero? 1.0))
    771 (test "zero?" #f (zero? (read-from-string "+5i")))
     739(test "zero?" #f (zero? +5i))
    772740(test "positive?" #t (positive? 1))
    773741(test "positive?" #f (positive? -1))
    774 (test "positive?" #t (positive? (read-from-string "1/7")))
    775 (test "positive?" #f (positive? (read-from-string "-1/7")))
     742(test "positive?" #t (positive? 1/7))
     743(test "positive?" #f (positive? -1/7))
    776744(test "positive?" #t (positive? 3.1416))
    777745(test "positive?" #f (positive? -3.1416))
    778 (test "positive?" #t (positive? (read-from-string "134539485343498539458394")))
    779 (test "positive?" #f (positive? (read-from-string "-134539485343498539458394")))
     746(test "positive?" #t (positive? 134539485343498539458394))
     747(test "positive?" #f (positive? -134539485343498539458394))
    780748(test "negative?" #f (negative? 1))
    781749(test "negative?" #t (negative? -1))
    782 (test "negative?" #f (negative? (read-from-string "1/7")))
    783 (test "negative?" #t (negative? (read-from-string "-1/7")))
     750(test "negative?" #f (negative? 1/7))
     751(test "negative?" #t (negative? -1/7))
    784752(test "negative?" #f (negative? 3.1416))
    785753(test "negative?" #t (negative? -3.1416))
    786 (test "negative?" #f (negative? (read-from-string "134539485343498539458394")))
    787 (test "negative?" #t (negative? (read-from-string "-134539485343498539458394")))
     754(test "negative?" #f (negative? 134539485343498539458394))
     755(test "negative?" #t (negative? -134539485343498539458394))
    788756
    789757(let-syntax ((tester (syntax-rules ()
     
    802770(test "eqv?" #t (eqv? 20 20))
    803771(test "eqv?" #t (eqv? 20.0 20.00000))
    804 (test "eqv?" #f (eqv? (read-from-string "4/5") 0.8))
    805 (test "eqv?" #t (eqv? (exact->inexact (read-from-string "4/5")) 0.8))
    806 ;(test "eqv?" #f (eqv? (read-from-string "4/5") (inexact->exact 0.8)))
     772(test "eqv?" #f (eqv? 4/5 0.8))
     773(test "eqv?" #t (eqv? (exact->inexact 4/5) 0.8))
     774(test "eqv?" #f (eqv? 4/5 (inexact->exact 0.8)))
    807775(test "eqv?" #t (eqv? 20 (inexact->exact 20.0)))
    808776(test "eqv?" #f (eqv? 20 20.0))
     
    885853(numcmp-test "flonum vs bignum eq" #t (expt 2.0 64) (expt 2 64))
    886854(numcmp-test "flonum vs bignum ne" #f (expt 2.0 64) (expt 2 63))
    887 (numcmp-test "ratnum vs fixnum ne" #f (/ 13 2) 6)
    888 (numcmp-test "ratnum vs ratnum eq" #t (/ 3 5) (/ 3 5))
    889 (numcmp-test "ratnum vs ratnum 1 ne" #f (/ 3 5) (/ 4 7))
    890 (numcmp-test "ratnum vs ratnum 2 ne" #f (/ 4 5) (/ 3 7))
    891 (numcmp-test "ratnum vs ratnum 3 ne" #f (/ 4 7) (/ 2 5))
    892 (numcmp-test "ratnum vs ratnum 4 ne" #f (/ 4 7) (/ 3 7))
    893 (numcmp-test "ratnum vs flonum eq" #t (/ 3 8) 0.375)
    894 (numcmp-test "ratnum vs flonum ne" #f (/ 8 9) 0.6)
     855(numcmp-test "ratnum vs fixnum ne" #f 13/2 6)
     856(numcmp-test "ratnum vs ratnum eq" #t 3/5 3/5)
     857(numcmp-test "ratnum vs ratnum 1 ne" #f 3/5 4/7)
     858(numcmp-test "ratnum vs ratnum 2 ne" #f 4/5 3/7)
     859(numcmp-test "ratnum vs ratnum 3 ne" #f 4/7 2/5)
     860(numcmp-test "ratnum vs ratnum 4 ne" #f 4/7 3/7)
     861(numcmp-test "ratnum vs flonum eq" #t 3/8 0.375)
     862(numcmp-test "ratnum vs flonum ne" #f 8/9 0.6)
    895863(numcmp-test "ratnum vs bignum ne" #f (/ (+ (expt 2 64) 1) 2) (expt 2 63))
    896864
     
    900868
    901869(test "fixnum/ratnum comparison" #f
    902        (= (read-from-string "-98781233389595723930250385525631360344437602649022271391716773162526352115087074898920261954897888235939429993829738630297052776667061779065100945771127020439712527398509771853491319737304616607041615012797134365574007368603232768089410097730646360760856052946465578073788924743642391638455649511108051053789425902013657106523269224045822294981391380222050223141347787674321888089837786284947870569165079491411110074602544203383038299901291952931113248943344436935596614205784436844912243069019367149526328612664067719765890897558075277707055756274228634652905751880612235340874976952880431555921814590049070979276358637989837532124647692152520447680373275200239544449293834424643702763974403094033892112967196087310232853165951285609426599617479356206218697586025251765476179158153123631158173662488102357611674821528467825910806391548770908013608889792001203039243914696463472490444573930050190716726220002151679336252008777326482398042427845860796285369622627679324605214987983884122808994422164327311297556122943400093231935477754959547620500784989043704825777186301417894825200797719289692636286337716705491307686644214213732116277102140558505945554566856673724837541141206267647285222293953181717113434757149921850120377706206012113994795124049471433490016083401216757825264766474891405185591236321448744678896448941259668731597494947127423662646933419809756274038044752395708014998820826196523041220918922611359697502638594907608648168849193813197790291360087857093790119162389573209640804111261616771827989939551840471235079945175327536638365874717775169210186608268924244639016270610098894971732892267642318266405837012482726627199088381027028630711279130575230815976484191675172279903609489448225149181063260231957171204855841611039996959582465138269247794842445177715476581512709861409446684911276158067098438009067149531119008707418601627426255891/2063950098473886055933596136103014753954685977787179797499441692283103642150668140884348149132839387663291870239435604463778573480782766958396423322880804442523056530013282118705429274303746421980903580754656364533869319744640130831962767797772323836293079599182477171562218297208495122660799328579852852969560730744211066545295945803939271680397511478811389399527913043145952054883289558914237172406636283114284363301999238526952309439259354223729114988806937903509692118585280437646676248013406270664905997291670857985754768850507766359973207600149782819306010561088246502918148146264806947375101624011387317921439210509902170092173796154464078297852707797984007992277904626058467143192149921546030028316990855470478894515952884526783686210401408859364838148201339959570732480920969000913791571631154267939054105878236201498477027265774680071188764947522112650857013491135901945605796776829525789886482760578142306057177990048751864852763036720112071475134369179525117161001517868525821398753039187062869247457336940152614866298628205010037695017885878296140891234142925514925051385440766473260338168038302226808098439763889250948602137806546736025439919604390464712793474019469457135856879584745805794574609707742445431851999335443724488636749987837445626810087003490329257105472274738811579817454656532496370562155449815456374456838912258383282154811001588175608617475540639254689723629881619252699580383612847920348111900440075645703960104081690968807839189109040568288972353424306876947127635585164905071821419089229871978994388197349499565628906992171901547121903117815637249359328193980583892566359962066242217169190169986105579733710057404319381685578470983838597020624234209884597110721892707818651210378187525863009879314177842634871978427592746452643603586344401223449546482306838947819060455178762434166799996220143825677025686435609179225302671777326568324855229172912876656233006785717920665743720753617646617017219230313226844735567400507490772935145894670445831971526014183234960075574401616682479457962912905141754252265169682318523572680657053374002911007741991220001444440319448034755483178790032581428679303588017268970") 0))
     870       (= -98781233389595723930250385525631360344437602649022271391716773162526352115087074898920261954897888235939429993829738630297052776667061779065100945771127020439712527398509771853491319737304616607041615012797134365574007368603232768089410097730646360760856052946465578073788924743642391638455649511108051053789425902013657106523269224045822294981391380222050223141347787674321888089837786284947870569165079491411110074602544203383038299901291952931113248943344436935596614205784436844912243069019367149526328612664067719765890897558075277707055756274228634652905751880612235340874976952880431555921814590049070979276358637989837532124647692152520447680373275200239544449293834424643702763974403094033892112967196087310232853165951285609426599617479356206218697586025251765476179158153123631158173662488102357611674821528467825910806391548770908013608889792001203039243914696463472490444573930050190716726220002151679336252008777326482398042427845860796285369622627679324605214987983884122808994422164327311297556122943400093231935477754959547620500784989043704825777186301417894825200797719289692636286337716705491307686644214213732116277102140558505945554566856673724837541141206267647285222293953181717113434757149921850120377706206012113994795124049471433490016083401216757825264766474891405185591236321448744678896448941259668731597494947127423662646933419809756274038044752395708014998820826196523041220918922611359697502638594907608648168849193813197790291360087857093790119162389573209640804111261616771827989939551840471235079945175327536638365874717775169210186608268924244639016270610098894971732892267642318266405837012482726627199088381027028630711279130575230815976484191675172279903609489448225149181063260231957171204855841611039996959582465138269247794842445177715476581512709861409446684911276158067098438009067149531119008707418601627426255891/2063950098473886055933596136103014753954685977787179797499441692283103642150668140884348149132839387663291870239435604463778573480782766958396423322880804442523056530013282118705429274303746421980903580754656364533869319744640130831962767797772323836293079599182477171562218297208495122660799328579852852969560730744211066545295945803939271680397511478811389399527913043145952054883289558914237172406636283114284363301999238526952309439259354223729114988806937903509692118585280437646676248013406270664905997291670857985754768850507766359973207600149782819306010561088246502918148146264806947375101624011387317921439210509902170092173796154464078297852707797984007992277904626058467143192149921546030028316990855470478894515952884526783686210401408859364838148201339959570732480920969000913791571631154267939054105878236201498477027265774680071188764947522112650857013491135901945605796776829525789886482760578142306057177990048751864852763036720112071475134369179525117161001517868525821398753039187062869247457336940152614866298628205010037695017885878296140891234142925514925051385440766473260338168038302226808098439763889250948602137806546736025439919604390464712793474019469457135856879584745805794574609707742445431851999335443724488636749987837445626810087003490329257105472274738811579817454656532496370562155449815456374456838912258383282154811001588175608617475540639254689723629881619252699580383612847920348111900440075645703960104081690968807839189109040568288972353424306876947127635585164905071821419089229871978994388197349499565628906992171901547121903117815637249359328193980583892566359962066242217169190169986105579733710057404319381685578470983838597020624234209884597110721892707818651210378187525863009879314177842634871978427592746452643603586344401223449546482306838947819060455178762434166799996220143825677025686435609179225302671777326568324855229172912876656233006785717920665743720753617646617017219230313226844735567400507490772935145894670445831971526014183234960075574401616682479457962912905141754252265169682318523572680657053374002911007741991220001444440319448034755483178790032581428679303588017268970 0))
    903871
    904872
     
    908876
    909877(test "fixnum? fixnum" #t (fixnum? 0))
    910 (test "fixnum? ratnum" #f (fixnum? (read-from-string "1/2")))
     878(test "fixnum? ratnum" #f (fixnum? 1/2))
    911879(test "fixnum? bignum" #f (fixnum? (expt 2 256)))
    912880(test "fixnum? flonum" #f (fixnum? 3.14))
    913 (test "fixnum? compnum" #f (fixnum? (read-from-string "1+3i")))
     881(test "fixnum? compnum" #f (fixnum? 1+3i))
    914882
    915883(test "fixnum? greatest"    #t (fixnum? (greatest-fixnum)))
     
    932900(test-begin "integer addition")
    933901
    934 (define x (read-from-string "#xffffffff00000000ffffffff00000000"))
     902(define x #xffffffff00000000ffffffff00000000)
    935903(define xx (- x))
    936 (define y (read-from-string "#x00000002000000000000000200000000"))
     904(define y #x00000002000000000000000200000000)
    937905(define yy (- y))
    938 (define z (read-from-string "#x00000000000000010000000000000001"))
    939 (test "bignum + bignum" (read-from-string "#x100000001000000010000000100000000")
     906(define z #x00000000000000010000000000000001)
     907(test "bignum + bignum" #x100000001000000010000000100000000
    940908      (+ x y))
    941 (test "bignum + -bignum" (read-from-string "#xfffffffd00000000fffffffd00000000")
     909(test "bignum + -bignum" #xfffffffd00000000fffffffd00000000
    942910      (+ x yy))
    943 (test "bignum - bignum" (read-from-string "#xfffffffefffffffffffffffeffffffff")
     911(test "bignum - bignum" #xfffffffefffffffffffffffeffffffff
    944912      (- x z))
    945913(test "bignum - bignum" x
    946914      (- (+ x y) y))
    947 (test "-bignum + bignum" (read-from-string "#x-fffffffd00000000fffffffd00000000")
     915(test "-bignum + bignum" #x-fffffffd00000000fffffffd00000000
    948916      (+ xx y))
    949 (test "-bignum + -bignum" (read-from-string "#x-100000001000000010000000100000000")
     917(test "-bignum + -bignum" #x-100000001000000010000000100000000
    950918      (+ xx yy))
    951 (test "-bignum - bignum" (read-from-string "#x-100000001000000010000000100000000")
     919(test "-bignum - bignum" #x-100000001000000010000000100000000
    952920      (- xx y))
    953 (test "-bignum - -bignum" (read-from-string "#x-fffffffd00000000fffffffd00000000")
     921(test "-bignum - -bignum" #x-fffffffd00000000fffffffd00000000
    954922      (- xx yy))
    955923
     
    1022990(test "NUMSUBI" #x-100000003 (- -3 x))
    1023991(test "NUMSUBI" #x100000003 (- x -3))
    1024 (define x (/ 33 7))
    1025 (test "NUMADDI" (read-from-string "54/7") (+ 3 x))
    1026 (test "NUMADDI" (read-from-string "54/7") (+ x 3))
    1027 (test "NUMADDI" (read-from-string "26/7") (+ -1 x))
    1028 (test "NUMADDI" (read-from-string "26/7") (+ x -1))
    1029 (test "NUMADDI" (read-from-string "-12/7") (- 3 x))
    1030 (test "NUMADDI" (read-from-string "12/7") (- x 3))
    1031 (test "NUMADDI" (read-from-string "-54/7") (- -3 x))
    1032 (test "NUMADDI" (read-from-string "54/7") (- x -3))
     992(define x 33/7)
     993(test "NUMADDI" 54/7 (+ 3 x))
     994(test "NUMADDI" 54/7 (+ x 3))
     995(test "NUMADDI" 26/7 (+ -1 x))
     996(test "NUMADDI" 26/7 (+ x -1))
     997(test "NUMADDI" -12/7 (- 3 x))
     998(test "NUMADDI" 12/7 (- x 3))
     999(test "NUMADDI" -54/7 (- -3 x))
     1000(test "NUMADDI" 54/7 (- x -3))
    10331001
    10341002(test "NUMADDI" 30 (+ 10 (if #t 20 25)))
     
    10661034(test "NUMADDF" 1.0 (+ -1 x))
    10671035(test "NUMADDF" 1.0 (+ x -1))
    1068 (test "NUMADDF" (read-from-string "2.0+1.0i") (+ (read-from-string "+i") x))
    1069 (test "NUMADDF" (read-from-string "2.0+1.0i") (+ x (read-from-string "+i")))
     1036(test "NUMADDF" 2.0+1.0i (+ +i x))
     1037(test "NUMADDF" 2.0+1.0i (+ x +i))
    10701038
    10711039(test "NUMSUBF" 1.0 (- 3 x))
     
    10731041(test "NUMSUBF" -5.0 (- -3 x))
    10741042(test "NUMSUBF" 5.0 (- x -3))
    1075 (test "NUMSUBF" (read-from-string "-2.0+1.0i") (- (read-from-string "+i") x))
    1076 (test "NUMSUBF" (read-from-string "2.0-1.0i") (- x (read-from-string "+i")))
     1043(test "NUMSUBF" -2.0+1.0i (- +i x))
     1044(test "NUMSUBF" 2.0-1.0i (- x +i))
    10771045
    10781046(test "NUMMULF" 4.0 (* x 2))
     
    10801048(test "NUMMULF" 3.0 (* x 1.5))
    10811049(test "NUMMULF" 3.0 (* 1.5 x))
    1082 (test "NUMMULF" (read-from-string "0+2.0i") (* x (read-from-string "+i")))
    1083 (test "NUMMULF" (read-from-string "0+2.0i") (* (read-from-string "+i") x))
     1050(test "NUMMULF" 0+2.0i (* x +i))
     1051(test "NUMMULF" 0+2.0i (* +i x))
    10841052
    10851053(test "NUMDIVF" 0.5 (/ x 4))
     
    10871055(test "NUMDIVF" 0.5 (/ x 4.0))
    10881056(test "NUMDIVF" 2.0 (/ 4.0 x))
    1089 (test "NUMDIVF" (read-from-string "0.0-0.5i") (/ x (read-from-string "+4i")))
    1090 (test "NUMDIVF" (read-from-string "0.0+2.0i") (/ (read-from-string "+4i") x))
     1057(test "NUMDIVF" 0.0-0.5i (/ x +4i))
     1058(test "NUMDIVF" 0.0+2.0i (/ +4i x))
    10911059
    10921060(test-end)
     
    10951063(test-begin "rational number addition")
    10961064
    1097 (test "ratnum +" (read-from-string "482/247")
    1098       (+ (read-from-string "11/13") (read-from-string "21/19")))
    1099 (test "ratnum -" (read-from-string "-64/247")
    1100       (- (read-from-string "11/13") (read-from-string "21/19")))
     1065(test "ratnum +" 482/247 (+ 11/13 21/19))
     1066(test "ratnum -" -64/247 (- 11/13 21/19))
    11011067
    11021068;; tests possible shortcut in Scm_Add etc.
    1103 (test "ratnum + 0" (list (read-from-string "11/13") (read-from-string "11/13"))
    1104        (list (apply + (list 0 (read-from-string "11/13")))
    1105              (apply + (list (read-from-string "11/13") 0))))
    1106 (test "ratnum - 0" (list (read-from-string "-11/13") (read-from-string "11/13"))
    1107        (list (apply - (list 0 (read-from-string "11/13")))
    1108              (apply - (list (read-from-string "11/13") 0))))
     1069(test "ratnum + 0" (list 11/13 11/13)
     1070       (list (apply + '(0 11/13)) (apply + '(11/13 0))))
     1071(test "ratnum - 0" (list -11/13 11/13)
     1072       (list (apply - '(0 11/13)) (apply - '(11/13 0))))
    11091073(test "ratnum * 0" (list 0 0)
    1110        (list (apply * (list 0 (read-from-string "11/13")))
    1111              (apply * (list (read-from-string "11/13") 0))))
    1112 (test "ratnum * 1" (list (read-from-string "11/13") (read-from-string "11/13"))
    1113        (list (apply * (list 1 (read-from-string "11/13")))
    1114              (apply * (list (read-from-string "11/13") 1))))
    1115 (test "ratnum / 1" (read-from-string "11/13")
    1116        (apply / (list (read-from-string "11/13") 1)))
     1074       (list (apply * '(0 11/13)) (apply * '(11/13 0))))
     1075(test "ratnum * 1" (list 11/13 11/13)
     1076       (list (apply * '(1 11/13)) (apply * '(11/13 1))))
     1077(test "ratnum / 1" 11/13
     1078       (apply / '(11/13 1)))
    11171079
    11181080(test-end)
     
    11331095(test "+" '(3 #t) (+-tester (+ 1 2)))
    11341096(test "+" '(6 #t) (+-tester (+ 1 2 3)))
    1135 (test "+" '(1 #t) (+-tester (+ (string->number "1/6") (string->number "1/3") (string->number "1/2"))))
     1097(test "+" '(1 #t) (+-tester (+ 1/6 1/3 1/2)))
    11361098(test "+" '(1.0 #f) (+-tester (+ 1.0)))
    11371099(test "+" '(3.0 #f) (+-tester (+ 1.0 2)))
    11381100(test "+" '(3.0 #f) (+-tester (+ 1 2.0)))
    11391101(test "+" '(6.0 #f) (+-tester (+ 1 2 3.0)))
    1140 (test "+" '(1.0 #f) (+-tester (+ (string->number "1/6") (string->number "1/3") 0.5)))
    1141 ;; Fixed for exactness because Gauche always uses inexact values for compnums
    1142 (test "+" (list (read-from-string "1+i") #t) (+-tester (+ 1 (read-from-string "+i"))))
    1143 (test "+" (list (read-from-string "3+i") #t) (+-tester (+ 1 2 (read-from-string "+i"))))
    1144 (test "+" (list (read-from-string "3+i") #t) (+-tester (+ (read-from-string "+i") 1 2)))
    1145 (test "+" (list (read-from-string "3.0+i") #f) (+-tester (+ 1.0 2 (read-from-string "+i"))))
    1146 (test "+" (list (read-from-string "3.0+i") #f) (+-tester (+ (read-from-string "+i") 1.0 2)))
    1147 (test "+" '(4294967298.0 #f) (+-tester (+ (read-from-string "4294967297") 1.0)))
    1148 (test "+" '(4294967299.0 #f) (+-tester (+ (read-from-string "4294967297") 1 1.0)))
    1149 (test "+" (list (read-from-string "4294967298.0-i") #f)
    1150       (+-tester (+ (read-from-string "4294967297") 1.0 (read-from-string "-i"))))
    1151 (test "+" (list (read-from-string "4294967298.0-i") #f)
    1152       (+-tester (+ (read-from-string "-i") (read-from-string "4294967297") 1.0)))
    1153 (test "+" (list (read-from-string "4294967298.0-i") #f)
    1154       (+-tester (+ 1.0 (read-from-string "4294967297") (read-from-string "-i"))))
     1102(test "+" '(1.0 #f) (+-tester (+ 1/6 1/3 0.5)))
     1103(test "+" '(1+i #t) (+-tester (+ 1 +i)))
     1104(test "+" '(3+i #t) (+-tester (+ 1 2 +i)))
     1105(test "+" '(3+i #t) (+-tester (+ +i 1 2)))
     1106(test "+" '(3.0+i #f) (+-tester (+ 1.0 2 +i)))
     1107(test "+" '(3.0+i #f) (+-tester (+ +i 1.0 2)))
     1108(test "+" '(4294967298.0 #f) (+-tester (+ 4294967297 1.0)))
     1109(test "+" '(4294967299.0 #f) (+-tester (+ 4294967297 1 1.0)))
     1110(test "+" '(4294967298.0-i #f) (+-tester (+ 4294967297 1.0 -i)))
     1111(test "+" '(4294967298.0-i #f) (+-tester (+ -i 4294967297 1.0)))
     1112(test "+" '(4294967298.0-i #f) (+-tester (+ 1.0 4294967297 -i)))
    11551113
    11561114(test-end)
     
    11901148;;   http://www.dd.iij4u.or.jp/~okuyamak/Information/Fermat.html
    11911149(test "fermat(7)" (fermat 7)
    1192       (* (read-from-string "59649589127497217")
    1193          (read-from-string "5704689200685129054721")))
     1150      (* 59649589127497217 5704689200685129054721))
    11941151(test "fermat(8)" (fermat 8)
    1195       (* (read-from-string "1238926361552897")
    1196          (read-from-string "93461639715357977769163558199606896584051237541638188580280321")))
     1152              (* 1238926361552897
     1153           93461639715357977769163558199606896584051237541638188580280321))
    11971154(test "fermat(9)" (fermat 9)
    1198       (* 2424833
    1199          (read-from-string "7455602825647884208337395736200454918783366342657")
    1200          (read-from-string "741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737")))
     1155              (* 2424833
     1156           7455602825647884208337395736200454918783366342657
     1157           741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737))
    12011158(test "fermat(10)" (fermat 10)
    1202       (* (read-from-string "45592577")
    1203          (read-from-string "6487031809")
    1204          (read-from-string "4659775785220018543264560743076778192897")
    1205          (read-from-string "130439874405488189727484768796509903946608530841611892186895295776832416251471863574140227977573104895898783928842923844831149032913798729088601617946094119449010595906710130531906171018354491609619193912488538116080712299672322806217820753127014424577")))
     1159              (* 45592577
     1160           6487031809
     1161           4659775785220018543264560743076778192897
     1162           130439874405488189727484768796509903946608530841611892186895295776832416251471863574140227977573104895898783928842923844831149032913798729088601617946094119449010595906710130531906171018354491609619193912488538116080712299672322806217820753127014424577
     1163           ))
    12061164(test "fermat(11)" (fermat 11)
    1207       (* 319489
    1208          974849
    1209          (read-from-string "167988556341760475137")
    1210          (read-from-string "3560841906445833920513")
    1211          (read-from-string "173462447179147555430258970864309778377421844723664084649347019061363579192879108857591038330408837177983810868451546421940712978306134189864280826014542758708589243873685563973118948869399158545506611147420216132557017260564139394366945793220968665108959685482705388072645828554151936401912464931182546092879815733057795573358504982279280090942872567591518912118622751714319229788100979251036035496917279912663527358783236647193154777091427745377038294584918917590325110939381322486044298573971650711059244462177542540706913047034664643603491382441723306598834177")))
     1165              (* 319489
     1166           974849
     1167           167988556341760475137
     1168           3560841906445833920513
     1169           173462447179147555430258970864309778377421844723664084649347019061363579192879108857591038330408837177983810868451546421940712978306134189864280826014542758708589243873685563973118948869399158545506611147420216132557017260564139394366945793220968665108959685482705388072645828554151936401912464931182546092879815733057795573358504982279280090942872567591518912118622751714319229788100979251036035496917279912663527358783236647193154777091427745377038294584918917590325110939381322486044298573971650711059244462177542540706913047034664643603491382441723306598834177
     1170           ))
    12121171
    12131172(test-end)
     
    12311190        )
    12321191
    1233   (test "ratnum * 0"  0 (apply * (list (read-from-string "1/2") 0)))
    1234   (test "0 * ratnum"  0 (apply * (list 0 (read-from-string "1/2"))))
    1235   (test "ratnum * 1"  (read-from-string "1/2") (apply * (list (read-from-string "1/2") 1)))
    1236   (test "1 * ratnum"  (read-from-string "1/2") (apply * (list 1 (read-from-string "1/2"))))
    1237 
    1238   (test "ratnum * 0.0"  0.0 (apply * (list (read-from-string "1/2") 0.0)))
    1239   (test "0.0 * ratnum"  0.0 (apply * (list 0.0 (read-from-string "1/2"))))
    1240   (test "ratnum * 1.0"  0.5 (apply * (list (read-from-string "1/2") 1.0)))
    1241   (test "1.0 * ratnum"  0.5 (apply * (list 1.0 (read-from-string "1/2"))))
    1242 
    1243   ;; Fixed for exactness (Gauche represents zero always exactly?)
    1244   (test "flonum * 0"  0.0 (apply * '(3.0 0)))
    1245   (test "0 * flonum"  0.0 (apply * '(0 3.0)))
    1246   (test "flonum * 1"  3.0 (apply * '(3.0 1)))
    1247   (test "1 * flonum"  3.0 (apply * '(1 3.0)))
    1248 
    1249   (test "flonum * 0.0"  0.0 (apply * '(3.0 0.0)))
    1250   (test "0.0 * flonum"  0.0 (apply * '(0.0 3.0)))
    1251   (test "flonum * 1.0"  3.0 (apply * '(3.0 1.0)))
    1252   (test "1.0 * flonum"  3.0 (apply * '(1.0 3.0)))
    1253 
    1254   (test "compnum * 0" 0 (* 0 (read-from-string "+i")))
    1255   (test "0 * compnum" 0 (* (read-from-string "+i") 0))
    1256   (test "compnum * 1" (read-from-string "+i") (* 1 (read-from-string "+i")))
    1257   (test "1 * compnum" (read-from-string "+i") (* (read-from-string "+i") 1))
    1258 
    1259   (test "compnum * 0.0" 0.0 (* 0.0 (read-from-string "+i")))
    1260   (test "0.0 * compnum" 0.0 (* (read-from-string "+i") 0.0))
    1261   (test "compnum * 1.0" (read-from-string "+1.0i") (* 1.0 (read-from-string "+i")))
    1262   (test "1.0 * compnum" (read-from-string "+1.0i") (* (read-from-string "+i") 1.0)))
     1192(test "ratnum * 0"  0 (apply * '(1/2 0)))
     1193(test "0 * ratnum"  0 (apply * '(0 1/2)))
     1194(test "ratnum * 1"  1/2 (apply * '(1/2 1)))
     1195(test "1 * ratnum"  1/2 (apply * '(1 1/2)))
     1196
     1197(test "ratnum * 0.0"  0.0 (apply * '(1/2 0.0)))
     1198(test "0.0 * ratnum"  0.0 (apply * '(0.0 1/2)))
     1199(test "ratnum * 1.0"  0.5 (apply * '(1/2 1.0)))
     1200(test "1.0 * ratnum"  0.5 (apply * '(1.0 1/2)))
     1201
     1202;; Fixed for exactness (Gauche represents zero always exactly?)
     1203(test "flonum * 0"  0.0 (apply * '(3.0 0)))
     1204(test "0 * flonum"  0.0 (apply * '(0 3.0)))
     1205(test "flonum * 1"  3.0 (apply * '(3.0 1)))
     1206(test "1 * flonum"  3.0 (apply * '(1 3.0)))
     1207
     1208(test "flonum * 0.0"  0.0 (apply * '(3.0 0.0)))
     1209(test "0.0 * flonum"  0.0 (apply * '(0.0 3.0)))
     1210(test "flonum * 1.0"  3.0 (apply * '(3.0 1.0)))
     1211(test "1.0 * flonum"  3.0 (apply * '(1.0 3.0)))
     1212
     1213(test "compnum * 0" 0 (* 0 +i))
     1214(test "0 * compnum" 0 (* +i 0))
     1215(test "compnum * 1" +i (* 1 +i))
     1216(test "1 * compnum" +i (* +i 1))
     1217
     1218(test "compnum * 0.0" 0.0 (* 0.0 +i))
     1219(test "0.0 * compnum" 0.0 (* +i 0.0))
     1220(test "compnum * 1.0" +1.0i (* 1.0 +i))
     1221(test "1.0 * compnum" +1.0i (* +i 1.0)))
    12631222
    12641223(test-end)
     
    12671226(test-begin "division")
    12681227
    1269 (test "exact division" (read-from-string "3/20") (/ 3 4 5))
    1270 (test "exact division" (read-from-string "1/2")
    1271       (/ (string->number "9223372036854775808")
    1272          (string->number "18446744073709551616")))
    1273 (test "exact division" (string->number "4692297364841/7")
    1274       (/ (string->number "28153784189046") 42))
    1275 (test "exact division" (string->number "7/4692297364841")
    1276        (/ 42 (string->number "28153784189046")))
    1277 (test "exact division" (string->number "-7/4692297364841")
    1278        (/ 42 (string->number "-28153784189046")))
    1279 (test "exact division" (string->number "7/4692297364841")
    1280        (/ -42 (string->number "-28153784189046")))
    1281 (test "exact reciprocal" (string->number "1/3") (/ 3))
    1282 (test "exact reciprocal" (string->number "-1/3") (/ -3))
    1283 (test "exact reciprocal" (string->number "5/6") (/ (read-from-string "6/5")))
    1284 (test "exact reciprocal" (string->number "-5/6") (/ (read-from-string "-6/5")))
    1285 (test "exact reciprocal" (string->number "7/4692297364841") (/ (string->number "4692297364841/7")))
     1228(test "exact division" 3/20 (/ 3 4 5))
     1229(test "exact division" 1/2  (/ 9223372036854775808 18446744073709551616))
     1230(test "exact division" 4692297364841/7
     1231       (/ 28153784189046 42))
     1232(test "exact division" 7/4692297364841
     1233       (/ 42 28153784189046))
     1234(test "exact division" -7/4692297364841
     1235       (/ 42 -28153784189046))
     1236(test "exact division" 7/4692297364841
     1237       (/ -42 -28153784189046))
     1238(test "exact reciprocal" 1/3 (/ 3))
     1239(test "exact reciprocal" -1/3 (/ -3))
     1240(test "exact reciprocal" 5/6 (/ 6/5))
     1241(test "exact reciprocal" -5/6 (/ -6/5))
     1242(test "exact reciprocal" 7/4692297364841 (/ 4692297364841/7))
    12861243
    12871244(define (almost=? x y)
     
    13041261      (d-tester 13 4.0))
    13051262(test "exact/inexact -> inexact" (d-result 1.625 #f)
    1306       (d-tester (read-from-string "13/2") 4.0))
     1263      (d-tester 13/2 4.0))
    13071264(test "inexact/exact -> inexact" (d-result 3.25 #f)
    13081265      (d-tester 13.0 4))
    13091266(test "inexact/exact -> inexact" (d-result 9.75 #f)
    1310       (d-tester 13.0 (read-from-string "4/3")))
     1267      (d-tester 13.0 4/3))
    13111268(test "inexact/inexact -> inexact" (d-result 3.25 #f)
    13121269      (d-tester 13.0 4.0))
     
    13151272(test "complex division" 0.0
    13161273       (let ((a 3)
    1317              (b (read-from-string "4+3i"))
     1274             (b 4+3i)
    13181275             (c 7.3))
    13191276         (- (/ a b c)
     
    13311288        (exact? (quotient x y))))
    13321289
     1290
    13331291;; these uses BignumDivSI -> bignum_sdiv
    13341292(test "big[1]/fix->fix" (q-result 17353 #t)
    1335       (q-tester (read-from-string "727836879") 41943))
     1293      (q-tester 727836879 41943))
    13361294(test "big[1]/fix->fix" (q-result 136582 #t)
    1337       (q-tester (read-from-string "3735928559") 27353))
    1338 (test "big[2]/fix->big[1]" (q-result (read-from-string "535341266467") #t)
    1339       (q-tester (read-from-string "12312849128741") 23))
    1340 (test "big[2]/fix->big[2]" (q-result (read-from-string "12312849128741") #t)
    1341       (q-tester (read-from-string "12312849128741") 1))
     1295      (q-tester 3735928559 27353))
     1296(test "big[2]/fix->big[1]" (q-result 535341266467 #t)
     1297      (q-tester 12312849128741 23))
     1298(test "big[2]/fix->big[2]" (q-result 12312849128741 #t)
     1299      (q-tester 12312849128741 1))
    13421300
    13431301;; these uses BignumDivSI -> bignum_gdiv
    13441302(test "big[1]/fix->fix" (q-result 41943 #t)
    1345       (q-tester (read-from-string "3663846879") 87353))
     1303      (q-tester 3663846879 87353))
    13461304(test "big[2]/fix->fix" (q-result 19088743 #t)
    1347       (q-tester (read-from-string "705986470884353") 36984440))
     1305      (q-tester 705986470884353 36984440))
    13481306(test "big[2]/fix->fix" (q-result 92894912 #t)
    1349       (q-tester (read-from-string "12312849128741") 132546))
    1350 (test "big[2]/fix->big[1]" (q-result (read-from-string "2582762030") #t)
    1351       (q-tester (read-from-string "425897458766735") 164900))
     1307      (q-tester 12312849128741 132546))
     1308(test "big[2]/fix->big[1]" (q-result 2582762030 #t)
     1309      (q-tester 425897458766735 164900))
    13521310
    13531311;; these uses BignumDivRem
    13541312(test "big[1]/big[1]->fix" (q-result 2 #t)
    1355       (q-tester (read-from-string "4020957098") (read-from-string "1952679221")))
     1313      (q-tester 4020957098 1952679221))
    13561314(test "big[1]/big[1] -> fix" (q-result 0 #t)
    1357       (q-tester (read-from-string "1952679221") (read-from-string "4020957098")))
     1315      (q-tester 1952679221 4020957098))
    13581316;; this tests loop in estimation phase
    1359 (test "big[3]/big[2] -> big[1]" (q-result (read-from-string "#xffff0001") #t)
    1360       (q-tester (read-from-string "#x10000000000000000") (read-from-string "#x10000ffff")))
     1317(test "big[3]/big[2] -> big[1]" (q-result #xffff0001 #t)
     1318      (q-tester #x10000000000000000 #x10000ffff))
    13611319;; this test goes through a rare case handling code ("add back") in
    13621320;; the algorithm.
    13631321(test "big[3]/big[2] -> fix" (q-result #xeffe #t)
    1364       (q-tester (read-from-string "#x7800000000000000") (read-from-string "#x80008889ffff")))
     1322      (q-tester #x7800000000000000 #x80008889ffff))
    13651323
    13661324;; inexact quotient
     
    13791337
    13801338;; Test by fermat numbers
    1381 (test "fermat(7)" (read-from-string "59649589127497217")
    1382       (quotient (fermat 7) (read-from-string "5704689200685129054721")))
    1383 (test "fermat(8)" (read-from-string "1238926361552897")
    1384       (quotient (fermat 8) (read-from-string "93461639715357977769163558199606896584051237541638188580280321")))
     1339(test "fermat(7)" 59649589127497217
     1340      (quotient (fermat 7) 5704689200685129054721))
     1341(test "fermat(8)" 1238926361552897
     1342              (quotient (fermat 8) 93461639715357977769163558199606896584051237541638188580280321))
    13851343(test "fermat(9)" 2424833
    1386       (quotient (quotient (fermat 9) (read-from-string "7455602825647884208337395736200454918783366342657"))
    1387                 (read-from-string "741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737")))
    1388 (test "fermat(10)" (read-from-string "4659775785220018543264560743076778192897")
    1389       (quotient (quotient (quotient (fermat 10)
    1390                                     (read-from-string "130439874405488189727484768796509903946608530841611892186895295776832416251471863574140227977573104895898783928842923844831149032913798729088601617946094119449010595906710130531906171018354491609619193912488538116080712299672322806217820753127014424577"))
    1391                           (read-from-string "6487031809"))
    1392                 (read-from-string "45592577")))
    1393 (test "fermat(11)" (read-from-string "3560841906445833920513")
    1394       (quotient (quotient (quotient (quotient (fermat 11)
    1395                                               (read-from-string "167988556341760475137"))
    1396                                     (read-from-string "173462447179147555430258970864309778377421844723664084649347019061363579192879108857591038330408837177983810868451546421940712978306134189864280826014542758708589243873685563973118948869399158545506611147420216132557017260564139394366945793220968665108959685482705388072645828554151936401912464931182546092879815733057795573358504982279280090942872567591518912118622751714319229788100979251036035496917279912663527358783236647193154777091427745377038294584918917590325110939381322486044298573971650711059244462177542540706913047034664643603491382441723306598834177")
    1397                                     )
    1398                           974849)
    1399                 319489))
     1344              (quotient (quotient (fermat 9) 7455602825647884208337395736200454918783366342657)
     1345                  741640062627530801524787141901937474059940781097519023905821316144415759504705008092818711693940737))
     1346(test "fermat(10)" 4659775785220018543264560743076778192897
     1347              (quotient (quotient (quotient (fermat 10)
     1348                                      130439874405488189727484768796509903946608530841611892186895295776832416251471863574140227977573104895898783928842923844831149032913798729088601617946094119449010595906710130531906171018354491609619193912488538116080712299672322806217820753127014424577)
     1349                            6487031809)
     1350                  45592577))
     1351(test "fermat(11)" 3560841906445833920513
     1352              (quotient (quotient (quotient (quotient (fermat 11)
     1353                                                167988556341760475137)
     1354                                      173462447179147555430258970864309778377421844723664084649347019061363579192879108857591038330408837177983810868451546421940712978306134189864280826014542758708589243873685563973118948869399158545506611147420216132557017260564139394366945793220968665108959685482705388072645828554151936401912464931182546092879815733057795573358504982279280090942872567591518912118622751714319229788100979251036035496917279912663527358783236647193154777091427745377038294584918917590325110939381322486044298573971650711059244462177542540706913047034664643603491382441723306598834177
     1355                                      )
     1356                            974849)
     1357                  319489))
    14001358
    14011359(test-end)
     
    14161374      (r-tester 1234 87935))
    14171375(test "fix rem big[1] -> fix" (r-result 12345 #t)
    1418       (r-tester 12345 (read-from-string "3735928559")))
     1376      (r-tester 12345 3735928559))
    14191377
    14201378;; these uses BignumDivSI -> bignum_sdiv
    14211379(test "big[1] rem fix -> fix" (r-result 0 #t)
    1422       (r-tester (read-from-string "727836879") 41943))
     1380      (r-tester 727836879 41943))
    14231381(test "big[1] rem fix -> fix" (r-result 1113 #t)
    1424       (r-tester (read-from-string "3735928559") 27353))
     1382      (r-tester 3735928559 27353))
    14251383(test "big[2] rem fix -> fix" (r-result 15 #t)
    1426       (r-tester (read-from-string "12312849128756") 23))
     1384      (r-tester 12312849128756 23))
    14271385(test "big[2] rem fix -> fix" (r-result 0 #t)
    1428       (r-tester (read-from-string "12312849128756") 1))
     1386      (r-tester 12312849128756 1))
    14291387
    14301388;; these uses BignumDivSI -> bignum_gdiv
    14311389(test "big[1] rem fix -> fix" (r-result 0 #t)
    1432       (r-tester (read-from-string "3663846879") 87353))
     1390      (r-tester 3663846879 87353))
    14331391(test "big[2] rem fix -> fix" (r-result 725433 #t)
    1434       (r-tester (read-from-string "705986470884353") 36984440))
     1392      (r-tester 705986470884353 36984440))
    14351393(test "big[2] rem fix -> fix" (r-result 122789 #t)
    1436       (r-tester (read-from-string "12312849128741") 132546))
     1394      (r-tester 12312849128741 132546))
    14371395(test "big[2] rem fix -> fix" (r-result 19735 #t)
    1438       (r-tester (read-from-string "425897458766735") 164900))
     1396      (r-tester 425897458766735 164900))
    14391397
    14401398;; these uses BignumDivRem
    14411399(test "big[1] rem big[1] -> fix" (r-result 115598656 #t)
    1442       (r-tester (read-from-string "4020957098") (read-from-string "1952679221")))
     1400      (r-tester 4020957098 1952679221))
    14431401(test "big[1] rem big[1] -> fix" (r-result 1952679221 #t)
    1444       (r-tester (read-from-string "1952679221") (read-from-string "4020957098")))
     1402      (r-tester 1952679221 4020957098))
    14451403;; this tests loop in estimation phase
    1446 (test "big[3] rem big[2] -> big[1]" (r-result (read-from-string "#xfffe0001") #t)
    1447       (r-tester (read-from-string "#x10000000000000000") (read-from-string "#x10000ffff")))
     1404(test "big[3] rem big[2] -> big[1]" (r-result #xfffe0001 #t)
     1405      (r-tester #x10000000000000000 #x10000ffff))
    14481406;; this tests "add back" code
    1449 (test "big[3] rem big[2] -> big[2]" (r-result (read-from-string "#x7fffb114effe") #t)
    1450       (r-tester (read-from-string "#x7800000000000000") (read-from-string "#x80008889ffff")))
     1407(test "big[3] rem big[2] -> big[2]" (r-result #x7fffb114effe #t)
     1408      (r-tester #x7800000000000000 #x80008889ffff))
    14511409
    14521410;; inexact remainder
     
    14801438(test "fix mod fix -> fix" (m-result 1234 86701 #t)
    14811439      (m-tester 1234 87935))
    1482 (test "fix mod big[1] -> fix/big" (m-result 12345 (read-from-string "3735916214") #t)
    1483       (m-tester 12345 (read-from-string "3735928559")))
     1440(test "fix mod big[1] -> fix/big" (m-result 12345 3735916214 #t)
     1441      (m-tester 12345 3735928559))
    14841442
    14851443;; these uses BignumDivSI -> bignum_sdiv
    14861444(test "big[1] mod fix -> fix" (m-result 0 0 #t)
    1487       (m-tester (read-from-string "727836879") 41943))
     1445      (m-tester 727836879 41943))
    14881446(test "big[1] mod fix -> fix" (m-result 1113 26240 #t)
    1489       (m-tester (read-from-string "3735928559") 27353))
     1447      (m-tester 3735928559 27353))
    14901448(test "big[2] mod fix -> fix" (m-result 15 8 #t)
    1491       (m-tester (read-from-string "12312849128756") 23))
     1449      (m-tester 12312849128756 23))
    14921450(test "big[2] mod fix -> fix" (m-result 0 0 #t)
    1493       (m-tester (read-from-string "12312849128756") 1))
     1451      (m-tester 12312849128756 1))
    14941452
    14951453;; these uses BignumDivSI -> bignum_gdiv
    14961454(test "big[1] mod fix -> fix" (m-result 0 0 #t)
    1497       (m-tester (read-from-string "3663846879") 87353))
     1455      (m-tester 3663846879 87353))
    14981456(test "big[2] mod fix -> fix" (m-result 725433 36259007 #t)
    1499       (m-tester (read-from-string "705986470884353") 36984440))
     1457      (m-tester 705986470884353 36984440))
    15001458(test "big[2] mod fix -> fix" (m-result 122789 9757 #t)
    1501       (m-tester (read-from-string "12312849128741") 132546))
     1459      (m-tester 12312849128741 132546))
    15021460(test "big[2] mod fix -> fix" (m-result 19735 145165 #t)
    1503       (m-tester (read-from-string "425897458766735") 164900))
     1461      (m-tester 425897458766735 164900))
    15041462
    15051463;; these uses BignumDivRem
    1506 (test "big[1] mod big[1] -> fix"
    1507       (m-result (read-from-string "115598656") (read-from-string "1837080565") #t)
    1508       (m-tester (read-from-string "4020957098") (read-from-string "1952679221")))
    1509 (test "big[1] mod big[1] -> fix"
    1510       (m-result (read-from-string "1952679221") (read-from-string "2068277877") #t)
    1511       (m-tester (read-from-string "1952679221") (read-from-string "4020957098")))
     1464(test "big[1] mod big[1] -> fix" (m-result 115598656 1837080565 #t)
     1465      (m-tester 4020957098 1952679221))
     1466(test "big[1] mod big[1] -> fix" (m-result 1952679221 2068277877 #t)
     1467      (m-tester 1952679221 4020957098))
    15121468;; this tests loop in estimation phase
    1513 (test "big[3] mod big[2] -> big[1]"
    1514       (m-result (read-from-string "#xfffe0001") (read-from-string "#x2fffe") #t)
    1515       (m-tester (read-from-string "#x10000000000000000") (read-from-string "#x10000ffff")))
     1469(test "big[3] mod big[2] -> big[1]" (m-result #xfffe0001 #x2fffe #t)
     1470      (m-tester #x10000000000000000 #x10000ffff))
    15161471;; this tests "add back" code
    1517 (test "big[3] mod big[2] -> big[2]"
    1518       (m-result (read-from-string "#x7fffb114effe") (read-from-string "#xd7751001") #t)
    1519       (m-tester (read-from-string "#x7800000000000000") (read-from-string "#x80008889ffff")))
     1472(test "big[3] mod big[2] -> big[2]" (m-result #x7fffb114effe #xd7751001 #t)
     1473      (m-tester #x7800000000000000 #x80008889ffff))
    15201474
    15211475;; inexact modulo
     
    16211575              (- (expt 2 99)) (- (expt 2 99)) (- (expt 2 99)) (- (expt 2 99)))
    16221576
    1623 (round-tester (read-from-string "9/4")  #t 3 2 2 2)
    1624 (round-tester (read-from-string "-9/4") #t -2 -3 -2 -2)
    1625 (round-tester (read-from-string "34985495387484938453495/17") #t
    1626               (read-from-string "2057970316910878732559")
    1627               (read-from-string "2057970316910878732558")
    1628               (read-from-string "2057970316910878732558")
    1629               (read-from-string "2057970316910878732559"))
    1630 (round-tester (read-from-string "-34985495387484938453495/17") #t
    1631               (read-from-string "-2057970316910878732558")
    1632               (read-from-string "-2057970316910878732559")
    1633               (read-from-string "-2057970316910878732558")
    1634               (read-from-string "-2057970316910878732559"))
    1635 
    1636 (round-tester (read-from-string "35565/2") #t 17783 17782 17782 17782)
    1637 (round-tester (read-from-string "-35565/2") #t -17782 -17783 -17782 -17782)
    1638 (round-tester (read-from-string "35567/2") #t 17784 17783 17783 17784)
    1639 (round-tester (read-from-string "-35567/2") #t -17783 -17784 -17783 -17784)
    1640 
    1641 (parameterize ((current-test-comparator =))
    1642   (test "round->exact" 3 (round->exact 3.4))
    1643   (test "round->exact" 4 (round->exact 3.5))
    1644   (test "floor->exact" 3 (floor->exact 3.4))
    1645   (test "floor->exact" -4 (floor->exact -3.5))
    1646   (test "ceiling->exact" 4 (ceiling->exact 3.4))
    1647   (test "ceiling->exact" -3 (ceiling->exact -3.5))
    1648   (test "truncate->exact" 3 (truncate->exact 3.4))
    1649   (test "truncate->exact" -3 (truncate->exact -3.5)))
     1577(round-tester 9/4  #t 3 2 2 2)
     1578(round-tester -9/4 #t -2 -3 -2 -2)
     1579(round-tester 34985495387484938453495/17 #t
     1580              2057970316910878732559
     1581              2057970316910878732558
     1582              2057970316910878732558
     1583              2057970316910878732559)
     1584(round-tester -34985495387484938453495/17 #t
     1585              -2057970316910878732558
     1586              -2057970316910878732559
     1587              -2057970316910878732558
     1588              -2057970316910878732559)
     1589
     1590(round-tester 35565/2 #t 17783 17782 17782 17782)
     1591(round-tester -35565/2 #t -17782 -17783 -17782 -17782)
     1592(round-tester 35567/2 #t 17784 17783 17783 17784)
     1593(round-tester -35567/2 #t -17783 -17784 -17783 -17784)
     1594
     1595(test "round->exact" 3 (round->exact 3.4))
     1596(test "round->exact" 4 (round->exact 3.5))
     1597(test "floor->exact" 3 (floor->exact 3.4))
     1598(test "floor->exact" -4 (floor->exact -3.5))
     1599(test "ceiling->exact" 4 (ceiling->exact 3.4))
     1600(test "ceiling->exact" -3 (ceiling->exact -3.5))
     1601(test "truncate->exact" 3 (truncate->exact 3.4))
     1602(test "truncate->exact" -3 (truncate->exact -3.5))
    16501603
    16511604(test-end)
     
    17301683      (ash #x-408000 0))
    17311684
    1732 (test "ash (fixnum->bignum)" (string->number "#x81000000")
     1685
     1686(test "ash (fixnum->bignum)" #x81000000
    17331687      (ash #x81 24))
    1734 (test "ash (fixnum->bignum)" (string->number "#x4080000000")
     1688(test "ash (fixnum->bignum)" #x4080000000
    17351689      (ash #x81 31))
    1736 (test "ash (fixnum->bignum)" (string->number "#x8100000000")
     1690(test "ash (fixnum->bignum)" #x8100000000
    17371691      (ash #x81 32))
    1738 (test "ash (fixnum->bignum)" (string->number "#x8100000000000000")
     1692(test "ash (fixnum->bignum)" #x8100000000000000
    17391693      (ash #x81 56))
    1740 (test "ash (fixnum->bignum)" (string->number "#x408000000000000000")
     1694(test "ash (fixnum->bignum)" #x408000000000000000
    17411695      (ash #x81 63))
    1742 (test "ash (fixnum->bignum)" (string->number "#x810000000000000000")
     1696(test "ash (fixnum->bignum)" #x810000000000000000
    17431697      (ash #x81 64))
    1744 (test "ash (neg.fixnum->bignum)" (string->number "#x-81000000")
     1698(test "ash (neg.fixnum->bignum)" #x-81000000
    17451699      (ash #x-81 24))
    1746 (test "ash (neg.fixnum->bignum)" (string->number "#x-4080000000")
     1700(test "ash (neg.fixnum->bignum)" #x-4080000000
    17471701      (ash #x-81 31))
    1748 (test "ash (neg.fixnum->bignum)" (string->number "#x-8100000000")
     1702(test "ash (neg.fixnum->bignum)" #x-8100000000
    17491703      (ash #x-81 32))
    1750 (test "ash (neg.fixnum->bignum)" (string->number "#x-8100000000000000")
     1704(test "ash (neg.fixnum->bignum)" #x-8100000000000000
    17511705      (ash #x-81 56))
    1752 (test "ash (neg.fixnum->bignum)" (string->number "#x-408000000000000000")
     1706(test "ash (neg.fixnum->bignum)" #x-408000000000000000
    17531707      (ash #x-81 63))
    1754 (test "ash (neg.fixnum->bignum)" (string->number "#x-810000000000000000")
     1708(test "ash (neg.fixnum->bignum)" #x-810000000000000000
    17551709      (ash #x-81 64))
    17561710
    17571711(test "ash (bignum->fixnum)" #x81
    1758       (ash (string->number "#x81000000") -24))
     1712      (ash  #x81000000 -24))
    17591713(test "ash (bignum->fixnum)" #x40
    1760       (ash  (string->number "#x81000000") -25))
     1714      (ash  #x81000000 -25))
    17611715(test "ash (bignum->fixnum)" 1
    1762       (ash (string->number "#x81000000") -31))
     1716      (ash  #x81000000 -31))
    17631717(test "ash (bignum->fixnum)" 0
    1764       (ash (string->number "#x81000000") -32))
     1718      (ash  #x81000000 -32))
    17651719(test "ash (bignum->fixnum)" 0
    1766       (ash (string->number "#x81000000") -100))
     1720      (ash  #x81000000 -100))
    17671721(test "ash (bignum->fixnum)" #x81
    1768       (ash (string->number "#x4080000000") -31))
     1722      (ash #x4080000000 -31))
    17691723(test "ash (bignum->fixnum)" #x81
    1770       (ash (string->number "#x8100000000") -32))
     1724      (ash #x8100000000 -32))
    17711725(test "ash (bignum->fixnum)" #x40
    1772       (ash (string->number "#x8100000000") -33))
     1726      (ash #x8100000000 -33))
    17731727(test "ash (bignum->fixnum)" 1
    1774       (ash (string->number "#x8100000000") -39))
     1728      (ash #x8100000000 -39))
    17751729(test "ash (bignum->fixnum)" 0
    1776       (ash (string->number "#x8100000000") -40))
     1730      (ash #x8100000000 -40))
    17771731(test "ash (bignum->fixnum)" 0
    1778       (ash (string->number "#x8100000000") -100))
     1732      (ash #x8100000000 -100))
    17791733(test "ash (bignum->fixnum)" #x81
    1780       (ash (string->number "#x8100000000000000") -56))
     1734      (ash #x8100000000000000 -56))
    17811735(test "ash (bignum->fixnum)" #x81
    1782       (ash (string->number "#x408000000000000000") -63))
     1736      (ash #x408000000000000000 -63))
    17831737(test "ash (bignum->fixnum)" #x40
    1784       (ash (string->number "#x408000000000000000") -64))
     1738      (ash #x408000000000000000 -64))
    17851739(test "ash (bignum->fixnum)" #x20
    1786       (ash (string->number "#x408000000000000000") -65))
     1740      (ash #x408000000000000000 -65))
    17871741(test "ash (bignum->fixnum)" 1
    1788       (ash (string->number "#x408000000000000000") -70))
     1742      (ash #x408000000000000000 -70))
    17891743(test "ash (bignum->fixnum)" 0
    1790       (ash (string->number "#x408000000000000000") -71))
     1744      (ash #x408000000000000000 -71))
    17911745(test "ash (bignum->fixnum)" 0
    1792       (ash (string->number "#x408000000000000000") -100))
     1746      (ash #x408000000000000000 -100))
    17931747
    17941748(test "ash (neg.bignum->fixnum)" #x-81
    1795       (ash (string->number "#x-81000000") -24))
     1749      (ash #x-81000000 -24))
    17961750(test "ash (neg.bignum->fixnum)" #x-41
    1797       (ash (string->number "#x-81000000") -25))
     1751      (ash #x-81000000 -25))
    17981752(test "ash (neg.bignum->fixnum)" #x-21
    1799       (ash (string->number "#x-81000000") -26))
     1753      (ash #x-81000000 -26))
    18001754(test "ash (neg.bignum->fixnum)" -2
    1801       (ash (string->number "#x-81000000") -31))
     1755      (ash #x-81000000 -31))
    18021756(test "ash (neg.bignum->fixnum)" -1
    1803       (ash (string->number "#x-81000000") -32))
     1757      (ash #x-81000000 -32))
    18041758(test "ash (neg.bignum->fixnum)" -1
    1805       (ash (string->number "#x-81000000") -33))
     1759      (ash #x-81000000 -33))
    18061760(test "ash (neg.bignum->fixnum)" -1
    1807       (ash (string->number "#x-81000000") -100))
     1761      (ash #x-81000000 -100))
    18081762(test "ash (neg.bignum->fixnum)" #x-81
    1809       (ash (string->number "#x-4080000000") -31))
     1763      (ash #x-4080000000 -31))
    18101764(test "ash (neg.bignum->fixnum)" #x-41
    1811       (ash (string->number "#x-4080000000") -32))
     1765      (ash #x-4080000000 -32))
    18121766(test "ash (neg.bignum->fixnum)" #x-21
    1813       (ash (string->number "#x-4080000000") -33))
     1767      (ash #x-4080000000 -33))
    18141768(test "ash (neg.bignum->fixnum)" -2
    1815       (ash (string->number "#x-4080000000") -38))
     1769      (ash #x-4080000000 -38))
    18161770(test "ash (neg.bignum->fixnum)" -1
    1817       (ash (string->number "#x-4080000000") -39))
     1771      (ash #x-4080000000 -39))
    18181772(test "ash (neg.bignum->fixnum)" -1
    1819       (ash (string->number "#x-4080000000") -100))
     1773      (ash #x-4080000000 -100))
    18201774(test "ash (neg.bignum->fixnum)" #x-81
    1821       (ash (string->number "#x-408000000000000000") -63))
     1775      (ash #x-408000000000000000 -63))
    18221776(test "ash (neg.bignum->fixnum)" #x-41
    1823       (ash (string->number "#x-408000000000000000") -64))
     1777      (ash #x-408000000000000000 -64))
    18241778(test "ash (neg.bignum->fixnum)" #x-21
    1825       (ash (string->number "#x-408000000000000000") -65))
     1779      (ash #x-408000000000000000 -65))
    18261780(test "ash (neg.bignum->fixnum)" -2
    1827       (ash (string->number "#x-408000000000000000") -70))
     1781      (ash #x-408000000000000000 -70))
    18281782(test "ash (neg.bignum->fixnum)" -1
    1829       (ash (string->number "#x-408000000000000000") -71))
     1783      (ash #x-408000000000000000 -71))
    18301784(test "ash (neg.bignum->fixnum)" -1
    1831       (ash (string->number "#x-408000000000000000") -72))
    1832 
    1833 (test "ash (bignum->bignum)" (string->number "#x12345678123456780")
     1785      (ash #x-408000000000000000 -72))
     1786
     1787(test "ash (bignum->bignum)" #x12345678123456780
    18341788      (ash #x1234567812345678 4))
    1835 (test "ash (bignum->bignum)" (string->number "#x1234567812345678000000000000000")
     1789(test "ash (bignum->bignum)" #x1234567812345678000000000000000
    18361790      (ash #x1234567812345678 60))
    1837 (test "ash (bignum->bignum)" (string->number "#x12345678123456780000000000000000")
     1791(test "ash (bignum->bignum)" #x12345678123456780000000000000000
    18381792      (ash #x1234567812345678 64))
    1839 (test "ash (bignum->bignum)" (string->number "#x123456781234567")
     1793(test "ash (bignum->bignum)" #x123456781234567
    18401794      (ash #x1234567812345678 -4))
    1841 (test "ash (bignum->bignum)" (string->number "#x12345678")
     1795(test "ash (bignum->bignum)" #x12345678
    18421796      (ash #x1234567812345678 -32))
    1843 (test "ash (neg.bignum->bignum)" (string->number "#x-123456781234568")
     1797(test "ash (neg.bignum->bignum)" #x-123456781234568
    18441798      (ash #x-1234567812345678 -4))
    1845 (test "ash (bignum->bignum)" (string->number "#x-12345679")
     1799(test "ash (bignum->bignum)" #x-12345679
    18461800      (ash #x-1234567812345678 -32))
    18471801
     
    18501804(test "lognot (fixnum)" -65536 (lognot 65535))
    18511805(test "lognot (fixnum)" 65535 (lognot -65536))
    1852 (test "lognot (bignum)" (string->number "#x-1000000000000000001")
    1853       (lognot (string->number "#x1000000000000000000")))
    1854 (test "lognot (bignum)" (string->number "#x1000000000000000000")
    1855       (lognot (string->number "#x-1000000000000000001")))
     1806(test "lognot (bignum)" #x-1000000000000000001
     1807      (lognot #x1000000000000000000))
     1808(test "lognot (bignum)" #x1000000000000000000
     1809      (lognot #x-1000000000000000001))
    18561810
    18571811(test "logand (+fix & 0)" 0
     
    18611815(test "logand (+fix & -1)" #x123456
    18621816      (logand #x123456 -1))
    1863 (test "logand (+big & -1)" (string->number "#x1234567812345678")
    1864       (logand (string->number "#x1234567812345678") -1))
     1817(test "logand (+big & -1)" #x1234567812345678
     1818      (logand #x1234567812345678 -1))
    18651819(test "logand (+fix & +fix)" #x2244
    18661820      (logand #xaa55 #x6666))
    18671821(test "logand (+fix & +big)" #x2244
    1868       (logand #xaa55 (string->number "#x6666666666")))
     1822      (logand #xaa55 #x6666666666))
    18691823(test "logand (+big & +fix)" #x4422
    18701824      (logand #xaa55aa55aa #x6666))
    1871 (test "logand (+big & +big)" (string->number "#x2244224422")
    1872       (logand (string->number "#xaa55aa55aa") (string->number "#x6666666666")))
    1873 (test "logand (+big & +big)" (string->number "#x103454301aaccaa")
    1874       (logand (string->number "#x123456789abcdef")
    1875               (string->number "#xfedcba987654321fedcba987654321fedcba")))
     1825(test "logand (+big & +big)" #x2244224422
     1826      (logand #xaa55aa55aa #x6666666666))
     1827(test "logand (+big & +big)" #x103454301aaccaa
     1828      (logand #x123456789abcdef #xfedcba987654321fedcba987654321fedcba))
    18761829(test "logand (+big & +big)" #x400000
    1877       (logand (string->number "#xaa55ea55aa") (string->number "#x55aa55aa55")))
     1830      (logand #xaa55ea55aa #x55aa55aa55))
    18781831(test "logand (+fix & -fix)" #x8810
    18791832      (logand #xaa55 #x-6666))
    18801833(test "logand (+fix & -big)" #x8810
    1881       (logand #xaa55 (string->number "#x-6666666666")))
    1882 (test "logand (+big & -fix)" (string->number "#xaa55aa118a")
    1883       (logand (string->number "#xaa55aa55aa") #x-6666))
    1884 (test "logand (+big & -big)" (string->number "#x881188118a")
    1885       (logand (string->number "#xaa55aa55aa") (string->number "#x-6666666666")))
    1886 (test "logand (+big & -big)" (string->number "#x20002488010146")
    1887       (logand (string->number "#x123456789abcdef")
    1888               (string->number "#x-fedcba987654321fedcba987654321fedcba")))
     1834      (logand #xaa55 #x-6666666666))
     1835(test "logand (+big & -fix)" #xaa55aa118a
     1836      (logand #xaa55aa55aa #x-6666))
     1837(test "logand (+big & -big)" #x881188118a
     1838      (logand #xaa55aa55aa #x-6666666666))
     1839(test "logand (+big & -big)" #x20002488010146
     1840      (logand #x123456789abcdef #x-fedcba987654321fedcba987654321fedcba))
    18891841(test "logand (-fix & +fix)" #x4422
    18901842      (logand #x-aa55 #x6666))
    1891 (test "logand (-fix & +big)" (string->number "#x6666664422")
    1892       (logand #x-aa55 (string->number "#x6666666666")))
     1843(test "logand (-fix & +big)" #x6666664422
     1844      (logand #x-aa55 #x6666666666))
    18931845(test "logand (-big & +fix)" #x2246
    18941846      (logand #x-aa55aa55aa #x6666))
    1895 (test "logand (-big & +big)" (string->number "#x4422442246")
    1896       (logand (string->number "#x-aa55aa55aa") (string->number "#x6666666666")))
    1897 (test "logand (-big & +big)"
    1898       (string->number "#xfedcba987654321fedcba884200020541010")
    1899       (logand (string->number "#x-123456789abcdef")
    1900               (string->number "#xfedcba987654321fedcba987654321fedcba")))
     1847(test "logand (-big & +big)" #x4422442246
     1848      (logand #x-aa55aa55aa #x6666666666))
     1849(test "logand (-big & +big)" #xfedcba987654321fedcba884200020541010
     1850      (logand #x-123456789abcdef #xfedcba987654321fedcba987654321fedcba))
    19011851(test "logand (-fix & -fix)" #x-ee76
    19021852      (logand #x-aa55 #x-6666))
    1903 (test "logand (-fix & -big)" (string->number "#x-666666ee76")
    1904       (logand #x-aa55 (string->number "#x-6666666666")))
    1905 (test "logand (-big & -fix)" (string->number "#x-aa55aa77ee")
    1906       (logand (string->number "#x-aa55aa55aa") #x-6666))
    1907 (test "logand (-big & -big)" (string->number "#x-ee77ee77ee")
    1908       (logand (string->number "#x-aa55aa55aa")
    1909               (string->number "#x-6666666666")))
    1910 (test "logand (-big & -big)"
    1911       (string->number "#x-fedcba987654321fedcba9a76567a9ffde00")
    1912       (logand (string->number "#x-123456789abcdef")
    1913               (string->number "#x-fedcba987654321fedcba987654321fedcba")))
     1853(test "logand (-fix & -big)" #x-666666ee76
     1854      (logand #x-aa55 #x-6666666666))
     1855(test "logand (-big & -fix)" #x-aa55aa77ee
     1856      (logand #x-aa55aa55aa #x-6666))
     1857(test "logand (-big & -big)" #x-ee77ee77ee
     1858      (logand #x-aa55aa55aa #x-6666666666))
     1859(test "logand (-big & -big)" #x-fedcba987654321fedcba9a76567a9ffde00
     1860      (logand #x-123456789abcdef #x-fedcba987654321fedcba987654321fedcba))
    19141861
    19151862(test "logior (+fix | 0)" #x123456
    19161863      (logior #x123456 0))
    1917 (test "logior (+big | 0)" (string->number "#x1234567812345678")
    1918       (logior (string->number "#x1234567812345678") 0))
     1864(test "logior (+big | 0)" #x1234567812345678
     1865      (logior #x1234567812345678 0))
    19191866(test "logior (+fix | -1)" -1
    19201867      (logior #x123456 -1))
    19211868(test "logior (+big | -1)" -1
    1922       (logior (string->number "#x1234567812345678") -1))
     1869      (logior #x1234567812345678 -1))
    19231870(test "logior (+fix | +fix)" #xee77
    19241871      (logior #xaa55 #x6666))
    1925 (test "logior (+fix | +big)" (string->number "#x666666ee77")
    1926       (logior #xaa55 (string->number "#x6666666666")))
    1927 (test "logior (+big | +fix)" (string->number "#xaa55aa77ee")
    1928       (logior (string->number "#xaa55aa55aa") #x6666))
    1929 (test "logior (+big | +big)" (string->number "#xee77ee77ee")
    1930       (logior (string->number "#xaa55aa55aa")
    1931               (string->number "#x6666666666")))
    1932 (test "logior (+big | +big)"
    1933       (string->number "#xfedcba987654321fedcba9a76567a9ffddff")
    1934       (logior (string->number "#x123456789abcdef")
    1935               (string->number "#xfedcba987654321fedcba987654321fedcba")))
     1872(test "logior (+fix | +big)" #x666666ee77
     1873      (logior #xaa55 #x6666666666))
     1874(test "logior (+big | +fix)" #xaa55aa77ee
     1875      (logior #xaa55aa55aa #x6666))
     1876(test "logior (+big | +big)" #xee77ee77ee
     1877      (logior #xaa55aa55aa #x6666666666))
     1878(test "logior (+big | +big)" #xfedcba987654321fedcba9a76567a9ffddff
     1879      (logior #x123456789abcdef #xfedcba987654321fedcba987654321fedcba))
    19361880(test "logior (+fix | -fix)" #x-4421
    19371881      (logior #xaa55 #x-6666))
    1938 (test "logior (+fix | -big)" (string->number "#x-6666664421")
    1939       (logior #xaa55 (string->number "#x-6666666666")))
     1882(test "logior (+fix | -big)" #x-6666664421
     1883      (logior #xaa55 #x-6666666666))
    19401884(test "logior (+big | -fix)" #x-2246
    1941       (logior (string->number "#xaa55aa55aa") #x-6666))
    1942 (test "logior (+big | -big)" (string->number "#x-4422442246")
    1943       (logior (string->number "#xaa55aa55aa")
    1944               (string->number "#x-6666666666")))
    1945 (test "logior (+big | -big)"
    1946       (string->number "#x-fedcba987654321fedcba884200020541011")
    1947       (logior (string->number "#x123456789abcdef")
    1948               (string->number "#x-fedcba987654321fedcba987654321fedcba")))
     1885      (logior #xaa55aa55aa #x-6666))
     1886(test "logior (+big | -big)" #x-4422442246
     1887      (logior #xaa55aa55aa #x-6666666666))
     1888(test "logior (+big | -big)" #x-fedcba987654321fedcba884200020541011
     1889      (logior #x123456789abcdef #x-fedcba987654321fedcba987654321fedcba))
    19491890(test "logior (-fix | +fix)" #x-8811
    19501891      (logior #x-aa55 #x6666))
    19511892(test "logior (-fix | +big)" #x-8811
    1952       (logior #x-aa55 (string->number "#x6666666666")))
    1953 (test "logior (-big | +fix)" (string->number "#x-aa55aa118a")
    1954       (logior (string->number "#x-aa55aa55aa") #x6666))
    1955 (test "logior (-big | +big)" (string->number "#x-881188118a")
    1956       (logior (string->number "#x-aa55aa55aa") (string->number "#x6666666666")))
    1957 (test "logior (-big | +big)" (string->number "#x-20002488010145")
    1958       (logior (string->number "#x-123456789abcdef")
    1959               (string->number "#xfedcba987654321fedcba987654321fedcba")))
     1893      (logior #x-aa55 #x6666666666))
     1894(test "logior (-big | +fix)" #x-aa55aa118a
     1895      (logior #x-aa55aa55aa #x6666))
     1896(test "logior (-big | +big)" #x-881188118a
     1897      (logior #x-aa55aa55aa #x6666666666))
     1898(test "logior (-big | +big)" #x-20002488010145
     1899      (logior #x-123456789abcdef #xfedcba987654321fedcba987654321fedcba))
    19601900(test "logior (-fix | -fix)" #x-2245
    19611901      (logior #x-aa55 #x-6666))
    19621902(test "logior (-fix | -big)" #x-2245
    1963       (logior #x-aa55 (string->number "#x-6666666666")))
     1903      (logior #x-aa55 #x-6666666666))
    19641904(test "logior (-big | -fix)" #x-4422
    1965       (logior (string->number "#x-aa55aa55aa") #x-6666))
    1966 (test "logior (-big | -big)" (string->number "#x-2244224422")
    1967       (logior (string->number "#x-aa55aa55aa")
    1968               (string->number "#x-6666666666")))
    1969 (test "logior (-big | -big)" (string->number "#x-103454301aacca9")
    1970       (logior (string->number "#x-123456789abcdef")
    1971               (string->number "#x-fedcba987654321fedcba987654321fedcba")))
     1905      (logior #x-aa55aa55aa #x-6666))
     1906(test "logior (-big | -big)" #x-2244224422
     1907      (logior #x-aa55aa55aa #x-6666666666))
     1908(test "logior (-big | -big)" #x-103454301aacca9
     1909      (logior #x-123456789abcdef #x-fedcba987654321fedcba987654321fedcba))
    19721910
    19731911(test "logtest" #t
    1974       (logtest (string->number "#xfeedbabe") (string->number "#x10000000")))
     1912      (logtest #xfeedbabe #x10000000))
    19751913(test "logtest" #f
    1976       (logtest (string->number "#xfeedbabe") (string->number "#x01100101")))
     1914      (logtest #xfeedbabe #x01100101))
    19771915
    19781916#|
     
    20291967(test "+. (1)" 1.0 (+. 1))
    20301968(test "+. (1big)" 1.0e20 (+. 100000000000000000000))
    2031 (test "+. (1rat)" 1.5 (+. (read-from-string "3/2")))
    2032 (test "+. (1cmp)" (read-from-string "1.0+1.0i") (+. (read-from-string "1+i")))
     1969(test "+. (1rat)" 1.5 (+. 3/2))
     1970(test "+. (1cmp)" 1.0+i (+. 1+i))
    20331971(test "+. (2)" 1.0 (+. 0 1))
    20341972(test "+. (2big)" 1.0e20 (+. 1 100000000000000000000))
    2035 (test "+. (2rat)" 1.5 (+. 1 (read-from-string "1/2")))
     1973(test "+. (2rat)" 1.5 (+. 1 1/2))
    20361974(test "+. (many)" 15.0 (+. 1 2 3 4 5))
    20371975
    20381976(test "-. (1)" -1.0 (-. 1))
    2039 (test "-. (1big)" -1.0e20 (-. (read-from-string "100000000000000000000")))
    2040 (test "-. (1rat)" -1.5 (-. (read-from-string "3/2")))
    2041 (test "-. (1cmp)" (read-from-string "-1.0-1.0i") (-. (read-from-string "1+i")))
     1977(test "-. (1big)" -1.0e20 (-. 100000000000000000000))
     1978(test "-. (1rat)" -1.5 (-. 3/2))
     1979(test "-. (1cmp)" -1.0-i (-. 1+i))
    20421980(test "-. (2)" -1.0 (-. 0 1))
    2043 (test "-. (2big)" -1.0e20 (-. 1 (read-from-string "100000000000000000000")))
    2044 (test "-. (2rat)" 0.5 (-. 1 (read-from-string "1/2")))
     1981(test "-. (2big)" -1.0e20 (-. 1 100000000000000000000))
     1982(test "-. (2rat)" 0.5 (-. 1 1/2))
    20451983(test "-. (many)" -13.0 (-. 1 2 3 4 5))
    20461984
    20471985(test "*. (0)" 1.0 (*.))
    20481986(test "*. (1)" 1.0 (*. 1))
    2049 (test "*. (1big)" 1.0e20 (*. (read-from-string "100000000000000000000")))
    2050 (test "*. (1rat)" 1.5 (*. (read-from-string "3/2")))
    2051 (test "*. (1cmp)" (read-from-string "1.0+1.0i") (*. (read-from-string "1+i")))
     1987(test "*. (1big)" 1.0e20 (*. 100000000000000000000))
     1988(test "*. (1rat)" 1.5 (*. 3/2))
     1989(test "*. (1cmp)" 1.0+i (*. 1+i))
    20521990(test "*. (2)"  0.0 (*. 0 1))
    2053 (test "*. (2big)" 1.0e20 (*. 1 (read-from-string "100000000000000000000")))
    2054 (test "*. (2rat)" 0.5 (*. 1 (read-from-string "1/2")))
     1991(test "*. (2big)" 1.0e20 (*. 1 100000000000000000000))
     1992(test "*. (2rat)" 0.5 (*. 1 1/2))
    20551993(test "*. (many)" 120.0 (*. 1 2 3 4 5))
    20561994
    20571995(test "/. (1)" 1.0 (/. 1))
    2058 (test "/. (1big)" 1.0e-20 (/. (read-from-string "100000000000000000000")))
    2059 (test "/. (1rat)" 0.6666666666666666 (/. (read-from-string "3/2")))
    2060 (test "/. (1cmp)" (read-from-string "0.5-0.5i") (/. (read-from-string "1+i")))
     1996(test "/. (1big)" 1.0e-20 (/. 100000000000000000000))
     1997(test "/. (1rat)" 0.6666666666666666 (/. 3/2))
     1998(test "/. (1cmp)" 0.5-0.5i (/. 1+i))
    20611999(test "/. (2)"  0.0 (/. 0 1))
    2062 (test "/. (2big)" 1.0e-20 (/. 1 (read-from-string "100000000000000000000")))
    2063 (test "/. (2rat)" 2.0 (/. 1 (read-from-string "1/2")))
     2000(test "/. (2big)" 1.0e-20 (/. 1 100000000000000000000))
     2001(test "/. (2rat)" 2.0 (/. 1 1/2))
    20642002(test "/. (many)" 0.1 (/. 1 2 5))
    20652003
     
    21562094   
    21572095    (define (inverse-erf>0 z)
    2158       (let1 r (* pi z z (read-from-string "1/4"))          ; (pi*z^2)/4
     2096      (let1 r (* pi z z 1/4) ; (pi*z^2)/4
    21592097        (let loop ((k 0) (cks '(1)) (sum 0) (a 1))
    21602098          (let1 delta (* a (/ (car cks) (+ k k 1)))
    21612099            (if (< delta (* sum *epsilon*))
    2162               (* (read-from-string "1/2") z (sqrt pi) sum)
     2100              (* 1/2 z (sqrt pi) sum)
    21632101              (loop (+ k 1)
    21642102                    (cons (calc-next-ck (+ k 1) cks) cks)
     
    21752113  ;;
    21762114  (parameterize ((current-test-comparator ~=))
    2177    (test "probit(0.025)" -1.959964 (probit 0.025))
    2178    (test "probit(0.975)" 1.959964 (probit 0.975)))
     2115    (test "probit(0.025)" -1.959964 (probit 0.025))
     2116    (test "probit(0.975)" 1.959964 (probit 0.975)))
    21792117  )
    21802118
  • release/4/numbers/branches/schemification/tests/numbers-test.scm

    r26182 r26606  
    22
    33(require-extension test)
    4 (use numbers)
     4(use numbers posix)
     5
     6;; The default "comparator" doesn't know how to deal with extended number types
     7(current-test-comparator
     8 (lambda (exp act)
     9   (or (equal? exp act)
     10       (if (or (and (cplxnum? exp) (number? act))
     11               (and (cplxnum? act) (number? exp)))
     12           (and (< (abs (real-part (- exp act)))
     13                   (current-test-epsilon))
     14                (< (abs (imag-part (- exp act)))
     15                   (current-test-epsilon)))
     16           (and (number? exp)
     17                (inexact? exp)
     18                (< (abs (- 1 (abs (if (zero? act) (+ 1 exp) (/ exp act)))))
     19                   (current-test-epsilon)))))))
    520
    621(test-begin "numbers")
     
    3449(define r1 (/ 33 44))
    3550(define r2 (/ 1000 44))
     51
     52;; Found with the pi-ratios benchmark (find-pi 10 20 50)
     53(define pi    3.14159265358979323881089001960817518141234854964894)
     54(define ratpi 314159265358979323881089001960817518141234854964894/100000000000000000000000000000000000000000000000000)
    3655
    3756(test-group "basic constructors"
     
    5574 (test "+: adding complex/fix (inexact)" (make-rectangular 97.8 44) (+ c2 99))
    5675 (test "+: flo/flo" 9.0 (+ 3.4 5.6))
    57  ;; Have to use string->number for the flonum too, because the compiler
    58  ;; drops digits when printing back the number(!) by using e-notation
    59  ;; (should be fixed in 4.8.0).  This is also done below in a few other places.
    60  ;; Doing this defeats the numbers.types rewrite rules, so it's probably
    61  ;; good to get rid of this as soon as 4.8.0 is released.
    6276 (test "+: flo/big"
    63        (if 64-bits? (string->number "9223372036854775809.4") 2147483671.4)
     77       (if 64-bits? 9223372036854775809.4 2147483671.4)
    6478       (+ 3.4 b1))
    6579 (test-assert "+: flo/rat" (show (+ 33.4 r1)))
     
    93107 (test "-: complex/fix (inexact)" (make-rectangular -100.2 44) (- c2 99))
    94108 (test "-: fix/complex (inexact)" (make-rectangular 100.2 -44) (- 99 c2))
     109 (test "-: fix/complex (negative im)" 98-2i (- 99 1+2i))
     110 (test "-: fix/complex (negative im, inexact)" 98.0-2.0i (- 99 1.0+2.0i))
     111 (test "-: fix/complex (negative real, inexact)" 100.0-2.0i (- 99 -1.0+2.0i))
     112 (test "-: rat/complex (negative real)" 5/2-2i (- 3/2 -1+2i))
    95113 
    96114 (parameterize ((current-test-epsilon 1e-10))
     
    124142 (test "*: flo/flo" 19.04 (* 3.4 5.6))
    125143 (test "*: flo/big"
    126        (if 64-bits? (string->number "9223372036854775.806") 2147483.668)
     144       (if 64-bits? 9223372036854775.806 2147483.668)
    127145       (* 0.001 b1))
    128146 (test-assert "*: flo/rat" (show (* 3.4 r1)))
     
    167185 (test-assert "/: comp/comp" (show (/ c1 c1)))
    168186 (test-assert "/: comp/comp (inexact)" (show (/ c1 c2)))
     187 (test "/: rat/complex" 1/10-1/5i (/ 1/2 1+2i))
     188 (test "/: rat/complex (negative im)" 1/10+1/5i (/ 1/2 1-2i))
     189 (test "/: rat/complex (negative real)" -1/10-1/5i (/ 1/2 -1+2i))
     190 (test "/: rat/complex (negative real&im)" -1/10+1/5i (/ 1/2 -1-2i))
     191 
    169192 (test-assert "/: multiarg" (show (/ 66 2 44)))
    170193 (test-error "/: div by 0" (/ 33 0))
     
    182205  (test "quotient: flo/fix" 2.0 (quotient 22.0 11))
    183206  (test "quotient: flo/big" 0.0 (quotient 22.0 b1))
    184   ;; When "upgrading" from regular Chicken to numbers, existing semantics
    185   ;; should be maintained.  That's why we allow non-integer flonums.
    186   (test "quotient: flo/flo (fractional)" 2.0 (quotient 23.0 11.5))
    187   (test "quotient: fix/flo (fractional)" 2.0 (quotient 23 11.5))
    188   (test "quotient: big/flo (fractional)" 2.0 (quotient b1 (/ b1 2.0)))
    189   (test "quotient: flo/fix (fractional)" 2.0 (quotient 13.5 6))
     207  (test "quotient: big/flo" 2.0 (quotient b1 (/ b1 2.0)))
     208  (test-error "quotient: flo/flo (fractional)" (quotient 23.0 11.5))
     209  (test-error "quotient: fix/flo (fractional)" (quotient 23 11.5))
     210  (test-error "quotient: flo/fix (fractional)" (quotient 13.5 6))
    190211)
    191212
     
    202223    (test "remainder: flo/big" 22.0 (remainder 22.0 b1)))
    203224 
    204   ;; When "upgrading" from regular Chicken to numbers, existing semantics
    205   ;; should be maintained.  That's why we allow non-integer flonums.
    206   (test "remainder: flo/flo (fractional)" 0.0 (remainder 22.5 2.25))
    207   (test "remainder: fix/flo (fractional)" 6.0 (remainder 6 12.5))
    208   (test "remainder: flo/fix (fractional)" 1.5 (remainder 13.5 6))
     225  (test-error "remainder: flo/flo (fractional)" (remainder 22.5 2.25))
     226  (test-error "remainder: fix/flo (fractional)" (remainder 6 12.5))
     227  (test-error "remainder: flo/fix (fractional)" (remainder 13.5 6))
    209228  (unless 64-bits?
    210     (test "remainder: flo/big (fractional)" 0.5 (remainder (+ b1 0.5) b1)))
     229    (test-error "remainder: flo/big (fractional)" (remainder (+ b1 0.5) b1)))
    211230)
    212231
     
    226245  (test "quotient&remainder: fix/flo"
    227246        '(5.0 2.0) (receive l (quotient&remainder 22 4.0) l))
    228   (unless 64-bits?
    229     (test "quotient&remainder: flo/big"
    230           '(1.0 0.5) (receive l (quotient&remainder (+ b1 0.5) b1) l))
    231     (test "quotient&remainder: big/flo"
    232           `(0.0 ,(exact->inexact b1))
    233           (receive l (quotient&remainder b1 (+ b1 0.5)) l)))
     247  (test-error "quotient&remainder: flo/fix (fractional)"
     248              (receive l (quotient&remainder 0.1 2) l))
     249  (test-error "quotient&remainder: flo/big (fractional)"
     250              (receive l (quotient&remainder 0.5 b1) l))
     251  (test-error "quotient&remainder: big/flo (fractional)"
     252              (receive l (quotient&remainder b1 0.5) l))
    234253)
    235254
    236255(test-group "gcd"
    237   (test "gcd: fix (64-bit)/big" 1 (gcd (string->number "907947775416515") (string->number "11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111")))
    238 )
     256  (test "gcd: fix (64-bit)/big" 1 (gcd 907947775416515 11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
     257  (test 0 (gcd))
     258  (test 6 (gcd 6))
     259  (test 2 (gcd 6 8))
     260  (test 1 (gcd 6 8 5))
     261  (test 1 (gcd 6 -8 5))
     262  (test 2.0 (gcd 6.0 8.0))
     263  (test-error (gcd 6.1 8.0))
     264  (test-error (gcd 6.0 8.1))
     265  (test-error (gcd +inf.0))
     266  (test-error (gcd +nan.0))
     267  (test-error (gcd 6.0 +inf.0))
     268  (test-error (gcd +inf.0 6.0))
     269  (test-error (gcd +nan.0 6.0))
     270  (test-error (gcd 6.0 +nan.0))
     271  (test-error (gcd 1+2i 3+4i))
     272  (test-error (gcd 1/2 3/4)))
     273
     274(test-group "lcm"
     275  (test 1 (lcm))
     276  (test 24 (lcm 6 8))
     277  (test 120 (lcm 6 8 5))
     278  (test 24.0 (lcm 6.0 8.0))
     279  (test-error (lcm 6.1 8.0))
     280  (test-error (lcm 6.0 8.1))
     281  (test-error (lcm +inf.0))
     282  (test-error (lcm +nan.0))
     283  (test-error (lcm 6.0 +inf.0))
     284  (test-error (lcm +inf.0 6.0))
     285  (test-error (lcm +nan.0 6.0))
     286  (test-error (lcm 6.0 +nan.0))
     287  (test-error (lcm 1+2i 3+4i))
     288  (test-error (lcm 1/2 3/4)))
    239289
    240290
     
    245295 (test "=: !fix/fix" #f (= 33 34))
    246296 (test "=: !fix/flo" #f (= 33 33.1))
     297 (test "=: !fix/flo (overflow)" #f (= 9007199254740993 9007199254740993.0))
     298 (test "=: !fix/flo (inf)" #f (= 0 +inf.0))
     299 (test "=: !fix/flo (-inf)" #f (= 0 -inf.0))
     300 (test "=: !fix/flo (+nan)" #f (= 0 -nan.0))
    247301 (test "=: flo/fix" #t (= 33.0 33))
     302 (test "=: !flo/fix (overflow)" #f (= 9007199254740993.0 9007199254740993))
     303 (test "=: !flo/fix (inf)" #f (= +inf.0 0))
     304 (test "=: !flo/fix (-inf)" #f (= -inf.0 0))
     305 (test "=: !flo/fix (+nan)" #f (= -nan.0 0))
    248306 (test "=: flo/flo" #t (= 33.1 33.1))
    249307 (test "=: !flo/flo" #f (= 33.1 -33.1))
     
    286344
    287345
    288 (test-group "greater"
     346(test-group "greater & greater/equal"
    289347
    290348 (test ">: fix/fix" #t (> 44 33))
     349 (test ">=: fix/fix" #t (>= 44 33))
     350 (test ">: fix/fix/fix" #t (> 44 33 22))
     351 (test ">=: fix/fix/fix" #t (>= 44 33 22))
    291352 (test ">: !fix/fix" #f (> 33 44))
     353 (test ">=: !fix/fix" #f (>= 33 44))
     354 (test ">: !fix/fix/fix" #f (> 22 33 44))
     355 (test ">=: !fix/fix/fix" #f (>= 22 33 44))
     356 (test ">: fix/fix" #f (> 33 33))
     357 (test ">=: !fix/fix" #t (>= 33 33))
    292358 (test ">: fix/flo" #t (> 44 33.0))
     359 (test ">=: fix/flo" #t (>= 44 33.0))
    293360 (test ">: !fix/flo" #f (> 33 44.0))
    294  (print b2)
     361 (test ">=: !fix/flo" #f (>= 33 44.0))
     362 (test ">: !fix/flo" #f (> 33 33.0))
     363 (test ">=: !fix/flo" #t (>= 33 33.0))
     364 (test ">: fix/flo (flo overflow), on 64 bits"
     365       #t (> 9007199254740993 9007199254740992.0)) ; 2^53
     366 (test ">=: fix/flo (flo overflow), on 64 bits"
     367       #t (>= 9007199254740993 9007199254740992.0))
     368 (test ">: fix/flo (flo underflow), on 64 bits"
     369       #f (> -9007199254740992 -9007199254740991.0))
     370 (test ">=: fix/flo (flo underflow), on 64 bits"
     371       #f (>= -9007199254740992 -9007199254740991.0))
    295372 (test ">: fix/big" #t (> 44 b2))
     373 (test ">=: fix/big" #t (>= 44 b2))
    296374 (test ">: !fix/big" #f (> 33 b1))
     375 (test ">=: !fix/big" #f (>= 33 b1))
    297376 (test ">: fix/rat" #t (> 44 r1))
     377 (test ">=: fix/rat" #t (>= 44 r1))
    298378 (test ">: !fix/rat" #f (> 0 r1))
     379 (test ">=: !fix/rat" #f (>= 0 r1))
    299380
    300381 (test ">: flo/fix" #t (> 44.0 33))
     382 (test ">=: flo/fix" #t (>= 44.0 33))
    301383 (test ">: !flo/fix" #f (> 33.0 44))
     384 (test ">=: !flo/fix" #f (>= 33.0 44))
     385 (test ">: !flo/fix" #f (> 33.0 33))
     386 (test ">=: flo/fix" #t (>= 33.0 33))
    302387 (test ">: flo/flo" #t (> 44.0 33.0))
     388 (test ">=: flo/flo" #t (>= 44.0 33.0))
    303389 (test ">: !flo/flo" #f (> 33.0 44.0))
     390 (test ">=: !flo/flo" #f (>= 33.0 44.0))
    304391 (test ">: flo/big" #t (> 44.0 b2))
     392 (test ">=: flo/big" #t (>= 44.0 b2))
     393 (test ">: flo/fix (flo overflow), on 64 bits"
     394       #f (> 9007199254740992.0 9007199254740993)) ; 2^53
     395 (test ">=: flo/fix (flo overflow), on 64 bits"
     396       #f (>= 9007199254740992.0 9007199254740993))
     397 (test ">: fix/flo (flo underflow), on 64 bits"
     398       #t (> -9007199254740991.0 -9007199254740992))
     399 (test ">=: fix/flo (flo underflow), on 64 bits"
     400       #t (>= -9007199254740991.0 -9007199254740992))
    305401 (test ">: flo/big (flo overflow)"
    306        #f (> 1237940039285380274899124224.0 (string->number "1237940039285380274899124225")))
     402       #f (> 1237940039285380274899124224.0 1237940039285380274899124225))
     403 (test ">=: flo/big (flo overflow)"
     404       #f (>= 1237940039285380274899124224.0 1237940039285380274899124225))
    307405 (test ">: !flo/big" #f (> 33.0 b1))
     406 (test ">=: !flo/big" #f (>= 33.0 b1))
    308407 (test ">: flo/rat" #t (> 44.0 r1))
     408 (test ">=: flo/rat" #t (>= 44.0 r1))
    309409 (test ">: !flo/rat" #f (> 0.0 r1))
     410 (test ">=: !flo/rat" #f (>= 0.0 r1))
     411 (test ">: !rat/rat" #f (> r1 r1))
     412 (test ">=: rat/rat" #t (>= r1 r1))
     413 (test ">: flo/nan" #f (> 0.0 +nan.0))
     414 (test ">=: flo/nan" #f (>= 0.0 +nan.0))
     415 (test ">: nan/flo" #f (> +nan.0 0.0))
     416 (test ">=: nan/flo" #f (>= +nan.0 0.0))
     417 (test ">: flo/flo/nan" #f (> 1.0 0.0 +nan.0))
     418 (test ">=: flo/flo/nan" #f (>= 1.0 0.0 +nan.0))
    310419
    311420 (test ">: big/fix" #t (> b1 33))
     421 (test ">=: big/fix" #t (>= b1 33))
    312422 (test ">: !big/fix" #f (> b2 44))
     423 (test ">=: !big/fix" #f (>= b2 44))
    313424 (test ">: big/flo" #t (> b1 33.0))
     425 (test ">=: big/flo" #t (>= b1 33.0))
    314426 (test ">: big/flo (flo overflow)"
    315        #t (> (string->number "1237940039285380274899124225") 1237940039285380274899124224.0))
     427       #t (> 1237940039285380274899124225 1237940039285380274899124224.0))
     428 (test ">=: big/flo (flo overflow)"
     429       #t (>= 1237940039285380274899124225 1237940039285380274899124224.0))
    316430 (test ">: !big/flo" #f (> b2 44.0))
     431 (test ">=: !big/flo" #f (>= b2 44.0))
    317432 (test ">: big/big" #t (> b1 b2))
     433 (test ">=: big/big" #t (>= b1 b2))
    318434 (test ">: !big/big" #f (> b2 b1))
     435 (test ">=: !big/big" #f (>= b2 b1))
    319436 (test ">: big/rat" #t (> b1 r1))
     437 (test ">=: big/rat" #t (>= b1 r1))
    320438 (test ">: !big/rat" #f (> b2 r1))
     439 (test ">=: !big/rat" #f (>= b2 r1))
    321440
    322441 (test ">: rat/fix" #f (> r1 2))
     442 (test ">=: rat/fix" #f (>= r1 2))
    323443 (test ">: !rat/fix" #f (> r1 44))
     444 (test ">=: !rat/fix" #f (>= r1 44))
    324445 (test ">: rat/flo" #t (> r2 2.0))
     446 (test ">=: rat/flo" #t (>= r2 2.0))
    325447 (test ">: !rat/flo" #f (> b2 44.0))
     448 (test ">=: !rat/flo" #f (>= b2 44.0))
    326449 (test ">: !rat/big" #f (> r1 b1))
     450 (test ">=: !rat/big" #f (>= r1 b1))
    327451 (test ">: rat/rat" #t (> r2 r1))
     452 (test ">=: rat/rat" #t (>= r2 r1))
    328453 (test ">: !rat/rat" #f (> r1 r2))
    329 )
    330 
    331 
    332 (test-group "less"
     454 (test ">=: !rat/rat" #f (>= r1 r2))
     455 (test ">: rat/flo (flo overflow)"
     456       #t (> 1237940039285380274899124224/1237940039285380274899124223 1.0))
     457 (test ">: rat/flo (flo overflow)"
     458       #f (> 1237940039285380274899124224/1237940039285380274899124223 1.5))
     459 (test ">=: rat/flo (flo overflow)"
     460       #t (>= 1237940039285380274899124224/1237940039285380274899124223 1.0))
     461 (test ">=: rat/flo (flo overflow)"
     462       #f (>= 1237940039285380274899124224/1237940039285380274899124223 1.5))
     463 (test ">: rat/flo (flo underflow)"
     464       #f (> -1237940039285380274899124224/1237940039285380274899124223 -1.0))
     465 (test ">: rat/flo (flo underflow)"
     466       #t (> -1237940039285380274899124224/1237940039285380274899124223 -1.5))
     467 (test ">=: rat/flo (flo underflow)"
     468       #f (>= -1237940039285380274899124224/1237940039285380274899124223 -1.0))
     469 (test ">=: rat/flo (flo underflow)"
     470       #t (>= -1237940039285380274899124224/1237940039285380274899124223 -1.5))
     471)
     472
     473
     474(test-group "less & less/equal"
    333475
    334476 (test "<: !fix/fix" #f (< 44 33))
     477 (test "<=: !fix/fix" #f (<= 44 33))
     478 (test "<: fix/fix/fix" #t (< 33 44 55))
     479 (test "<=: fix/fix/fix" #t (<= 33 44 55))
     480 (test "<: !fix/fix/fix" #f (< 33 55 44))
     481 (test "<=: !fix/fix/fix" #f (<= 33 55 44))
     482 (test "<: !fix/fix/fix" #f (< 44 33 55))
     483 (test "<=: !fix/fix/fix" #f (<= 44 33 55))
     484 (test "<: !fix/fix/fix" #f (< 44 44 44))
     485 (test "<=: fix/fix/fix" #t (<= 44 44 44))
    335486 (test "<: fix/fix" #t (< 33 44))
     487 (test "<=: fix/fix" #t (<= 33 44))
     488 (test "<: !fix/fix" #f (< 33 33))
     489 (test "<=: fix/fix" #t (<= 33 33))
    336490 (test "<: !fix/flo" #f (< 44 33.0))
     491 (test "<=: !fix/flo" #f (<= 44 33.0))
    337492 (test "<: fix/flo" #t (< 33 44.0))
     493 (test "<=: fix/flo" #t (<= 33 44.0))
     494 (test "<: fix/flo (flo overflow), on 64 bits"
     495       #f (< 9007199254740993 9007199254740992.0)) ; 2^53
     496 (test "<=: fix/flo (flo overflow), on 64 bits"
     497       #f (< 9007199254740993 9007199254740992.0))
     498 (test "<: fix/flo (flo underflow), on 64 bits"
     499       #t (< -9007199254740993 -9007199254740992.0))
     500 (test "<=: fix/flo (flo underflow), on 64 bits"
     501       #t (<= -9007199254740993 -9007199254740992.0))
     502 (test "<: !fix/flo" #f (< 33.0 33.0))
     503 (test "<=: fix/flo" #t (<= 33.0 33.0))
    338504 (test "<: !fix/big" #f (< 44 b2))
     505 (test "<=: !fix/big" #f (<= 44 b2))
    339506 (test "<: fix/big" #t (< 33 b1))
     507 (test "<=: fix/big" #t (<= 33 b1))
     508 (test "<: !big/big" #f (< b1 b1))
     509 (test "<=: big/big" #t (<= b1 b1))
    340510 (test "<: !fix/rat" #f (< 44 r1))
     511 (test "<=: !fix/rat" #f (<= 44 r1))
    341512 (test "<: fix/rat" #t (< 0 r1))
     513 (test "<=: fix/rat" #t (<= 0 r1))
    342514
    343515 (test "<: !flo/fix" #f (< 44.0 33))
     516 (test "<=: !flo/fix" #f (<= 44.0 33))
    344517 (test "<: flo/fix" #t (< 33.0 44))
     518 (test "<=: flo/fix" #t (<= 33.0 44))
    345519 (test "<: !flo/flo" #f (< 44.0 33.0))
     520 (test "<=: !flo/flo" #f (<= 44.0 33.0))
    346521 (test "<: flo/flo" #t (< 33.0 44.0))
     522 (test "<=: flo/flo" #t (<= 33.0 44.0))
    347523 (test "<: !flo/big" #f (< 44.0 b2))
     524 (test "<=: !flo/big" #f (<= 44.0 b2))
    348525 (test "<: flo/big" #t (< 33.0 b1))
     526 (test "<=: flo/big" #t (<= 33.0 b1))
     527 (test "<: flo/fix (flo overflow), on 64 bits"
     528       #t (< 9007199254740992.0 9007199254740993)) ; 2^53
     529 (test "<=: flo/fix (flo overflow), on 64 bits"
     530       #t (< 9007199254740992.0 9007199254740993))
     531 (test "<: flo/fix (flo underflow), on 64 bits"
     532       #f (< -9007199254740992.0 -9007199254740993))
     533 (test "<=: flo/fix (flo underflow), on 64 bits"
     534       #f (<= -9007199254740992.0 -9007199254740993))
    349535 (test "<: flo/big (flo overflow)"
    350        #t (< 1237940039285380274899124224.0 (string->number "1237940039285380274899124225")))
     536       #t (< 1237940039285380274899124224.0 1237940039285380274899124225))
     537 (test "<=: flo/big (flo overflow)"
     538       #t (<= 1237940039285380274899124224.0 1237940039285380274899124225))
    351539 (test "<: !flo/rat" #f (< 44.0 r1))
     540 (test "<=: !flo/rat" #f (<= 44.0 r1))
    352541 (test "<: flo/rat" #t (< 0.0 r1))
     542 (test "<=: flo/rat" #t (<= 0.0 r1))
     543 (test "<: flo/nan" #f (< 0.0 +nan.0))
     544 (test "<=: flo/nan" #f (<= 0.0 +nan.0))
     545 (test "<: nan/flo" #f (< +nan.0 0.0))
     546 (test "<=: nan/flo" #f (<= +nan.0 0.0))
     547 (test "<: flo/flo/nan" #f (< 0.0 1.0 +nan.0))
     548 (test "<=: flo/flo/nan" #f (<= 0.0 1.0 +nan.0))
    353549
    354550 (test "<: !big/fix" #f (< b1 33))
     551 (test "<=: !big/fix" #f (<= b1 33))
    355552 (test "<: big/fix" #t (< b2 44))
     553 (test "<=: big/fix" #t (<= b2 44))
    356554 (test "<: !big/flo" #f (< b1 33.0))
     555 (test "<=: !big/flo" #f (<= b1 33.0))
    357556 (test "<: big/flo" #t (< b2 44.0))
     557 (test "<=: big/flo" #t (<= b2 44.0))
    358558 (test "<: big/flo (max flo)"
    359        #f (< (string->number "1237940039285380274899124224")
    360              (string->number "1237940039285380274899124224.0")))
     559       #f (< 1237940039285380274899124224 1237940039285380274899124224.0))
     560 (test "<=: big/flo (max flo)"
     561       #t (<= 1237940039285380274899124224 1237940039285380274899124224.0))
    361562 (test "<: big/flo (max flo, smaller bignum)"
    362        #t (< (string->number "1237940039285380274899124223")
    363              (string->number "1237940039285380274899124224.0")))
     563       #t (< 1237940039285380274899124223 1237940039285380274899124224.0))
     564 (test "<: big/flo (max flo, smaller bignum)"
     565       #t (<= 1237940039285380274899124223 1237940039285380274899124224.0))
    364566 (test "<: !big/big" #f (< b1 b2))
     567 (test "<=: !big/big" #f (<= b1 b2))
    365568 (test "<: big/big" #t (< b2 b1))
     569 (test "<=: big/big" #t (<= b2 b1))
    366570 (test "<: !big/rat" #f (< b1 r1))
     571 (test "<=: !big/rat" #f (<= b1 r1))
    367572 (test "<: big/rat" #t (< b2 r1))
     573 (test "<=: big/rat" #t (<= b2 r1))
    368574
    369575 (test "<: !rat/fix" #f (< r2 2))
     576 (test "<=: !rat/fix" #f (<= r2 2))
    370577 (test "<: rat/fix" #t (< r1 44))
     578 (test "<=: rat/fix" #t (<= r1 44))
    371579 (test "<: !rat/flo" #f (< r2 2.0))
     580 (test "<=: !rat/flo" #f (<= r2 2.0))
    372581 (test "<: rat/flo" #t (< b2 44.0))
     582 (test "<=: rat/flo" #t (<= b2 44.0))
    373583 (test "<: rat/big" #t (< r1 b1))
     584 (test "<=: rat/big" #t (<= r1 b1))
    374585 (test "<: !rat/rat" #f (< r2 r1))
     586 (test "<=: !rat/rat" #f (<= r2 r1))
    375587 (test "<: rat/rat" #t (< r1 r2))
     588 (test "<=: rat/rat" #t (<= r1 r2))
     589 (test "<: rat/flo (flo overflow)"
     590       #f (< 1237940039285380274899124224/1237940039285380274899124223 1.0))
     591 (test "<: rat/flo (flo overflow)"
     592       #t (< 1237940039285380274899124224/1237940039285380274899124223 1.5))
     593 (test "<=: rat/flo (flo overflow)"
     594       #f (<= 1237940039285380274899124224/1237940039285380274899124223 1.0))
     595 (test "<=: rat/flo (flo overflow)"
     596       #t (<= 1237940039285380274899124224/1237940039285380274899124223 1.5))
     597 (test "<: rat/flo (flo underflow)"
     598       #t (< -1237940039285380274899124224/1237940039285380274899124223 -1.0))
     599 (test "<: rat/flo (flo underflow)"
     600       #f (< -1237940039285380274899124224/1237940039285380274899124223 -1.5))
     601 (test "<=: rat/flo (flo underflow)"
     602       #t (<= -1237940039285380274899124224/1237940039285380274899124223 -1.0))
     603 (test "<=: rat/flo (flo underflow)"
     604       #f (<= -1237940039285380274899124224/1237940039285380274899124223 -1.5))
    376605)
    377606
     
    379608
    380609 (test "real-part" 33 (real-part c1))
     610 (test "real-part of flonum" 1.23 (real-part 1.23))
     611 (test "real-part of fixnum" 123 (real-part 123))
     612 (test "real-part of ratnum" 1/2 (real-part 1/2))
     613 (test "real-part of bignum" b1 (real-part b1))
     614 (test "real-part of negative flonum" -1.23 (real-part -1.23))
     615 (test "real-part of negative fixnum" -123 (real-part -123))
     616 (test "real-part of negative ratnum" -1/2 (real-part -1/2))
     617 (test "real-part of negative bignum" (- b1) (real-part (- b1)))
    381618 (test "imag-part" 44 (imag-part c1))
    382  (test "real-part" 33 (real-part 33))
    383  (test "imag-part" 0 (imag-part 33))
     619 (test "imag-part of flonum" 0.0 (imag-part 1.23))
     620 (test "imag-part of fixnum" 0 (imag-part 123))
     621 (test "imag-part of ratnum" 0 (imag-part 1/2))
     622 (test "imag-part of bignum" 0 (imag-part b1))
    384623 (test-assert "make-polar" (show (make-polar 33 44)))
    385  (test-assert "magnitude" (show (magnitude c1)))
     624 (test "magnitude" 8 (magnitude 0+8i))
     625 (test "magnitude" 1/2 (magnitude 0+1/2i))
     626 (test "magnitude of flonum" 1.23 (magnitude 1.23))
     627 (test "magnitude of fixnum" 123 (magnitude 123))
     628 (test "magnitude of ratnum" 1/2 (magnitude 1/2))
     629 (test "magnitude of bignum" b1 (magnitude b1))
     630 (test "magnitude of negative flonum" 1.23 (magnitude -1.23))
     631 (test "magnitude of negative fixnum" 123 (magnitude -123))
     632 (test "magnitude of negative ratnum" 1/2 (magnitude -1/2))
     633 (test "magnitude of negative bignum" b1 (magnitude (- b1)))
    386634 (test-assert "angle" (show (angle c1)))
     635 (test "angle of flonum" 0.0 (angle 1.23))
     636 (test "angle of fixnum" 0.0 (angle 123))
     637 (test "angle of ratnum" 0.0 (angle 1/2))
     638 (test "angle of bignum" 0.0 (angle b1))
     639 (test "angle of negative flonum" pi (angle -1.23))
     640 (test "angle of negative fixnum" pi (angle -123))
     641 (test "angle of negative ratnum" pi (angle -1/2))
     642 (test "angle of negative bignum" pi (angle (- b1)))
    387643)
    388644
     
    399655(test-group "misc"
    400656
    401  (test "inexact->exact" (string->number "2589569785738035/1125899906842624") (inexact->exact 2.3))
     657 (test "inexact->exact" 2589569785738035/1125899906842624 (inexact->exact 2.3))
    402658 (test-error "inexact->exact +inf" (inexact->exact +inf.0))
    403659 (test-error "inexact->exact -inf" (inexact->exact -inf.0))
    404660 (test-error "inexact->exact -NaN" (inexact->exact +nan.0))
     661 (test "sqrt (integer result)" 4 (sqrt 16))
     662 (test "sqrt (exact result)" 1/2 (sqrt 1/4))
     663 (test "sqrt (inexact result)" 1.4142135623730951 (sqrt 2))
     664 (test "sqrt (inexact input)" 2.0 (sqrt 4.0))
     665 (test "sqrt (exact large number)" max-fix (sqrt (* max-fix max-fix)))
     666 (test-error "exact-integer-sqrt (nonint flonum)" (exact-integer-sqrt 1.5))
     667 (test-error "exact-integer-sqrt (ratnum)" (exact-integer-sqrt 1/2))
     668 (test-error "exact-integer-sqrt (int flonum)" (exact-integer-sqrt 4.0))
     669 (test "exact-integer-sqrt (w/o rest)"
     670       (list max-fix 0)
     671       (receive x (exact-integer-sqrt (* max-fix max-fix)) x))
     672 (test "exact-integer-sqrt (with rest)"
     673       (list max-fix 5)
     674       (receive x (exact-integer-sqrt (+ (* max-fix max-fix) 5)) x))
     675 (test "exact-integer-nth-root without rest"
     676       (list 3 0)
     677       (receive x (exact-integer-nth-root 243 5) x))
     678 (test "exact-integer-nth-root with rest"
     679       (list 3 47)
     680       (receive x (exact-integer-nth-root 128 4) x))
     681 (test "exact-integer-nth-root with insanely large base"
     682       (list 1 4)
     683       (receive x (exact-integer-nth-root 5 (if 64-bits? 10000000000 100000000)) x))
    405684 (test "expt" 16 (expt 2 4))
    406685 (test-assert "expt" (show (expt 2 100)))
    407  (test-assert "expt" (show (expt 33 (/ 1 3))))
     686 (test "expt (rat base)" 1/4 (expt 1/2 2))
     687 (test "expt (rat exponent)" 2 (expt 16 1/4))
     688 (test "expt (negative rat exponent)" 1/2 (expt 16 -1/4))
     689 (test "expt (inexact from rat exponent)" 1.1040895136738123 (expt 2 1/7))
     690 (test "expt (> 1 rat exponent)" 1/512 (expt 1/64 3/2))
     691 (test "expt (rat base & exponent)" 1/2 (expt 1/4 1/2))
     692 (parameterize ((current-test-epsilon 1e-10))
     693   (test "expt (negative w/ rat exponent)" 1.4142135623731+1.41421356237309i (expt -16 1/4)))
    408694 (test-assert "expt" (show (expt 2 2.0)))
    409695 (test-assert "expt" (show (expt 2 -1)))
    410696 (test "expt between double and 64-bit integer value"
    411        (string->number "994014980014994001") (expt 999 6))
    412  (test "expt with complex result" (string->number "-1.836909530733566e-16-1.0i") (expt -1 1.5))
     697       994014980014994001 (expt 999 6))
     698 ;; Why do these work with epsilon set to 0?
     699 (test "expt with complex result" -1.836909530733566e-16-1.0i (expt -1 1.5))
     700 (test "exact expt with complex number" 0+1i (expt 0+1i 5))
     701 (test "exact expt with complex number, real result" -1 (expt 0+1i 6))
     702 (test "inexact expt with complex number" 0.0+1.0i (expt 0.0+1.0i 5.0))
     703 (test "inexact expt with complex number, real result" -1.0 (expt 0.0+1.0i 6.0))
     704 (parameterize ((current-test-epsilon 1e-10))
     705   (test "inexact noninteger expt with complex number"
     706         1.4142135623731+1.41421356237309i (expt 0.0+4.0i 0.5)))
    413707 
    414  (test "exp with complex numbers"
    415        (string->number "1.4686939399158851+2.2873552871788423i")
    416        (exp (string->number "1+i")))
     708 (test "exp with complex numbers" 1.4686939399158851+2.2873552871788423i (exp 1+i))
    417709
    418710 (test "log of exp = 1" 1.0 (log (exp 1)))
    419  (test "log of -1" (string->number "0.0+3.141592653589793i") (log -1))
    420 
    421  (test "log with complex number"
    422        (string->number "0.0+1.5707963267948966i")
    423        (log (string->number "+i")))
    424 
    425  (test "exp(log(x)) = x"
    426        (string->number "2.0-3.0i") (exp (log (string->number "2.0-3.0i"))))
    427  (test "log(exp(x)) = x"
    428        (string->number "2.0-3.0i") (log (exp (string->number "2.0-3.0i"))))
     711 (test "log of -1" 0.0+3.141592653589793i (log -1))
     712
     713 (test "log with complex number" 0.0+1.5707963267948966i (log +i))
     714
     715 (test "exp(log(x)) = x" 2.0-3.0i (exp (log 2.0-3.0i)))
     716 (test "log(exp(x)) = x" 2.0-3.0i (log (exp 2.0-3.0i)))
    429717
    430718 (letrec ((fac (lambda (n)
     
    472760 (test "rational?" #t (rational? (/ 6 3)))
    473761 (test "integer?" #t (integer? (make-rectangular 3 0)))
     762 (test "integer?" #f (integer? 1+3i))
    474763 (test "integer?" #t (integer? 3.0))
    475764 (test "integer?" #t (integer? (/ 8 4)))
     765 (test "integer?" #f (integer? 1/2))
     766 (test "exact-integer?" #t (exact-integer? (make-rectangular 3 0)))
     767 (test "exact-integer?" #f (exact-integer? 1+3i))
     768 (test "exact-integer?" #f (exact-integer? 3.0))
     769 (test "exact-integer?" #t (exact-integer? (/ 8 4)))
     770 (test "exact-integer?" #f (exact-integer? 1/2))
    476771
    477772 (test "max" 4 (max 3 4))
     
    479774
    480775 (test "modulo" 1 (modulo 13 4))
     776 (test "modulo" 1.0 (modulo 13.0 4))
     777 (test "modulo" 1.0 (modulo 13 4.0))
     778 (test-error "modulo" (modulo 13.1 4.0))
     779 (test-error "modulo" (modulo 13.0 4.1))
    481780 (test "remainder" 1 (remainder 13 4))
     781 (test-error "remainder" (remainder 13.1 4.0))
     782 (test-error "remainder" (remainder 13.0 4.1))
    482783 (test "modulo" 3 (modulo -13 4))
    483784 (test "remainder" -1 (remainder -13 4))
     
    487788 (test "remainder" -1 (remainder -13 -4))
    488789 (test "remainder" -1.0 (remainder -13 -4.0))
     790
     791 (test-assert (even? 2))
     792 (test-assert (not (even? 1)))
     793 (test-assert (even? -2))
     794 (test-assert (not (even? -1)))
     795 (test-assert (even? 2.0))
     796 (test-assert (not (even? 1.0)))
     797 (test-assert (even? -2.0))
     798 (test-assert (not (even? -1.0)))
     799 (test-error (even? 2.1))
     800 (test-error (even? -2.3))
     801 (test-error (even? +inf.0))
     802 (test-error (even? +nan.0))
     803 (test-assert (even? (* most-positive-fixnum 2)))
     804 (test-assert (not (even? (+ (* most-positive-fixnum 2) 1))))
     805 (test-assert (odd? (+ (* most-positive-fixnum 2) 1)))
     806 (test-assert (not (odd? (* most-positive-fixnum 2))))
     807 (test-error (even? 2.0+3.0i))
     808 (test-error (even? 2+3i))
     809 (test-error (odd? 2.0+3.0i))
     810 (test-error (odd? 2+3i))
    489811
    490812 (test "floor" -5.0 (floor -4.3))
     
    500822 (test "round" 7 (round 7))
    501823
    502  (test-assert "rationalize (1/3)" (show (rationalize (inexact->exact .3) (/ 1 10))))
    503  (test-assert "rationalize (#i1/3)" (show (rationalize .3 (/ 1 10))))
     824 (test "rationalize (1/3)" 1/3 (rationalize (inexact->exact .3) (/ 1 10)))
     825 (test "rationalize (#i1/3)" #i1/3 (rationalize .3 (/ 1 10)))
    504826)
    505827
     
    510832 (test "xor" 14 (bitwise-xor #x0f #x1))
    511833 (test-assert "not" (show (bitwise-not #x0f)))
    512  (test "shift left" #x3c (arithmetic-shift #xf 2))
    513  (test "shift right" 60 (arithmetic-shift #xf 2))
     834 (test 60 (arithmetic-shift 15 2))
     835 (test 3 (arithmetic-shift 15 -2))
     836 (test -60 (arithmetic-shift -15 2))
     837 (test -4 (arithmetic-shift -15 -2)) ; 2's complement
     838 (test-error (arithmetic-shift 0.1 2))
     839 ;; XXX Do the following two need to fail?  Might as well use the integral value
     840 (test-error (arithmetic-shift #xf 2.0))
     841 (test-error (arithmetic-shift #xf -2.0))
     842 (test-error (arithmetic-shift #xf 2.1))
     843 (test-error (arithmetic-shift #xf -2.1))
     844 (test-error (arithmetic-shift +inf.0 2))
     845 (test-error (arithmetic-shift +nan.0 2))
     846 (when 64-bits?
     847   (test 0 (arithmetic-shift (expt 2 31) (- (expt 2 31)))))
    514848
    515849 ;; by Jeremy Sydik
     
    517851        (lambda (value amount)
    518852          (let ((shifted (arithmetic-shift value amount)))
    519             (let ((anded (bitwise-and (string->number "#xFFFFFFFF") shifted)))
     853            (let ((anded (bitwise-and #xFFFFFFFF shifted)))
    520854              (bitwise-ior anded
    521855                           (arithmetic-shift shifted -32)))) )))
    522856   (test "leftrot32 28" 268435456 (leftrot32 1 28))
    523857   (test "leftrot32 29" 536870912 (leftrot32 1 29))
    524    (test "leftrot32 30" (string->number "1073741824") (leftrot32 1 30)))
     858   (test "leftrot32 30" 1073741824 (leftrot32 1 30)))
    525859)
    526860
     
    540874 (test "fix/unusual-base" 194 (string->number "1234" 5))
    541875 (test "fix/wrong-base" #f (string->number "1234" 4))
     876 (test-error "fix/invalid-base" (string->number "1234" 0))
     877 (test-error "fix/invalid-base" (string->number "1234" 1))
    542878 (test "flo" 123.23 (string->number "123.23"))
    543879 (test "flo2" 100.0 (string->number "1e2"))
     
    557893 (test-assert "comp" (show (string->number "1/2@3/4")))
    558894 (test-assert "comp2" (show (string->number "#x99+55i")))
     895 ;; This is to check for a silly problem cause by representing numbers exactly
     896 ;; all the way until the end, then converting to inexact.  This "silly problem"
     897 ;; could probably be exploited in a resource consumption attack.
     898 (let* ((t1 (current-seconds))
     899        (i1 (string->number "1e1000000"))
     900        (i2 (string->number "1.0e1000000"))
     901        (e1 (string->number "#e1e1000000"))
     902        (e2 (string->number "#e1.0e1000000"))
     903        (t2 (current-seconds)))
     904   (test-assert "read time for inexacts with large positive exp isn't insanely high" (< (- t2 t1) 2))
     905   (test "inexact read back are equal" i1 i2)
     906   (test "inexact are inf" i1 +inf.0)
     907   (test "exact are equal" e1 e2)
     908   (test "exact are false" e1 #f))
     909 (let* ((t1 (current-seconds))
     910        (i1 (string->number "-1e1000000"))
     911        (i2 (string->number "-1.0e1000000"))
     912        (e1 (string->number "#e-1e1000000"))
     913        (e2 (string->number "#e-1.0e1000000"))
     914        (t2 (current-seconds)))
     915   (test-assert "read time for inexacts with large positive exp isn't insanely high" (< (- t2 t1) 2))
     916   (test "negative inexact read back are equal" i1 i2)
     917   (test "negative inexact are negative inf" i1 -inf.0)
     918   (test "negative exact are equal" e1 e2)
     919   (test "negative exact are false" e1 #f))
     920 (let* ((t1 (current-seconds))
     921        (i1 (string->number "1e-1000000"))
     922        (i2 (string->number "1.0e-1000000"))
     923        (e1 (string->number "#e1e-1000000"))
     924        (e2 (string->number "#e1.0e-1000000"))
     925        (t2 (current-seconds)))
     926   (test-assert "read time for inexacts with large negative exp isn't insanely high" (< (- t2 t1) 2))
     927   (test "inexact read back are equal" i1 i2)
     928   (test "inexact are 0" i1 +0.0)
     929   (test "exact are equal" e1 e2)
     930   (test "exact are false" e1 #f))
    559931)
    560932
     
    597969
    598970 (test "cplxnum: compintintnum" #t (cplxnum? c1))
    599  (test "cplxnum: compintflointnum" #t (cplxnum? (string->number "1.0+1i")))
     971 (test "cplxnum: compintflointnum" #t (cplxnum? 1.0+1i))
    600972 (test "cplxnum: compflointnum" #t (cplxnum? c2))
    601  (test "cplxnum: compfloflonum" #t (cplxnum? (string->number "3.4-4.3i")))
     973 (test "cplxnum: compfloflonum" #t (cplxnum? 3.4-4.3i))
    602974 (test "not cplxnum: fixnum" #f (cplxnum? 1))
    603975
    604976 (test "rectnum: compintintnum" #t (rectnum? c1))
    605  (test "rectnum: compintflointnum" #t (rectnum? (string->number "1.0+1i")))
     977 (test "rectnum: compintflointnum" #t (rectnum? 1.0+1i))
    606978 (test "not rectnum: compflointum" #f (rectnum? c2))
    607979
    608  (test "compnum: compfloflonum" #t (compnum? (string->number "3.4-4.3i")))
    609  (test "compnum: compflointnum" #t (compnum? (string->number "1.0+1i")))
     980 (test "compnum: compfloflonum" #t (compnum? 3.4-4.3i))
     981 (test "compnum: compflointnum" #t (compnum? 1.0+1i))
    610982 (test "not compnum: compintintnum" #f (compnum? c1))
    611983
     
    617989 (test "cflonum: intflonum" #t (cflonum? 1.0))
    618990 (test "cflonum: flonum" #t (cflonum? 3.4))
    619  (test "cflonum: compfloflonum" #t (cflonum? (string->number "3.4-4.3i")))
     991 (test "cflonum: compfloflonum" #t (cflonum? 3.4-4.3i))
    620992 (test "cflonum: compfloflonum" #t (cflonum? c2))
    621993)
    622 
    623 ;; Found with the pi-ratios benchmark (find-pi 10 20 50)
    624 (define pi    3.14159265358979323881089001960817518141234854964894)
    625 (define ratpi (string->number
    626                (conc "314159265358979323881089001960817518141234854964894"
    627                      "/"
    628                      "100000000000000000000000000000000000000000000000000")))
    629994
    630995;; The usual comparator doesn't work, because zero or a very small number
    631996;; is many times any other small number, but the absolute difference should
    632997;; be minimal, so we compare for that instead.
    633 (parameterize ((current-test-epsilon 1e-10)
     998(parameterize ((current-test-epsilon 1e-9)
    634999               (current-test-comparator
    6351000                (lambda (exp act)
     
    6781043      (test "cos(   2pi)" 1.0 (cos (* 2 pi)))
    6791044      (test "acos(cos(   2pi))" 0 (acos (cos (* 2 pi))))
    680       (test "acos(<large number>)" +nan.0 (acos 1e100))
     1045      (test "acos(pi)" 0.0+1.81152627246085i (acos pi))
    6811046      (test "acos(+inf)" -nan.0 (acos +inf.0))
    6821047
     
    7131078      (test "sin(   2pi)" 0.0 (sin (* 2 pi)))
    7141079      (test "asin(sin(   2pi))" 0.0 (asin (sin (* 2 pi))))
    715       (test "asin(<large number>)" +nan.0 (asin 1e100))
     1080      (test "asin(pi)" 1.57079632679490-1.81152627246085i (asin pi))
    7161081      (test "asin(+inf)" -nan.0 (asin +inf.0))
    7171082     
     
    7431108      (test "tan(   2pi)" 0.0 (tan (* 2 pi)))
    7441109      (test "atan(tan(   2pi))" 0.0 (atan (tan (* 2 pi))))
    745       (test "atan(<large number>)" (/ pi 2) (atan 1e100))
     1110      (test "atan(pi)" (/ pi 2) (atan 1e100))
    7461111      (test "atan(+inf)" (/ pi 2) (atan +inf.0))
    7471112
     
    7531118      (test "atan2(1, 2) = angle(2+i)"
    7541119            (atan 1 2) (angle (make-rectangular 2 1)))
     1120      (test "atan2(1, b1) = angle(2+i)"
     1121            (atan 1 b1) (angle (make-rectangular b1 1)))
     1122      (test "atan2(b1, 1) = angle(2+i)"
     1123            (atan b1 1) (angle (make-rectangular 1 b1)))
    7551124      (test "atan2(-0.1, 3.2) = angle(3.2-0.1i)"
    7561125            (atan -0.1 3.2) (angle (make-rectangular 3.2 -0.1)))
     
    7611130      (test "cos(0.0+1.0i)" 1.5430806348152437
    7621131            (cos (make-rectangular 0.0 1.0)))
    763       (test "acos(cos(0.0+1.0i))" +nan.0
     1132      (test "acos(cos(0.0+1.0i))" 0.0+1.0i
    7641133            (acos (cos (make-rectangular 0.0 1.0))))
    7651134      (test "cos(0.0-1.0i)" 1.5430806348152437
    7661135            (cos (make-rectangular 0.0 -1.0)))
    767       (test "acos(cos(0.0-1.0i))" +nan.0
     1136      (test "acos(cos(0.0-1.0i))" 0.0+1.0i
    7681137            (acos (cos (make-rectangular 0.0 -1.0))))
    7691138      (test "cos(0.0+3.0i)" 10.067661995777765
    7701139            (cos (make-rectangular 0.0 3.0)))
    771       (test "acos(cos(0.0+3.0i))" +nan.0
     1140      (test "acos(cos(0.0+3.0i))" 0.0+3.0i
    7721141            (acos (cos (make-rectangular 0.0 3.0))))
    7731142      (test "cos(0.0-3.0i)" 10.067661995777765
    7741143            (cos (make-rectangular 0.0 -3.0)))
    775       (test "acos(cos(0.0-3.0i))" +nan.0
     1144      (test "acos(cos(0.0-3.0i))" 0.0+3.0i
    7761145            (acos (cos (make-rectangular 0.0 -3.0))))
    7771146      (test "cos(0.5+0.5i)"
     
    10481417    (test-group "bignums"
    10491418      (test "acos(<negative bignum>)" -nan.0 (acos (- b1)))
    1050       (test "acos(<bignum>)" +nan.0 (acos b1))
     1419      ;; These are bogus (maybe the negative ones too!), but I don't want to
     1420      ;; "fix" them by copying the output and assume it's alright.
     1421      #;(test "acos(<bignum>)" +nan.0 (acos b1))
    10511422      (test "asin(<negative bignum>)" -nan.0 (asin (- b1)))
    1052       (test "asin(<bignum>)" +nan.0 (asin b1))
     1423      #;(test "asin(<bignum>)" +nan.0 (asin b1))
    10531424      (test "atan(<negative bignum>)" (- (/ pi 2)) (atan (- b1)))
    10541425      (test "atan(<bignum>)" (/ pi 2) (atan b1)))
     
    10621433      (test "acos(1)" 0.0 (acos 1))
    10631434      (test "cos(-1)" (cos -1.0) (cos -1))
    1064       (test "acos(-1)" pi (acos -1)))
     1435      (test "acos(-1)" pi (acos -1))
     1436      (test "acos(-2)" (make-rectangular pi -1.31695789692482) (acos -2))
     1437      (test "acos(2)" 0.0+1.31695789692482i (acos 2))
     1438      (test "asin(1)" (/ pi 2) (asin 1))
     1439      (test "asin(-1)" (/ pi -2) (asin -1))
     1440      (test "asin(2)" (make-rectangular (/ pi 2) -1.31695789692482) (asin 2))
     1441      (test "asin(-2)" (make-rectangular (/ pi -2) 1.31695789692482) (asin -2)))
    10651442
    10661443    (test-group "ratnums"
  • release/4/numbers/branches/schemification/tests/run.scm

    r26200 r26606  
    77
    88(test-group "compiled"
    9   (compile -O3 "all-tests.scm")
     9  (compile -X numbers-syntax -O3 "all-tests.scm")
    1010  (let ((exit-status (system "./all-tests")))
    1111    (test "compiled test succeeded" 0 exit-status)))
     12
     13(test-exit)
  • release/4/numbers/branches/schemification/tests/string-conversion.scm

    r26169 r26606  
    192192 ("nan.0" #f)
    193193 ("inf.0" #f)
     194 ;; Thanks to John Cowan for these
     195 ("#e+nan.0" #f)
     196 ("#e+inf.0" #f)
     197 ("#e-inf.0" #f)
     198 ("#i+nan.0" the-nan "+nan.0" "+NaN.0")
     199 ("#i+inf.0" pos-inf "+inf.0" "+Inf.0")
     200 ("#i-inf.0" neg-inf "-inf.0" "-Inf.0")
    194201
    195202 "Fractions"
     
    197204  ((exact)
    198205   ("1/2" (/ 1 2))
     206   ("#e1/2" (/ 1 2) "1/2")
    199207   ("10/2" 5 "5")
    200208   ("-1/2" (- (/ 1 2)))
     209   ("10/0" #f)
     210   ("0/10" 0 "0")
     211   ("#e0/10" 0 "0")
    201212   ("#e1#/2" 5 (/ 15 2) "5" "15/2")
    202    ("#e1/2#" (/ 1 20) "1/20"))
     213   ("#e1/2#" (/ 1 20) "1/20")
     214   ("#i3/2" (/ 3.0 2.0) "1.5"))
    203215  ((inexact)
    204216   ("1/2" (/ 1 2) "0.5" ".5" "500.0e-3")
     217   ("0/10" 0.0 "0.0")
    205218   ("10/2" 5.0 "5.0" "5.")
     219   ;; Unsure what "#e1/2" is supposed to do in Scheme w/o exact fractions
     220   ("#i10/2" 5.0 "5.0" "5.")
    206221   ("-1/2" (- (/ 1 2)) "-0.5" "-.5" "-500.0e-3")))
    207222 (fractions
    208223  ((inexact exact)
     224   ("#i1/0" pos-inf "+inf.0" "+Inf.0")
     225   ("#i-1/0" neg-inf "-inf.0" "-Inf.0")
     226   ("#i0/0" the-nan "+nan.0" "+NaN.0")
     227   ;; This _could_ be valid in some Schemes (but isn't as pretty)
     228   ;("#i1/0" #f)
     229   ;("#i-1/0" #f)
     230   ;("#i0/0" #f)
     231   
    209232   ("1/-2" #f)
    210233   ("1.0/2" #f)
     
    301324   ("0.5+1/1#2i" #f)
    302325   ("1/#+0.5i" #f)
    303    ("1/1#2+0.5i" #f)))
     326   ("1/1#2+0.5i" #f)
     327
     328   "Mixed notation with infinity (might fail on mixed exactness compnums)"
     329   ;; This is a nasty one. Switch to inexact *after* reading the first number.
     330   ;; Note that it's perfectly acceptable for a scheme with *mixed* exactness
     331   ;; in complex values to return #f here.  TODO: How to parameterize this, we
     332   ;; *really* want to test that single-exactness compnums systems accept this.
     333   ("1/0+1.2i" (make-rectangular pos-inf 1.2) "+inf.0+1.2i" "+Inf.0+1.2i")
     334   ;; Less nasty, most get this right.  Same caveat as above re: mixed exactness
     335   ("1.2+1/0i" (make-rectangular 1.2 pos-inf) "1.2+inf.0i" "1.2+Inf.0")))
    304336
    305337 (compnums
Note: See TracChangeset for help on using the changeset viewer.