静的リンクにしておけば・・・

ベンチマークを取った際に2倍以上Gaucheに放されるテストが多数あったので原因を追求してみた。
端的にはこれ↓

(cond-expand
 (sagittarius
  (import (sagittarius compiler))
  (define flush flush-output-port)
  )
 (gauche
  (define compile-p2 (with-module gauche.internal compile-p2))
  (define compile-p3 (with-module gauche.internal compile-p3))
  )
 (else
  (exit)))

(define sexp '(define (lookup key table)
(let loop ((x table))
 (if (null? x)
     #f
     (let ((pair (car x))) ;; 【*1】ここが問題
(if (eq? (car pair) key)
   pair
   (loop (cdr x))))))))

(compile-p2 sexp)
(flush (current-output-port))
(compile-p3 sexp)

この結果が以下

$ sash -I"(srfi :0)" test.scm
($define () lookup
  ($lambda[lookup.0] (key[1.0] table[1.0])
    ($call[embed] ($lambda[loop.2] (x[3.0])
                    ($label #0
                      ($if ($asm (NULLP)
                             ($lref x[3.0]))
                        ($const #f)
                        ($let ((pair[2.0] ($asm (CAR)
                                            ($lref x[3.0]))))
                          ($if ($asm (EQ)
                                 ($asm (CAR)
                                   ($lref pair[2.0]))
                                 ($lref key[1.0]))
                            ($lref pair[2.0])
                            ($call[jump] ($call[embed] ($lambda[loop.2] (x[3.0])

                                                         label#0)
                                           ($lref table[1.0]))
                              ($asm (CDR)
                                ($lref x[3.0]))))))))
      ($lref table[1.0]))))
size: 5
0: CLOSURE #
  size: 37
  0: LET_FRAME(3) ;; (let loop ((x table)
  1: LREF_PUSH(0) ;; key
  2: LREF_PUSH(1) ;; table
  3: DISPLAY(2)
  4: LREF_PUSH(1) ;; table
  5: POP_LET_FRAME(1)
  6: MARK
  7: LREF(0) ;; x
  8: BNNULL 5 ;; (if (null? x) #f (le
  10: CONST #f
  12: JUMP 23 ;; #f
  14: LET_FRAME(4) ;; (let ((pair (car x))
  15: FREF_PUSH(1) ;; key
  16: LREF_PUSH(0) ;; x
  17: FREF_PUSH(0) ;; table
  18: DISPLAY(3)
  19: LREF_CAR(0) ;; x
  20: PUSH
  21: POP_LET_FRAME(1)
  22: LREF_CAR(0) ;; pair
  23: PUSH
  24: FREF(2) ;; key
  25: BNEQ 4 ;; (if (eq? (car pair)
  27: LREF(0) ;; pair
  28: JUMP 7 ;; #f
  30: FREF(1) ;; x
  31: CDR ;; (cdr x)
  32: PUSH
  33: SHIFTJ(1 1)
  34: JUMP -28 ;; #f
  36: RET

2: DEFINE(0) # ;; (define (lookup key
4: HALT

もう一つはGauche

$ gosh test.scm
($define () lookup
  ($lambda[lookup;0] (key[1;0] table[1;0])
    ($letrec ((loop[2;0] ($lambda[loop;0] (x[3;0])
                           ($if ($asm (NULLP)
                                  ($lref x[3;0]))
                             ($const #f)
                             ($let ((pair[2;0] ($asm (CAR)
                                                 ($lref x[3;0])))
                                    )
                               ($if ($asm (EQ)
                                      ($asm (CAR)
                                        ($lref pair[2;0]))
                                      ($lref key[1;0]))
                                 ($lref pair[2;0])
                                 ($call ($lref loop[2;0])
                                   ($asm (CDR)
                                     ($lref x[3;0]))))))))
              )
      ($call ($lref loop[2;0])
        ($lref table[1;0])))))
main_code (name=%toplevel, code=0x1043bc00, size=5, const=2, stack=0):
args: #f
     0 CLOSURE #      ; (lambda (key table) (let loop ((x table) ...
     2 DEFINE(0) #; (define (lookup key table) (let loop
 ((x ...
     4 RET
internal_closure_0 (name=lookup, code=0x1043bc18, size=6, const=1 stack=8):
args: #f
     0 LOCAL-ENV-CLOSURES(1) (#); (let loop ((x table)) (if (null? x)
#f ( ...
     2 LREF10-PUSH              ; table
     3 LREF0                    ; loop
     4 TAIL-CALL(1)
     5 RET
internal_closure_1 (name=loop, code=0x104c6f78, size=17, const=0 stack=8):
args: #f
     0 LREF0                    ; x
     1 BNNULL 4                 ; (null? x)
     3 CONSTF-RET
     4 LREF0-CAR                ; (car x)
     5 PUSH-LOCAL-ENV(1)        ; (let ((pair (car x))) (if (eq? (car pair ...
     6 LREF0-CAR                ; (car pair)
     7 PUSH
     8 LREF(3,1)                ; key
     9 BNEQ 12                  ; (eq? (car pair) key)
    11 LREF0-RET                ; pair
    12 LREF10-CDR               ; (cdr x)
    13 PUSH
    14 LREF20                   ; loop
    15 TAIL-CALL(1)             ; (loop (cdr x))
    16 RET

適当にスクロールして見てください。
一つ目の結果はそこまで変わらないのに、2つ目のインストラクションがまずいことに。
原因はSagittariusはmoshのようにDisplay closureを持っていて(これは3imp.pdfにあるやつ)、自由変数が現れると作られるのだが、この処理が重い。参照は早いが作成は遅いというもの。
Gaucheは逆に静的リンクで、作成は軽いが参照が若干重いというもの(だと思う)。
問題になるのは【*1】で示した場所で、ここでletをはさむためkeyとtableが自由変数になる。
ここで【*1】のletを削って、(eq? (car pair) key)を(eq? (car (car x)) key)とすると自由変数が無くなりちょっと処理が軽くなる。

この辺最適化でなんとかできるのかなぁ？stalinでも読むか。