パラメータ用ミニマクロ

gauche.parameter を使うときにちょっと楽できるように。

(define-syntax define-parameter
  (syntax-rules ()
    ((_ var expr)
     (define var (make-parameter expr)))))

(define-syntax with-parameter
  (syntax-rules ()
    ((_ (param ...) body ...)
     (let ((param (param)) ...)
       body ...))))

たくさんパラメータを定義したり、使ったりするときにはタイピング量を減らせるのと、多少は見やすくなる。

(define-parameter x 1)
(define-parameter y 2)
(define-parameter z 3)

(define (sum)
  (with-parameter (x y z)
    (+ x y z)))

展開後。

(define x (make-parameter 1))
(define y (make-parameter 2))
(define z (make-parameter 3))

(define (sum)
  (let ((x (x))
        (y (y))
        (z (z)))
    (+ x y z)))

Plot

最近見つけて気に入っている、二次元データプロットソフトウェア、PlotMac OS X でデータを可視化したいとき、gnuplot や R などの UNIX 系プログラムはあったものの、GUI で手軽に使えるものが見当たらなかったのだが、Plot がその穴を埋めてくれそう。作者の方は NeXT 時代にも SciPlot というプログラムを書いていたらしい。

非常に開発が活発なので、ここ1、2ヶ月でもずいぶん機能が増えてきたのだけど、MySQL データのインポートも可能であったり(個人的には使わなそうだが)、マクロによって自動化することもできたりと、面白い機能も備えている。まだ挙動がおかしな点が多く見られるものの、十分使えるレベル。何より、Cocoa ソフトだから Quartz による美しいグラフが得られるのはありがたい。

with-slots (2)

引き続き、define-syntax を使った with-slots マクロの定義について。昨日の shiro さんのコメントを受けて修正しつつ、Common Lisp の with-slots の仕様に近づくように修正。以下のサンプルコードを用意。

(define-class <person> ()
  ((name :init-keyword :name)
   (gender :init-keyword :gender)
   (age :init-keyword :age)))

(define-method initialize ((p <person>) initargs)
  (next-method)
  (format #t "[~a] is born.~%" (slot-ref p 'name)))

(define (example-1)
  (with-slots (name gender age)
      (make <person> :name "Hoge" :gender 'male :age 20)
    (format #t "~a ~a ~d~%" name gender age)))

(define (example-2)
  (with-slots ((n1 name) (g1 gender))
      (make <person> :name "Hoge" :gender 'male)
    (with-slots ((n2 name) (g2 gender))
        (make <person> :name "Fuga" :gender 'female)
      (format #t "~a-~a, ~a-~a~%" n1 g1 n2 g2))))

(define (example-3)
  (with-slots ((n name) age) (make <person> :name "Hoge" :age 20)
    (format #t "~a is ~d years old.~%" n age)))

example-1 は昨日のものと同じ。ただしインスタンス生成は一度だけ行われるかどうかチェック。example-2 は Common Lisp の with-slots のように、束縛するシンボルも指定できるようにしたもの。example-3 は example-1 と example-2 の混合。ただし今回の with-slots ではエラーになってしまうため、今後の課題。

example-1, 2 両方に対応できるよう with-slots マクロはつぎようにしてみた。基本は example-2 に対応する形としておいて、example-1 のようにシンボルが省略された形で使われたときは、スロット名をそのままシンボルとして扱うようにして内部的に with-slots を使うように。

(define-syntax with-slots
  (syntax-rules ()
    ;; matches with examle-2   
    ((_ ((var slot) ...) expr body ...)
     (let ((obj expr))
       (let ((var (slot-ref obj 'slot)) ...)
         body ...)))
    ;; matches with example-1
    ((_ (slot ...) expr body ...)
     (with-slots ((slot slot) ...) expr body ...))))

これでテスト。

gosh> (example-1)
[Hoge] is born.
Hoge male 20
#<undef>
gosh> (example-2)
[Hoge] is born.
[Fuga] is born.
Hoge-male, Fuga-female
#<undef>

正しく動作しているようだ。先に書いたように example-3 はまだ対応できていない。

gosh> (example-3)
[Hoge] is born.
*** ERROR: object of class #<class <person>> doesn't have such slot: (n name)
Stack Trace:
_______________________________________
  0  (slot-ref obj '(n name))
        [unknown location]

もう一工夫必要そうだ。ちなみに with-slots は Emacs の場合、

(put 'with-slots 'scheme-indent-function 2)

define-syntax は直感的で良いし、パターンマッチングを採用したあたりが面白い。マッチングって以前少しだけ勉強した OCaml を思い出させる。ちなみに、Ocaml は面白いなと思ったのだけど、Scheme を使っているときのような、ノリというかツボというか、うまく表現できない感覚が得られず、結局今は使ってない。計算がむちゃくちゃ速いのはすごくいいなと思うんだけど。

with-slots

Common Lisp にある with-slots を Gauche でも使ってみる。次のクラスがあったとき、

(define-class <person> ()
  ((name :init-keyword :name)
   (gender :init-keyword :gender)
   (age :init-keyword :age)))

こんなふうに使えるようにする。

;; Example-1
(let ((hoge (make <person> :name "Hoge" :gender 'male :age 20)))
  (with-slots (name gender age) hoge
    (format #t "~a: ~a ~d~%" name gender age)))

まず define-syntax を使ってマクロを書いてみた。

(define-syntax with-slots
  (syntax-rules ()
    ((_ () obj body ...)
     (begin body ...))
    ((_ (slot1 slot2 ...) obj body ...)
     (let ((slot1 (slot-ref obj 'slot1)))
       (with-slots (slot2 ...) obj body ...)))))

Example-1 を評価した限り、うまく動いているように見える。しかし次のような場合はどうか。

;; Example-2
(with-slots (name gender age)
    (make <person> :name "Hoge" :gender 'male :age 20)
  (format #t "~a: ~a ~d~%" name gender age))

これだとスロットが展開されるたびに インスタンスが作られてしまう。 の初期化でメッセージを出すようにしてみる。

(define-method initialize ((p <person>) initargs)
  (next-method)
  (format #t "[~a] initialized.~%" (slot-ref p 'name)))

with-slots で指定した数だけ initialize が呼び出されるのがわかる。

たぶん、define-syntax でもこういう場合の回避方法はあるんだろうが、今のところ不明なので define-macro でマクロを書くことにした(追記: shiro さんのコメント参照)。こちらは Common Lisp のマクロの書き方がそのまま参考になる。

(define-macro (with-slots slots obj . body)
  (let ((gobj (gensym)))
    `(let ((,gobj ,obj))
       (let ,(map (lambda (slot)
                    `(,slot (slot-ref ,gobj ',slot)))
                  slots)
         ,@body))))

今度は最初に一回だけ obj を評価して展開するので Example-2 でも問題ない。

Common Lisp の with-slots は束縛するシンボルも指定できる。

(with-slots ((name1 name) (age1 age)) person1
  (with-slots ((name2 name) (age2 age)) person2
    ;; ...
    ))

でも今回は省略。

Carbon Emacs 'mac-option-modifier'

銭谷さんの Carbon Emacs パッケージを12月版からテスト版へ更新。いつの間にか option キーを Meta キーとして使うオプション変数 mac-command-key-is-meta が使えなくなっていた(本家CVSの変更?)。*.el ファイルを grep してそれっぽい変数を発見。

(setq mac-option-modifier 'meta)

で設定できた。

Gauche を C プログラムから使う

libgauche をリンクすればできるみたい。http://www.practical-scheme.net/wiliki/wiliki.cgi?Gauche%3AYAGHG%3AIntroduction を参考に、外部の scheme コードをロードして結果を表示するプログラムを書いてみた。
main.c で同じディレクトリにある test.scm をロードして、関数 test を評価。結果は と決めうち。

/* main.c */
#include <stdio.h>
#include <gauche.h>

ScmObj test()
{
    Scm_Load("./test", 0);
    ScmObj expr = Scm_ReadFromCString("(test)");
    return Scm_Eval(expr, SCM_OBJ(Scm_UserModule()));
}

int main()
{
    GC_INIT();
    Scm_Init(GAUCHE_SIGNATURE);

    ScmObj result = test();
    printf("%d?n", SCM_INT_VALUE(result));
    
    Scm_Exit(0);
    return 0;
}

ロードされる test.scm はこれだけ。

;;; test.scm
(define (test)
  (+ 1 2))

最後にとりあえずの Makefile

INCLUDE = -I/opt/local/lib/gauche/0.8.6/include
LIBS = -lpthread -lm -lgauche
LIBDIR = -L'/opt/local/lib/gauche/0.8.6/powerpc-apple-darwin8.3.0' -L/opt/local/lib

main: main.c
	cc $(INCLUDE) $(LIBDIR) $(LIBS) -o $@ $<

make して実行。

$ ./main 
3

Gauche でモデルは素早く楽して作ってライブラリにしておいて、Cocoa (Objective-C) でユーザーインタフェースはさくっと作って、ライブラリをロードするような場面を想定している。

マクロを使ったジェネリック関数宣言の一例

x, y 座標をスロットに持つ vec クラスを考える。Common Lisp では次のような定義になる。

(defclass vec ()
  ((x :initarg :x :initform 0d0 :accessor vec-x)
   (y :initarg :y :initform 0d0 :accessor vec-y)))

ついでに factory も定義しておく。

(defun make-vec (x y)
  (make-instance 'vec :x x :y y))

この vec のインスタンス同士で四則演算を行いたいので次のような関数を考える。

(defun v+ (v1 v2)
  (make-vec (+ (vec-x v1) (vec-x v2))
	    (+ (vec-y v1) (vec-y v2))))

もちろん v1, v2 を vec のインスタンスに限らずに、スカラー値も渡したいのでジェネリック関数として定義しておいて、オブジェクトによって使う関数を変えることにする。

(defgeneric v+ (a b)
  (:documentation "..."))
(defmethod v+ ((a vec) (b vec))
  (make-vec (+ (vec-x a) (vec-x b))
	    (+ (vec-y a) (vec-y b))))
(defmethod v+ ((a vec) b)
  (make-vec (+ (vec-x a) b)
	    (+ (vec-y a) b)))
(defmethod v+ (a (b vec))
  (make-vec (+ a (vec-x b))
	    (+ a (vec-y b))))

これで

(v+ (make-vec 1d0 2d0) (make-vec 0d0 0d0))	;; => (1d0, 2d0)
(v+ 1d0 (make-vec 1d0 1d0))	     		;; => (2d0, 2d0)
(v+ (make-vec 1d0 0d0) 3d0)			;; => (4d0, 3d0)

のように汎用的に使えるようになった。

しかし、一連の defmethod の定義をそれぞれの演算子に対して行うのは面倒だ。パターンを見つけたらマクロを使う。defvec-op マクロは関数名と関数を引数として、上で定義したような複数のジェネリック関数に展開してくれるマクロとする。途中は省略して、最終的なマクロは次のようになった。

(defmacro defvec-op (method proc &optional (doc nil))
  `(progn
     (defgeneric ,method (a b)
       (:documentation ,doc))
     (defmethod ,method ((a vec) (b vec))
       (make-vec (funcall ,proc (vec-x a) (vec-x b))
		 (funcall ,proc (vec-y a) (vec-y b))))
     (defmethod ,method ((a vec) b)
       (make-vec (funcall ,proc (vec-x a) b)
		 (funcall ,proc (vec-y a) b)))
     (defmethod ,method (a (b vec))
       (make-vec (funcall ,proc a (vec-x b))
		 (funcall ,proc a (vec-y b))))))

このマクロを使って、四則演算を定義しよう。

(defvec-op v+ #'+)
(defvec-op v- #'-)
(defvec-op v* #'*)
(defvec-op v/ #'/)

めでたしめでたし。
さて、同じようなことを Scheme でもやってみたい。Scheme には標準仕様としてのオブジェクト・システムが存在しないのでここでは Gauche を代表例にする。Scheme のマクロはまだよくわからない事も多く、果たして正しい書き方か不安だが次のように書いてみた。

(define-class <vec> ()
  ((x :init-value 0.0 :init-keyword :x :accessor vec-x)
   (y :init-value 0.0 :init-keyword :y :accessor vec-y)))

(define (make-vec x y)
  (make <vec> :x x :y y))

(define-syntax define-vec-op
  (syntax-rules ()
    ((_ method proc)
     (begin
       (define-generic method)
       (define-method method ((a <vec>) (b <vec>))
         (make-vec (proc (vec-x a) (vec-x b))
                   (proc (vec-y a) (vec-y b))))
       (define-method method ((a <vec>) b)
         (make-vec (proc (vec-x a) b)
                   (proc (vec-y a) b)))
       (define-method method (a (b <vec>))
         (make-vec (proc a (vec-x b))
                   (proc a (vec-y b))))))))

(define-vec-op v+ +)
(define-vec-op v- -)
(define-vec-op v* *)
(define-vec-op v/ /)

Scheme の define-syntax は Common Lisp のマクロと違って、変数の面倒を見てくれるので楽だし、見やすい。さきほどの Common Lisp 版も一続きのコードとして再掲する。

(defclass vec ()
  ((x :initarg :x :initform 0d0 :accessor vec-x)
   (y :initarg :y :initform 0d0 :accessor vec-y)))

(defun make-vec (x y)
  (make-instance 'vec :x x :y y))

(defmacro defvec-op (method proc &optional (doc nil))
  `(progn
     (defgeneric ,method (a b)
       (:documentation ,doc))
     (defmethod ,method ((a vec) (b vec))
       (make-vec (funcall ,proc (vec-x a) (vec-x b))
		 (funcall ,proc (vec-y a) (vec-y b))))
     (defmethod ,method ((a vec) b)
       (make-vec (funcall ,proc (vec-x a) b)
		 (funcall ,proc (vec-y a) b)))
     (defmethod ,method (a (b vec))
       (make-vec (funcall ,proc a (vec-x b))
		 (funcall ,proc a (vec-y b))))))
		 
(defvec-op v+ #'+)
(defvec-op v- #'-)
(defvec-op v* #'*)
(defvec-op v/ #'/)

やはり、Scheme の方が全体として美しい。Scheme の関数と変数の名前空間を一緒に扱う設計によってより簡潔になっている。