my-lisp2では、標準入力などに入力された文字列をオブジェクトに変換する処理を主にリーダー(reader)で行っています。パーサーはシンボルと数値を区別するために用います。今回はシンボル型と数値型を区別しないリーダーを作成し、次回プリンターを作成してその動作を確認します。
ソースコード

reader.h

まずは、ヘッダーファイルです。

reader.h

/*
 * reader.h
 */

#ifndef READER_H_
#define READER_H_

#include <stdio.h>

void reader_initialize(void);
void reader_free(void);
void *reader_read(FILE *stream);

#endif

reader.c

次にソースファイルです。455行あるので、まずはその概形を示します。

reader.c

/*
 * reader.c
 */

#include <stdio.h>
#include <ctype.h>
#include "../chapter02/type.h"
#include "helper.h"
#include "../chapter03/buffer.h"
#include "../chapter04/cons_buffer.h"
#include "../chapter05/state.h"
#include "reader.h"

BUFFER buffer;

static void *read_list(FILE *stream);
static void *read_string(FILE *stream);

void reader_initialize(void) {
    buffer = buffer_allocate();
}

void reader_free(void) {
    buffer_free(buffer);
}

void *reader_read(FILE *stream) {

(中略)

}

static void *read_list(FILE *stream) {

(中略)

}

static void *read_string(FILE *stream) {

(中略)

}

reader_initialize関数は文字列バッファを初期化し、reader_free関数は文字列バッファを解放します。reader_read関数は１つの式をリードして、そのオブジェクトを返します。reader_list関数はリスト、reader_string関数は文字列をリードしてそのオブジェクトを返します。reader_read関数とread_list関数は与えられた入力によっては再帰的に呼び出されます。

reader_read関数

reader_read関数の中身も長いので、概形を示します。

reader.c

void *reader_read(FILE *stream) {
    while (1) {
        int c;
LOOP1:      
        c = fgetc(stream);
        if (c == EOF) {
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                return retval;
            } else {
                state = STATE_EXIT;
                return 0;
            }
        }
        switch ((char)c) {

        (中略)

        default:
            buffer_write_char(buffer, toupper(c));
        }
    }
}

reader_read関数は、巨大なループからなっていて、その先頭で１文字リードしています。読み込んだ文字がもしEOFであったならば、文字列バッファの中身をシンボルとして返します。または文字列バッファが空ならばアプリケーションの終了処理を行います。略しているところは、いわゆるマクロ文字やエスケープ文字などの処理です。デフォルト部は、それ以外の文字の部分であり、アルファベットの小文字は大文字に変換されて文字列バッファに書き込まれます。
　それでは、特殊な処理について見ていきましょう。

左カッコ

文字列バッファの中身をシンボルとして返します。ただしリードした(自身はungetc関数でストリームに戻しています。なぜそうするかというと、REPLが一巡するとまたリードするためです。その時は、文字列バッファが空なので、read_list関数を呼び出してリストをリードします。
　「文字列バッファの中身をシンボルで返してungetc」という手順は、これ以外の文字でも基本的には使われます（エスケープ文字以外）。

reader.c

        case '(':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            } else {
                return read_list(stream);
            }
            break;

右カッコ

文字列バッファが空ならばエラーを送出します。

reader.c

        case ')':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            } else {
                fprintf(stderr, "余分な閉じ括弧です\n");
                state = STATE_ERROR;
                return 0;
            }
            break;

ダブルクォーテーションマーク

文字列バッファが空ならば、read_string関数を呼び出して文字列をリードします。

reader.c

        case '"':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            } else {
                return read_string(stream);
            }
            break;

セミコロン

文字列バッファが空ならば、改行文字まで読み飛ばします。

reader.c

        case ';':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            } else {
                while (1) {
                    c = fgetc(stream);
                    if (c == EOF) {
                        state = STATE_EXIT;
                        return 0;
                    } else if (c == '\n') {
                        goto LOOP1;
                    }
                }
            }
            break;

シャープ

文字列バッファが空ならば、もう１文字リードし、それがシングルクォーテーションマークならばreader_read関数を呼び出して、(FUNCTION 式)という結果を返します。

reader.c

        case '#':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            } else {
                c = fgetc(stream);
                if (c == EOF) {
                    fprintf(stderr, "ファイルの終わりに到達しました\n");
                    state = STATE_ERROR;
                    return 0;
                }
                switch (c) {
                    void *expr;
                case '\'':
                    expr = reader_read(stream);
                    if (!expr) return 0;
                    return cons(make_symbol("FUNCTION"), cons(expr, NIL));
                default:
                    fprintf(stderr, "未実装のマクロ文字です\n");
                    state = STATE_ERROR;
                    return 0;
                }
            }

シングルクォーテーションマーク

文字列バッファが空ならば、reader_read関数を呼び出して(QUOTE 式)という結果を返します。

reader.c

        case '\'':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval; 
            } else {
                void *expr = reader_read(stream);
                if (!expr) return 0;
                return cons(make_symbol("QUOTE"), cons(expr, NIL));
            }
            break;

バッククォート

文字列バッファが空ならば、reader_read関数を呼び出して(QUASIQUOTE 式)という結果を返します。

reader.c

        case '`':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            } else {
                void *expr = reader_read(stream);
                if (!expr) return 0;
                /* QUASIQUOTEはCommon LispではなくSchemeの語彙であることに注意 */
                return cons(make_symbol("QUASIQUOTE"), cons(expr, NIL));
            }
            break;

コンマ

文字列バッファが空ならば、もう１文字リードして@じゃなければ(UNQUOTE 式)という結果を、@ならば(UNQUOTE-SPLICING 式)という結果を返します。

reader.c

        case ',':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            } else {
                c = fgetc(stream);
                if (c == EOF) {
                    fprintf(stderr, "ファイルの終わりに到達しました\n");
                    state = STATE_ERROR;
                    return 0;
                }
                if (c != '@') {
                    ungetc(c, stream);
                    void *expr = reader_read(stream);
                    if (!expr) return 0;
                    /* UNQUOTEはSchemeの語彙であることに注意 */
                    return cons(make_symbol("UNQUOTE"), cons(expr, NIL));
                } else {
                    void *expr = reader_read(stream);
                    if (!expr) return 0;
                    /* UNQUOTE-SPLICINGはSchemeの語彙であることに注意 */
                    return cons(make_symbol("UNQUOTE-SPLICING"),
                                cons(expr, NIL));
                }
            }
            break;

バーティカルバー（パイプ文字）

この文字はエスケープ文字なので処理が特殊です。次のバーティカルバーまで文字をそのまま文字列バッファに書き込みます（通常は小文字は大文字になるし、空白やマクロ文字はシンボルにできない）。

reader.c

        case '|':
            while (1) {
                c = fgetc(stream);
                if (c == EOF) {
                    fprintf(stderr, "ファイルの終わりに到達しました\n");
                    state = STATE_ERROR;
                    return 0;
                }
                if (c == '\\') {
                    c = fgetc(stream);
                    if (c == EOF) {
                        fprintf(stderr, "ファイルの終わりに到達しました\n");
                        state = STATE_ERROR;
                        return 0;
                    }
                    buffer_write_char(buffer, c);
                } else if (c == '|') {
                    goto LOOP1;
                } else {
                    buffer_write_char(buffer, c);
                }
            }
            break;

バックスラッシュ

これもエスケープ文字です。次の文字をそのまま文字列バッファに書き込みます。

reader.c

        case '\\':
            c = fgetc(stream);
            if (c == EOF) {
                fprintf(stderr, "ファイルの終わりに到達しました\n");
                state = STATE_ERROR;
                return 0;
            }
            buffer_write_char(buffer, c);
            break;

空白文字

文字列バッファが空ならば、何もしません。

reader.c

        case ' ':
        case '\n':
        case '\t':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            }
            break;

read_list関数

read_list関数の中身も長いので概形を示します。行っていることはほとんどreader_read関数と同じです。違うのは、オブジェクトを返すのではなく、オブジェクトをコンスバッファに書き込むところです。

reader.c

static void *read_list(FILE *stream) {
    CONS_BUFFER cbuf = cons_buffer_allocate();
    while (1) {
        int c;
LOOP1:
        c = fgetc(stream);
        if (c == EOF) {
            fprintf(stderr, "ファイルの終わりに到達しました\n");
            cons_buffer_free(cbuf);
            state = STATE_ERROR;
            return 0;
        }
        switch ((char)c) {

        (中略)

        default:
            buffer_write_char(buffer, toupper((char)c));
        }
    }
}

左カッコ

reader.c

        case '(':
            if (buffer_get_size(buffer) != 0) {
                cons_buffer_add(cbuf, make_symbol_from_buffer(buffer));
                buffer_clear(buffer);
            }
            void *list1 = read_list(stream);
            if (!list1) {
                cons_buffer_free(cbuf);
                return 0;
            }
            cons_buffer_add(cbuf, list1);
            break;

右カッコ

reader_readとは異なり、右カッコだけがread_list関数のオブジェクトを返します。

reader.c

        case ')':
            if (buffer_get_size(buffer) != 0) {
                cons_buffer_add(cbuf, make_symbol_from_buffer(buffer));
                buffer_clear(buffer);
            }
            {
                void *retval = cons_buffer_get_list(cbuf);
                cons_buffer_free(cbuf);
                return retval;
            }
            break;

ダブルクォーテーションマーク

reader.c

        case '"':
            if (buffer_get_size(buffer) != 0) {
                cons_buffer_add(cbuf, make_symbol_from_buffer(buffer));
                buffer_clear(buffer);
            }
            {
                void *str = read_string(stream);
                if (!str) {
                    cons_buffer_free(cbuf);
                    return 0;
                }
                cons_buffer_add(cbuf, str);
            }
            break;

セミコロン

reader.c

        case ';':
            if (buffer_get_size(buffer) != 0) {
                cons_buffer_add(cbuf, make_symbol_from_buffer(buffer));
                buffer_clear(buffer);
            }
            while (1) {
                c = fgetc(stream);
                if (c == EOF) {
                    fprintf(stderr, "ファイルの終わりに到達しました\n");
                    cons_buffer_free(cbuf);
                    state = STATE_ERROR;
                    return 0;
                } else if (c == '\n') {
                    goto LOOP1;
                }
            }
            break;

シャープ

reader.c

        case '#':
            if (buffer_get_size(buffer) != 0) {
                cons_buffer_add(cbuf, make_symbol_from_buffer(buffer));
                buffer_clear(buffer);
            }
            c = fgetc(stream);
            if (c == EOF) {
                fprintf(stderr, "ファイルの終わりに到達しました\n");
                cons_buffer_free(cbuf);
                state = STATE_ERROR;
                return 0;
            }
            switch (c) {
            case '\'':
                {
                    void *expr = reader_read(stream);
                    if (!expr) {
                        cons_buffer_free(cbuf);
                        return 0;
                    }
                    cons_buffer_add(cbuf,
                        cons(make_symbol("FUNCTION"),
                            cons(expr, NIL)));
                }
                break;
            default:
                fprintf(stderr, "未実装のマクロ文字です");
                cons_buffer_free(cbuf);
                state = STATE_ERROR;
                return 0;
            }
            break;

シングルクォーテーションマーク

reader.c

        case '\'':
            if (buffer_get_size(buffer) != 0) {
                cons_buffer_add(cbuf, make_symbol_from_buffer(buffer));
                buffer_clear(buffer);
            } else {
                void *expr = reader_read(stream);
                if (!expr) {
                    cons_buffer_free(cbuf);
                    return 0;
                }
                cons_buffer_add(cbuf,
                    cons(make_symbol("QUOTE"), cons(expr, NIL)));
            }
            break;

バッククォート

reader.c

        case '`':
            if (buffer_get_size(buffer) != 0) {
                cons_buffer_add(cbuf, make_symbol_from_buffer(buffer));
                buffer_clear(buffer);
            } else {
                void *expr = reader_read(stream);
                if (!expr) {
                    cons_buffer_free(cbuf);
                    return 0;
                }
                /* QUASIQUOTEはSchemeの語彙であることに注意 */
                cons_buffer_add(cbuf,
                    cons(make_symbol("QUASIQUOTE"), cons(expr, NIL)));
            }
            break;

コンマ

reader.c

        case ',':
            if (buffer_get_size(buffer) != 0) {
                void *retval = make_symbol_from_buffer(buffer);
                buffer_clear(buffer);
                ungetc(c, stream);
                return retval;
            } else {
                c = fgetc(stream);
                if (c == EOF) {
                    fprintf(stderr, "ファイルの終わりに到達しました\n");
                    state = STATE_ERROR;
                    return 0;
                }
                if (c != '@') {
                    ungetc(c, stream);
                    void *expr = reader_read(stream);
                    if (!expr) {
                        cons_buffer_free(cbuf);
                        return 0;
                    }
                    /* UNQUOTEはSchemeの語彙であることに注意 */
                    cons_buffer_add(cbuf,
                        cons(make_symbol("UNQUOTE"), cons(expr, NIL)));
                } else {
                    void *expr = reader_read(stream);
                    if (!expr) return 0;
                    /* UNQUOTE-SPLICINGはSchemeの語彙であることに注意 */
                    cons_buffer_add(cbuf,
                        cons(make_symbol("UNQUOTE-SPLICING"),
                            cons(expr, NIL)));
                }
            }
            break;

バーティカルバー（パイプ文字）

reader.c

        case '|':
            while (1) {
                c = fgetc(stream);
                if (c == EOF) {
                    fprintf(stderr, "ファイルの終わりに到達しました\n");
                    state = STATE_ERROR;
                    return 0;
                }
                if (c == '\\') {
                    c = fgetc(stream);
                    if (c == EOF) {
                        fprintf(stderr, "ファイルの終わりに到達しました\n");
                        state = STATE_ERROR;
                        return 0;
                    }
                    buffer_write_char(buffer, c);
                } else if (c == '|') {
                    goto LOOP1;
                } else {
                    buffer_write_char(buffer, c);
                }
            }
            break;

バックスラッシュ

reader.c

        case '\\':
            c = fgetc(stream);
            if (c == EOF) {
                fprintf(stderr, "ファイルの終わりに到達しました\n");
                state = STATE_ERROR;
                return 0;
            }
            buffer_write_char(buffer, c);
            break;

空白文字

reader.c

        case ' ':
        case '\n':
        case '\t':
            if (buffer_get_size(buffer) != 0) {
                cons_buffer_add(cbuf, make_symbol_from_buffer(buffer));
                buffer_clear(buffer);
            }
            break;

read_string関数

ダブルクォーテーションマークが来るまで文字を読み込みます。ただし、バックスラッシュの後はダブルクォーテーションマークが来ても文字として読み込みます。

reader.c

static void *read_string(FILE *stream) {
    while (1) {
        int c = fgetc(stream);
        if (c == EOF) {
            fprintf(stderr, "ファイルの終わりに到達しました\n");
            state = STATE_ERROR;
            return 0;
        }
        switch ((char)c) {
        case '"':
            {
                void *retval = make_string_from_buffer(buffer);
                buffer_clear(buffer);
                return retval;
            }
            break;
        case '\\':
            c = fgetc(stream);
            if (c == EOF) {
                fprintf(stderr, "ファイルの終わりに到達しました\n");
                state = STATE_ERROR;
                return 0;
            }
            buffer_write_char(buffer, c);
            break;
        default:
            buffer_write_char(buffer, c);
        }
    }
}

helper.h

次の３つの関数が追加されています。また、buffer.hをインクルードしています。

helper.h

SYMBOL * make_symbol_from_buffer(BUFFER buf);
STRING * make_string_from_buffer(BUFFER buf);
SYMBOL * make_symbol(char *str1);

helper.c

make_symbol_from_buffer関数は文字列バッファの内容をリードして、シンボル型オブジェクトを返します。

helper.c

SYMBOL * make_symbol_from_buffer(BUFFER buf) {
    size_t len;
    SYMBOL *symbol;
    char *s;

    len = buffer_get_size(buf) + 1;
    symbol = malloc(sizeof(SYMBOL) + len);
    symbol->h.type = TYPE_SYMBOL;
    s = (char *)symbol;
    buffer_copy(buf, s + sizeof(SYMBOL));
    s[sizeof(SYMBOL) + len - 1] = '\0';

    return symbol;
}

make_string_from_buffer関数は文字列バッファの中身をリードして文字列型オブジェクトを返します。

reader.c

STRING * make_string_from_buffer(BUFFER buf) {
    size_t len;
    STRING *string;
    char *s;
    
    len = buffer_get_size(buf) + 1;
    string = malloc(sizeof(STRING) + len);
    string->h.type = TYPE_STRING;
    s = (char *)string;
    buffer_copy(buf, s + sizeof(STRING));
    s[sizeof(STRING) + len - 1] = '\0';

    return string;
}

make_symbol関数は文字列からシンボル型オブジェクトを生成します。

reader.c

SYMBOL * make_symbol(char *str1) {
    size_t len;
    SYMBOL *symbol;
    char *s;

    len = strlen(str1) + 1;
    symbol = malloc(sizeof(SYMBOL) + len);
    symbol->h.type = TYPE_SYMBOL;
    s = (char *)symbol;
    strcpy(s + sizeof(SYMBOL), str1);

    return symbol;
}