suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix bad attempt to speed up rational comparisons, as well as th egap in the test suite

Browse Source 
svn: r5472
This commit is contained in:
Matthew Flatt 2007-01-27 01:40:58 +00:00
parent 3946c25fd9
commit f31128cf11
4 changed files with 16 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/mzscheme/benchmarks/common/auto.ss
View File

@ -138,10 +138,10 @@ exec mzscheme -qu "$0" ${1+"$@"}
extract-mzscheme-times extract-mzscheme-times
clean-up-nothing clean-up-nothing
'()) '())
(make-impl 'mzscheme3m (make-impl 'mzschemecgc
mk-mzscheme mk-mzscheme
(lambda (bm) (lambda (bm)
(system (format "mzscheme3m -qu ~a.ss" bm))) (system (format "mzschemecgc -qu ~a.ss" bm)))
extract-mzscheme-times extract-mzscheme-times
clean-up-nothing clean-up-nothing
'()) '())
@ -161,10 +161,10 @@ exec mzscheme -qu "$0" ${1+"$@"}
extract-mzscheme-times extract-mzscheme-times
clean-up-nothing clean-up-nothing
'()) '())
(make-impl 'mzscheme3m-tl (make-impl 'mzschemecgc-tl
mk-mzscheme-tl mk-mzscheme-tl
(lambda (bm) (lambda (bm)
(system (format "mzscheme3m -qr compiled/~a.zo" bm))) (system (format "mzschemecgc -qr compiled/~a.zo" bm)))
extract-mzscheme-times extract-mzscheme-times
clean-up-zo clean-up-zo
'(nucleic2)) '(nucleic2))
@ -193,7 +193,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
clean-up-fasl clean-up-fasl
'(maze)))) '(maze))))
(define obsolte-impls '(mzscheme mzscheme-j mzscheme3m-tl mzc)) (define obsolte-impls '(mzscheme mzscheme-j mzschemecgc-tl mzc))
(define benchmarks (define benchmarks
'(conform '(conform

4
collects/tests/mzscheme/benchmarks/shootout/run.ss
View File

@ -22,11 +22,11 @@
("nestedloop.ss" "18") ("nestedloop.ss" "18")
("nsieve.ss") ("nsieve.ss")
("nsievebits.ss") ("nsievebits.ss")
("partialsums.ss") ("partialsums.ss" "2500000")
("pidigits.ss") ("pidigits.ss")
("pidigits1.ss") ("pidigits1.ss")
("random.ss" "900000") ("random.ss" "900000")
("recursive.ss") ("recursive.ss" "11")
("regexmatch.ss") ("regexmatch.ss")
("regexpdna.ss") ("regexpdna.ss")
("reversecomplement.ss" #f ,(lambda () (mk-revcomp-input))) ("reversecomplement.ss" #f ,(lambda () (mk-revcomp-input)))

1
collects/tests/mzscheme/number.ss
View File

@ -193,6 +193,7 @@
(test-compare 0.5 1.2 2.3) (test-compare 0.5 1.2 2.3)
(test-compare 2/5 1/2 2/3) (test-compare 2/5 1/2 2/3)
(test-compare 1/4 1/3 1/2)
(test #t = 1/2 2/4) (test #t = 1/2 2/4)
(test #f = 2/3 2/5) (test #f = 2/3 2/5)
(test #f = 2/3 2/500000000000000000000000000) (test #f = 2/3 2/500000000000000000000000000)

24
src/mzscheme/src/rational.c
View File

@ -200,30 +200,18 @@ static int rational_lt(const Scheme_Object *a, const Scheme_Object *b, int or_eq
Scheme_Rational *rb = (Scheme_Rational *)b; Scheme_Rational *rb = (Scheme_Rational *)b;
Scheme_Object *ma, *mb; Scheme_Object *ma, *mb;
#if 0
/* Avoid multiplication in simple cases: */
if (scheme_bin_lt_eq(ra->num, rb->num)
&& scheme_bin_gt_eq(ra->denom, rb->denom)) {
if (!or_eq) {
if (scheme_rational_eq(a, b))
return 0;
}
return 1;
} else
#endif
if (or_eq) {
if (scheme_rational_eq(a, b))
return 1;
}
/* Checking only for lt at this point */
ma = scheme_bin_mult(ra->num, rb->denom); ma = scheme_bin_mult(ra->num, rb->denom);
mb = scheme_bin_mult(rb->num, ra->denom); mb = scheme_bin_mult(rb->num, ra->denom);
if (SCHEME_INTP(ma) && SCHEME_INTP(mb)) { if (SCHEME_INTP(ma) && SCHEME_INTP(mb)) {
if (or_eq)
return (SCHEME_INT_VAL(ma) <= SCHEME_INT_VAL(mb));
else
return (SCHEME_INT_VAL(ma) < SCHEME_INT_VAL(mb)); return (SCHEME_INT_VAL(ma) < SCHEME_INT_VAL(mb));
} else if (SCHEME_BIGNUMP(ma) && SCHEME_BIGNUMP(mb)) { } else if (SCHEME_BIGNUMP(ma) && SCHEME_BIGNUMP(mb)) {
if (or_eq)
return scheme_bignum_le(ma, mb);
else
return scheme_bignum_lt(ma, mb); return scheme_bignum_lt(ma, mb);
} else if (SCHEME_BIGNUMP(mb)) { } else if (SCHEME_BIGNUMP(mb)) {
return SCHEME_BIGPOS(mb); return SCHEME_BIGPOS(mb);