Changeset 31450 in project


Ignore:
Timestamp:
09/18/14 21:06:41 (5 years ago)
Author:
sjamaan
Message:

numbers: Some small consistency improvements and very minor optimisations

Location:
release/4/numbers/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/numbers/trunk/numbers-c.c

    r31445 r31450  
    9191static C_word bignum_normalize_shifted(C_word bignum, C_word shift_right);
    9292
    93 /* This should be replaced by C_header_bits(x) == C_BIGNUM_TYPE in core */
    94 #define C_IS_BIGNUM_TYPE(x) (C_header_bits(x) == C_STRUCTURE_TYPE && C_block_item(CHICKEN_gc_root_ref(tags), BIG_TAG) == C_block_item(x, 0))
    95 
    9693static C_word
    9794init_tags(___scheme_value tagvec)
  • release/4/numbers/trunk/numbers-c.h

    r31445 r31450  
    5050#define C_BIGNUM_DIGIT_COMBINE(h,l)     ((h) << C_BIGNUM_HALF_DIGIT_LENGTH|(l))
    5151
     52/* This should be replaced by C_header_bits(x) == C_BIGNUM_TYPE in core */
     53#define C_IS_BIGNUM_TYPE(x) (C_header_bits(x) == C_STRUCTURE_TYPE && C_block_item(CHICKEN_gc_root_ref(tags), BIG_TAG) == C_block_item(x, 0))
     54
    5255#define C_fitsinbignumdigitp(n)         ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_DIGIT_MASK))
    5356#define C_fitsinbignumhalfdigitp(n)     ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_HALF_DIGIT_MASK))
     
    110113void C_ccall C_u_2_integer_bitwise_op(C_word c, C_word self, C_word k, C_word op, C_word x, C_word y);
    111114
     115C_inline C_word C_i_bignump(C_word x)
     116{
     117  return C_mk_bool(!C_immediatep(x) && C_IS_BIGNUM_TYPE(x));
     118}
     119
     120C_inline C_word C_i_basic_numberp(C_word x)
     121{
     122  return C_mk_bool((x & C_FIXNUM_BIT) ||
     123                   (!C_immediatep(x) &&
     124                    (C_block_header(x) == C_FLONUM_TAG ||
     125                     C_IS_BIGNUM_TYPE(x))));
     126}
    112127
    113128C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
  • release/4/numbers/trunk/numbers.scm

    r31445 r31450  
    148148(define-inline (%flo-integer? x) (##core#inline "C_u_i_fpintegerp" x))
    149149
    150 (define-inline (complex-real c) (##sys#slot c 1))
    151 (define-inline (complex-imag c) (##sys#slot c 2))
     150(define-inline (compnum-real c) (##sys#slot c 1))
     151(define-inline (compnum-imag c) (##sys#slot c 2))
    152152(define-inline (%make-complex r i) (##sys#make-structure 'compnum r i))
    153153
    154 (define-inline (rat-numerator c) (##sys#slot c 1))
    155 (define-inline (rat-denominator c) (##sys#slot c 2))
    156 (define-inline (%make-rat r i) (##sys#make-structure 'ratnum r i))
     154(define-inline (ratnum-numerator c) (##sys#slot c 1))
     155(define-inline (ratnum-denominator c) (##sys#slot c 2))
     156(define-inline (%make-ratnum r i) (##sys#make-structure 'ratnum r i))
    157157
    158158(define-inline (%fix->flo n) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) n))
     
    253253
    254254  (define (comp+comp x y)
    255     (let ((r (%+ (complex-real x) (complex-real y)))
    256           (i (%+ (complex-imag x) (complex-imag y))) )
     255    (let ((r (%+ (compnum-real x) (compnum-real y)))
     256          (i (%+ (compnum-imag x) (compnum-imag y))) )
    257257      (make-complex r i) ) )
    258258
     
    264264               (NONE (bad-number '+ y))
    265265               ;; a/b + c/d = (a*d + b*c)/(b*d)  [with d = 1]
    266                (else (let ((b (rat-denominator x)))
    267                        (%/ (%+ (rat-numerator x) (%* b y)) b))) ))
     266               (else (let ((b (ratnum-denominator x)))
     267                       (%/ (%+ (ratnum-numerator x) (%* b y)) b))) ))
    268268        (COMP (switchq (%check-number y)
    269269                (COMP (comp+comp x y))
     
    273273        (else (switchq (%check-number y) ; x is a basic number, y isn't
    274274                ;; a/b + c/d = (a*d + b*c)/(b*d)  [with b = 1]
    275                 (RAT (let ((d (rat-denominator y)))
    276                        (%/ (%+ (%* x d) (rat-numerator y)) d)))
     275                (RAT (let ((d (ratnum-denominator y)))
     276                       (%/ (%+ (%* x d) (ratnum-numerator y)) d)))
    277277                (COMP (comp+comp (%make-complex x 0) y))
    278278                (else (bad-number '+ y)) ) ) ) ) )
     
    287287        (FLO (fpneg arg1))
    288288        (BIG ((##core#primitive "C_u_bignum_negate") arg1))
    289         (RAT (%make-rat (- (rat-numerator arg1))
    290                         (rat-denominator arg1)))
    291         (COMP (%make-complex (%- 0 (complex-real arg1))
    292                              (%- 0 (complex-imag arg1))))
     289        (RAT (%make-ratnum (- (ratnum-numerator arg1))
     290                           (ratnum-denominator arg1)))
     291        (COMP (%make-complex (%- 0 (compnum-real arg1))
     292                             (%- 0 (compnum-imag arg1))))
    293293        (else (bad-number '- arg1)) )
    294294      (let loop ([args (##sys#slot args 1)] [x (%- arg1 (##sys#slot args 0))])
     
    299299(define (%- x y)
    300300  (define (comp-comp x y)
    301     (let ((r (%- (complex-real x) (complex-real y)))
    302           (i (%- (complex-imag x) (complex-imag y))) )
     301    (let ((r (%- (compnum-real x) (compnum-real y)))
     302          (i (%- (compnum-imag x) (compnum-imag y))) )
    303303      (make-complex r i) ) )
    304304
     
    310310               (NONE (bad-number '- y))
    311311               ;; a/b - c/d = (a*d - b*c)/(b*d)  [with d = 1]
    312                (else (let ((b (rat-denominator x)))
    313                        (%/ (%- (rat-numerator x) (%* b y)) b))) ) )
     312               (else (let ((b (ratnum-denominator x)))
     313                       (%/ (%- (ratnum-numerator x) (%* b y)) b))) ) )
    314314        (COMP (switchq (%check-number y)
    315315                (COMP (comp-comp x y))
     
    319319        (else (switchq (%check-number y)
    320320                ;; a/b - c/d = (a*d - b*c)/(b*d)  [with b = 1]
    321                 (RAT (let ((d (rat-denominator y)))
    322                        (%/ (%- (%* x d) (rat-numerator y)) d)))
     321                (RAT (let ((d (ratnum-denominator y)))
     322                       (%/ (%- (%* x d) (ratnum-numerator y)) d)))
    323323                (COMP (comp-comp (%make-complex x 0) y))
    324324                (else (bad-number '- y)) ) ) )) )
     
    342342
    343343  (define (comp*comp x y)
    344     (let* ([a (complex-real x)]
    345            [b (complex-imag x)]
    346            [c (complex-real y)]
    347            [d (complex-imag y)]
     344    (let* ([a (compnum-real x)]
     345           [b (compnum-imag x)]
     346           [c (compnum-real y)]
     347           [d (compnum-imag y)]
    348348           [r (%- (%* a c) (%* b d))]
    349349           [i (%+ (%* a d) (%* b c))] )
     
    354354    ;;  =  ((a / g) * c) / (d / g)
    355355    ;; With   g = gcd(a, d)   and  a = x   [Knuth, 4.5.1]
    356     (let* ((d (rat-denominator y))
     356    (let* ((d (ratnum-denominator y))
    357357           (g (%gcd-0 '* x d)))
    358       (ratnum (%* (%quotient '* x g) (rat-numerator y))
     358      (ratnum (%* (%quotient '* x g) (ratnum-numerator y))
    359359              (%quotient '* d g))))
    360360
     
    365365               ;;   = ((a / g1) * (c / g2)) / ((b / g2) * (d / g1))
    366366               ;; With   g1 = gcd(a, d)   and    g2 = gcd(b, c) [Knuth, 4.5.1]
    367                (RAT (let* ((a (rat-numerator x)) (b (rat-denominator x))
    368                            (c (rat-numerator y)) (d (rat-denominator y))
     367               (RAT (let* ((a (ratnum-numerator x)) (b (ratnum-denominator x))
     368                           (c (ratnum-numerator y)) (d (ratnum-denominator y))
    369369                           (g1 (%gcd-0 '* a d)) (g2 (%gcd-0 '* b c)))
    370370                      (ratnum (%* (%quotient '* a g1) (%quotient '* c g2))
     
    402402  ;;   = ((a / g1) * d * sign(a)) / abs(c / g1)
    403403  ;; With   g1 = gcd(a, c)   and   a = x  [Knuth, 4.5.1 ex. 4]
    404   (let* ((c (rat-numerator y))
     404  (let* ((c (ratnum-numerator y))
    405405         (g (%gcd-0 '/ x c)))
    406     (%/ (%* (%quotient '/ x g) (rat-denominator y))
     406    (%/ (%* (%quotient '/ x g) (ratnum-denominator y))
    407407        (%quotient '/ c g))))
    408408
     
    444444       ;;   = ((a / g1) * (d / g2) * sign(a)) / abs((b / g2) * (c / g1))
    445445       ;; With   g1 = gcd(a, c)   and    g2 = gcd(b, d) [Knuth, 4.5.1 ex. 4]
    446        [RAT (let* ((a (rat-numerator x)) (b (rat-denominator x))
    447                    (c (rat-numerator y)) (d (rat-denominator y))
     446       [RAT (let* ((a (ratnum-numerator x)) (b (ratnum-denominator x))
     447                   (c (ratnum-numerator y)) (d (ratnum-denominator y))
    448448                   (g1 (%gcd-0 '/ a c)) (g2 (%gcd-0 '/ b d)))
    449449              (%/ (%* (%quotient '/ a g1) (%quotient '/ d g2))
     
    456456       ;;   = ((a / g) * sign(a)) / abs(b * (c / g))
    457457       ;; With   g = gcd(a, c)   and  c = y  [Knuth, 4.5.1 ex. 4]
    458        [else (let* ((a (rat-numerator x))
     458       [else (let* ((a (ratnum-numerator x))
    459459                    (g (%gcd-0 '/ a y))) ;; TODO: Improve error message if /0
    460460               (%/ (%quotient '/ a g)
    461                    (%* (rat-denominator x) (%quotient '/ y g))))] ) ]
     461                   (%* (ratnum-denominator x) (%quotient '/ y g))))] ) ]
    462462    [COMP
    463463     (switchq (%check-number y)
     
    468468
    469469(define (%comp/comp p q)
    470   (let* ([a (complex-real p)]
    471          [b (complex-imag p)]
    472          [c (complex-real q)]
    473          [d (complex-imag q)]
     470  (let* ([a (compnum-real p)]
     471         [b (compnum-imag p)]
     472         [c (compnum-real q)]
     473         [d (compnum-imag q)]
    474474         [r (%+ (%* c c) (%* d d))]
    475475         [x (%/ (%+ (%* a c) (%* b d)) r)]
     
    516516       [BIG #f] ;; Rats are never x/1, because those are normalised to just x
    517517       ;; TODO: Use integer= here, when we write it
    518        [RAT (and (%= (rat-numerator x) (rat-numerator y))
    519                  (%= (rat-denominator x) (rat-denominator y)))]
     518       [RAT (and (%= (ratnum-numerator x) (ratnum-numerator y))
     519                 (%= (ratnum-denominator x) (ratnum-denominator y)))]
    520520       [COMP #f] ;; Comps are only ever equal to other comps
    521521       [else (bad-number '= y)] ) ]
    522522    [COMP
    523523     (switchq (%check-number y)
    524        [COMP (and (%= (complex-real x) (complex-real y))
    525                   (%= (complex-imag x) (complex-imag y)))]
     524       [COMP (and (%= (compnum-real x) (compnum-real y))
     525                  (%= (compnum-imag x) (compnum-imag y)))]
    526526       [NONE (bad-number '= y)]
    527527       [else #f] ) ]
     
    548548           (BIG  (fx= (%big-cmp a b) 0))
    549549           ;; TODO: Use integer= here, when we write it
    550            (RAT  (and (%= (rat-numerator a) (rat-numerator b))
    551                       (%= (rat-denominator a) (rat-denominator b))))
     550           (RAT  (and (%= (ratnum-numerator a) (ratnum-numerator b))
     551                      (%= (ratnum-denominator a) (ratnum-denominator b))))
    552552           ;; We use eqv? here because exactness of components needs to match
    553            (COMP (and (eqv? (complex-real a) (complex-real b))
    554                       (eqv? (complex-imag a) (complex-imag b))))
     553           (COMP (and (eqv? (compnum-real a) (compnum-real b))
     554                      (eqv? (compnum-imag a) (compnum-imag b))))
    555555           (else (error "This should not happen"))))))
    556556
     
    582582       (BIG (%big-negative? y))
    583583       ;; a/b > c/d  when  a*d > b*c  [with b = 1]
    584        (RAT (%> (%* x (rat-denominator y))
    585                 (rat-numerator y) loc))
     584       (RAT (%> (%* x (ratnum-denominator y))
     585                (ratnum-numerator y) loc))
    586586       (COMP (bad-complex/o loc y))
    587587       (else (bad-number loc y)) ) )
     
    612612       (BIG (fx> (%big-cmp x y) 0))
    613613       ;; a/b > c/d  when  a*d > b*c  [with b = 1]
    614        (RAT (%> (%* x (rat-denominator y))
    615                 (rat-numerator y) loc))
     614       (RAT (%> (%* x (ratnum-denominator y))
     615                (ratnum-numerator y) loc))
    616616       (COMP (bad-complex/o loc y))
    617617       (else (bad-number loc y)) ) )
     
    619619     (switchq (%check-number y)
    620620       ;; a/b > c/d  when  a*d > b*c  [generic]
    621        (RAT (%> (%* (rat-numerator x) (rat-denominator y))
    622                 (%* (rat-denominator x) (rat-numerator y)) loc))
     621       (RAT (%> (%* (ratnum-numerator x) (ratnum-denominator y))
     622                (%* (ratnum-denominator x) (ratnum-numerator y)) loc))
    623623       (FLO (or (fp= y -inf.0)
    624624                (and (not (fp= y +inf.0)) (fp= y y)
     
    627627       (NONE (bad-number loc y))
    628628       ;; a/b > c/d  when  a*d > b*c  [with d = 1]
    629        (else (%> (rat-numerator x)
    630                  (%* (rat-denominator x) y) loc)) ) )
     629       (else (%> (ratnum-numerator x)
     630                 (%* (ratnum-denominator x) y) loc)) ) )
    631631    (COMP (bad-complex/o loc x))
    632632    (else (bad-number loc x)) ) )
     
    659659       (BIG (not (%big-negative? y)))
    660660       ;; a/b < c/d  when  a*d < b*c  [with b = 1]
    661        (RAT (%< (%* x (rat-denominator y))
    662                 (rat-numerator y) loc))
     661       (RAT (%< (%* x (ratnum-denominator y))
     662                (ratnum-numerator y) loc))
    663663       (COMP (bad-complex/o loc y))
    664664       (else (bad-number loc y)) ) )
     
    689689       (BIG (fx< (%big-cmp x y) 0))
    690690       ;; a/b < c/d  when  a*d < b*c  [with b = 1]
    691        (RAT (%< (%* x (rat-denominator y))
    692                 (rat-numerator y) loc))
     691       (RAT (%< (%* x (ratnum-denominator y))
     692                (ratnum-numerator y) loc))
    693693       (COMP (bad-complex/o loc y))
    694694       (else (bad-number loc y)) ) )
     
    696696     (switchq (%check-number y)
    697697       ;; a/b < c/d  when  a*d < b*c  [generic]
    698        (RAT (%< (%* (rat-numerator x) (rat-denominator y))
    699                 (%* (rat-denominator x) (rat-numerator y)) loc))
     698       (RAT (%< (%* (ratnum-numerator x) (ratnum-denominator y))
     699                (%* (ratnum-denominator x) (ratnum-numerator y)) loc))
    700700       (COMP (bad-complex/o loc y))
    701701       (FLO (or (fp= y +inf.0)
     
    704704       (NONE (bad-number loc y))
    705705       ;; a/b < c/d  when  a*d < b*c  [with d = 1]
    706        (else (%< (rat-numerator x)
    707                  (%* (rat-denominator x) y) loc)) ) )
     706       (else (%< (ratnum-numerator x)
     707                 (%* (ratnum-denominator x) y) loc)) ) )
    708708    (COMP (bad-complex/o loc x))
    709709    (else (bad-number loc x)) ) )
     
    741741
    742742(define (make-rectangular r i)
    743   (switchq (%check-number r)
    744     (COMP (bad-real 'make-rectangular r))
    745     (NONE (bad-number 'make-rectangular r)) )
    746   (switchq (%check-number i)
    747     (COMP (bad-real 'make-rectangular i))
    748     (NONE (bad-number 'make-rectangular i)) )
     743  (unless (real? r) (bad-real 'make-rectangular r))
     744  (unless (real? i) (bad-real 'make-rectangular i))
    749745  (make-complex r i) )
    750746
    751747(define (%make-polar r phi)
    752   (switchq (%check-number r)
    753     (COMP (bad-real 'make-polar r))
    754     (NONE (bad-number 'make-polar r)) )
    755   (switchq (%check-number phi)
    756     (COMP (bad-real 'make-polar phi))
    757     (NONE (bad-number 'make-polar phi)) )
     748  (unless (real? r) (bad-real 'make-rectangular r))
     749  (unless (real? phi) (bad-real 'make-rectangular phi))
    758750  (let ((fphi (exact->inexact phi)))
    759751    (make-complex (%* r (##core#inline_allocate ("C_a_i_cos" 4) fphi))
     
    764756(define (real-part x)
    765757  (switchq (%check-number x)
    766     (COMP (complex-real x))
     758    (COMP (compnum-real x))
    767759    (NONE (bad-number 'real-part x))
    768760    (else x) ) )
     
    771763  (switchq (%check-number x)
    772764    (NONE (bad-number 'imag-part x))
    773     (COMP (complex-imag x))
     765    (COMP (compnum-imag x))
    774766    (FLO 0.0)
    775767    (else 0) ) )
     
    777769(define (%magnitude x)
    778770  (switchq (%check-number x)
    779     (COMP (let ((r (complex-real x))
    780                 (i (complex-imag x)) )
     771    (COMP (let ((r (compnum-real x))
     772                (i (compnum-imag x)) )
    781773            (%sqrt 'magnitude (%+ (%* r r) (%* i i))) ) )
    782774    (NONE (bad-number 'magnitude x))
     
    789781    (NONE (bad-number 'angle x))
    790782    (COMP (##core#inline_allocate ("C_a_i_atan2" 4)
    791                                   (%exact->inexact (complex-imag x))
    792                                   (%exact->inexact (complex-real x))))
     783                                  (%exact->inexact (compnum-imag x))
     784                                  (%exact->inexact (compnum-real x))))
    793785    (else (##core#inline_allocate ("C_a_i_atan2" 4) 0.0 (%exact->inexact x))) ) )
    794786
     
    802794   ((eq? n 1) m)
    803795   ((eq? n -1) (- m))
    804    ((negative? n) (%make-rat (- m) (- n)))
    805    (else (%make-rat m n))))
     796   ((negative? n) (%make-ratnum (- m) (- n)))
     797   (else (%make-ratnum m n))))
    806798
    807799;; Knuth, 4.5.1
    808800(define (rat+/- loc op x y)
    809   (let ((a (rat-numerator x)) (b (rat-denominator x))
    810         (c (rat-numerator y)) (d (rat-denominator y)))
     801  (let ((a (ratnum-numerator x)) (b (ratnum-denominator x))
     802        (c (ratnum-numerator y)) (d (ratnum-denominator y)))
    811803    (let ((g1 (%gcd-0 loc b d)))
    812804      (cond
    813        ((eq? g1 1) (%make-rat (op (%* a d) (%* b c)) (%* b d)))
     805       ((eq? g1 1) (%make-ratnum (op (%* a d) (%* b c)) (%* b d)))
    814806       ;; Save a quotient and multiplication if the gcd is equal
    815807       ;; to one of the denominators since quotient of b or d and g1 = 1
     
    827819                           (%* c b/g1)))
    828820                    (g2 (%gcd-0 loc t g1)))
    829                (%make-rat (%quotient loc t g2)
    830                           (%* b/g1 (%quotient loc d g2)))))))))
     821               (%make-ratnum (%quotient loc t g2)
     822                             (%* b/g1 (%quotient loc d g2)))))))))
    831823
    832824(define (numerator x)
     
    838830          (else (exact->inexact (numerator (%flo->rat 'numerator x))))))
    839831    (BIG x)
    840     (RAT (rat-numerator x))
     832    (RAT (ratnum-numerator x))
    841833    (COMP (bad-ratnum 'numerator x))
    842834    (else (bad-number 'numerator x)) ) )
     
    850842          (else (exact->inexact (denominator (%flo->rat 'denominator x))))))
    851843    (BIG 1)
    852     (RAT (rat-denominator x))
     844    (RAT (ratnum-denominator x))
    853845    (COMP (bad-ratnum 'denominator x))
    854846    (else (bad-number 'denominator x)) ) )
     
    863855    (FLO (##core#inline_allocate ("C_a_i_abs" 4) x))
    864856    (BIG (%big-abs x))
    865     (RAT (%make-rat (%abs (rat-numerator x)) (rat-denominator x)))
     857    (RAT (%make-ratnum (%abs (ratnum-numerator x)) (ratnum-denominator x)))
    866858    (COMP (##sys#signal-hook #:type-error 'abs "can not compute absolute value of complex number" x))
    867859    (NONE (bad-number 'abs x)) ) )
     
    870862
    871863(define (number? x)
    872   (switchq (%check-number x)
    873     (NONE #f)
    874     (else #t) ) )
     864  (or (##core#inline "C_i_basic_numberp" x) (extended-number? x)))
     865
     866;; TODO: Extend C_i_integerp
     867(define (%integer? x)
     868  (and (##core#inline "C_i_basic_numberp" x)
     869       (or (not (##core#inline "C_i_flonump" x))
     870           (##core#inline "C_u_i_fpintegerp" x))))
     871
     872(set! ##sys#integer? %integer?)
     873(define integer? %integer?)
    875874
    876875(set! ##sys#number? number?)
    877876(define complex? number?)
    878877
     878;; All numbers are real, except for compnums
    879879(define (real? x)
    880   (switchq (%check-number x)
    881     (COMP #f)
    882     (NONE #f)
    883     (else #t) ) )
     880  (or (##core#inline "C_i_basic_numberp" x)
     881      (##sys#structure? x 'ratnum) ) )
    884882
    885883(define (rational? x) (and (real? x) (finite? x)))
    886884
    887 (define (%integer? x)
    888   (switchq (%check-number x)
    889     (FIX #t)
    890     (FLO (%flo-integer? x))
    891     (BIG #t)
    892     (else #f) ) )
    893 
    894 (set! ##sys#integer? %integer?)
    895 (define integer? %integer?)
    896 
    897885(define (exact-integer? x)
    898   (switchq (%check-number x)
    899     (FIX #t)
    900     (BIG #t)
    901     (else #f) ) )
     886  (or (##core#inline "C_fixnump" x) (##core#inline "C_i_bignump" x)) )
     887
    902888
    903889(define (%exact? x)
    904890  (switchq (%check-number x)
    905891    (FLO #f)
    906     (COMP (and (%exact? (complex-real x)) (%exact? (complex-imag x))))
     892    (COMP (and (%exact? (compnum-real x)) (%exact? (compnum-imag x))))
    907893    (NONE (bad-number 'exact? x))
    908894    (else #t) ) )
     
    914900  (switchq (%check-number x)
    915901    (FLO #t)
    916     (COMP (and (%inexact? (complex-real x)) (%inexact? (complex-imag x))))
     902    (COMP (and (%inexact? (compnum-real x)) (%inexact? (compnum-imag x))))
    917903    (NONE (bad-number 'inexact? x))
    918904    (else #f) ) )
     
    11601146    (BIG x)
    11611147    (RAT x)
    1162     (COMP (make-complex (%inexact->exact (complex-real x))
    1163                         (%inexact->exact (complex-imag x))))
     1148    (COMP (make-complex (%inexact->exact (compnum-real x))
     1149                        (%inexact->exact (compnum-imag x))))
    11641150    (NONE (bad-number 'inexact->exact x)) ) )
    11651151
     
    11781164;; TODO: Use (fp/ n d) if both are finite after conversion to flonums
    11791165(define (%rat->flo x)
    1180   (let* ((n1 (rat-numerator x))
     1166  (let* ((n1 (ratnum-numerator x))
    11811167         (an (%abs n1))
    1182          (d1 (rat-denominator x))
     1168         (d1 (ratnum-denominator x))
    11831169         ;; Approximate distance between the numbers in powers of 2
    11841170         ;; ie,  2^e-1 < n/d < 2^e+1  (e is the *un*biased value of e_w in M2)
     
    12141200    (BIG (%big->flo x))
    12151201    (RAT (%rat->flo x))
    1216     (COMP (make-complex (%exact->inexact (complex-real x)) (%exact->inexact (complex-imag x))))
     1202    (COMP (make-complex (%exact->inexact (compnum-real x)) (%exact->inexact (compnum-imag x))))
    12171203    (NONE (bad-number 'exact->inexact x)) ) )
    12181204
     
    12801266    (BIG x)
    12811267    ;; (floor x) = greatest integer <= x
    1282     (RAT (let* ((n (rat-numerator x))
    1283                 (q (quotient n (rat-denominator x))))
     1268    (RAT (let* ((n (ratnum-numerator x))
     1269                (q (quotient n (ratnum-denominator x))))
    12841270           (if (>= n 0)
    12851271               q
     
    12951281    (BIG x)
    12961282    ;; (ceiling x) = smallest integer >= x
    1297     (RAT (let* ((n (rat-numerator x))
    1298                 (q (quotient n (rat-denominator x))))
     1283    (RAT (let* ((n (ratnum-numerator x))
     1284                (q (quotient n (ratnum-denominator x))))
    12991285           (if (>= n 0)
    13001286               (%+ q 1)
     
    13081294    (BIG x)
    13091295    ;; (rational-truncate x) = integer of largest magnitude <= (abs x)
    1310     (RAT (%quotient 'truncate (rat-numerator x) (rat-denominator x)))
     1296    (RAT (%quotient 'truncate (ratnum-numerator x) (ratnum-denominator x)))
    13111297    (else (bad-real 'truncate x))) )
    13121298
     
    13161302    (FLO (##core#inline_allocate ("C_a_i_flonum_round_proper" 4) x))
    13171303    (BIG x)
    1318     (RAT (let* ((x+1/2 (%+ x (%make-rat 1 2)))
     1304    (RAT (let* ((x+1/2 (%+ x (%make-ratnum 1 2)))
    13191305                (r (%floor x+1/2)))
    13201306           (if (and (%= r x+1/2)
     
    13551341  (switchq (%check-number n)
    13561342    (NONE (bad-number 'exp n))
    1357     (COMP (%* (##core#inline_allocate ("C_a_i_exp" 4) (complex-real n))
    1358               (let ((p (complex-imag n)))
     1343    (COMP (%* (##core#inline_allocate ("C_a_i_exp" 4) (compnum-real n))
     1344              (let ((p (compnum-imag n)))
    13591345                (make-complex
    13601346                 (##core#inline_allocate ("C_a_i_cos" 4) p)
     
    14811467                (m (##core#inline_allocate ("C_a_i_sqrt" 4) (%magnitude n))) )
    14821468            (make-complex (%* m (%cos p)) (%* m (%sin p)) ) ) )
    1483     (RAT (let ((num (rat-numerator n))
    1484                (den (rat-denominator n)))
     1469    (RAT (let ((num (ratnum-numerator n))
     1470               (den (ratnum-denominator n)))
    14851471           (if (and (>= num 0) (>= den 0))
    14861472               (receive (ns^2 nr)
     
    15701556           ;; (n*d)^b = n^b * d^b = n^b * x^{-b}  | x = 1/b
    15711557           ;; Hopefully faster than integer-power
    1572            (%* (expt (rat-numerator a) b) (expt (rat-denominator a) (- b))))
     1558           (%* (expt (ratnum-numerator a) b)
     1559               (expt (ratnum-denominator a) (- b))))
    15731560          ;; x^{a/b} = (x^{1/b})^a
    15741561          ((eq? RAT tb)
     
    15771564                      (%expt-0 (%fix->flo a) (%rat->flo b))
    15781565                      (receive (ds^n r)
    1579                         (%exact-integer-nth-root 'expt a (rat-denominator b))
     1566                        (%exact-integer-nth-root 'expt a (ratnum-denominator b))
    15801567                        (if (eq? r 0)
    1581                             (expt ds^n (rat-numerator b))
     1568                            (expt ds^n (ratnum-numerator b))
    15821569                            (%expt-0 (%fix->flo a) (%rat->flo b))))))
    15831570             (BIG (if (%big-negative? a)
    15841571                      (%expt-0 (%big->flo a) (%rat->flo b))
    15851572                      (receive (ds^n r)
    1586                         (%exact-integer-nth-root 'expt a (rat-denominator b))
     1573                        (%exact-integer-nth-root 'expt a (ratnum-denominator b))
    15871574                        (if (eq? r 0)
    1588                             (expt ds^n (rat-numerator b))
     1575                            (expt ds^n (ratnum-numerator b))
    15891576                            (%expt-0 (%big->flo a) (%rat->flo b))))))
    15901577             (FLO (%expt-0 a (%rat->flo b)))
     
    16031590  (switchq (%check-number n)
    16041591    (NONE (bad-number 'conj n))
    1605     (COMP (make-complex (complex-real n) (%- 0 (complex-imag n))))
     1592    (COMP (make-complex (compnum-real n) (%- 0 (compnum-imag n))))
    16061593    (else n) ) )
    16071594
     
    16181605               (else 1.0) ) )
    16191606    (BIG (if (%big-negative? n) -1 1)) ; Can't be 0; it would be a fixnum then
    1620     (RAT (signum (rat-numerator n)))
     1607    (RAT (signum (ratnum-numerator n)))
    16211608    (COMP (make-polar 1 (angle n)))     ; Definition from CLHS signum
    16221609    (else (bad-number 'signum n)) ) )
     
    16861673                (else (number->string-0 n base))))
    16871674          (BIG (%big->string n base))
    1688           (RAT (string-append (numstr (rat-numerator n))
     1675          (RAT (string-append (numstr (ratnum-numerator n))
    16891676                              "/"
    1690                               (numstr (rat-denominator n))))
    1691           (COMP (let ((r (complex-real n))
    1692                       (i (complex-imag n)) )
     1677                              (numstr (ratnum-denominator n))))
     1678          (COMP (let ((r (compnum-real n))
     1679                      (i (compnum-imag n)) )
    16931680                  (string-append
    16941681                   (numstr r)
     
    19411928;;; Non-standard type procedures
    19421929
    1943 (define (bignum? x) (eq? (%check-number x) BIG)) ; big number
    1944 (define (ratnum? x) (eq? (%check-number x) RAT)) ; rational number
    1945 (define (cplxnum? x) (eq? (%check-number x) COMP)) ; complex number
     1930(define (basic-number? x) (##core#inline "C_i_basic_numberp" x))
     1931
     1932(define (extended-number? x) ; This does _not_ "include" basics; see "number?"
     1933  (and (##core#inline "C_blockp" x)
     1934       (##sys#generic-structure? x)
     1935       (or (eq? (##sys#slot x 0) 'ratnum)
     1936           (eq? (##sys#slot x 0) 'compnum))))
     1937
     1938(define (bignum? x) (##core#inline "C_i_bignump" x))
    19461939
    19471940(define (nan? x)
     
    19491942    (NONE (bad-number 'nan? x))
    19501943    (FLO (not (fp= x x)))
    1951     (COMP (or (nan? (complex-real x)) (nan? (complex-imag x))))
     1944    (COMP (or (nan? (compnum-real x)) (nan? (compnum-imag x))))
    19521945    (else #f)))
    19531946(define (infinite? x)
     
    19551948    (NONE (bad-number 'infinite? x))
    19561949    (FLO (or (fp= x +inf.0) (fp= x -inf.0)))
    1957     (COMP (or (infinite? (complex-real x)) (infinite? (complex-imag x))))
     1950    (COMP (or (infinite? (compnum-real x)) (infinite? (compnum-imag x))))
    19581951    (else #f)))
    19591952(define (finite? x)
     
    19611954    (NONE (bad-number 'finite? x))
    19621955    (FLO (and (fp= x x) (not (fp= x +inf.0)) (not (fp= x -inf.0))))
    1963     (COMP (and (finite? (complex-real x)) (finite? (complex-imag x))))
     1956    (COMP (and (finite? (compnum-real x)) (finite? (compnum-imag x))))
    19641957    (else #t)))
    19651958
     1959(define (ratnum? x) (##sys#structure? x 'ratnum)) ; rational number
     1960
     1961;; XXX THE ONES BELOW ARE EXTREMELY CONFUSING
     1962;; Especially considering the type tag in a complex number is "compnum"!
     1963;; Best to rename cplxnum? to compnum? and ditch the rest.
     1964;; A user can easily define them themselves
     1965(define (cplxnum? x) (##sys#structure? x 'compnum)) ; complex number
     1966
    19661967(define (rectnum? x)    ; "exact" complex number
    1967   (and (eq? (%check-number x) COMP)
    1968        (%integer? (complex-real x))
    1969        (%integer? (complex-imag x))))
     1968  (and (cplxnum? x)
     1969       (%integer? (compnum-real x))
     1970       (%integer? (compnum-imag x))))
    19701971
    19711972(define (compnum? x)    ; inexact complex number
    1972   (and (eq? (%check-number x) COMP)
    1973        (%inexact? (complex-real x))
    1974        (%inexact? (complex-imag x))))
     1973  (and (cplxnum? x)
     1974       (%inexact? (compnum-real x))
     1975       (%inexact? (compnum-imag x))))
    19751976
    19761977(define (cintnum? x)    ; integer number
    1977   (switchq (%check-number x)
    1978     (FIX #t)
    1979     (BIG #t)
    1980     (FLO (%flo-integer? x))
    1981     (COMP (and (%integer? (complex-real x)) (%integer? (complex-imag x))))
    1982     (else #f) ) )
     1978  (or (%integer? x) (rectnum? x)) )
    19831979
    19841980(define (cflonum? x)    ; floatingpoint number
    1985   (switchq (%check-number x)
    1986     (FLO #t)
    1987     (COMP (and (%flonum? (complex-real x)) (%flonum? (complex-imag x))))
    1988     (else #f) ) )
     1981  (or (##core#inline "C_i_flonump" x) (compnum? x)) )
    19891982
    19901983;;; What we provide
Note: See TracChangeset for help on using the changeset viewer.