SICP 読み (397) 5.5 翻訳系 - yamanetoshi's diary

今日は残りの

STRING
SYMBOL
NUMBER

をヤッツける事に。こっから先は gauche-0.1 をカンニング OK という事を自分で許可。通勤途上で STRING はスルーしてやるか、と思ったりしたんですが、とりあえずヤッてみます。

STRING

まず STRING から。gauche.h 見てて最初に出てくる関数は Scm_MakeStringConst() なんでソコからチェキ。Constructors なククリで定義されている一連の手続きが以下

ScmObj Scm_MakeStringConst(const char *str, int size, int len)
ScmObj Scm_MakeString(const char *str, int size, int len)
ScmObj Scm_MakeFillString(int len, ScmChar fill)
static ScmObj makestring_from_list(ScmObj chars)
ScmObj Scm_MakeStringFromList(ScmObj chars)
char *Scm_GetString(ScmString *str)
const char *Scm_GetStringConst(ScmString *str)
ScmObj Scm_CopyString(ScmString *x)

とりあえずこんだけありゃ十分じゃね? って気もしますが (を
以下、順に控えを

Scm_MakeStringConst()

Const がケツに付いてるのとそうでないソレの違いは何だろう。SCM_NEW_ATOMIC2 と memcpy が Const 方面には無い。てーコトは Scm_MakeStringConst() は

Scm_MakeStringConst("abcde", -1, -1);

みたいなカンジで使われるのかな。セグメントで言えばデータセグメント、みたいなソレかなぁ。違うや。文字列な領域をヒープに取るかそうでないか、の違いだな。あるいは size と len という変数がございますが、count_size_and_length() 関数の中を見る限りでは

len は文字数
size は領域のサイズ

という形になってる模様。基本的に len と size には 0 未満を指定しておいてあげれば安全にそれぞれの属性値が正しく設定されるように見えます。あとは INITSTR というマクロで

ScmString な領域確保
クラスのセット
属性値のセット

されて SCM_OBJ マクロでくるんで戻すカンジ。string.c 作って試験書いてみよ。
とりあえず count_length() と count_size_and_length() は static なソレなので試験から呼び出せん。MakeString* なソレで吸収する方向で。あとマルチバイトなソレはスルーな方向で。

エラー処理

簡単な試験を書いて make したらエラーが続々でた。しかもついに Scm_Error() が未定義との事。むむむ、とウナりつつ、これもパクる事に。(こら
しかもこれは別途チェキとゆーコトでもの凄いヤッツケ状態だなこりゃ。しかも今度はパクッた error.c のコンパイルで色々怒られる。これは参った芋ヅル式。しかも Scm_Error() において vm がお出ましになられました。とりあえず Scm_Error() な方々は空で定義してみる事に。なんか乱暴だなぁ。

とほほ

eazy にパクりまくってるので port とか vm とかその他モロモロ不整合起きまくり。事態の収拾まで時間かかりそげ。やっぱキチンとやんないと駄目だ。
って SCM_DEFCLASS で

SCM_DEFCLASS(Scm_StringClass, "<string>", string_print, 
             SCM_CLASS_SEQUENCE_CPL);

をそのまんまコピってるから問題が出るんだな。

SCM_DEFCLASS(Scm_StringClass, "<string>", NULL, NULL);

でどうか。例外クラスも定義されている模様ですが同様の対処で何とか試験の実行まで到達。ちなみに試したのは以下。

void test_scheme_Scm_MakeStringConst(void)
{
	ScmObj obj;
	char *str = "abcde";
	obj = Scm_MakeStringConst(str, -1, -1);
	CU_ASSERT_EQUAL(5, SCM_STRING_LENGTH(obj));
	CU_ASSERT_EQUAL(5, SCM_STRING_SIZE(obj));
	CU_ASSERT_EQUAL(str, SCM_STRING_START(obj));
}

void test_scheme_Scm_MakeString(void)
{
	ScmObj obj;
	char *str = "abcde";
	obj = Scm_MakeString(str, -1, -1);
	CU_ASSERT_EQUAL(5, SCM_STRING_LENGTH(obj));
	CU_ASSERT_EQUAL(5, SCM_STRING_SIZE(obj));
	CU_ASSERT_NOT_EQUAL(str, SCM_STRING_START(obj));
}

size やら len のあたりの確認微妙ですが、最低限の確認はできているかな、と。メシ食って続きに取りかかる予定。

続き

次は Scm_MakeFillString() ですが、これはいきなり試験書いてしまえ。

void test_scheme_Scm_MakeFillString(void)
{
    int len = 10;
    ScmObj obj, c;
    c = SCM_MAKE_CHAR('a');
    obj = Scm_MakeFillString(len, (SCM_CHAR(c)));
    CU_ASSERT_EQUAL(len, SCM_STRING_LENGTH(obj));
    CU_ASSERT_EQUAL(len, SCM_STRING_SIZE(obj));
    CU_ASSERT_EQUAL(0, strcmp("aaaaaaaaaa", SCM_STRING_START(obj)));
}

キタナらしいけどご愛嬌ってコトで。しかも試験にパスしない。パクッたナニに無理矢理手を入れて試験を通した。
次の MakeStringFromList() は文字のみからなるリストから文字列を作る模様

リストの char な要素の数を調べ (マルチバイト対応??)
必要なサイズ分の領域確保
再度リストの各要素から文字を取り出してコピー
MakeStringConst() を戻す

な形。Scm_Error() は空なのでエラーケイスは略ってコトで以下が試験

void test_scheme_Scm_MakeStringFromList(void)
{
    ScmObj base, obj;
    base = Scm_List(SCM_MAKE_CHAR('a'),
                    SCM_MAKE_CHAR('b'),
                    SCM_MAKE_CHAR('c'),
                    SCM_MAKE_CHAR('d'),
                    SCM_NIL);
    obj = Scm_MakeStringFromList(base);
    CU_ASSERT_EQUAL(Scm_Length(base), SCM_STRING_LENGTH(obj));
    CU_ASSERT_EQUAL(Scm_Length(base), SCM_STRING_SIZE(obj));
    CU_ASSERT_EQUAL(0, strcmp("abcd", SCM_STRING_START(obj)));
}

Scm_GetString()

ラスト三つ。これは領域を確保してコピーした後に戻している。

void test_scheme_Scm_GetString(void)
{
    char *str = "abcdefg";
    ScmObj obj = Scm_MakeStringConst(str, -1, -1);
    char *test = Scm_GetString(SCM_STRING(obj));

    CU_ASSERT_NOT_EQUAL(str, test);
    CU_ASSERT_EQUAL(0, strcmp(str, SCM_STRING_START(obj)));
}

Scm_GetStringConst()

こっちはなんか不思議なコードが書いてある

ScmString オブジェクトが持っている文字列の末端 (って言って良いのかなぁ) がヌルストップな場合には先頭アドレスそのまま返却
そうでない場合には領域確保 (size + 1) して size 分コピッた後にいっちゃんケツに '\0' 付けて返却

これも通常のケイスのみ試験確認ってコトで。

void test_scheme_Scm_GetStringConst(void)
{
    char *str = "abcdefg";
    ScmObj obj = Scm_MakeStringConst(str, -1, -1);
    char *test = Scm_GetStringConst(SCM_STRING(obj));

    CU_ASSERT_EQUAL(str, test);
    CU_ASSERT_EQUAL(0, strcmp(str, SCM_STRING_START(obj)));
}

Scm_CopyString()

これで最後。これはオブジェクトのコピーになっている。でも文字列は同じ領域を指している模様。

void test_scheme_Scm_CopyString(void)
{
    ScmObj base = Scm_MakeStringConst("abcdefg", -1, -1);
    ScmObj test = Scm_CopyString(SCM_STRING(base));

    CU_ASSERT_EQUAL(SCM_STRING_SIZE(base), SCM_STRING_SIZE(test));
    CU_ASSERT_EQUAL(SCM_STRING_LENGTH(base), SCM_STRING_LENGTH(test));
    CU_ASSERT_EQUAL(SCM_STRING_START(base), SCM_STRING_START(test));
}

これで STRING は終了。作業進める中で必要なものが出てきたら随時追加ってコトで。

SYMBOL

どうしよう。これも作って名前が取れればとりあえず良しとしておきます。と言いつつ Scm_Intern() の中身を見てると

オブジェクトは HashTable (中身未確認) で管理
Intern なリクエストがあっても HashTable にあれば云々

たしかに複数あったり探しにくかったりな管理は必要です。単純にパクッとイケれば良いのですが ...
どうしたものやら

配列はあらかじめ準備した領域に収まりきらなくなった場合、再度作成する手間がかかりすぎ
リストはオーバーフロー時の手間はそうでもないけど直接アクセス不可能 (これは配列も同様
Hash は直接アクセル可能。でも実装が面倒

リストにするとしたらどんなが良いのか。とりあえず Scm なオブジェクトでなくても良い事にして

struct SymbolList {
    ScmObj val;
    struct SymbolList *next;
};

みたいなカンジであとは探索かけてヒットしたら戻す手続きと追加する手続きがあれば良いでしょうか。うーん。リスト先頭ってグローバルにしたくない。

static struct SymbolList *top = NULL, *end = NULL;
struct SymbolList *symbol_list_search(ScmObj key)
{
    struct SymbolList *ptr = top;
    for(; ptr; ptr = ptr->next) {
        if(SCM_EQ(ptr->val, key)) return ptr;
    }
    return ptr;
}
void symbol_list_put(ScmObj obj)
{
    struct SymbolList *ptr = SCM_NEW(struct SymbolList);
    if(top == NULL) {
        top = ptr;
    }
    if(end == NULL) {
        end = top;
    } else {
        end->next = ptr;
        end = ptr;
        ptr->next = NULL
    }
    ptr->val = obj;
}

微妙。これはなんつーかリストのハンドルなソレ的に微妙な気がするのは気のせいでしょうか。とりあえず上記を symbol.c に取り込んで試験をどうしよう。一応上記の手続きは static なソレにしておいて Scm_Intern() で何とかする方向で。
で、色々とノタウチ回った挙句に以下のような試験にパスするようにはなりました。

void test_scheme_Scm_Intern(void)
{
    ScmObj obj, newobj, newerobj;
    obj = Scm_Intern(SCM_MAKE_STR("quote"));
    CU_ASSERT_TRUE(SCM_SYMBOLP(obj));

    newobj = Scm_Intern(SCM_MAKE_STR("quote"));
    CU_ASSERT_TRUE(SCM_SYMBOLP(newobj));
    CU_ASSERT_EQUAL(newobj, obj);

    newerobj = Scm_Intern(SCM_MAKE_STR("XXX"));
    CU_ASSERT_TRUE(SCM_SYMBOLP(newerobj));
    CU_ASSERT_NOT_EQUAL(newerobj, obj);
}

string.c に StringEqual な関数盛り込み (これはパクりました

ScmObj Scm_StringEqual(ScmString *x, ScmString *y)
{
    int sizx = SCM_STRING_SIZE(x);
    int sizy = SCM_STRING_SIZE(y);
    if (sizx == sizy) {
        if (memcmp(SCM_STRING_START(x), SCM_STRING_START(y), sizx) == 0) {
            return SCM_TRUE;
        }
    }
    return SCM_FALSE;
}

現時点での symbol.c の状態が以下

#include "gauche.h"

SCM_DEFCLASS(Scm_SymbolClass, "<symbol>", NULL, NULL);

struct SymbolList {
    ScmObj val;
    struct SymbolList *next;
};

#define INITSYM(sym, nam)                       \
    sym = SCM_NEW(ScmSymbol);                   \
    SCM_SET_CLASS(sym, SCM_CLASS_SYMBOL);       \
    sym->name = SCM_STRING(nam)

static struct SymbolList *top = NULL, *end = NULL;
struct SymbolList *symbol_list_search(ScmString *key)
{
    struct SymbolList *ptr = top;
    for(; ptr != NULL; ptr = ptr->next) {
        if(SCM_TRUEP(Scm_StringEqual((SCM_SYMBOL(ptr->val))->name, key))) return ptr;
    }
    return ptr;
}
void symbol_list_put(ScmObj obj)
{
    struct SymbolList *ptr = SCM_NEW(struct SymbolList);
    if(top == NULL) {
        top = ptr;
    }
    if(end == NULL) {
        end = top;
    } else {
        end->next = ptr;
        end = ptr;
        ptr->next = NULL;
    }
    ptr->val = obj;
}

ScmObj Scm_Intern(ScmString *name)
{
    struct SymbolList *e = symbol_list_search(name);
    if(e) return e->val;
    else {
        ScmSymbol *sym;
        INITSYM(sym, Scm_CopyString(name));
        symbol_list_put(SCM_OBJ(sym));
        return SCM_OBJ(sym);
    }
}

symbol.c の中で作った SymbolList は探索するはず、って思っていたのですが、それらしい手続きが元にはどこにも無いように見える。うーん。
GLOC ってヤツはスルー方針ってコトで

NUMBER

これも手抜き気味に。

小さい整数 (FIXNUM)
大きい整数 (BIGNUM)
実数 (FLONUM)
虚数 (COMPLEX)

これは number.c をパクって試験だけ書くか。