Marc:
I'm trying to write my own tracing routine for my new naive-div routine, and it's a little tricky.
I wrote the following macro to (1) use naive-div-new for naive-div, (2) collect the args and results of all calls to naive-div-new when computing an expression, (3) resetting naive-div to naive-div-orig, and (4) pretty-printing some of the results.
(define-macro (while-tracing-naive-div-new expression) (let ((result (gensym)) (args+result (gensym))) `(let ((,args+result '())) (set! naive-div (lambda (u v) (let ((result (naive-div-new u v))) (set! ,args+result (cons (list u v result) ,args+result)) result))) ;; calculate expression with naive-div-new (let ((result ,expression)) ;; set naive-div back to naive-div-orig before calling any more number-manipulating routines (set! naive-div naive-div-orig) (pp (map (lambda (args+result) (append args+result (list (naive-div-orig (car args+result) (cadr args+result))))) ,args+result)) ;; supposed to return result, but returns #!void ???????????????? result))))
I use it in the following way:
(while-tracing-naive-div-new (string->number (number->string xx)))
which expression is expanded by
gsc -expansion -c test-naive-div.scm > ! crap.scm
to
(let ((#:g4 ('#<procedure #24 ##box> '()))) (let ((begin-temp.27 (set! naive-div (lambda (u v) (let ((result (naive-div-new u v))) (let ((begin-temp.24 ('#<procedure #31 ##set-box!> #:g4 ('#<procedure #5 cons> ('#<procedure #6 list> u v result) ('#<procedure #25 ##unbox> #:g4))))) result)))))) (let ((result ('#<procedure #28 string->number> ('#<procedure #29 number->string> xx)))) (let ((begin-temp.26 (set! naive-div naive-div-orig))) (let ((begin-temp.25 (pp ('#<procedure #32 map> (lambda (args+result) ('#<procedure #33 append> args+result ('#<procedure #6 list> (naive-div-orig ('#<procedure #9 car> args+result) ('#<procedure #34 cadr> args+result))))) ('#<procedure #25 ##unbox> #:g4))))) #!void)))))
So where did the #!void at the end come from?
Brad
Afficher les réponses par date
It seems you need commas before your references of result.
Marc
On 2013-09-27, at 2:20 PM, Bradley Lucier lucier@math.purdue.edu wrote:
Marc:
I'm trying to write my own tracing routine for my new naive-div routine, and it's a little tricky.
I wrote the following macro to (1) use naive-div-new for naive-div, (2) collect the args and results of all calls to naive-div-new when computing an expression, (3) resetting naive-div to naive-div-orig, and (4) pretty-printing some of the results.
(define-macro (while-tracing-naive-div-new expression) (let ((result (gensym)) (args+result (gensym))) `(let ((,args+result '())) (set! naive-div (lambda (u v) (let ((result (naive-div-new u v))) (set! ,args+result (cons (list u v result) ,args+result)) result))) ;; calculate expression with naive-div-new (let ((result ,expression)) ;; set naive-div back to naive-div-orig before calling any more number-manipulating routines (set! naive-div naive-div-orig) (pp (map (lambda (args+result) (append args+result (list (naive-div-orig (car args+result) (cadr args+result))))) ,args+result)) ;; supposed to return result, but returns #!void ???????????????? result))))
I use it in the following way:
(while-tracing-naive-div-new (string->number (number->stringxx)))
which expression is expanded by
gsc -expansion -c test-naive-div.scm > ! crap.scm
to
(let ((#:g4 ('#<procedure #24 ##box> '()))) (let ((begin-temp.27 (set! naive-div (lambda (u v) (let ((result (naive-div-new u v))) (let ((begin-temp.24 ('#<procedure #31 ##set-box!> #:g4 ('#<procedure #5 cons> ('#<procedure #6 list> u v result) ('#<procedure #25 ##unbox> #:g4))))) result)))))) (let ((result ('#<procedure #28 string->number> ('#<procedure #29 number->string> xx)))) (let ((begin-temp.26 (set! naive-div naive-div-orig))) (let ((begin-temp.25 (pp ('#<procedure #32 map> (lambda (args+result) ('#<procedure #33 append> args+result ('#<procedure #6 list> (naive-div-orig ('#<procedure #9 car> args+result) ('#<procedure #34 cadr> args+result))))) ('#<procedure #25 ##unbox> #:g4))))) #!void)))))
So where did the #!void at the end come from?
Brad
On 09/27/2013 02:31 PM, Marc Feeley wrote:
It seems you need commas before your references of result.
I don't think so:
(define-macro (while-tracing-naive-div-new expression) (let ((result (gensym)) (args+result (gensym))) `(let ((,args+result '())) (set! naive-div (lambda (u v) (let ((result (naive-div-new u v))) (set! ,args+result (cons (list u v result) ,args+result)) result))) ;; calculate expression with naive-div-new (let ((,result ,expression)) ;; set naive-div back to naive-div-orig before calling any more number-manipulating routines (set! naive-div naive-div-orig) (pp (map (lambda (args+result) (append args+result (list (naive-div-orig (car args+result) (cadr args+result))))) ,args+result)) ;; supposed to return result, but returns #!void ???????????????? ,result))))
(while-tracing-naive-div-new (string->number (number->string xx)))
(let ((#:g4 ('#<procedure #24 ##box> '()))) (let ((begin-temp.27 (set! naive-div (lambda (u v) (let ((result (naive-div-new u v))) (let ((begin-temp.24 ('#<procedure #31 ##set-box!> #:g4 ('#<procedure #5 cons> ('#<procedure #6 list> u v result) ('#<procedure #25 ##unbox> #:g4))))) result)))))) (let ((#:g3 ('#<procedure #28 string->number> ('#<procedure #29 number->string> xx)))) (let ((begin-temp.26 (set! naive-div naive-div-orig))) (let ((begin-temp.25 (pp ('#<procedure #32 map> (lambda (args+result) ('#<procedure #33 append> args+result ('#<procedure #6 list> (naive-div-orig ('#<procedure #9 car> args+result) ('#<procedure #34 cadr> args+result))))) ('#<procedure #25 ##unbox> #:g4))))) #!void)))))
On 2013-09-27, at 2:39 PM, Bradley Lucier lucier@math.purdue.edu wrote:
On 09/27/2013 02:31 PM, Marc Feeley wrote:
It seems you need commas before your references of result.
I don't think so:
When I try compiling your code, I get "result" where you get #!void . Perhaps you are not showing us the whole code?
Marc
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"))))))))))))))))
On 09/28/2013 01:40 PM, Bradley Lucier wrote:
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:
Sorry again, I see the problem.
Brad
-
Bradley Lucier -
Marc Feeley