takl を深追い

takl ベンチマークで遠く Gauche におよばないので調べます。約10倍 Gauche が速いです。

;;; TAKL -- The TAKeuchi function using lists as counters.
;;;   from http://www.ccs.neu.edu/home/will/Twobit/benchmarksAbout.html

(define (listn n)
  (if (= n 0)
    '()
    (cons n (listn (- n 1)))))

(define l18 (listn 18))
(define l12 (listn 12))
(define  l6 (listn 6))

(define (mas x y z)
  (if (not (shorterp y x))
      z
      (mas (mas (cdr x) y z)
           (mas (cdr y) z x)
           (mas (cdr z) x y))))

(define (shorterp x y)
  (and (not (null? y))
       (or (null? x)
           (shorterp (cdr x)
                     (cdr y)))))

(unless (equal? (mas l18 l12 l6) '(7 6 5 4 3 2 1))
  (error "takl failed"))

ちょっと比較のために sscm や guile などでも計測してみましたが、いずれの処理系よりも Gauche が一桁速いようです。
それぞれの手続きの disasm を見て分析してみます。

以下のように見てみると shorterp で吐かれるコードが Gauche ではとても短いことが分かりました。
これはおそらく pass3/$if の最適化が効いているのだろうなあ。

listn

     0 LREF0                    ; n
     1 BNUMNEI(0) 5             ; (= n 0)
     3 CONSTN 
     4 RET 
     5 LREF0-PUSH               ; n
     6 PRE-CALL(1) 12
     8 LREF0                    ; n
     9 NUMADDI(-1)              ; (- n 1)
    10 PUSH-GREF-CALL(1) #<identifier user#listn>; (listn (- n 1))
    12 CONS                     ; (cons n (listn (- n 1)))
    13 RET

自前処理系は命令長 20 でした。

mas

     0 PRE-CALL(2) 6
     2 LREF1-PUSH               ; y
     3 LREF2-PUSH               ; x
     4 GREF-CALL(2) #<identifier user#shorterp>; (shorterp y x)
     6 BF 34                    ; (if (not (shorterp y x)) z (mas (mas (cd ...
     8 PRE-CALL(3) 15
    10 LREF2                    ; x
    11 CDR-PUSH                 ; (cdr x)
    12 LREF1-PUSH               ; y
    13 LREF0-PUSH-GREF-CALL(3) #<identifier user#mas>; (mas (cdr x) y z)
    15 PUSH-PRE-CALL(3) 23
    17 LREF1                    ; y
    18 CDR-PUSH                 ; (cdr y)
    19 LREF0-PUSH               ; z
    20 LREF2-PUSH               ; x
    21 GREF-CALL(3) #<identifier user#mas>; (mas (cdr y) z x)
    23 PUSH-PRE-CALL(3) 31
    25 LREF0                    ; z
    26 CDR-PUSH                 ; (cdr z)
    27 LREF2-PUSH               ; x
    28 LREF1-PUSH               ; y
    29 GREF-CALL(3) #<identifier user#mas>; (mas (cdr z) x y)
    31 PUSH-GREF-TAIL-CALL(3) #<identifier user#mas>; (mas (mas (cdr x) y z) (mas (cdr y) z x) ...
    33 RET 
    34 LREF0                    ; z
    35 RET 

自前では命令長 52 。

shorterp

     0 LREF0                    ; y
     1 NULLP                    ; (null? y)
     2 NOT                      ; (not (null? y))
     3 RF 
     4 LREF1                    ; x
     5 BNNULL 8                 ; (null? x)
     7 RET 
     8 LREF1                    ; x
     9 CDR-PUSH                 ; (cdr x)
    10 LREF0                    ; y
    11 CDR-PUSH                 ; (cdr y)
    12 GREF-TAIL-CALL(2) #<identifier user#shorterp>; (shorterp (cdr x) (cdr y))
    14 RET

自前では命令長 73。

and とか or の展開

そういえば Gauche で and とか or がどう展開されるか見たことなかったな。

(define-pass1-syntax (and form cenv) :null
  (define (rec exprs)
    (match exprs
      (() `#(,$CONST #t))
      ((expr) (pass1 expr cenv))
      ((expr . more)
       ($if #f (pass1 expr (cenv-sans-name cenv)) (rec more) ($it)))
      (else
       (error "syntax-error: malformed and:" form))))
  (rec (cdr form)))

これだこれ。そうだ。以前調べたときどこかで書いたはずなのに忘れてた。
$if は $it を持つんだよ。
$it の意味は↓。

;; $if <src> <test> <then> <else>
;;   Conditional.
;;   A special IForm, $it, can appear in either <then> or <else>
;;   clause; it is no-op and indicates that the result(s) of <test>
;;   should be carried over.

きちんとした理解は次の日記に続く。