[gambit-list] Don't understand effects of (declare fixnum)
Bradley Lucier
lucier at math.purdue.edu
Fri Oct 12 17:27:04 EDT 2012
Marc:
Here's some code (motivated by Programming Praxis):
(declare (standard-bindings)
(extended-bindings)
(block)
;; (fixnum)
(not safe))
(define (same? n)
(let loop ((n n)
(rs '()))
(and (not (zero? n))
(let ((r (random-integer 365)))
(or (memv r rs)
(loop (- n 1)
(cons r rs)))))))
When compiled, this expands the memv into a loop and then expands the eqv? in the memv loop:
(define same?
(lambda (n)
(letrec ((loop (lambda (n rs)
(and ('#<procedure #19 ##not>
(if ('#<procedure #2 ##fixnum?> n)
('#<procedure #3 ##fxzero?> n)
(if ('#<procedure #4 ##flonum?> n) ('#<procedure #5 ##flzero?> n) ('#<procedure #6 zero?> n))))
(let ((r (random-integer 365)))
(or (letrec ((loop.14 (lambda (r lst1.15)
(if ('#<procedure #7 ##pair?> lst1.15)
(let ((x.16 ('#<procedure #8 ##car> lst1.15)))
(if (or ('#<procedure #9 ##eq?> r x.16)
(and ('#<procedure #10 ##subtyped?> r)
(and ('#<procedure #10 ##subtyped?> x.16)
(and ('#<procedure #11 ##fx=> ('#<procedure #12 ##subtype> r) ('#<procedure #12 ##subtype> x.16))
('#<procedure #13 ##eqv?> r x.16)))))
lst1.15
(loop.14 r ('#<procedure #14 ##cdr> lst1.15))))
#f))))
(loop.14 r rs))
(let ((n (if ('#<procedure #2 ##fixnum?> n)
(let ((temp.21 ('#<procedure #15 ##fx-?> n 1))) (if temp.21 temp.21 ('#<procedure #16 -> n 1)))
('#<procedure #16 -> n 1)))
(rs ('#<procedure #17 ##cons> r rs)))
(and ('#<procedure #19 ##not>
(if ('#<procedure #2 ##fixnum?> n)
('#<procedure #3 ##fxzero?> n)
(if ('#<procedure #4 ##flonum?> n) ('#<procedure #5 ##flzero?> n) ('#<procedure #6 zero?> n))))
(let ((r (random-integer 365)))
(or (letrec ((loop.14 (lambda (r lst1.15)
(if ('#<procedure #7 ##pair?> lst1.15)
(let ((x.16 ('#<procedure #8 ##car> lst1.15)))
(if (or ('#<procedure #9 ##eq?> r x.16)
(and ('#<procedure #10 ##subtyped?> r)
(and ('#<procedure #10 ##subtyped?> x.16)
(and ('#<procedure #11 ##fx=>
('#<procedure #12 ##subtype> r)
('#<procedure #12 ##subtype> x.16))
('#<procedure #13 ##eqv?> r x.16)))))
lst1.15
(loop.14 r ('#<procedure #14 ##cdr> lst1.15))))
#f))))
(loop.14 r rs))
(loop (if ('#<procedure #2 ##fixnum?> n)
(let ((temp.21 ('#<procedure #15 ##fx-?> n 1))) (if temp.21 temp.21 ('#<procedure #16 -> n 1)))
('#<procedure #16 -> n 1))
('#<procedure #17 ##cons> r rs))))))))))))
(loop n '()))))
When you uncomment the (fixnum) declaration then the memv is expanded, but the eqv? is not:
(define same?
(lambda (n)
(letrec ((loop (lambda (n rs)
(and ('#<procedure #10 ##not> ('#<procedure #2 ##fxzero?> n))
(let ((r (random-integer 365)))
(or (letrec ((loop.7 (lambda (r lst1.8)
(if ('#<procedure #3 ##pair?> lst1.8)
(let ((x.9 ('#<procedure #4 ##car> lst1.8)))
(if ('#<procedure #5 ##eqv?> r x.9) lst1.8 (loop.7 r ('#<procedure #6 ##cdr> lst1.8))))
#f))))
(loop.7 r rs))
(loop ('#<procedure #7 ##fx-> n 1) ('#<procedure #8 ##cons> r rs))))))))
(loop n '()))))
The trampoline call to ##eqv? in the inner loop is worse than calling the system memv once, because the call to ##eqv? in the system memv is expanded by the compiler.
Brad
More information about the Gambit-list
mailing list