Don't understand effects of (declare fixnum) - Gambit-list

12 Oct 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