Gauche の拡張ライブラリでクラスを定義する

lisp scheme gauche

Gauche の拡張ライブラリで、自分でクラスを定義する方法、というよりメモとしてのテンプレート。正しい手順か不明だけど、とりあえず動く。

安直だけど、"clos" という名前の拡張ライブラリを書くとして、Scheme で書くと次のような定義になるようにする。

(define-class <person> ()
  ((name :init-value "Anonymous")
   (age  :init-value 20)))

拡張ライブラリのヘッダファイル clos.h の宣言。

typedef struct ScmPersonRec {
    SCM_HEADER;
    ScmObj name;
    int age;
} ScmPerson;

SCM_CLASS_DECL(Scm_PersonClass);
#define SCM_CLASS_PERSON	(&Scm_PersonClass)
#define SCM_PERSON(obj)		((ScmPerson*)obj)
#define SCM_PERSON_P(obj)	SCM_XTYPEP(obj, &Scm_PersonClass)

// ScmObj Scm_MakePerson(void);

構造体を使ってクラスのスロットを用意。さらに、マクロ。命名規則は gauche.h で使われているものを参考にした。最後のコメントアウトされている Scm_MakePerson は、gosh 側で を使うときには必要なく、拡張ライブラリ内で を作りたいときに使うので、今回は省略。

次に clos.c。

static ScmObj person_allocate(ScmClass *klass, ScmObj initargs);

SCM_DEFINE_BUILTIN_CLASS(Scm_PersonClass,
			 NULL, NULL, NULL,
			 person_allocate,
			 NULL);

static ScmObj person_allocate(ScmClass *klass, ScmObj initargs)
{
    ScmPerson *p = SCM_NEW(ScmPerson);
    SCM_SET_CLASS(p, SCM_CLASS_PERSON);
    p->name = SCM_MAKE_STR("Anonymous");
    p->age = 20;
    return SCM_OBJ(p);
}

static ScmObj person_name(ScmPerson *p)
{
    return p->name;
}

static ScmObj person_age(ScmPerson *p)
{
    return SCM_MAKE_INT(p->age);
}

static void set_person_name(ScmPerson *p, ScmObj val) {
    if (SCM_STRINGP(val)) {
	p->name = val;
    } else {
	Scm_Error("slot name  must be a string.?n");
    }
}

static ScmClassStaticSlotSpec person_slots[] = {
    SCM_CLASS_SLOT_SPEC("name", person_name, set_person_name),
    SCM_CLASS_SLOT_SPEC("age", person_age, NULL),
    { NULL }
};

クラスのアロケーションに使われる関数が person_allocate。スロットの初期値もここでセットしておく。 クラスのスロットを slot-ref を使ってアクセスしたい場合は、getter / setter 用の関数も用意する必要がある。 をインクルードする必要あり。今回は、name スロットについては両方用意してみた。age は getter のみだが、int を ScmObj でくるんで返す。スロットを完全に隠蔽するなら、必要ない。最後に、モジュールの初期化関数内で、Scm_InitStaticClass を使ってクラスを初期化（登録？）する。

ScmObj Scm_Init_clos(void)
{
    ScmModule *mod;

    /* Register this DSO to Gauche */
    SCM_INIT_EXTENSION(clos);

    /* Create the module if it doesn't exist yet. */
    mod = SCM_MODULE(SCM_FIND_MODULE("clos", TRUE));

    Scm_InitStaticClass(SCM_CLASS_PERSON, "<person>", mod, person_slots, 0);

    /* Register stub-generated procedures */
    Scm_Init_closlib(mod);
}

今回 closlib.stub はノータッチ。clos.scm で シンボルをエクスポートして終わり。

gosh からテスト。

gosh> (use clos)
#<undef>
gosh> (d <person>)
#<class <person>> is an instance of class <class>
slots:
  name      : <person>
  cpl       : (#<class <person>> #<class <top>>)
  direct-supers: (#<class <top>>)
  accessors : ((age . #<slot-accessor <person>.age native :age>) (name . #
  slots     : ((name :allocation :builtin :slot-accessor #<slot-accessor <
  direct-slots: ((name :allocation :builtin :slot-accessor #<slot-accessor <
  num-instance-slots: 0
  direct-subclasses: ()
  direct-methods: ()
  initargs  : ()
  defined-modules: ()
  redefined : #f
  category  : builtin
gosh> (define *p* (make <person>))
*p*
gosh> (slot-ref *p* 'name)
"Anonymous"
gosh> (set! (slot-ref *p* 'name) "tomapd")
#<undef>
gosh> (slot-ref *p* 'name)
"tomapd"
gosh> (set! (slot-ref *p* 'age) 0)
*** ERROR: slot age of class #<class <person>> is read-only
Stack Trace:
_______________________________________
  0  (set! (slot-ref *p* 'age) 0)
        At line 7 of "(stdin)"
  1  (set! (slot-ref *p* 'age) 0)
        At line 7 of "(stdin)"

動いた。

gosh> (d (make <person> :name "tomapd" :age 24))
#<<person> 0x696ec0> is an instance of class <person>
slots:
  name      : "tomapd"
  age       : 20

setter を定義したスロットについては、:init-keyword としても使えるみたい。