Long answer:
First we try it as is:
#!/usr/bin/env gsi-script (declare (not safe) (mostly-flonum))
(define (main arg) (let ((k (string->number arg))) (pretty-print (time (cpi (exact->inexact k))))))
(define (cpi n) (letrec ((rec (lambda (i sum) (let* ((x (fl/ (fl- i 0.5) n)) (summand (fl/ 4.0 (fl+ 1.0 (fl* x x))))) (if (fl> i n) (fl/ sum n) (rec (fl+ i 1.0) (fl+ sum summand))))))) (rec 0.0 0.0)))
[Media-Mac-mini-3:~] lucier% gsc -exe pi.scm gcc: warning: couldn't understand kern.osversion '14.3.0 gcc: warning: couldn't understand kern.osversion '14.3.0 gcc: warning: couldn't understand kern.osversion '14.3.0 [Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi (exact->inexact k))) 60 ms real time 59 ms cpu time (56 user, 3 system) 104 collections accounting for 21 ms real time (20 user, 0 system) 224000448 bytes allocated 567 minor faults no major faults 3.1415966535897644 0.060u 0.009s 0:00.07 85.7% 0+0k 0+0io 0pf+0w
Then we look at the code expansion:
[Media-Mac-mini-3:~] lucier% gsc -exe -expansion pi.scm Expansion:
(define main (lambda (arg) (let ((k (string->number arg))) (pretty-print (##time (lambda () (cpi (if (and ('#<procedure #2 ##eq?> exact->inexact '#<procedure #3 exact->inexact>) ('#<procedure #4 ##flonum?> k)) k (exact->inexact k)))) '(cpi (exact->inexact k)))))))
(define cpi (lambda (n) (letrec ((rec (lambda (n i sum) (let ((x (let ((temp.3 (if ('#<procedure #2 ##eq?> fl- '#<procedure #5 fl->) ('#<procedure #6 ##fl-> i .5) (fl- i .5)))) (if ('#<procedure #2 ##eq?> fl/ '#<procedure #7 fl/>) ('#<procedure #8 ##fl/> temp.3 n) (fl/ temp.3 n))))) (let ((summand (let ((temp.10 (let ((temp.8 (if ('#<procedure #2 ##eq?> fl* '#<procedure #9 fl*>) ('#<procedure #10 ##fl*> x x) (fl* x x)))) (if ('#<procedure #2 ##eq?> fl+ '#<procedure #11 fl+>) ('#<procedure #12 ##fl+> 1. temp.8) (fl+ 1. temp.8))))) (if ('#<procedure #2 ##eq?> fl/ '#<procedure #7 fl/>) ('#<procedure #8 ##fl/> 4. temp.10) (fl/ 4. temp.10))))) (if (if ('#<procedure #2 ##eq?> fl> '#<procedure #13 fl>>) ('#<procedure #14 ##fl>> i n) (fl> i n)) (if ('#<procedure #2 ##eq?> fl/ '#<procedure #7 fl/>) ('#<procedure #8 ##fl/> sum n) (fl/ sum n)) (rec n (if ('#<procedure #2 ##eq?> fl+ '#<procedure #11 fl+>) ('#<procedure #12 ##fl+> i 1.) (fl+ i 1.)) (if ('#<procedure #2 ##eq?> fl+ '#<procedure #11 fl+>) ('#<procedure #12 ##fl+> sum summand) (fl+ sum summand))))))))) (rec n 0. 0.))))
So you see that the code keeps checking that the flonum procedures fl+, etc., are really fl+ before inlining them.
So we declare standard-bindings and extended-bindings to tell the compiler that the procedures are what they say (it would be good to declare block, too, to say that we don’t redefine user procedures, but that’s not needed because we call cpi only once):
#!/usr/bin/env gsi-script (declare (standard-bindings) (extended-bindings) (not safe) (mostly-flonum))
(define (main arg) (let ((k (string->number arg))) (pretty-print (time (cpi (exact->inexact k))))))
(define (cpi n) (letrec ((rec (lambda (i sum) (let* ((x (fl/ (fl- i 0.5) n)) (summand (fl/ 4.0 (fl+ 1.0 (fl* x x))))) (if (fl> i n) (fl/ sum n) (rec (fl+ i 1.0) (fl+ sum summand))))))) (rec 0.0 0.0)))
[Media-Mac-mini-3:~] lucier% gsc -exe -expansion pi.scm Expansion:
(define main (lambda (arg) (let ((k ('#<procedure #2 string->number> arg))) (pretty-print (##time (lambda () (cpi (if ('#<procedure #3 ##flonum?> k) k ('#<procedure #4 exact->inexact> k)))) '(cpi (exact->inexact k)))))))
(define cpi (lambda (n) (letrec ((rec (lambda (n i sum) (let ((x ('#<procedure #5 ##fl/> ('#<procedure #6 ##fl-> i .5) n))) (let ((summand ('#<procedure #5 ##fl/> 4. ('#<procedure #7 ##fl+> 1. ('#<procedure #8 ##fl*> x x))))) (if ('#<procedure #9 ##fl>> i n) ('#<procedure #5 ##fl/> sum n) (rec n ('#<procedure #7 ##fl+> i 1.) ('#<procedure #7 ##fl+> sum summand)))))))) (rec n 0. 0.))))
That's better:
[Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi (exact->inexact k))) 28 ms real time 27 ms cpu time (25 user, 2 system) 44 collections accounting for 7 ms real time (7 user, 0 system) 96000192 bytes allocated 563 minor faults 4 major faults 3.1415966535897644 0.030u 0.012s 0:00.29 13.7% 0+0k 0+0io 753pf+0w
But you notice that 96 bytes are allocated for each value of i. That's a lot. So you look at the C code generated:
[Media-Mac-mini-3:~] lucier% gsc -exe -keep-c pi.scm [Media-Mac-mini-3:~] lucier% vi pi.c
and you say "Holy shit, the Gambit compiler sure boxes flonums a lot (F64BOX)" and "what are all those CHECK_HEAPS for?".
Well, the CHECK_HEAPS are because the F64BOXes are using up the heap.
And the F64BOXes are using up the heap because the Gambit compiler does not keep flonums unboxed across jumps.
So if you want to distort the code to work around limitations of the Gambit compiler, you can keep an explicit f64vector to hold the partial sums.
But first you notice there's a bug in the program, and it should start with i=1.
And then you remember that fixnums are never boxed.
So you screw up your code as follows:
#!/usr/bin/env gsi-script (declare (standard-bindings) (extended-bindings) (not safe) (mostly-flonum))
(define (main arg) (let ((k (string->number arg))) (pretty-print (time (cpi k)))))
(define (cpi n) (letrec ((rec (lambda (i sum) (let* ((x (fl/ (fl- (fixnum->flonum i) 0.5) (fixnum->flonum n))) (summand (fl/ 4.0 (fl+ 1.0 (fl* x x))))) (f64vector-set! sum 0 (fl+ (f64vector-ref sum 0) summand)) (if (fx> i n) (fl/ (f64vector-ref sum 0) (fixnum->flonum n)) (rec (fx+ i 1) sum)))))) (rec 1 (f64vector 0.0))))
and you get:
[Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi k)) 18 ms real time 18 ms cpu time (17 user, 0 system) no collections 64 bytes allocated no minor faults 2 major faults 3.1415946535887644 0.021u 0.008s 0:00.07 28.5% 0+0k 0+0io 753pf+0w
And so now there is no allocation each run through the loop.
And so you decide that you don't need to interrupt the loop, either for checking the heap or checking for ^C (CNTL-C), so you disable interrupts; you don't have any generic math operations so you don't need to declare mostly-flonum:
#!/usr/bin/env gsi-script (declare (standard-bindings) (extended-bindings) (not interrupts-enabled) (not safe))
(define (main arg) (let ((k (string->number arg))) (pretty-print (time (cpi k)))))
(define (cpi n) (letrec ((rec (lambda (i sum) (let* ((x (fl/ (fl- (fixnum->flonum i) 0.5) (fixnum->flonum n))) (summand (fl/ 4.0 (fl+ 1.0 (fl* x x))))) (f64vector-set! sum 0 (fl+ (f64vector-ref sum 0) summand)) (if (fx> i n) (fl/ (f64vector-ref sum 0) (fixnum->flonum n)) (rec (fx+ i 1) sum)))))) (rec 1 (f64vector 0.0))))
and get
[Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi k)) 18 ms real time 17 ms cpu time (17 user, 0 system) no collections 64 bytes allocated no minor faults no major faults 3.1415946535887644 0.021u 0.009s 0:00.09 22.2% 0+0k 0+0io 753pf+0w
So that last bit didn't help too much.
On my machine I get
[Media-Mac-mini-3:~] lucier% g++ -Wall -W -Ofast pi.cc pi.cc:12:14: warning: unused parameter 'argc' [-Wunused-parameter] int main(int argc, char* argv[]) { ^ 1 warning generated. [Media-Mac-mini-3:~] lucier% time ./a.out 1000000 3.1415926535899388
0.018200999999999998 0.018u 0.001s 0:00.02 50.0% 0+0k 0+0io 0pf+0w
Pretty close.