objectマクロを非R5RSマクロで

今回は勝手にシンボルをでっちあげて、新しい名前を作ってみる。
271ページの

例えば構造体を定義するマクロdefine-structを定義することを考えます。fileという構造体を定義し、それがnameというスロットを持つ場合、自動的にfile-nameというスロットアクセス手続きを定義したい、と思うかもしれません。

ってのは、C++やらC#やらJavaやらで例えると、fileっていうクラスにnameっていうフィールドを定義したら、自動的にgetFileNameやsetFileNameみたいなアクセサも自動で定義したい、みたいな感じなのかな。
だったら、define-structに引数として与えられるであろうシンボル(例えばfileという式)を使ってfile-nameというシンボルが作れればいい、というお話になるのかな?


ということで、id:yagiey:20100210:1265827551で出てきたobjectマクロに、第1引数で与えたフィールドへのアクセサを自動生成してやる機能を追加して、非R5RSマクロで定義してみる。
いきなりやると混乱するので、まずはアクセサget-○○○のみマクロで生成してやることにした。

(define-macro (object args . methods)
  `(lambda ,args
     (lambda (mname . margs)
       ,(cons 'case
         (cons 'mname
          (map (lambda (e) `((,e) ,e)) args))))))

こんなかんじ。get-○○○にしたかったけど、シンボルの連結の方法が分からなかったのでやめた。
このマクロを使うときは、こう。

gosh> (define make-account (object (owner balance)))
make-account
gosh> 
(define acc (make-account "yagiey" 42000))
acc
gosh> (acc 'owner)
"yagiey"
gosh> (acc 'balance)
42000

うん、ちゃんとメソッドができてるみたいだ。
symbol->stringで文字列にして、"get-"とstring-join string-appendして、改めてstring->symbolしてやればget-○○○っていう名前ができそうだなぁ。後で気づいた。


じゃあ、もともとあったメソッド定義の機能も追加してあげよう。
caseの中身が増えるだけだからmapの戻り値をappendしてやった。

(define-macro (object args . methods)
  `(lambda ,args
     (lambda (mname . margs)
       ,(cons 'case
          (cons 'mname
            (append
              ;; このmapはアクセサの自動生成のため
              (map (lambda (e) `((,e) ,e)) args)
              ;; このmapはマクロ使用時に定義されたメソッドのため
              (map
                (lambda (e)
                  `((,(car e))
                    (apply
                      (lambda ,(cadr e) ,(caddr e))
                      margs)))
                methods)))))))

つかってみる。

gosh> (define make-account
        (object (owner balance)
          (show () (begin (print owner "'s balance: " balance) #t))
          (deposit (amount) (begin (inc! balance amount) balance))
          (withdraw (amount) (begin (dec! balance amount) amount))))
make-account
gosh> (define acc (make-acc "yagiey" 42000))
acc
gosh> (acc 'owner)
"yagiey"
gosh> (acc 'balance)
42000
gosh> (acc 'show)
yagiey's balance: 42000
#t
gosh> (acc 'deposit 500)
42500
gosh> (acc 'withdraw 1500)
1500
gosh> (acc 'show)
yagiey's balance: 41000
#t

いいんじゃないかなー。