gauche の oo

今まで gauche のオブジェクトシステム周りはスルーしてきましたが、何かと使う機会が出てきました。なので、プログラミング Gauche の「総称関数とオブジェクト」のところを再読・写経などしてます。MOP（メタオブジェクトプロトコル）すごいですね。CLOS！CLOS！CLOS！すごくメタメタしいですね。アスペクト指向っぽいことも超お手軽ですね。

以前、@s1mple さんに見せてもらった Common Lisp オブジェクトシステム をもう一度読んでみたくなりました。

ここの o/r mapper すごいすね。

• GaucheでRDBプログラミング － ＠IT

ちゃんとドキュメント読んでみよう。

• Gauche ユーザリファレンス: 7. オブジェクトシステム
• Gauche ユーザリファレンス: 2.5 統合されたオブジェクトシステム
• Gauche:スロットアクセス
• すべてオブジェクトである (もしそれがお望みなら) - karetta.jp

プログラミングGauche を見ながら写経してみたコードをつらつらと。

;; programming gauche - P.248

(define-class <count-instance-meta> (<class>)
  ((num-of-instance :init-value 0)))

(define-class <count-instance-mixin> ()
  ()
  :metaclass <count-instance-meta>)

(define-method make ((klass <count-instance-meta>) . initargs)
  (inc! (~ klass 'num-of-instance))
  (next-method))

(define-class <myclass> (<count-instance-mixin>)())

(make <myclass>)

(~ <myclass> 'num-of-instance)
;; -> 1

(make <myclass>)

(~ <myclass> 'num-of-instance)
;; -> 2

(define-class <logger-generic> (<generic>)())

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

(define-method apply-generic ((gf <logger-generic>) args)
  (format #t "args: ~s\n" args)
  (let ((return-value (next-method)))
    (format #t "result: ~s\n" return-value)
    return-value))

(define-method add ((num1 <number>)(num2 <number>))
  (+ num1 num2))

(add 3 4)
;; args: (3 4)
;; result: 7
;; 7

(use gauche.time)

(define-class <profiler-generic> (<logger-generic>)
  ((counter :init-value 0)
   (time :init-form (make <real-time-counter>))))

(define-generic sub :class <profiler-generic>)

(define-method apply-generic ((gf <profiler-generic>) args)
  (inc! (~ gf 'counter))
  (with-time-counter (~ gf 'time)(next-method)))

(define-method sub ((num1 <number>)(num2 <number>))
  (- num1 num2))

(define-method get-profile ((gf <profiler-generic>))
  (format #t "~s: ~d times called and spent time ~d\n"
          (~ gf 'time)(~ gf 'counter)
          (time-counter-value (~ gf 'time))))

(define-method init-profile ((gf <profiler-generic>))
  (set! (~ gf 'counter) 0)
  (set! (~ gf 'time)(make <real-time-counter>)))


(use srfi-1)

(init-profile sub)

(define val (with-output-to-string
              (^ _ (map sub
                        (iota 10000 100 3)
                        (iota 10000 100 5)))))

(get-profile sub)
;; #<<real-time-counter>   0.836>: 10000 times called and spent time 0.8360000000000006

(define-class <profiler-generic> (<generic>)
  ((counter :init-value 0)
   (time :init-form (make <real-time-counter>))))

(define-class <logger-profiler-generic>
  (<logger-generic> <profiler-generic>)())

(define-generic mul :class <logger-profiler-generic>)

(define-method mul ((num1 <number>)(num2 <number>))
  (* num1 num2))

(init-profile mul)

(define val (with-output-to-string
              (^ _ (map mul
                        (iota 10000 100 3)
                        (iota 10000 100 5)))))

(get-profile mul)
;; #<<real-time-counter>   0.339>: 10000 times called and spent time 0.33900000000000025