Common Lisp風のLISPを作ってみる（５．環境）

今回はmy-lisp2の環境(environment)モジュールについて解説します。Common Lispにおける環境とは、束縛(binding)の集合のことです。束縛とは、ある名前とそれが指し示すものの関連(association)です。つまり、連想リストのようなものだと考えると分かりやすいでしょう。
　この環境を作るにあたって、「[計算機プログラムの構造と解釈](https://ja.wikipedia.org/wiki/計算機プログラムの構造と解釈)」、いわゆるSICP本のモデルを採用しています。ちなみに私はminghai版を読みました。そのモデルでは、環境は複数のフレーム（それぞれが連想リスト）で表現されていました。なので本モジュールでも環境を複数の連想リストで表現できるようにしています。
[ソースコード](https://github.com/haruo-wakakusa/my-lisp2/tree/main/chapter05)
## environment.h
まずはヘッダーファイルからです。今回は関数が多いですね。
```environment.h
/* environment.h */

#ifndef ENVIRONMENT_H_
#define ENVIRONMENT_H_

void *environment_init(void *parent);
void environment_add(void *env, void *key, void *val);
int environment_exists(void *env, void *key);
int environment_get(void *env, void *key, void **val);
int environment_modify(void *env, void *key, void *val);
int environment_remove(void *env, void *key);
int environment_get_recurse(void *env, void *key, void **val);
int environment_exists_recurse(void *env, void *key);
int environment_modify_recurse(void *env, void *key, void *val);

#endif
```
## environment.c
今回もファイルを上から見ていきましょう。まずinclude文からです。
```environment.c
/*
 * environment.c
 */

#include <stdlib.h>
#include <string.h>
#include "../chapter02/type.h"
#include "helper.h"
#include "environment.h"
```
`environment_init`関数は環境を初期化します。初期化する時に、そのフレームが「指し示す」フレームを`parent`引数に指定します。この最初のコンスセルは環境のフレームそのものを表現しているのであって、連想リストではないことに注意してください。
```environment.c
/* LISPの環境において、通常、parentという言い方はしないことに注意 */
void *environment_init(void *parent) {
    return cons(NIL, parent);
}
```
`environment_add`関数はフレームにキー・バリューのペアを１組追加します。
```environment.c
void environment_add(void *env, void *key, void *val) {
    void *assoc = cons(key, val);
    void *joint = cons(assoc, car(env));
    rplaca(env, joint);
}
```
`environment_exists`関数はそのフレームに`key`があるかどうかを判別します。
```environment.c
int environment_exists(void *env, void *key) {
    SYMBOL *sym1 = (SYMBOL *)key;
    void *p = car(env);
    while (p != NIL) {
        SYMBOL *sym2 = (SYMBOL *)car(car(p));
        if (strcmp(get_symbol_string(sym2), get_symbol_string(sym1)) == 0) {
            return 1;
        }
        p = cdr(p);
    }
    return 0;
}
```
`environment_get`関数は与えられた`key`に対応する`val`を取得します。もしフレーム内に`key`がない場合は返り値が`0`になります。
```environment.c
int environment_get(void *env, void *key, void **val) {
    SYMBOL *sym1 = (SYMBOL *)key;
    void *p = car(env);
    while (p != NIL) {
        SYMBOL *sym2 = (SYMBOL *)car(car(p));
        if (strcmp(get_symbol_string(sym2), get_symbol_string(sym1)) == 0) {
            *val = cdr(car(p));
            return 1;
        }
        p = cdr(p);
    }
    return 0;
}
```
`environment_modify`関数は、フレーム内のキー・バリューのペアにおいてバリューを書き換えます。キーが存在しなかった場合は`0`を返します。
```environment.c
int environment_modify(void *env, void *key, void *val) {
    SYMBOL *sym1 = (SYMBOL *)key;
    void *p = car(env);
    while (p != NIL) {
        SYMBOL *sym2 = (SYMBOL *)car(car(p));
        if (strcmp(get_symbol_string(sym2), get_symbol_string(sym1)) == 0) {
            rplacd(car(p), val);
            return 1;
        }
        p = cdr(p);
    }
    return 0;
}
```
`environment_remove`関数はフレーム内において与えられた`key`のペアを削除します。ペアが存在しなかった場合は`0`を返します。
```environment.c
int environment_remove(void *env, void *key) {
    SYMBOL *sym1 = (SYMBOL *)key;
    SYMBOL *sym2;
    void *p = car(env);
    void *q;
    if (p == NIL) return 0;
    sym2 = (SYMBOL *)car(car(p));
    if (strcmp(get_symbol_string(sym2), get_symbol_string(sym1)) == 0) {
        rplaca(env, cdr(p));
        return 1;
    }
    q = p;
    p = cdr(p);
    while (p != NIL) {
        sym2 = (SYMBOL *)car(car(p));
        if (strcmp(get_symbol_string(sym2), get_symbol_string(sym1)) == 0) {
            rplacd(q, cdr(p));
            return 1;
        }
        q = p;
        p = cdr(p);
    }
    return 0;
}
```
`environment_get_recurse`, `environment_exists_recurse`, `environment_modify_recurse`関数は上記の操作を再帰的に行います。つまり、フレームが指し示すフレームについても、その先が無くなるまで繰り返します。
```environment.c
int environment_get_recurse(void *env, void *key, void **val) {
    while (env != NIL) {
        if (environment_get(env, key, val)) return 1;
        env = cdr(env);
    }
    return 0;
}

int environment_exists_recurse(void *env, void *key) {
    while (env != NIL) {
        if (environment_exists(env, key)) return 1;
        env = cdr(env);
    }
    return 0;
}

int environment_modify_recurse(void *env, void *key, void *val) {
    while (env != NIL) {
        if (environment_modify(env, key, val)) return 1;
        env = cdr(env);
    }
    return 0;
}
```
## helper.h
ヘルパー関数が追加されています。また、`SYMBOL`型は`type.h`で定義されているので`type.h`のインクルードも行います。
```helper.h
char * get_symbol_string(SYMBOL *symbol);
int consp(void *obj);
void *car(void *obj);
void *cdr(void *obj);
void *rplaca(void *cons1, void *obj);
void *rplacd(void *cons1, void *obj);
```
## helper.c
`get_symbol_string`関数はシンボル型オブジェクトが保持している文字列を取得します。
```helper.c
char * get_symbol_string(SYMBOL *symbol) {
    return symbol->str;
}
```
`consp`関数はLispの`consp`関数同様、コンスセルの判定を行います。
```helper.c
int consp(void *obj) {
    return (((HEADER *)obj)->type == TYPE_CONS);
}
```
`car`関数も同様です。ただしアトムがこの関数に与えられるとステートをエラーにして`0`を返します。my-lisp2における`void *`の`0`は異常状態を表します。詳細は`state.h`, `state.c`の項で解説します。
```helper.c
void *car(void *obj) {
    if (obj == NIL) return NIL;
    if (!consp(obj)) {
        fprintf(stderr, "CARはアトムに適用できません\n");
        state = STATE_ERROR;
        return 0;
    }
    return ((CONS *)obj)->car;
}
```
`cdr`関数です。
```helper.c
void *cdr(void *obj) {
    if (obj == NIL) return NIL;
    if (!consp(obj)) {
        fprintf(stderr, "CDRはアトムに適用できません\n");
        state = STATE_ERROR;
        return 0;
    }
    return ((CONS *)obj)->cdr;
}
```
`rplaca`関数です。
```helper.c
void *rplaca(void *cons1, void *obj) {
    if (!consp(cons1)) {
        fprintf(stderr, "コンスセルではありません\n");
        state = STATE_ERROR;
        return 0;
    }
    ((CONS *)cons1)->car = obj;
    return cons1;
}
```
`rplacd`関数です。
```helper.c
void *rplacd(void *cons1, void *obj) {
    if (!consp(cons1)) {
        fprintf(stderr, "コンスセルではありません\n");
        state = STATE_ERROR;
        return 0;
    }
    ((CONS *)cons1)->cdr = obj;
    return cons1;
}
```
## state.h
`STATE`列挙体はアプリケーションのステートを表現します。`block_name_when_return`, `return_value_when_return`, `tag_name_when_go`はスペシャルオペレーター`return-from`, `go`で用いる変数です。
```state.h
/*
 * state.h
 */

#ifndef STATE_H_
#define STATE_H_

typedef enum {
    STATE_NORMAL,
    STATE_ERROR,
    STATE_EXIT,
    STATE_JUMP_RETURN,
    STATE_JUMP_GO
} STATE;

extern STATE state;
extern void *block_name_when_return;
extern void *return_value_when_return;
extern void *tag_name_when_go;

#endif
```
`STATE`列挙体の意味を記します。
| STATEの値 | 意味 |
|:-:|:-:|
| STATE_NORMAL | 通常の状態 |
| STATE_ERROR | エラーの状態 |
| STATE_EXIT | 終了するよう指示された状態(`exit`関数など) |
| STATE_JUMP_RETURN | `return-from`からのジャンプ |
| STATE_JUMP_GO | `go`からのジャンプ |

my-lisp2では例外処理の機構は各関数が責任を持つこととします。`void *`が`0`の時はとにかく確保したリソースを解放して`return 0`することを心がけます。そのことにより、アプリケーションの安全性を高めます。
## state.c
このファイルには共有されるグローバル変数の実体が配置されています。
```state.c
/*
 * state.c
 */

#include "state.h"

STATE state = STATE_NORMAL;
void *block_name_when_return = 0;
void *return_value_when_return = 0;
void *tag_name_when_go = 0;
```