Gauche:プロファイラ

Gauche:プロファイラ

プロファイラ

いずれは組込みでサポートしたいと思っていたところ、koguroさんが マクロで実装してしまいました。

koguroさん版

マクロの勉強をかねて、プロファイラを書いてみました。

;;
;; profiler.scm 
;; 

(use srfi-26)
(use gauche.time)

(define (make-stat) (cons 1 0))
(define (stat-count stat) (car stat))
(define (stat-elapse stat) (cdr stat))
(define (inc-stat-count stat) 
  (set-car! stat (+ (car stat) 1)))
(define (add-stat-elapse stat time) 
  (set-cdr! stat (+ (cdr stat) time)))

(define *symbol-table* (make-hash-table))
(define (symbol-table-put! proc v)
  (hash-table-put! *symbol-table* proc v))
(define (symbol-table-get proc)
  (hash-table-get *symbol-table* proc))

(define *profiler-table* (make-hash-table))
(define (inc-count v)
  (if (hash-table-exists? *profiler-table* v)
      (inc-stat-count (hash-table-get *profiler-table* v))
      (hash-table-put! *profiler-table* v (make-stat))))
(define (add-elapse v time)
  (if (hash-table-exists? *profiler-table* v)
      (add-stat-elapse (hash-table-get *profiler-table* v) time)
      (hash-table-put! *profiler-table* v (make-stat))))

(define (show-profile)
  (hash-table-map *profiler-table* 
                  (lambda (proc stat)
                    (format #t "~a ~a ~a~%" 
                            (stat-count stat)
                            (* 1000 (stat-elapse stat))
                            (symbol-table-get proc)))))

(define *define* define)
(define *lambda* lambda)

(define-syntax wrap 
  (syntax-rules ()
    ((wrap proc wrap-proc)
     (let ((proc proc)
           (apply apply))
       (*lambda* variables
                 (wrap-proc (*lambda* () (apply proc variables))))))))

(define (profile-function id proc)
  (let ((time-counter (make <real-time-counter>)))
    (inc-count id)
    (begin0
        (with-time-counter time-counter (proc))
      (add-elapse id (time-counter-value time-counter)))))

(define-syntax define
  (syntax-rules ()
    ((define (variable . formals) body ...)
     (begin
       (define variable (lambda formals body ...))))
    ((define variable expression) 
     (begin
       (*define* variable expression)
       (if (procedure? variable)
           (symbol-table-put! variable 'variable))))))

(define-syntax lambda
  (syntax-rules ()
    ((lambda formals body ...)
     (letrec ((proc (*lambda* formals body ...))
              (wrap-proc (wrap proc (cut profile-function wrap-proc <>))))
       (symbol-table-put! wrap-proc (format "~s" '(lambda formals body ...)))
       wrap-proc))))

(define-syntax profile
  (syntax-rules ()
    ((profile proc)
     (define proc
       (let ((proc proc))
         (lambda formals (apply proc formals)))))))

(*define* (main args)
          (*define* (main args) 0)
          (load (cadr args))
          (main (cdr args))
          (show-profile)
          0)

./profiler.scm ./tarai.scm のように実行すると、最後に

192
27649 441019.93199998135 tarai

実行回数、実行時間(ms)、関数名を表示します。ただしとても遅いです。 なお、define, lambda で定義された関数が計測対象となります。プリミティブな関数を計測したいときは、(profile car) のように指定してください。

Gauche 0.8での問題

teranishi: Gauche0.8で実行すると、以下のエラーが出ます。

*** ERROR: *define* is used at non-toplevel: (*define* (main args) 0)

該当個所を (set! main (*lambda* (args) 0)) に直せば動きますが、内部defineのデータが取れません。

$ cat definetest.scm
(define (main args)
  (define (f x) 10)
  (f 20)
  0)
$ gosh profiler.scm definetest.scm
1 0 main

トップレベルでdefineを再定義しても、内部defineには反映されないようです。

Shiro: 内部defineに関しては、0.8以前から「マクロ展開の結果生成される 内部defineが内部defineとして認識されない」というバグがありました。 ただ、0.8以前はそれがトップレベルdefineとして認識されるという別の バグがあり、そのせいで前のバグが見えていなかったのだと思います。

teranishi

koguroさん版で、lambda式を評価するたびに別の関数としてカウントされるのが個人的に使いづらかったので、手を加えさせていただきました。

(use gauche.time)
(use util.match)

(define *profiler-table* ())

(define (make-profile-function name)
  (let ((count 0)
        (time (make <real-time-counter>)))
    (push! *profiler-table*
           (lambda ()
             (format #t "~a ~a ~s~%" count (* 1000 (time-counter-value time)) name)))
    (let ((before (lambda () (time-counter-start! time)))
          (after (lambda () (time-counter-stop! time))))
      (lambda (proc)
        (inc! count)
        (dynamic-wind before proc after)))))

(define (show-profile)
  (for-each (lambda (f) (f)) *profiler-table*))

(define *define* define)
(define *lambda* lambda)

(define-macro (profile proc)
  (let ((profile-function (make-profile-function proc)))
    `(*define* ,proc
       (let ((original ,proc))
         (*lambda* args (,profile-function (*lambda* () (,apply original args))))))))

(define-macro (define . rest)
  (match rest
    ((or ((variable . formals) body ...) (variable ('lambda formals body ...)))
     (let ((profile-function (make-profile-function variable)))
       `(*define* (,variable . ,formals) (,profile-function (*lambda* () ,@body)))))
    ((variable expression)
     `(*define* ,variable ,expression))))

(define-macro (lambda formals . body)
  (let ((profile-function (make-profile-function (list* 'lambda formals body))))
    `(*lambda* ,formals (,profile-function (*lambda* () ,@body)))))

(*define* (main args)
          (set! main (*lambda* (args) 0))
          (load (cadr args))
          (main (cdr args))
          (show-profile)
          0)

Last modified : 2012/02/23 03:36:39 UTC