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