Changeset 31450 in project
 Timestamp:
 09/18/14 21:06:41 (5 years ago)
 Location:
 release/4/numbers/trunk
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

release/4/numbers/trunk/numbersc.c
r31445 r31450 91 91 static C_word bignum_normalize_shifted(C_word bignum, C_word shift_right); 92 92 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 96 93 static C_word 97 94 init_tags(___scheme_value tagvec) 
release/4/numbers/trunk/numbersc.h
r31445 r31450 50 50 #define C_BIGNUM_DIGIT_COMBINE(h,l) ((h) << C_BIGNUM_HALF_DIGIT_LENGTH(l)) 51 51 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 52 55 #define C_fitsinbignumdigitp(n) ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_DIGIT_MASK)) 53 56 #define C_fitsinbignumhalfdigitp(n) ((C_uword)(n) == ((C_uword)(n) & C_BIGNUM_HALF_DIGIT_MASK)) … … 110 113 void 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); 111 114 115 C_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 120 C_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 } 112 127 113 128 C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1) 
release/4/numbers/trunk/numbers.scm
r31445 r31450 148 148 (defineinline (%flointeger? x) (##core#inline "C_u_i_fpintegerp" x)) 149 149 150 (defineinline (comp lexreal c) (##sys#slot c 1))151 (defineinline (comp leximag c) (##sys#slot c 2))150 (defineinline (compnumreal c) (##sys#slot c 1)) 151 (defineinline (compnumimag c) (##sys#slot c 2)) 152 152 (defineinline (%makecomplex r i) (##sys#makestructure 'compnum r i)) 153 153 154 (defineinline (rat numerator c) (##sys#slot c 1))155 (defineinline (rat denominator c) (##sys#slot c 2))156 (defineinline (%makerat r i) (##sys#makestructure 'ratnum r i))154 (defineinline (ratnumnumerator c) (##sys#slot c 1)) 155 (defineinline (ratnumdenominator c) (##sys#slot c 2)) 156 (defineinline (%makeratnum r i) (##sys#makestructure 'ratnum r i)) 157 157 158 158 (defineinline (%fix>flo n) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) n)) … … 253 253 254 254 (define (comp+comp x y) 255 (let ((r (%+ (comp lexreal x) (complexreal y)))256 (i (%+ (comp leximag x) (compleximag y))) )255 (let ((r (%+ (compnumreal x) (compnumreal y))) 256 (i (%+ (compnumimag x) (compnumimag y))) ) 257 257 (makecomplex r i) ) ) 258 258 … … 264 264 (NONE (badnumber '+ y)) 265 265 ;; 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 (ratnumdenominator x))) 267 (%/ (%+ (ratnumnumerator x) (%* b y)) b))) )) 268 268 (COMP (switchq (%checknumber y) 269 269 (COMP (comp+comp x y)) … … 273 273 (else (switchq (%checknumber y) ; x is a basic number, y isn't 274 274 ;; 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 (ratnumdenominator y))) 276 (%/ (%+ (%* x d) (ratnumnumerator y)) d))) 277 277 (COMP (comp+comp (%makecomplex x 0) y)) 278 278 (else (badnumber '+ y)) ) ) ) ) ) … … 287 287 (FLO (fpneg arg1)) 288 288 (BIG ((##core#primitive "C_u_bignum_negate") arg1)) 289 (RAT (%makerat ( (ratnumerator arg1))290 (ratdenominator arg1)))291 (COMP (%makecomplex (% 0 (comp lexreal arg1))292 (% 0 (comp leximag arg1))))289 (RAT (%makeratnum ( (ratnumnumerator arg1)) 290 (ratnumdenominator arg1))) 291 (COMP (%makecomplex (% 0 (compnumreal arg1)) 292 (% 0 (compnumimag arg1)))) 293 293 (else (badnumber ' arg1)) ) 294 294 (let loop ([args (##sys#slot args 1)] [x (% arg1 (##sys#slot args 0))]) … … 299 299 (define (% x y) 300 300 (define (compcomp x y) 301 (let ((r (% (comp lexreal x) (complexreal y)))302 (i (% (comp leximag x) (compleximag y))) )301 (let ((r (% (compnumreal x) (compnumreal y))) 302 (i (% (compnumimag x) (compnumimag y))) ) 303 303 (makecomplex r i) ) ) 304 304 … … 310 310 (NONE (badnumber ' y)) 311 311 ;; 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 (ratnumdenominator x))) 313 (%/ (% (ratnumnumerator x) (%* b y)) b))) ) ) 314 314 (COMP (switchq (%checknumber y) 315 315 (COMP (compcomp x y)) … … 319 319 (else (switchq (%checknumber y) 320 320 ;; 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 (ratnumdenominator y))) 322 (%/ (% (%* x d) (ratnumnumerator y)) d))) 323 323 (COMP (compcomp (%makecomplex x 0) y)) 324 324 (else (badnumber ' y)) ) ) )) ) … … 342 342 343 343 (define (comp*comp x y) 344 (let* ([a (comp lexreal x)]345 [b (comp leximag x)]346 [c (comp lexreal y)]347 [d (comp leximag y)]344 (let* ([a (compnumreal x)] 345 [b (compnumimag x)] 346 [c (compnumreal y)] 347 [d (compnumimag y)] 348 348 [r (% (%* a c) (%* b d))] 349 349 [i (%+ (%* a d) (%* b c))] ) … … 354 354 ;; = ((a / g) * c) / (d / g) 355 355 ;; With g = gcd(a, d) and a = x [Knuth, 4.5.1] 356 (let* ((d (rat denominator y))356 (let* ((d (ratnumdenominator y)) 357 357 (g (%gcd0 '* x d))) 358 (ratnum (%* (%quotient '* x g) (rat numerator y))358 (ratnum (%* (%quotient '* x g) (ratnumnumerator y)) 359 359 (%quotient '* d g)))) 360 360 … … 365 365 ;; = ((a / g1) * (c / g2)) / ((b / g2) * (d / g1)) 366 366 ;; With g1 = gcd(a, d) and g2 = gcd(b, c) [Knuth, 4.5.1] 367 (RAT (let* ((a (rat numerator x)) (b (ratdenominator x))368 (c (rat numerator y)) (d (ratdenominator y))367 (RAT (let* ((a (ratnumnumerator x)) (b (ratnumdenominator x)) 368 (c (ratnumnumerator y)) (d (ratnumdenominator y)) 369 369 (g1 (%gcd0 '* a d)) (g2 (%gcd0 '* b c))) 370 370 (ratnum (%* (%quotient '* a g1) (%quotient '* c g2)) … … 402 402 ;; = ((a / g1) * d * sign(a)) / abs(c / g1) 403 403 ;; With g1 = gcd(a, c) and a = x [Knuth, 4.5.1 ex. 4] 404 (let* ((c (rat numerator y))404 (let* ((c (ratnumnumerator y)) 405 405 (g (%gcd0 '/ x c))) 406 (%/ (%* (%quotient '/ x g) (rat denominator y))406 (%/ (%* (%quotient '/ x g) (ratnumdenominator y)) 407 407 (%quotient '/ c g)))) 408 408 … … 444 444 ;; = ((a / g1) * (d / g2) * sign(a)) / abs((b / g2) * (c / g1)) 445 445 ;; With g1 = gcd(a, c) and g2 = gcd(b, d) [Knuth, 4.5.1 ex. 4] 446 [RAT (let* ((a (rat numerator x)) (b (ratdenominator x))447 (c (rat numerator y)) (d (ratdenominator y))446 [RAT (let* ((a (ratnumnumerator x)) (b (ratnumdenominator x)) 447 (c (ratnumnumerator y)) (d (ratnumdenominator y)) 448 448 (g1 (%gcd0 '/ a c)) (g2 (%gcd0 '/ b d))) 449 449 (%/ (%* (%quotient '/ a g1) (%quotient '/ d g2)) … … 456 456 ;; = ((a / g) * sign(a)) / abs(b * (c / g)) 457 457 ;; 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 (ratnumnumerator x)) 459 459 (g (%gcd0 '/ a y))) ;; TODO: Improve error message if /0 460 460 (%/ (%quotient '/ a g) 461 (%* (rat denominator x) (%quotient '/ y g))))] ) ]461 (%* (ratnumdenominator x) (%quotient '/ y g))))] ) ] 462 462 [COMP 463 463 (switchq (%checknumber y) … … 468 468 469 469 (define (%comp/comp p q) 470 (let* ([a (comp lexreal p)]471 [b (comp leximag p)]472 [c (comp lexreal q)]473 [d (comp leximag q)]470 (let* ([a (compnumreal p)] 471 [b (compnumimag p)] 472 [c (compnumreal q)] 473 [d (compnumimag q)] 474 474 [r (%+ (%* c c) (%* d d))] 475 475 [x (%/ (%+ (%* a c) (%* b d)) r)] … … 516 516 [BIG #f] ;; Rats are never x/1, because those are normalised to just x 517 517 ;; TODO: Use integer= here, when we write it 518 [RAT (and (%= (rat numerator x) (ratnumerator y))519 (%= (rat denominator x) (ratdenominator y)))]518 [RAT (and (%= (ratnumnumerator x) (ratnumnumerator y)) 519 (%= (ratnumdenominator x) (ratnumdenominator y)))] 520 520 [COMP #f] ;; Comps are only ever equal to other comps 521 521 [else (badnumber '= y)] ) ] 522 522 [COMP 523 523 (switchq (%checknumber y) 524 [COMP (and (%= (comp lexreal x) (complexreal y))525 (%= (comp leximag x) (compleximag y)))]524 [COMP (and (%= (compnumreal x) (compnumreal y)) 525 (%= (compnumimag x) (compnumimag y)))] 526 526 [NONE (badnumber '= y)] 527 527 [else #f] ) ] … … 548 548 (BIG (fx= (%bigcmp a b) 0)) 549 549 ;; TODO: Use integer= here, when we write it 550 (RAT (and (%= (rat numerator a) (ratnumerator b))551 (%= (rat denominator a) (ratdenominator b))))550 (RAT (and (%= (ratnumnumerator a) (ratnumnumerator b)) 551 (%= (ratnumdenominator a) (ratnumdenominator b)))) 552 552 ;; We use eqv? here because exactness of components needs to match 553 (COMP (and (eqv? (comp lexreal a) (complexreal b))554 (eqv? (comp leximag a) (compleximag b))))553 (COMP (and (eqv? (compnumreal a) (compnumreal b)) 554 (eqv? (compnumimag a) (compnumimag b)))) 555 555 (else (error "This should not happen")))))) 556 556 … … 582 582 (BIG (%bignegative? y)) 583 583 ;; 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 (ratnumdenominator y)) 585 (ratnumnumerator y) loc)) 586 586 (COMP (badcomplex/o loc y)) 587 587 (else (badnumber loc y)) ) ) … … 612 612 (BIG (fx> (%bigcmp x y) 0)) 613 613 ;; 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 (ratnumdenominator y)) 615 (ratnumnumerator y) loc)) 616 616 (COMP (badcomplex/o loc y)) 617 617 (else (badnumber loc y)) ) ) … … 619 619 (switchq (%checknumber y) 620 620 ;; a/b > c/d when a*d > b*c [generic] 621 (RAT (%> (%* (rat numerator x) (ratdenominator y))622 (%* (rat denominator x) (ratnumerator y)) loc))621 (RAT (%> (%* (ratnumnumerator x) (ratnumdenominator y)) 622 (%* (ratnumdenominator x) (ratnumnumerator y)) loc)) 623 623 (FLO (or (fp= y inf.0) 624 624 (and (not (fp= y +inf.0)) (fp= y y) … … 627 627 (NONE (badnumber loc y)) 628 628 ;; 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 (%> (ratnumnumerator x) 630 (%* (ratnumdenominator x) y) loc)) ) ) 631 631 (COMP (badcomplex/o loc x)) 632 632 (else (badnumber loc x)) ) ) … … 659 659 (BIG (not (%bignegative? y))) 660 660 ;; 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 (ratnumdenominator y)) 662 (ratnumnumerator y) loc)) 663 663 (COMP (badcomplex/o loc y)) 664 664 (else (badnumber loc y)) ) ) … … 689 689 (BIG (fx< (%bigcmp x y) 0)) 690 690 ;; 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 (ratnumdenominator y)) 692 (ratnumnumerator y) loc)) 693 693 (COMP (badcomplex/o loc y)) 694 694 (else (badnumber loc y)) ) ) … … 696 696 (switchq (%checknumber y) 697 697 ;; a/b < c/d when a*d < b*c [generic] 698 (RAT (%< (%* (rat numerator x) (ratdenominator y))699 (%* (rat denominator x) (ratnumerator y)) loc))698 (RAT (%< (%* (ratnumnumerator x) (ratnumdenominator y)) 699 (%* (ratnumdenominator x) (ratnumnumerator y)) loc)) 700 700 (COMP (badcomplex/o loc y)) 701 701 (FLO (or (fp= y +inf.0) … … 704 704 (NONE (badnumber loc y)) 705 705 ;; 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 (%< (ratnumnumerator x) 707 (%* (ratnumdenominator x) y) loc)) ) ) 708 708 (COMP (badcomplex/o loc x)) 709 709 (else (badnumber loc x)) ) ) … … 741 741 742 742 (define (makerectangular r i) 743 (switchq (%checknumber r) 744 (COMP (badreal 'makerectangular r)) 745 (NONE (badnumber 'makerectangular r)) ) 746 (switchq (%checknumber i) 747 (COMP (badreal 'makerectangular i)) 748 (NONE (badnumber 'makerectangular i)) ) 743 (unless (real? r) (badreal 'makerectangular r)) 744 (unless (real? i) (badreal 'makerectangular i)) 749 745 (makecomplex r i) ) 750 746 751 747 (define (%makepolar r phi) 752 (switchq (%checknumber r) 753 (COMP (badreal 'makepolar r)) 754 (NONE (badnumber 'makepolar r)) ) 755 (switchq (%checknumber phi) 756 (COMP (badreal 'makepolar phi)) 757 (NONE (badnumber 'makepolar phi)) ) 748 (unless (real? r) (badreal 'makerectangular r)) 749 (unless (real? phi) (badreal 'makerectangular phi)) 758 750 (let ((fphi (exact>inexact phi))) 759 751 (makecomplex (%* r (##core#inline_allocate ("C_a_i_cos" 4) fphi)) … … 764 756 (define (realpart x) 765 757 (switchq (%checknumber x) 766 (COMP (comp lexreal x))758 (COMP (compnumreal x)) 767 759 (NONE (badnumber 'realpart x)) 768 760 (else x) ) ) … … 771 763 (switchq (%checknumber x) 772 764 (NONE (badnumber 'imagpart x)) 773 (COMP (comp leximag x))765 (COMP (compnumimag x)) 774 766 (FLO 0.0) 775 767 (else 0) ) ) … … 777 769 (define (%magnitude x) 778 770 (switchq (%checknumber x) 779 (COMP (let ((r (comp lexreal x))780 (i (comp leximag x)) )771 (COMP (let ((r (compnumreal x)) 772 (i (compnumimag x)) ) 781 773 (%sqrt 'magnitude (%+ (%* r r) (%* i i))) ) ) 782 774 (NONE (badnumber 'magnitude x)) … … 789 781 (NONE (badnumber 'angle x)) 790 782 (COMP (##core#inline_allocate ("C_a_i_atan2" 4) 791 (%exact>inexact (comp leximag x))792 (%exact>inexact (comp lexreal x))))783 (%exact>inexact (compnumimag x)) 784 (%exact>inexact (compnumreal x)))) 793 785 (else (##core#inline_allocate ("C_a_i_atan2" 4) 0.0 (%exact>inexact x))) ) ) 794 786 … … 802 794 ((eq? n 1) m) 803 795 ((eq? n 1) ( m)) 804 ((negative? n) (%makerat ( m) ( n)))805 (else (%makerat m n))))796 ((negative? n) (%makeratnum ( m) ( n))) 797 (else (%makeratnum m n)))) 806 798 807 799 ;; Knuth, 4.5.1 808 800 (define (rat+/ loc op x y) 809 (let ((a (rat numerator x)) (b (ratdenominator x))810 (c (rat numerator y)) (d (ratdenominator y)))801 (let ((a (ratnumnumerator x)) (b (ratnumdenominator x)) 802 (c (ratnumnumerator y)) (d (ratnumdenominator y))) 811 803 (let ((g1 (%gcd0 loc b d))) 812 804 (cond 813 ((eq? g1 1) (%makerat (op (%* a d) (%* b c)) (%* b d)))805 ((eq? g1 1) (%makeratnum (op (%* a d) (%* b c)) (%* b d))) 814 806 ;; Save a quotient and multiplication if the gcd is equal 815 807 ;; to one of the denominators since quotient of b or d and g1 = 1 … … 827 819 (%* c b/g1))) 828 820 (g2 (%gcd0 loc t g1))) 829 (%makerat (%quotient loc t g2)830 (%* b/g1 (%quotient loc d g2)))))))))821 (%makeratnum (%quotient loc t g2) 822 (%* b/g1 (%quotient loc d g2))))))))) 831 823 832 824 (define (numerator x) … … 838 830 (else (exact>inexact (numerator (%flo>rat 'numerator x)))))) 839 831 (BIG x) 840 (RAT (rat numerator x))832 (RAT (ratnumnumerator x)) 841 833 (COMP (badratnum 'numerator x)) 842 834 (else (badnumber 'numerator x)) ) ) … … 850 842 (else (exact>inexact (denominator (%flo>rat 'denominator x)))))) 851 843 (BIG 1) 852 (RAT (rat denominator x))844 (RAT (ratnumdenominator x)) 853 845 (COMP (badratnum 'denominator x)) 854 846 (else (badnumber 'denominator x)) ) ) … … 863 855 (FLO (##core#inline_allocate ("C_a_i_abs" 4) x)) 864 856 (BIG (%bigabs x)) 865 (RAT (%makerat (%abs (ratnumerator x)) (ratdenominator x)))857 (RAT (%makeratnum (%abs (ratnumnumerator x)) (ratnumdenominator x))) 866 858 (COMP (##sys#signalhook #:typeerror 'abs "can not compute absolute value of complex number" x)) 867 859 (NONE (badnumber 'abs x)) ) ) … … 870 862 871 863 (define (number? x) 872 (switchq (%checknumber x) 873 (NONE #f) 874 (else #t) ) ) 864 (or (##core#inline "C_i_basic_numberp" x) (extendednumber? 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?) 875 874 876 875 (set! ##sys#number? number?) 877 876 (define complex? number?) 878 877 878 ;; All numbers are real, except for compnums 879 879 (define (real? x) 880 (switchq (%checknumber x) 881 (COMP #f) 882 (NONE #f) 883 (else #t) ) ) 880 (or (##core#inline "C_i_basic_numberp" x) 881 (##sys#structure? x 'ratnum) ) ) 884 882 885 883 (define (rational? x) (and (real? x) (finite? x))) 886 884 887 (define (%integer? x)888 (switchq (%checknumber x)889 (FIX #t)890 (FLO (%flointeger? x))891 (BIG #t)892 (else #f) ) )893 894 (set! ##sys#integer? %integer?)895 (define integer? %integer?)896 897 885 (define (exactinteger? x) 898 (switchq (%checknumber x) 899 (FIX #t) 900 (BIG #t) 901 (else #f) ) ) 886 (or (##core#inline "C_fixnump" x) (##core#inline "C_i_bignump" x)) ) 887 902 888 903 889 (define (%exact? x) 904 890 (switchq (%checknumber x) 905 891 (FLO #f) 906 (COMP (and (%exact? (comp lexreal x)) (%exact? (compleximag x))))892 (COMP (and (%exact? (compnumreal x)) (%exact? (compnumimag x)))) 907 893 (NONE (badnumber 'exact? x)) 908 894 (else #t) ) ) … … 914 900 (switchq (%checknumber x) 915 901 (FLO #t) 916 (COMP (and (%inexact? (comp lexreal x)) (%inexact? (compleximag x))))902 (COMP (and (%inexact? (compnumreal x)) (%inexact? (compnumimag x)))) 917 903 (NONE (badnumber 'inexact? x)) 918 904 (else #f) ) ) … … 1160 1146 (BIG x) 1161 1147 (RAT x) 1162 (COMP (makecomplex (%inexact>exact (comp lexreal x))1163 (%inexact>exact (comp leximag x))))1148 (COMP (makecomplex (%inexact>exact (compnumreal x)) 1149 (%inexact>exact (compnumimag x)))) 1164 1150 (NONE (badnumber 'inexact>exact x)) ) ) 1165 1151 … … 1178 1164 ;; TODO: Use (fp/ n d) if both are finite after conversion to flonums 1179 1165 (define (%rat>flo x) 1180 (let* ((n1 (rat numerator x))1166 (let* ((n1 (ratnumnumerator x)) 1181 1167 (an (%abs n1)) 1182 (d1 (rat denominator x))1168 (d1 (ratnumdenominator x)) 1183 1169 ;; Approximate distance between the numbers in powers of 2 1184 1170 ;; ie, 2^e1 < n/d < 2^e+1 (e is the *un*biased value of e_w in M2) … … 1214 1200 (BIG (%big>flo x)) 1215 1201 (RAT (%rat>flo x)) 1216 (COMP (makecomplex (%exact>inexact (comp lexreal x)) (%exact>inexact (compleximag x))))1202 (COMP (makecomplex (%exact>inexact (compnumreal x)) (%exact>inexact (compnumimag x)))) 1217 1203 (NONE (badnumber 'exact>inexact x)) ) ) 1218 1204 … … 1280 1266 (BIG x) 1281 1267 ;; (floor x) = greatest integer <= x 1282 (RAT (let* ((n (rat numerator x))1283 (q (quotient n (rat denominator x))))1268 (RAT (let* ((n (ratnumnumerator x)) 1269 (q (quotient n (ratnumdenominator x)))) 1284 1270 (if (>= n 0) 1285 1271 q … … 1295 1281 (BIG x) 1296 1282 ;; (ceiling x) = smallest integer >= x 1297 (RAT (let* ((n (rat numerator x))1298 (q (quotient n (rat denominator x))))1283 (RAT (let* ((n (ratnumnumerator x)) 1284 (q (quotient n (ratnumdenominator x)))) 1299 1285 (if (>= n 0) 1300 1286 (%+ q 1) … … 1308 1294 (BIG x) 1309 1295 ;; (rationaltruncate x) = integer of largest magnitude <= (abs x) 1310 (RAT (%quotient 'truncate (rat numerator x) (ratdenominator x)))1296 (RAT (%quotient 'truncate (ratnumnumerator x) (ratnumdenominator x))) 1311 1297 (else (badreal 'truncate x))) ) 1312 1298 … … 1316 1302 (FLO (##core#inline_allocate ("C_a_i_flonum_round_proper" 4) x)) 1317 1303 (BIG x) 1318 (RAT (let* ((x+1/2 (%+ x (%makerat 1 2)))1304 (RAT (let* ((x+1/2 (%+ x (%makeratnum 1 2))) 1319 1305 (r (%floor x+1/2))) 1320 1306 (if (and (%= r x+1/2) … … 1355 1341 (switchq (%checknumber n) 1356 1342 (NONE (badnumber 'exp n)) 1357 (COMP (%* (##core#inline_allocate ("C_a_i_exp" 4) (comp lexreal n))1358 (let ((p (comp leximag n)))1343 (COMP (%* (##core#inline_allocate ("C_a_i_exp" 4) (compnumreal n)) 1344 (let ((p (compnumimag n))) 1359 1345 (makecomplex 1360 1346 (##core#inline_allocate ("C_a_i_cos" 4) p) … … 1481 1467 (m (##core#inline_allocate ("C_a_i_sqrt" 4) (%magnitude n))) ) 1482 1468 (makecomplex (%* m (%cos p)) (%* m (%sin p)) ) ) ) 1483 (RAT (let ((num (rat numerator n))1484 (den (rat denominator n)))1469 (RAT (let ((num (ratnumnumerator n)) 1470 (den (ratnumdenominator n))) 1485 1471 (if (and (>= num 0) (>= den 0)) 1486 1472 (receive (ns^2 nr) … … 1570 1556 ;; (n*d)^b = n^b * d^b = n^b * x^{b}  x = 1/b 1571 1557 ;; Hopefully faster than integerpower 1572 (%* (expt (ratnumerator a) b) (expt (ratdenominator a) ( b)))) 1558 (%* (expt (ratnumnumerator a) b) 1559 (expt (ratnumdenominator a) ( b)))) 1573 1560 ;; x^{a/b} = (x^{1/b})^a 1574 1561 ((eq? RAT tb) … … 1577 1564 (%expt0 (%fix>flo a) (%rat>flo b)) 1578 1565 (receive (ds^n r) 1579 (%exactintegernthroot 'expt a (rat denominator b))1566 (%exactintegernthroot 'expt a (ratnumdenominator b)) 1580 1567 (if (eq? r 0) 1581 (expt ds^n (rat numerator b))1568 (expt ds^n (ratnumnumerator b)) 1582 1569 (%expt0 (%fix>flo a) (%rat>flo b)))))) 1583 1570 (BIG (if (%bignegative? a) 1584 1571 (%expt0 (%big>flo a) (%rat>flo b)) 1585 1572 (receive (ds^n r) 1586 (%exactintegernthroot 'expt a (rat denominator b))1573 (%exactintegernthroot 'expt a (ratnumdenominator b)) 1587 1574 (if (eq? r 0) 1588 (expt ds^n (rat numerator b))1575 (expt ds^n (ratnumnumerator b)) 1589 1576 (%expt0 (%big>flo a) (%rat>flo b)))))) 1590 1577 (FLO (%expt0 a (%rat>flo b))) … … 1603 1590 (switchq (%checknumber n) 1604 1591 (NONE (badnumber 'conj n)) 1605 (COMP (makecomplex (comp lexreal n) (% 0 (compleximag n))))1592 (COMP (makecomplex (compnumreal n) (% 0 (compnumimag n)))) 1606 1593 (else n) ) ) 1607 1594 … … 1618 1605 (else 1.0) ) ) 1619 1606 (BIG (if (%bignegative? n) 1 1)) ; Can't be 0; it would be a fixnum then 1620 (RAT (signum (rat numerator n)))1607 (RAT (signum (ratnumnumerator n))) 1621 1608 (COMP (makepolar 1 (angle n))) ; Definition from CLHS signum 1622 1609 (else (badnumber 'signum n)) ) ) … … 1686 1673 (else (number>string0 n base)))) 1687 1674 (BIG (%big>string n base)) 1688 (RAT (stringappend (numstr (rat numerator n))1675 (RAT (stringappend (numstr (ratnumnumerator n)) 1689 1676 "/" 1690 (numstr (rat denominator n))))1691 (COMP (let ((r (comp lexreal n))1692 (i (comp leximag n)) )1677 (numstr (ratnumdenominator n)))) 1678 (COMP (let ((r (compnumreal n)) 1679 (i (compnumimag n)) ) 1693 1680 (stringappend 1694 1681 (numstr r) … … 1941 1928 ;;; Nonstandard type procedures 1942 1929 1943 (define (bignum? x) (eq? (%checknumber x) BIG)) ; big number 1944 (define (ratnum? x) (eq? (%checknumber x) RAT)) ; rational number 1945 (define (cplxnum? x) (eq? (%checknumber x) COMP)) ; complex number 1930 (define (basicnumber? x) (##core#inline "C_i_basic_numberp" x)) 1931 1932 (define (extendednumber? x) ; This does _not_ "include" basics; see "number?" 1933 (and (##core#inline "C_blockp" x) 1934 (##sys#genericstructure? 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)) 1946 1939 1947 1940 (define (nan? x) … … 1949 1942 (NONE (badnumber 'nan? x)) 1950 1943 (FLO (not (fp= x x))) 1951 (COMP (or (nan? (comp lexreal x)) (nan? (compleximag x))))1944 (COMP (or (nan? (compnumreal x)) (nan? (compnumimag x)))) 1952 1945 (else #f))) 1953 1946 (define (infinite? x) … … 1955 1948 (NONE (badnumber 'infinite? x)) 1956 1949 (FLO (or (fp= x +inf.0) (fp= x inf.0))) 1957 (COMP (or (infinite? (comp lexreal x)) (infinite? (compleximag x))))1950 (COMP (or (infinite? (compnumreal x)) (infinite? (compnumimag x)))) 1958 1951 (else #f))) 1959 1952 (define (finite? x) … … 1961 1954 (NONE (badnumber 'finite? x)) 1962 1955 (FLO (and (fp= x x) (not (fp= x +inf.0)) (not (fp= x inf.0)))) 1963 (COMP (and (finite? (comp lexreal x)) (finite? (compleximag x))))1956 (COMP (and (finite? (compnumreal x)) (finite? (compnumimag x)))) 1964 1957 (else #t))) 1965 1958 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 1966 1967 (define (rectnum? x) ; "exact" complex number 1967 (and ( eq? (%checknumber x) COMP)1968 (%integer? (comp lexreal x))1969 (%integer? (comp leximag x))))1968 (and (cplxnum? x) 1969 (%integer? (compnumreal x)) 1970 (%integer? (compnumimag x)))) 1970 1971 1971 1972 (define (compnum? x) ; inexact complex number 1972 (and ( eq? (%checknumber x) COMP)1973 (%inexact? (comp lexreal x))1974 (%inexact? (comp leximag x))))1973 (and (cplxnum? x) 1974 (%inexact? (compnumreal x)) 1975 (%inexact? (compnumimag x)))) 1975 1976 1976 1977 (define (cintnum? x) ; integer number 1977 (switchq (%checknumber x) 1978 (FIX #t) 1979 (BIG #t) 1980 (FLO (%flointeger? x)) 1981 (COMP (and (%integer? (complexreal x)) (%integer? (compleximag x)))) 1982 (else #f) ) ) 1978 (or (%integer? x) (rectnum? x)) ) 1983 1979 1984 1980 (define (cflonum? x) ; floatingpoint number 1985 (switchq (%checknumber x) 1986 (FLO #t) 1987 (COMP (and (%flonum? (complexreal x)) (%flonum? (compleximag x)))) 1988 (else #f) ) ) 1981 (or (##core#inline "C_i_flonump" x) (compnum? x)) ) 1989 1982 1990 1983 ;;; What we provide
Note: See TracChangeset
for help on using the changeset viewer.