Scheme:MOP:ProfiledGeneric

ProfiledGeneric

すでにGaucheにはプロファイラが実装されたわけだけど、 Gauche本とか読むと自分でみやってみたくなってきた。特に総称関数回りはいじったことなかったので。

profiled-generic.scm

うーん。まぁ土台はいいとして、<*-time-counter>の使い方とか意味とかこれでいいのかしらん。メソッド名とかも、どうもセンスねーなーって感じる。

残件

表示出力をもっとちゃんと整形する。(formatまだまだ使いこなせてない)

;;;
;;; profiled-generic - MOP sample -
;;;  
;;;   Copyright (c) 2007  Katsutoshi Itoh  <cut-sea@master.email.ne.jp>
;;;   
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;   
;;;   1. Redistributions of source code must retain the above copyright
;;;      notice, this list of conditions and the following disclaimer.
;;;  
;;;   2. Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;  
;;;   3. Neither the name of the authors nor the names of its contributors
;;;      may be used to endorse or promote products derived from this
;;;      software without specific prior written permission.
;;;  
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;  
;;;  $Id$
;;;

(define-module gauche.mop.profiled-generic
  (use srfi-1)
  (use gauche.time)

  (export
   <profiled-generic>
   profile-init!
   profile-on!
   profile-off!
   profile-on?
   get-profile
   )
  )
(select-module gauche.mop.profiled-generic)

(define-class <profiled-data> ()
  ((count     :accessor count-of :init-value 0)
   (real-time :accessor real-time-of :init-form (make <real-time-counter>))
   (sys-time  :accessor sys-time-of  :init-form (make <system-time-counter>))
   (proc-time :accessor proc-time-of :init-form (make <process-time-counter>))
   (user-time :accessor user-time-of :init-form (make <user-time-counter>))))

(define-class <profiled-generic> (<generic>)
  ((enable    :accessor enable-of :init-value #t)
   (hash      :accessor hash-of :init-value (make-hash-table 'equal?))))

(define-method profile-init! ((gf <profiled-generic>))
  (set! (hash-of gf) (make-hash-table 'equal?)))

(define-method profile-on! ((gf <profiled-generic>))
  (set! (enable-of gf) #t))

(define-method profile-off! ((gf <profiled-generic>))
  (set! (enable-of gf) #f))

(define-method profile-on? ((gf <profiled-generic>))
  (enable-of gf))

(define-method apply-generic ((gf <profiled-generic>) args)
  (if (profile-on? gf)
      (let ((h   (hash-of gf))
            (key (map class-of args)))
        (unless (hash-table-exists? h key)
          (hash-table-put! h key (make <profiled-data>)))
        (let1 pd (hash-table-get h key)
          (inc! (count-of pd))
          (with-time-counter (real-time-of pd)
            (with-time-counter (sys-time-of pd)
              (with-time-counter (proc-time-of pd)
                (with-time-counter (user-time-of pd)
                  (next-method)))))))
      (next-method)))

(define-method object-hash ((class <class>))
  (hash (ref class 'name)))

(define-method get-profile ((gf <profiled-generic>))
  (format #t "counts\treal\tsys\tproc\tuser\targuments~%")
  (hash-table-for-each (hash-of gf)
    (lambda (k v)
      (format #t "~d\t~d\t~d\t~d\t~d"
              (count-of v)
              (time-counter-value (real-time-of v))
              (time-counter-value (sys-time-of v))
              (time-counter-value (proc-time-of v))
              (time-counter-value (user-time-of v)))
      (format #t "\t~a~%" (string-join (map (lambda (c) (x->string (ref c 'name))) k) ",")))))

(provide "gauche/mop/prifiled-generic")

使用してみる

モジュールをuseしてからプロファイルしたい総称関数を用意。

(use gauche.mop.profiled-generic)

(define-generic add :class <profiled-generic>)

(define-method add ((n1 <number>) (n2 <number>))
  (+ n1 n2))

(define-method add ((s1 <string>) (s2 <string>))
  (string-append s1 s2))

(define-method add ((l1 <list>) (l2 <list>))
  (append l1 l2))

これでaddを使ってみよう。

gosh> (add (expt 2 100) (sin 0.9))
1.2676506002282294e30
gosh> (add "ABCDEF" "あいうえお")
"ABCDEFあいうえお"
gosh> (add (iota 10) (list <class> <integer>))
(0 1 2 3 4 5 6 7 8 9 #<class <class>> #<class <integer>>)

gosh> (get-profile add)
counts  real    sys     proc    user    arguments
1       1.31e-4 0.0     0.0     0.0     <integer>,<real>
1       1.27e-4 0.0     0.0     0.0     <pair>,<pair>
1       1.32e-4 0.0     0.0     0.0     <string>,<string>
#<undef>
gosh>

左からcallされた回数、real/system/process/userの消費時間、引数の型のつもり。