Marc:

Here's a simple benchmark harness plus two tests:

(declare (standard-bindings)
	 (extended-bindings)
	 (block))

(declare (inline))

(define (inline-unsafe-flonum-+ x y)
  (declare (not safe)
	   (flonum))
  (+ x y))

(define (inline-safe-flonum-+ x y)
  (declare (flonum))
  (+ x y))

(define-macro (test fn x y)

  (define (extend-name fn)
    (string->symbol (string-append "test-" (symbol->string fn))))

  `(begin
     (define (,(extend-name fn) x y)
       (declare (not safe))
       (let outer-loop ((x x)
			(y y)
			(number-of-tests 2)
			(begin-time #f)
			(i #f))
	 (##gc)
	 
	 (let inner-loop ((x x)
			  (y y)
			  (number-of-tests number-of-tests)
			  (begin-time (cpu-time))
			  (i 0))
	   (if (fx< i number-of-tests)
	       (begin
		 (let ()
		   (declare (inlining-limit 10000))
		   (,fn x y))
		 (inner-loop x
			     y
			     number-of-tests
			     begin-time
			     (fx+ i 1)))
	       (let ((run-time (fl- (cpu-time) begin-time)))
		 (if (fl< 1.0 run-time)
		     (pp (list (fl/ (exact->inexact number-of-tests)
				    run-time)
			       '(,fn x y)
			       ))
		     (outer-loop x
				 y
				 (fx* 2 number-of-tests)
				 begin-time
				 #f)))))))
     (,(extend-name fn) ,x ,y)))

(test inline-unsafe-flonum-+ 2. 3.)
(test inline-safe-flonum-+ 2. 3.)

Here's the compiled output:

heine:~/programs/gambc-v4_6_2-devel> gsc -c -expansion crap-test+.scm
Expansion:

(define inline-unsafe-flonum-+ (lambda (x y) ('#<procedure #2 ##fl+> x y)))

(define inline-safe-flonum-+ (lambda (x y) (if (and ('#<procedure #3 ##flonum?> y) ('#<procedure #3 ##flonum?> x)) ('#<procedure #2 ##fl+> x y) ('#<procedure #4 fl+> x y))))

(define test-inline-unsafe-flonum-+
  (lambda (x y)
    (letrec ((outer-loop
              (lambda (x y number-of-tests begin-time i)
                (let ((begin-temp.1 (##gc)))
                  (letrec ((inner-loop
                            (lambda (x y number-of-tests begin-time i)
                              (if ('#<procedure #5 ##fx<> i number-of-tests)
                                  (let ((begin-temp.0 (let ((x x) (y y)) ('#<procedure #2 ##fl+> x y)))) (inner-loop x y number-of-tests begin-time ('#<procedure #6 ##fx+> i 1)))
                                  (let ((run-time ('#<procedure #7 ##fl-> (cpu-time) begin-time)))
                                    (if ('#<procedure #8 ##fl<> 1. run-time)
                                        (pp ('#<procedure #9 ##list>
                                             ('#<procedure #10 ##fl/>
                                              (if ('#<procedure #11 ##fixnum?> number-of-tests)
                                                  ('#<procedure #12 ##fl<-fx> number-of-tests)
                                                  (if ('#<procedure #3 ##flonum?> number-of-tests) number-of-tests ('#<procedure #13 exact->inexact> number-of-tests)))
                                              run-time)
                                             '(inline-unsafe-flonum-+ x y)))
                                        (outer-loop x y ('#<procedure #14 ##fx*> 2 number-of-tests) begin-time #f)))))))
                    (inner-loop x y number-of-tests (cpu-time) 0))))))
      (outer-loop x y 2 #f #f))))

(test-inline-unsafe-flonum-+ 2. 3.)

(define test-inline-safe-flonum-+
  (lambda (x y)
    (letrec ((outer-loop
              (lambda (x y number-of-tests begin-time i)
                (let ((begin-temp.3 (##gc)))
                  (letrec ((inner-loop
                            (lambda (x y number-of-tests begin-time i)
                              (if ('#<procedure #5 ##fx<> i number-of-tests)
                                  (let ((begin-temp.2 (let ((x x) (y y)) (if (and ('#<procedure #3 ##flonum?> y) ('#<procedure #3 ##flonum?> x)) ('#<procedure #2 ##fl+> x y) ('#<procedure #4 fl+> x y)))))
                                    (inner-loop x y number-of-tests begin-time ('#<procedure #6 ##fx+> i 1)))
                                  (let ((run-time ('#<procedure #7 ##fl-> (cpu-time) begin-time)))
                                    (if ('#<procedure #8 ##fl<> 1. run-time)
                                        (pp ('#<procedure #9 ##list>
                                             ('#<procedure #10 ##fl/>
                                              (if ('#<procedure #11 ##fixnum?> number-of-tests)
                                                  ('#<procedure #12 ##fl<-fx> number-of-tests)
                                                  (if ('#<procedure #3 ##flonum?> number-of-tests) number-of-tests ('#<procedure #13 exact->inexact> number-of-tests)))
                                              run-time)
                                             '(inline-safe-flonum-+ x y)))
                                        (outer-loop x y ('#<procedure #14 ##fx*> 2 number-of-tests) begin-time #f)))))))
                    (inner-loop x y number-of-tests (cpu-time) 0))))))
      (outer-loop x y 2 #f #f))))

(test-inline-safe-flonum-+ 2. 3.)

Now see that

('#<procedure #2 ##fl+> x y))

is in the expansion of each test loop (at begin-temp.0 and begin-temp.2), but that addition is not in the C-code (presumably because it is not referenced).

It's OK with me that the compiler removes this code; what I find troubling is that it's still in the "expansion" of the scheme code---it appears that there are optimizations done after the expansion but before code generation.

I'd like to rely on the output of '-expansion' more and to rely on reading the C code (or the resulting assembly code in extreme cases) less in trying to figure out how gsc will compile my code.

Can the '-expansion' be emitted later in the compilation process, after all code-visible optimizations have been made?

Brad