Common Lisp風のLISPを作ってみる（１６．gensym）

さて、今回からマクロ編となります。まずは一番やさしそうなgensymからやっていきましょう。とはいえ、本物のgensymを実装しようとするとコードを全体的に書き換えなければならなくなるので、妥協できそうなgensymもどきを作ってやります。元々のgensymが、ユーザーが定義できないシンボル、というような感じなんですけど、エスケープ文字を使わなければ定義できないシンボル、としておけば日常的には問題ないのではないかと思いましたので、そのようにしました。
ソースコード

built_in_func.c

f_gensym関数はgensym関数の実体です。

built_in_func.c

/* gensymは引数を取らないこととする */
void *f_gensym(void *args) {
    static int count = 1;
    char name[16];
    if (list_length(args) != 0) {
        fprintf(stderr, "FUNCTION \"GENSYM\": 引数の数が不正です\n");
        state = STATE_ERROR;
        return 0;
    }   
    sprintf(name, "#:G%d", count);
    count++;
    return make_symbol(name);
}

printer.c

gensymで生成したシンボルについてはエスケープ文字が付いてプリントされないようにしました。

printer.c

static void print_symbol(FILE *stream, void *obj) {
    SYMBOL *symbol = (SYMBOL *)obj;
    char *p;
    int multiple_escape_is_needed = 0;
    for (p = get_symbol_string(symbol); *p != '\0'; ++p) {
        if (*p >= 'a' && *p <= 'z') {
            multiple_escape_is_needed = 1;
            break;
        }
        switch (*p) {
        case '(':
        case ')':
        case '\'':
        case ';':
        case '\"':
        case '`':
        case ',':
        case '#':
        case '\\':
        case '|':
        case ' ':
        case '\t':
        case '\n':
            multiple_escape_is_needed = 1;
            goto LOOPEND1;
        default:
            ;
        }
    }
    LOOPEND1:

    p = get_symbol_string(symbol);
    if (*(p++) == '#' && *(p++) == ':' && *(p++) == 'G' && isdigit(*(p++))) {
        int is_gensym = 1;
        while (*p != '\0') {
            if (!isdigit(*p)) {
                is_gensym = 0;
                break;
            }
        }
        if (is_gensym) multiple_escape_is_needed = 0;
    }

    if (!multiple_escape_is_needed) {
        fprintf(stream, "%s", get_symbol_string(symbol));
    } else {
        fputc('|', stream);
        for (p = get_symbol_string(symbol); *p != '\0'; ++p) {
            switch (*p) {
                case '\\':
                    fputs("\\\\", stream);
                    break;
                case '|':
                    fputs("\\|", stream);
                    break;
                default:
                    fputc(*p, stream);
            }
        }
        fputc('|', stream);
    }
}

動かしてみよう

まあ、こんなものです。

> (gensym)
#:G1
> (gensym)
#:G2