SICP 読み (386) 5.5 翻訳系

今日は休暇を頂いているのでヤリたい放題 (何
最初の用件がとりあえず済んだので作業着手。SCM_APPEND なんちゃらなマクロから。とは言え、SCM_APPEND1 と SCM_APPEND の違いは何なのか。

#define SCM_APPEND1(start, last, obj)                           \
    do {                                                        \
        if (SCM_NULLP(start)) {                                 \
            (start) = (last) = Scm_Cons((obj), SCM_NIL);        \
        } else {                                                \
            SCM_SET_CDR((last), Scm_Cons((obj), SCM_NIL));      \
            (last) = SCM_CDR(last);                             \
        }                                                       \
    } while (0)

#define SCM_APPEND(start, last, obj)                    \
    do {                                                \
        ScmObj list_SCM_GLS = (obj);                    \
        if (SCM_NULLP(start)) {                         \
            (start) = (list_SCM_GLS);                   \
            if (!SCM_NULLP(list_SCM_GLS)) {             \
                (last) = Scm_LastPair(list_SCM_GLS);    \
            }                                           \
        } else {                                        \
            SCM_SET_CDR((last), (list_SCM_GLS));        \
            (last) = Scm_LastPair(last);                \
        }                                               \
    } while (0)

1 の方は cons してるんで名前の通り、obj がピンと見て良いのかな。SCM_NULLP(start) な時の処理が微妙に違う。

gosh> (cons '() '())
(())
gosh> (append '() '())
()
gosh> 

みたいな感じに見えるのですが大丈夫かなぁ。(誰
とりあえず試験を作ってみます。

で

ここまで作った時点で Scm_LastPair() が必要な事に気づく。

void test_gauche_SCM_APPEND1(void)
{
	/* start is NIL, obj is NIL */
	{
		ScmObj start = SCM_NIL, end, obj = SCM_NIL;
		SCM_APPEND1(start, end, obj);
		CU_ASSERT_TRUE(SCM_PAIRP(start));
		CU_ASSERT_TRUE(SCM_PAIRP(end));
		CU_ASSERT_EQUAL(SCM_NIL, SCM_CAR(start));
		CU_ASSERT_EQUAL(SCM_NIL, SCM_CDR(start));
	}

	/* start is NIL, obj is 5 */
	{
		ScmObj start = SCM_NIL, end, obj = SCM_MAKE_INT(5);
		SCM_APPEND1(start, end, obj);
		CU_ASSERT_TRUE(SCM_PAIRP(start));
		CU_ASSERT_TRUE(SCM_PAIRP(end));
		CU_ASSERT_EQUAL(5, SCM_INT_VALUE(SCM_CAR(start)));
		CU_ASSERT_EQUAL(SCM_NIL, SCM_CDR(start));
	}

	/* start is '(1 2 3), obj is 5 */
	{
		ScmObj start, end, obj = SCM_MAKE_INT(5);
		end = Scm_Cons(SCM_MAKE_INT(3), SCM_NIL);
		ScmObj tmp = Scm_Cons(SCM_MAKE_INT(2), end);
		start = Scm_Cons(SCM_MAKE_INT(1), tmp);

		CU_ASSERT_EQUAL(3, SCM_INT_VALUE(SCM_CAR(end)));
		CU_ASSERT_EQUAL(SCM_NIL, SCM_CDR(end));

		SCM_APPEND1(start, end, obj);

		CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(start)));
		CU_ASSERT_EQUAL(2, SCM_INT_VALUE(SCM_CAR(SCM_CDR(start))));
		CU_ASSERT_EQUAL(3, SCM_INT_VALUE(SCM_CAR(SCM_CDR(SCM_CDR(start)))));
		CU_ASSERT_EQUAL(5, SCM_INT_VALUE(SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(start))))));

		CU_ASSERT_EQUAL(5, SCM_INT_VALUE(SCM_CAR(end)));
		CU_ASSERT_EQUAL(SCM_NIL, SCM_CDR(end));
	}
}

void test_gauche_SCM_APPEND(void)
{
	/* start is NIL, obj is NIL */
	{
		ScmObj start = SCM_NIL, end, obj = SCM_NIL;
		SCM_APPEND(start, end, obj);
		CU_ASSERT_EQUAL(SCM_NIL, start);
	}

	/* start is NIL, obj is '(1) */
	{
		ScmObj start = SCM_NIL, end, obj = Scm_Cons(SCM_MAKE_INT(1), SCM_NIL);

		SCM_APPEND(start, end, obj);

		CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(start)));
	}
}

だらだらヤッてる訳ではないんですが自宅でヤるとペース微妙。とり急ぎ作った Scm_LastPair() が以下で

ScmObj Scm_LastPair(ScmObj list)
{
	for(; SCM_PAIRP(SCM_CDR(list)); list = SCM_CDR(list));
	return list;	
}

試験が以下

void test_scheme_Scm_LastPair(void)
{
	/* '(1) */
	ScmObj obj = Scm_Cons(SCM_MAKE_INT(1), SCM_NIL);
	CU_ASSERT_TRUE(SCM_EQ(obj, Scm_LastPair(obj)));

	/* '(2 1) */
	ScmObj obj2 = Scm_Cons(SCM_MAKE_INT(2), obj);
	CU_ASSERT_TRUE(SCM_EQ(obj, Scm_LastPair(obj2)));
}

なんか_とりあえず_なニオイが充満しているカンジ。上記を確認後、SCM_APPEND マクロの試験を以下に修正。

void test_gauche_SCM_APPEND(void)
{
	/* start is NIL, obj is NIL */
	{
		ScmObj start = SCM_NIL, end, obj = SCM_NIL;
		SCM_APPEND(start, end, obj);
		CU_ASSERT_EQUAL(SCM_NIL, start);
	}

	/* start is NIL, obj is '(1) */
	{
		ScmObj start = SCM_NIL, end, obj = Scm_Cons(SCM_MAKE_INT(1), SCM_NIL);

		SCM_APPEND(start, end, obj);

		CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(start)));
		CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(end)));
	}

	/* start is '(1 2), obj is '(3) */
	{
		ScmObj tmp = Scm_Cons(SCM_MAKE_INT(2), SCM_NIL);
		ScmObj start = Scm_Cons(SCM_MAKE_INT(1), tmp);
		ScmObj end = Scm_LastPair(start);
		ScmObj obj = Scm_Cons(SCM_MAKE_INT(3), SCM_NIL);

		CU_ASSERT_EQUAL(2, SCM_INT_VALUE(SCM_CAR(end)));

		SCM_APPEND(start, end, obj);

		CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(start)));
		CU_ASSERT_EQUAL(2, SCM_INT_VALUE(SCM_CAR(SCM_CDR(start))));
		CU_ASSERT_EQUAL(3, SCM_INT_VALUE(SCM_CAR(SCM_CDR(SCM_CDR(start)))));
		CU_ASSERT_EQUAL(3, SCM_INT_VALUE(SCM_CAR(end)));
	}
}

まだ時間があるので追記するはず。

続

SCM_LIST な方々の試験も書いた。

#include <CUnit/CUnit.h>

#include "gauche.h"

void test_gauche_SCM_LIST1(void)
{
	ScmObj obj = SCM_LIST1(SCM_MAKE_INT(1));

	CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(obj)));
	CU_ASSERT_EQUAL(SCM_NIL, (SCM_CDR(obj)));
}

void test_gauche_SCM_LIST2(void)
{
	ScmObj obj = SCM_LIST2(SCM_MAKE_INT(1),
						   SCM_MAKE_INT(2));
	CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(obj)));

	ScmObj tmp = SCM_CDR(obj);
	CU_ASSERT_EQUAL(2, SCM_INT_VALUE(SCM_CAR(tmp)));
	CU_ASSERT_EQUAL(SCM_NIL, SCM_CDR(tmp));
}

void test_gauche_SCM_LIST3(void)
{
	ScmObj obj = SCM_LIST3(SCM_MAKE_INT(1),
						   SCM_MAKE_INT(2),
						   SCM_MAKE_INT(3));

	CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(obj)));

	ScmObj tmp = SCM_CDR(obj);
	CU_ASSERT_EQUAL(2, SCM_INT_VALUE(SCM_CAR(tmp)));

	tmp = SCM_CDR(tmp);
	CU_ASSERT_EQUAL(3, SCM_INT_VALUE(SCM_CAR(tmp)));
	CU_ASSERT_EQUAL(SCM_NIL, SCM_CDR(tmp));
}

void test_gauche_SCM_LIST4(void)
{
	ScmObj obj = SCM_LIST4(SCM_MAKE_INT(1),
						   SCM_MAKE_INT(2),
						   SCM_MAKE_INT(3),
						   SCM_MAKE_INT(4));

	CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(obj)));

	ScmObj tmp = SCM_CDR(obj);
	CU_ASSERT_EQUAL(2, SCM_INT_VALUE(SCM_CAR(tmp)));

	tmp = SCM_CDR(tmp);
	CU_ASSERT_EQUAL(3, SCM_INT_VALUE(SCM_CAR(tmp)));

	tmp = SCM_CDR(tmp);
	CU_ASSERT_EQUAL(4, SCM_INT_VALUE(SCM_CAR(tmp)));
	CU_ASSERT_EQUAL(SCM_NIL, SCM_CDR(tmp));
}

void test_gauche_SCM_LIST5(void)
{
	ScmObj obj = SCM_LIST5(SCM_MAKE_INT(1),
						   SCM_MAKE_INT(2),
						   SCM_MAKE_INT(3),
						   SCM_MAKE_INT(4),
						   SCM_MAKE_INT(5));

	CU_ASSERT_EQUAL(1, SCM_INT_VALUE(SCM_CAR(obj)));

	ScmObj tmp = SCM_CDR(obj);
	CU_ASSERT_EQUAL(2, SCM_INT_VALUE(SCM_CAR(tmp)));

	tmp = SCM_CDR(tmp);
	CU_ASSERT_EQUAL(3, SCM_INT_VALUE(SCM_CAR(tmp)));

	tmp = SCM_CDR(tmp);
	CU_ASSERT_EQUAL(4, SCM_INT_VALUE(SCM_CAR(tmp)));

	tmp = SCM_CDR(tmp);
	CU_ASSERT_EQUAL(5, SCM_INT_VALUE(SCM_CAR(tmp)));
	CU_ASSERT_EQUAL(SCM_NIL, SCM_CDR(tmp));
}

なんつーかダサいなぁ。力仕事だし。繰返し使えよ、ってカンジです。だらだらヤッてるから、とは言え工夫無さ杉。
次は Scm_List の実装と試験になるんですが、

ScmObj Scm_List(ScmObj elt, ...);

な引数の取り出し方を忘れている。ちょい時間かかりそう。