コンパイルが遅い原因を探る - Scheme VM を書く

VM 側に profiler っぽいものを仕込み、Gauche で整形ツールを書いたが、VMの構造上正確に計測するのが難しいことが分かった。
手続き名と、手続きの最後まで実行されたという目印を見つけるのが難しいのだ。
3時間くらいかけたことを捨てなくてはいけないが、この方法がダメだと分かったことが得られたので良しとしよう。

次の作戦は Scheme 側で測定。
測定用にコードを書き換えて、手続き呼出しの中で実行時間測定して変数に記録しておく。
疑似コードで書くならば

(define (find pred lst)
   ...body)

という元の定義を

(define (find pred lst)
  (define (tmp pred lst)
     ...body)
  (時刻取得)
  (let (ret ((tmp pred lst)))
    (時刻取得)
    (記録)
    ret))

のように書き換えてあげる。

もちろん書き換えはスクリプトで、簡単なコード変換でいけた。
コード変換の本体は

(define (proc->profiler-proc sexp)
  (let* ([name  (first (second sexp))]
         [args  (cdr (second sexp))]
         [args-no-dot (dot-pair->list args)]
         [body (cddr sexp)]
         [profile-var (string->symbol (string-append (symbol->string name) "-profile"))])
    `(begin
       (define ,profile-var (cons ,(symbol->string name) (cons 0 (cons 0 '()))))
       (set! profile-list (cons ,profile-var profile-list))
       (define (,name ,@args)
         (define (tmp ,@args-no-dot)
           ,@body)
         (let* ([t1 (get-time-of-day)]
                [ret (tmp ,@args-no-dot)]
                [t2 (get-time-of-day)]
                [time (+ (- (car t2) (car t1)) (- (cdr t2) (cdr t1)))])
           (set-car! (cdr ,profile-var) (+ 1 (car (cdr ,profile-var))))
           (set-car! (cdr (cdr ,profile-var)) (+ time (car (cdr (cdr ,profile-var)))))
           ret)))))

短い時間で作ったので読みやすさはあれだけど。
これが展開するコードが cadr などすら使えないのが辛かった。（cadr などを定義するライブラリもこのプロファイラの対象なので）