[gambit-list] Re: Need to reverse order of constant propagation and specialization

Bradley Lucier lucier at math.purdue.edu
Fri Jul 15 21:43:55 EDT 2005


On Jun 26, 2005, at 12:03 AM, Bradley Lucier wrote:

> Marc:
>
> Consider the following code:
>
> (declare (standard-bindings)(extended-bindings)(block))
>
> (define (expt1 a b)
>   (define (square x) (* x x))
>   (cond ((= b 0) 1)
>         ((even? b)
>          (square (expt1 a (quotient b 2))))
>         (else
>          (* a (square (expt1 a (quotient b 2)))))))
>
> (declare (inlining-limit 100000))
>
> (define a (expt1 2 20))
>
> (define b (expt1 2 40))
>
> (define c (expt1 2 80))
>
> When compiled, this gives

(define expt1
   (lambda (a b)
     (if (if (##fixnum? b) (##fixnum.= b 0) (= b 0))
         1
         (if (even? b)
             (let ((x (expt1 a
                             (if (and (##fixnum? b) #t)
                                 (##fixnum.quotient b 2)
                                 (quotient b 2)))))
               (if (and (##fixnum? x) (##fixnum? x))
                   (if (##fixnum.= x 0)
                       0
                       (let ((temp (if (##fixnum.= x -1)
                                       (##fixnum.-? x)
                                       (##fixnum.*? x x))))
                         (if temp temp (* x x))))
                   (* x x)))
             (let ((temp (let ((x (expt1 a
                                         (if (and (##fixnum? b) #t)
                                             (##fixnum.quotient b 2)
                                             (quotient b 2)))))
                           (if (and (##fixnum? x) (##fixnum? x))
                               (if (##fixnum.= x 0)
                                   0
                                   (let ((temp (if (##fixnum.= x -1)
                                                   (##fixnum.-? x)
                                                   (##fixnum.*? x x))))
                                     (if temp temp (* x x))))
                               (* x x)))))
               (if (and (##fixnum? temp) (##fixnum? a))
                   (if (##fixnum.= temp 0)
                       0
                       (let ((temp#1 (if (##fixnum.= temp -1)
                                         (##fixnum.-? a)
                                         (##fixnum.*? a temp))))
                         (if temp#1 temp#1 (* a temp))))
                   (* a temp)))))))

(define a 1048576)

(define b
   (let ((temp (##fixnum.*? 1048576 1048576))) (if temp temp 
1099511627776)))

(define c
   (let ((x (let ((temp (##fixnum.*? 1048576 1048576)))
              (if temp temp 1099511627776))))
     (if (and (##fixnum? x) (##fixnum? x))
         (if (##fixnum.= x 0)
             0
             (let ((temp (if (##fixnum.= x -1)
                             (##fixnum.-? x)
                             (##fixnum.*? x x))))
               (if temp temp (* x x))))
         (* x x))))

So the problem noticed for beta13 is still there---you need to do 
partial evaluation/constant propagation *before* specializing the 
functions for fixnum values.

Some other comments about the generated code:

1.  (even? b) and (odd? b) can be specialized for fixnum.

2.  The following don't look very good:

              (let ((temp (let ((x (expt1 a
                                         (if (and (##fixnum? b) #t)      
   ;;; <<<<<<<<<<<
                                             (##fixnum.quotient b 2)
                                             (quotient b 2)))))
                           (if (and (##fixnum? x) (##fixnum? x))         
   ;;; <<<<<<<<<<<
...

I guess the first happens because (quotient x y) is expanded to

     (let ((temp y))
       (if (and (##fixnum? temp)
                (and (##fixnum? x) (##not (##fixnum.= temp 0))))
           (if (##fixnum.= temp -1)
               (or (##fixnum.-? x) (quotient x temp))
               (##fixnum.quotient x temp))
           (quotient x temp)))

and when temp=2, (##fixnum? temp) and (##not (##fixnum.= temp 0)) both 
evaluate to #t and (##fixnum.= temp -1) evaluates to #f.

And unfortunately, the adjacent fixnum tests do appear in the C code.  
(Perhaps gcc eliminates them, I didn't check the assembly.)

3.  The code goes on to

                               (if (##fixnum.= x 0)
                                   0
                                   (let ((temp (if (##fixnum.= x -1)
                                                   (##fixnum.-? x)       
    ;;; <<<<<<<<<
                                                   (##fixnum.*? x x))))

Here it should just return 1.  (This happens with (* x x))

But overall, very nice.

Brad




More information about the Gambit-list mailing list