* Fixed a bug in (fl/ x) not inverting its argument.

This commit is contained in:
Abdulaziz Ghuloum 2007-06-16 09:59:39 +03:00
parent e51def62c1
commit 6d8c626017
9 changed files with 976 additions and 9 deletions

File diff suppressed because one or more lines are too long

View File

@ -62,3 +62,25 @@ AFTER $fl+, $fl-, $fl*, $fl/:
1890 ms elapsed real time 1890 ms elapsed real time
1600164776 bytes allocated 1600164776 bytes allocated
AFTER $fl=, $fl<, $fl<=, $fl>, $fl>=
running stats for fibfp:
343 collections
1984 ms elapsed cpu time
1999 ms elapsed real time
1433318512 bytes allocated
running stats for mbrot:
530 collections
1856 ms elapsed cpu time
1872 ms elapsed real time
2215766432 bytes allocated
running stats for pnpoly:
81 collections
1404 ms elapsed cpu time
1413 ms elapsed real time
335204824 bytes allocated
running stats for sumfp:
382 collections
1496 ms elapsed cpu time
1506 ms elapsed real time
1600164816 bytes allocated

View File

@ -1,11 +1,14 @@
#!/usr/bin/env ikarus --r6rs-script #!/usr/bin/env ikarus --r6rs-script
(import (import (ikarus))
(ikarus)
#;(r6rs-benchmarks))
(define (run name) (define (run name)
(eval '(main) (environment (list 'r6rs-benchmarks name)))) (let ([proc (time-it (format "compile-~a" name)
(lambda ()
(eval 'main
(environment
(list 'r6rs-benchmarks name)))))])
(proc)))
(apply (apply
(case-lambda (case-lambda

View File

@ -42,6 +42,7 @@
puzzle-iters puzzle-iters
quicksort-iters quicksort-iters
sboyer-iters sboyer-iters
simplex-iters
sum-iters sum-iters
sum1-iters sum1-iters
string-iters string-iters

View File

@ -165,7 +165,7 @@
(let loop () (let loop ()
(simp1 0 #f) (simp1 0 #f)
(cond (cond
((f(run))lpositive? bmax) ((flpositive? bmax)
(simp2) (simp2)
(cond ((zero? ip) #t) (cond ((zero? ip) #t)
(else (simp3 #f) (else (simp3 #f)

View File

@ -16,7 +16,7 @@
(sumport port 0.0)) (sumport port 0.0))
(define (go) (define (go)
(set! inport (open-input-file "r6rs-benchmarks/rn100")) (set! inport (open-input-file "rn100"))
(let ((result (sum inport))) (let ((result (sum inport)))
(close-input-port inport) (close-input-port inport)
result)) result))

Binary file not shown.

View File

@ -8,12 +8,12 @@
(library (ikarus flonums) (library (ikarus flonums)
(export $flonum->exact $flonum-signed-biased-exponent flonum-parts (export $flonum->exact $flonum-signed-biased-exponent flonum-parts
inexact->exact $flonum-rational? $flonum-integer? $flzero? inexact->exact $flonum-rational? $flonum-integer? $flzero?
$flnegative?) $flnegative? flpositive? flabs)
(import (import
(ikarus system $bytevectors) (ikarus system $bytevectors)
(except (ikarus system $flonums) $flonum-signed-biased-exponent (except (ikarus system $flonums) $flonum-signed-biased-exponent
$flonum-rational? $flonum-integer?) $flonum-rational? $flonum-integer?)
(except (ikarus) inexact->exact)) (except (ikarus) inexact->exact flpositive? flabs))
(define (flonum-bytes f) (define (flonum-bytes f)
(unless (flonum? f) (unless (flonum? f)
@ -108,7 +108,18 @@
[(or (fixnum? x) (ratnum? x) (bignum? x)) x] [(or (fixnum? x) (ratnum? x) (bignum? x)) x]
[else [else
(error 'inexact->exact "~s is not an inexact number" x)])) (error 'inexact->exact "~s is not an inexact number" x)]))
(define (flpositive? x)
(if (flonum? x)
($fl> x 0.0)
(error 'flpositive? "~s is not a flonum" x)))
(define (flabs x)
(if (flonum? x)
(if (flnegative? x)
(fl* x -1.0)
x)
(error 'flabs "~s is not a flonum" x)))
) )
@ -1317,7 +1328,7 @@
(f (fl/ ac (car rest)) (cdr rest))))] (f (fl/ ac (car rest)) (cdr rest))))]
[(x) [(x)
(if (flonum? x) (if (flonum? x)
x (fl/ 1.0 x)
(error 'fl/ "~s is not a flonum" x))])) (error 'fl/ "~s is not a flonum" x))]))
(flcmp flfl= flfx= fxfl= flbn= bnfl= $fl=) (flcmp flfl= flfx= fxfl= flbn= bnfl= $fl=)

View File

@ -381,6 +381,8 @@
[flsqrt i rfl] [flsqrt i rfl]
[flzero? i rfl] [flzero? i rfl]
[flnegative? i rfl] [flnegative? i rfl]
[flpositive? i rfl]
[flabs i rfl]
[fixnum->string i] [fixnum->string i]
[string->flonum i] [string->flonum i]
[- i r] [- i r]