On 09/27/2013 03:15 PM, Marc Feeley wrote:
When I try compiling your code, I get "result" where you get #!void . Perhaps you are not showing us the whole code?
Yes, sorry. I've attached the code, here is the expansion:
firefly:~/programs/gambit/gambit-debug/gambit> gsc -c -expansion test-inexact.scm Expansion:
(define test-inexact-printing (lambda () (let ((f2.0 (string->number "2.0")) (f1.0 (string->number "1.0")) (f0.5 (string->number "0.5")) (f0.0 (string->number "0.0"))) (let ((log2 (let ((l2 (log 2))) (lambda (x) (/ (log x) l2))))) (let ((float-precision (let ((minval (letrec ((do-temp.20 (lambda (f0.5 x) (if (zero? (* f0.5 x)) x (let ((x (* f0.5 x))) (if (zero? (* f0.5 x)) x (do-temp.20 f0.5 (* f0.5 x)))))))) (do-temp.20 f0.5 f1.0))) (mantissa-bits (letrec ((do-temp.19 (lambda (f1.0 f0.5 i eps) (if (= f1.0 (+ f1.0 eps)) i (let ((i (+ i 1)) (eps (* f0.5 eps))) (if (= f1.0 (+ f1.0 eps)) i (do-temp.19 f1.0 f0.5 (+ i 1) (* f0.5 eps)))))))) (do-temp.19 f1.0 f0.5 0 f1.0)))) (lambda (x) (apply (lambda (f e) (let ((eps (if (= f1.0 f) (expt f2.0 (+ 1 (- e mantissa-bits))) (if (zero? f) minval (expt f2.0 (- e mantissa-bits)))))) (if (zero? eps) minval eps))) (let ((x x)) (if (zero? x) (list f0.0 0) (let ((l2 (log2 x))) (let ((e (floor (log2 x)))) (let ((e (if (= l2 e) (inexact->exact e) (+ (inexact->exact e) 1)))) (let ((f (/ x (expt 2 e)))) (list f e)))))))))))) (let ((float-print-test (lambda (float-precision x) (let ((all-ok? ('#<procedure #2 ##box> #t)) (eps (float-precision x))) (letrec ((do-temp.3 (lambda (x all-ok? eps j) (if (or (not ('#<procedure #3 ##unbox> all-ok?)) (> j 100)) ('#<procedure #3 ##unbox> all-ok?) (let ((begin-temp.18 (let ((xx (+ x (* j eps)))) (let ((ok? (let ((number xx)) (let ((begin-temp.2 (set! naive-div naive-div-new))) (let ((result (eqv? number (string->number (number->string number))))) (let ((begin-temp.1 (set! naive-div naive-div-orig))) result)))))) (if (not ok?) (let ((begin-temp.17 (display "Number readback failure for "))) (let ((begin-temp.16 (write ('#<procedure #4 ##quasi-list> '+ x ('#<procedure #4 ##quasi-list> '* j eps))))) (let ((begin-temp.15 (newline))) (let ((begin-temp.14 (display xx))) (let ((begin-temp.13 (newline))) (let ((begin-temp.12 (display (let ((begin-temp.5 (set! naive-div naive-div-new))) (let ((result (string->number (number->string xx)))) (let ((begin-temp.4 (set! naive-div naive-div-orig))) result)))))) (let ((begin-temp.11 (newline))) (let ((begin-temp.10 (let ((#:g4 ('#<procedure #2 ##box> '()))) (let ((begin-temp.9 (set! naive-div (lambda (u v) (let ((result (naive-div-new u v))) (let ((begin-temp.6 ('#<procedure #5 ##set-box!> #:g4 (cons (list u v result) ('#<procedure #3 ##unbox> #:g4))))) result)))))) (let ((result (string->number (number->string xx)))) (let ((begin-temp.8 (set! naive-div naive-div-orig))) (let ((begin-temp.7 (pp (map (lambda (args+result) (append args+result (list (naive-div-orig (car args+result) (cadr args+result))))) ('#<procedure #3 ##unbox> #:g4))))) #!void))))))) ('#<procedure #5 ##set-box!> all-ok? #f))))))))) #!void))))) (do-temp.3 x all-ok? eps (+ j 1))))))) (do-temp.3 x all-ok? eps -100)))))) (let ((mult-float-print-test (lambda (float-precision x) (let ((res ('#<procedure #2 ##box> #t))) (let ((begin-temp.0 (for-each (lambda (mult) (or (float-print-test float-precision (* mult x)) ('#<procedure #5 ##set-box!> res #f))) (map string->number '("1.0" "10.0" "100.0" "1.0e20" "1.0e50" "1.0e100" "0.1" "0.01" "0.001" "1.0e-20" "1.0e-50" "1.0e-100"))))) ('#<procedure #3 ##unbox> res)))))) (let ((begin-temp.26 (SECTION 6 5 6))) (let ((begin-temp.25 (test #t 'float-print-test (float-print-test float-precision f0.0)))) (let ((begin-temp.24 (test #t 'mult-float-print-test (mult-float-print-test float-precision f1.0)))) (let ((begin-temp.23 (test #t 'mult-float-print-test (mult-float-print-test float-precision (string->number "3.0"))))) (let ((begin-temp.22 (test #t 'mult-float-print-test (mult-float-print-test float-precision (string->number "7.0"))))) (let ((begin-temp.21 (test #t 'mult-float-print-test (mult-float-print-test float-precision (string->number "3.1415926535897931"))))) (test #t 'mult-float-print-test (mult-float-print-test float-precision (string->number "2.7182818284590451"))))))))))))))))