今回は電卓プログラムにユーザが関数を定義する機能を追加してみましょう。
関数を定義するために、文法を次のように修正します。
[EBNF]
文 = 関数定義 | 式.
関数定義 = "def", 関数, "(", [仮引数リスト], ")", 式, "end".
式 = 代入式 | 式１.
代入式 = 変数, "=", 式.
式１ = 項, { ("+" | "-"), 項 }.
項 = 因子, { ("*" | "/"), 因子 }.
因子 = 数値 | ("+" | "-"), 因子 | "(", 式, ")" | 変数 | 関数, "(", [引数リスト], ")".
変数 = 識別子
関数 = 識別子
仮引数リスト = 変数, { ",", 変数 }.
引数リスト = 式, { ",", 式 }.
[注意] 数値と識別子の定義は省略
ユーザが関数を定義するときは def ... end で行います。ユーザが定義した関数は、仮引数リストと関数本体 (式) を連結リスト (仮引数リスト, 式) に格納して、それを関数名を表すシンボルにセットすることにします。
それではプログラムを作りましょう。トークンを切り分ける関数 get_token を修正します。
リスト : トークンの切り分け
// トークン
enum {Eof, Number, Ident, Assign, Add, Sub, Mul, Div, Lpar, Rpar,
Comma, Semic, Def, End, Others};
// トークンの切り分け
void get_token(void)
{
// 空白文字の読み飛ばし
while (isspace(getch())) nextch();
if (isdigit(getch())) {
token = Number;
value = get_number();
} else if (isalpha(getch())) {
symbol = get_ident();
if (strcmp(symbol->name, "def") == 0)
token = Def;
else if (strcmp(symbol->name, "end") == 0)
token = End;
else
token = Ident;
} else {
・・・省略・・・
}
}
トークンに def を表す Def と end を End を追加します。識別子を取得するとき、get_ident で取得したシンボルの名前が def ならば token に Def を、end ならば End をセットします。
次は構文解析の処理を修正します。関数 factor でユーザ関数を呼び出すための処理を追加します。
リスト : 因子の処理
Expr *factor(void)
{
Symbol *sym;
switch (token) {
・・・省略・・・
case Ident:
sym = symbol;
get_token();
if (sym->type == 0)
return make_sym(sym);
else {
if (token != Lpar) error("'(' expected");
Cell *cp = get_argument();
if (sym->type == 1) {
if (length(cp) != 1)
error("wrong number of arguments");
return make_func(sym, Func1, cp);
} else if(sym->type == 2) {
if (length(cp) != 2)
error("wrong number of arguments");
return make_func(sym, Func2, cp);
} else {
if (length(cp) != length(car(sym->ref_value)))
error("wrong number of arguments");
return make_func(sym, FuncU, cp);
}
}
default:
error("unexpected token");
}
}
sym->type が 0 でなければ関数呼び出しです。1 と 2 が組み込み関数で、それ以外がユーザ関数の呼び出しになります。get_argument で引数の式を求めて、連結リスト cp に格納します。ユーザ関数は sym->ref_value に格納されていて、先頭要素が仮引数リスト、次の要素が関数本体 (式) になります。仮引数リストと実引数リストの長さが異なる場合はエラーを送出します。そうでなければ、make_func で関数呼び出しの構文木 (タグは FuncU) を生成して返します。
次は引数を取得する関数 get_argument を修正します。
リスト : 引数の取得
Cell *get_argument(void)
{
Cell *cp = NULL;
get_token();
if (token == Rpar) {
get_token();
return cp;
}
while (true) {
cp = cons(expression(), cp);
if (token == Rpar) {
get_token();
return cp;
} else if (token == Comma) {
get_token();
} else
error("unexpected token in argument list");
}
}
ユーザ関数は引数がない場合も定義できるようにしたいので、( ) だけのときは空リストを返すように修正します。
次は局所変数を表すデータ構造を定義しましょう。この場合、変数名をキーとして、それに対応する値を求める処理が必要になります。たとえば、二分探索木やハッシュ表などを使えば、キーに対応する値を高速に求めることができますが、関数の引数は高々数個程度なので、今回は「連想リスト (association list, a-list)」という簡単なデータ構造を使うことにします。
連想リストは Lisp でよく使われるデータ構造です。次の図を見てください。
┌───┬───┬───┬──→ データ
│ │ │ │
連想リスト => ((a, 1), (b, 2), (c, 3), (d, 4))
│ │ │ │
└───┴───┴───┴──→ キー
図 : 連想リストの構造
上図の場合、シンボル a, b, c, d がキーで、整数 1, 2, 3, 4 がデータとなります。
一般的なプログラミング言語の場合、関数の引数は局所変数として扱われ、その有効範囲は「レキシカルスコープ」になります。これを実現するため、関数 eval の第 2 引数に局所変数とその値を格納した連想リストを渡すことにします。このリストを「環境 (environment)」と呼ぶことにします。
関数を呼び出すとき、関数本体を評価するための新しい環境が生成されます。このとき、環境は空リストです。関数の引数はこの新しい環境に追加されます。関数型言語の世界では、変数と値を格納するためのメモリ領域を確保することを「変数束縛」といいます。今回の電卓プログラムでは、環境に変数とその値を追加することが変数束縛になります。変数を参照するとき、環境に該当する変数が存在しない場合は大域変数を参照します。変数の値を書き換える場合も同様です。
それではプログラムを作りましょう。まず最初に、環境を表す構造体 Env を定義します。
リスト : 環境の定義と生成
typedef struct _env {
Symbol *var;
double val;
struct _env *next;
} Env;
// コンストラクタ
Env *acons(Symbol *sym, double n, Env *env)
{
Env *e = GC_MALLOC(sizeof(Env));
e->var = sym;
e->val = n;
e->next = env;
return e;
}
Env のメンバ変数 var にシンボルを格納し、val に数値を格納します。連結リストと同様に、next は次の環境へのポインタを格納し、終端は NULL で表します。関数 acons は引数のシンボル sym と数値 n を環境 env に追加します。GC_MALLOC で Env の実体 e を取得し、メンバ変数を引数の値で初期化します。最後に新しい環境 e を返します。
次は環境のアクセス関数を作ります。
リスト ; 環境のアクセス関数
// 参照
Env *assoc(Symbol *sym, Env *env)
{
while (env != NULL) {
if (sym == env->var) break;
env = env->next;
}
return env;
}
// 更新
double update(Symbol *sym, double x, Env *env)
{
Env *e = assoc(sym, env);
if (e != NULL)
e->val = x; // 局所変数
else
sym->val = x; // 大域変数
return x;
}
関数 assoc は環境 env からシンボル sym を探索します。見つからない場合は NULL を返します。格納されているシンボルはポインタなので、等値演算子 == で比較することができます。あとは、単純な線形探索なので、難しいところはないでしょう。
関数 update はシンボル sym の値を x に書き換えます。最初に、assoc で環境 env から sym を探索します。e が NULL でなければ、sym は局所変数です。e->val の値を x に書き換えます。NULL ならば、大域変数の値 sym->val を x に書き換えます。
次は関数 eval で変数を評価する処理を修正します。次のリストを見てください。
リスト : 変数の評価
double eval(Expr *e, Env *env)
{
Symbol *sym;
Env *env1;
switch (e->tag) {
case Num: return e->num;
case Sym:
sym = e->ref_value;
env1 = assoc(sym, env);
if (env1 != NULL) return env1->val; // 局所変数
return sym->val; // 大域変数
case Add1: return eval(e->left, env);
・・・省略・・・
case Assign2:
sym = e->left->ref_value;
return update(sym, eval(e->right, env), env);
・・・省略・・・
}
eval の第 2 引数 env が局所変数の環境を表す連想リストです。e->tag が Sym の場合、e->ref_value はシンボルです。変数 sym に代入して、assoc で引数 env の環境から sym を探索します。env1 が NULL でなければ、sym は局所変数なので、連想リストの値 env1->val を返します。そうでなければ、大域変数 (シンボル) の値 sym->val を返します。
e->tag が Assign2 の場合、左辺の値はシンボルなので、e->left->ref_value を変数 sym にセットします。あとは、右辺の式を eval で評価して、その結果を update に渡して変数 sym の値を更新します。
次は関数 eval にユーザが定義した関数を評価する処理を追加します。
リスト : ユーザ関数の評価
// 数式の評価
double eval(Expr *e, Env *env)
{
Symbol *sym;
Env *env1;
switch (e->tag) {
・・・省略・・・
case FuncU:
{
Cell *cp = e->ref_value;
Cell *fn = car(cp);
return eval(second(fn), add_bindings(car(fn), cdr(cp), env));
}
default:
fprintf(stderr, "invalid Expr tag %d\n", e->tag);
exit(1);
}
}
e->tag が FuncU の場合、ユーザ関数を呼び出します。e->ref_value には関数呼び出しを表す連結リストが格納されています。これを取り出して変数 cp にセットします。cp の先頭要素がユーザ関数で、変数 fn にセットします。fn の第 1 要素が仮引数リストで、第 2 要素が関数本体 (式) です。
ユーザ関数を評価するときは、関数 add_bindings で変数と値を新しい環境に追加し、その環境で関数本体を eval で評価します。引数 env を書き換えていないので、再帰呼び出しから戻ってくると、局所変数は元の環境に戻ります。これで「レキシカルスコープ」を実現することができます。
関数 add_binding は次のようになります。
リスト : 変数束縛
Env *add_bindings(Cell *para, Cell *args, Env *env)
{
Env *env1 = NULL;
while (para != NULL) {
env1 = acons(car(para), eval(car(args), env), env1);
para = cdr(para);
args = cdr(args);
}
return env1;
}
add_bindings の引数 para が仮引数リスト、args が実引数 (式) を格納したリスト、env が局所変数の環境です。変数 env1 が新しい環境を表します。env1 は NULL で初期化します。ここで、env1 を env で初期化すると、局所変数の有効範囲は「ダイナミックスコープ」になります。
あとは、para と args から要素を順番に取り出し、acons で連想リストを生成して env1 に追加します。args の要素を eval で評価するときは、新しい環境ではなく元の環境 env で評価することに注意してください。
最後に関数を定義する処理を toplevel に追加します。次のリストを見てください。
リスト : 式の入力と評価
void toplevel(void)
{
if (token == Def) {
// 関数定義
get_token();
if (token != Ident) error("Symbol expected");
Symbol *sym = symbol;
if (sym->type == 1 || sym->type == 2)
error("build-in function");
get_token();
if (token != Lpar) error("'(' expected");
Cell *para = get_parameter();
Expr *body = expression();
if (token != End) error("end expected");
sym->type = 3;
sym->ref_val = cons(para, cons(body, NULL));
printf("=> %s\nCalc> ", sym->name);
fflush(stdout);
} else {
Expr *e = expression();
if (token == Semic) {
printf("=> %.16g\nCalc> ", eval(e, NULL));
fflush(stdout);
} else {
error("invalid token");
}
}
}
token が def であれば関数定義文です。get_token で次のトークンを求め、それが Ident(name) でなければエラーを送出します。シンボル sym が組み込み関数であればエラーを送出します。
次に、仮引数を get_parameter で、関数本体を expression で取り出して変数 para と body にセットします。そして、token が end で終わっていることを確認します。あとは、sym->type を 3 に、sym->ref_value に関数を表す連結リストをセットするだけです。なお、関数定義は式ではなく文なので、最後にセミコロン ( ; ) を入力する必要はありません。
あとのプログラムは簡単なので説明は割愛します。詳細はプログラムリストをお読みください。
それでは実行してみましょう。
Calc> def square(x) x * x end square Calc> square(10); 100 Calc> square(1.1111); 1.23454321 Calc> square(square(10)); 10000 Calc> def add(x, y, z) x + y + z end add Calc> add(1, 2, 3); 6 Calc> add(square(10), square(20), square(30)); 1400
square は引数 x を 2 乗する関数です。square の引数で square を呼び出すこともできます。add は引数 x, y, z を足し算します。add の引数で square や他の組み込み関数を呼び出すこともできます。
もうひとつ簡単な実行例を示しましょう。引数の有効範囲がレキシカルスコープになることを確認します。
Calc> a = 123; => 123 Calc> def print_a() print(a) end => print_a Calc> print_a(); 123 => 123 Calc> def bar(a) print(a) end => bar Calc> bar(1); 1 => 1 Calc> def foo(a) print_a() end => foo Calc> foo(1); 123 => 123
変数 a に 123 をセットします。関数 print_a は大域変数 a を print で表示します。print は今回追加した組み込み関数です。print_a を実行すると 123 と表示されます。次に、関数 bar を定義します。bar は引数 a を受け取り、print で a の値を表示します。この場合、局所変数にアクセスするので、bar(1) を実行すると 1 と表示されます。
関数 foo は引数 a を受け取って print_a を呼び出します。レキシカルスコープの場合、呼び出し元関数の引数にアクセスすることはできません。したがって、foo(1) と呼び出すと、print_a は foo の引数 a にアクセスするのではなく、大域変数 a にアクセスするので、123 と表示されます。ダイナミックスコープの場合、呼び出し元関数の局所変数にアクセスできるので、print_a で表示される変数 a の値は 1 になります。
関数 add_bindings で変数 env1 を引数 env で初期化するとダイナミックスコープになります。興味のある方は試してみてください。
//
// calc5.c : 電卓プログラム (ユーザ定義関数)
//
// Copyright (C) 2015-2023 Makoto Hiroi
//
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <stdbool.h>
#include <math.h>
#include <setjmp.h>
#include <gc.h>
#define SYM_NAME_SIZE 32
// 連結リスト
typedef struct cell {
void *item;
struct cell *next;
} Cell;
// セルの生成
Cell *cons(void *x, Cell *xs)
{
Cell *cp = GC_MALLOC(sizeof(Cell));
cp->item = x;
cp->next = xs;
return cp;
}
// 先頭要素を取り出す
void *car(Cell *cp)
{
return cp->item;
}
// 先頭要素を取り除く
Cell *cdr(Cell *cp)
{
return cp->next;
}
// 2 番目の要素
void *second(Cell *cp)
{
return car(cdr(cp));
}
// 3 番目の要素
void *third(Cell *cp)
{
return car(cdr(cdr(cp)));
}
// 長さ
int length(Cell *cp)
{
int n = 0;
while (cp != NULL) {
cp = cdr(cp);
n++;
}
return n;
}
// シンボル
typedef struct {
int type;
char name[SYM_NAME_SIZE + 1]; // 変数名
union {
double val; // 即値
void *ref_val; // 参照型
};
} Symbol;
// シンボル表
#define SYM_TBL_SIZE 512
Symbol sym_table[SYM_TBL_SIZE];
int sym_count;
// 局所変数の環境
typedef struct _env {
Symbol *var;
double val;
struct _env *next;
} Env;
// コンストラクタ
Env *acons(Symbol *sym, double n, Env *env)
{
Env *e = GC_MALLOC(sizeof(Env));
e->var = sym;
e->val = n;
e->next = env;
return e;
}
// 参照
Env *assoc(Symbol *sym, Env *env)
{
while (env != NULL) {
if (sym == env->var) break;
env = env->next;
}
return env;
}
// 更新
double update(Symbol *sym, double x, Env *env)
{
Env *e = assoc(sym, env);
if (e != NULL)
e->val = x; // 局所変数
else
sym->val = x; // 大域変数
return x;
}
// タグ
enum {Num, Add2, Sub2, Mul2, Div2, Add1, Sub1,
Assign2, Sym, Func1, Func2, FuncU};
// 構文木
typedef struct expr {
int tag;
union {
double num; // 数値
void *ref_value; // 参照型
struct { // 構文木
struct expr *left;
struct expr *right;
};
};
} Expr;
// 数値の生成
Expr *make_number(double n)
{
Expr *e = GC_MALLOC_ATOMIC(sizeof(Expr));
e->tag = Num;
e->num = n;
return e;
}
// 単項演算子の生生
Expr *make_op1(int op, Expr *e1)
{
Expr *e = GC_MALLOC(sizeof(Expr));
e->tag = op;
e->left = e1;
e->right = NULL;
return e;
}
// 二項演算子
Expr *make_op2(int op, Expr *e1, Expr *e2)
{
Expr *e = GC_MALLOC(sizeof(Expr));
e->tag = op;
e->left = e1;
e->right = e2;
return e;
}
// 関数呼び出し
Expr *make_func(Symbol *sym, int tag, Cell *cp)
{
Expr *e = GC_MALLOC(sizeof(Expr));
e->tag = tag;
e->ref_value = cons(sym->ref_val, cp);
return e;
}
// 変数の生成
Expr *make_sym(Symbol *sym)
{
Expr *e = GC_MALLOC(sizeof(Expr));
e->tag = Sym;
e->ref_value = sym;
return e;
}
// トークン
enum {Eof, Number, Ident, Assign, Add, Sub, Mul, Div, Lpar, Rpar,
Comma, Semic, Def, End, Others};
// 外部変数
int ch; // 記号
int token; // トークン
double value; // 数値
Symbol *symbol; // シンボル
jmp_buf err; // エラー脱出用
// トークン名
char *token_name[] = {
"EOF",
"Number",
"Ident",
"=",
"+",
"-",
"*",
"/",
"(",
")",
",",
";",
"Def",
"End",
"Others",
};
// 記号の先読み
void nextch(void)
{
ch = getchar();
}
// 先読み記号の取得
int getch(void)
{
return ch;
}
// エラー
_Noreturn
void error(char *mes)
{
fprintf(stderr, "%s, %s\n", mes, token_name[token]);
longjmp(err, 1);
}
// シンボルの探索
Symbol *lookup(const char *name)
{
for (int i = 0; i < sym_count; i++) {
Symbol *sym = &sym_table[i];
if (strcmp(sym->name, name) == 0) return sym;
}
return NULL;
}
// シンボルの生成
Symbol *gensym(const char *name)
{
if (sym_count >= SYM_TBL_SIZE) error("Symbol table is full");
Symbol *sym = &sym_table[sym_count++];
strcpy(sym->name, name);
sym->val = 0;
sym->type = 0;
return sym;
}
// 組み込み関数
// 表示
double print(double x)
{
printf("%.16g\n", x);
return x;
}
// 組み込み関数の初期化
void init_func1(const char *name, double (*func)(double))
{
Symbol *sym = gensym(name);
sym->type = 1;
sym->ref_val = func;
}
void init_func2(const char *name, double (*func)(double, double))
{
Symbol *sym = gensym(name);
sym->type = 2;
sym->ref_val = func;
}
void init_func(void)
{
init_func1("sqrt", sqrt);
init_func2("fmod", fmod);
init_func2("pow", pow);
init_func1("exp", exp);
init_func1("log", log);
init_func1("log10", log10);
init_func1("fabs", fabs);
init_func1("ceil", ceil);
init_func1("floor", floor);
init_func1("sin", sin);
init_func1("cos", cos);
init_func1("tan", tan);
init_func1("asin", asin);
init_func1("acos", acos);
init_func1("atan", atan);
init_func2("atan2", atan2);
init_func1("sinh", sinh);
init_func1("cosh", cosh);
init_func1("tanh", tanh);
init_func1("print", print);
}
// シンボル (識別子) を取得する
Symbol *get_ident(void)
{
char name[SYM_NAME_SIZE + 1];
int i = 0;
name[i++] = getch();
nextch();
while (true) {
int c = getch();
if (!isalnum(c) && c != '_') break;
name[i++] = c;
if (i > SYM_NAME_SIZE)
error("symbol name is too long");
nextch();
}
name[i] = '\0';
Symbol *sym = lookup(name);
if (sym == NULL)
sym = gensym(name);
return sym;
}
#define SIZE 1024
// 整数部をバッファに格納する
int get_fixnum(char *buff, int i)
{
while (isdigit(getch())) {
buff[i++] = getch();
nextch();
}
return i;
}
// 数値を求める
double get_number(void)
{
char buff[SIZE + 1];
char *err;
int i = get_fixnum(buff, 0);
if (getch() == '.') {
buff[i++] = getch();
nextch();
i = get_fixnum(buff,i);
}
if (getch() == 'e' || getch() == 'E') {
buff[i++] = getch();
nextch();
if (getch() == '+' || getch() == '-') {
buff[i++] = getch();
nextch();
}
i = get_fixnum(buff, i);
}
buff[i] = '\0';
double value = strtod(buff, &err);
if (*err != '\0')
error("get_number: not Number\n");
return value;
}
// トークンの切り分け
void get_token(void)
{
// 空白文字の読み飛ばし
while (isspace(getch())) nextch();
if (isdigit(getch())) {
token = Number;
value = get_number();
} else if (isalpha(getch())) {
symbol = get_ident();
if (strcmp(symbol->name, "def") == 0)
token = Def;
else if (strcmp(symbol->name, "end") == 0)
token = End;
else
token = Ident;
} else {
switch(getch()){
case '=':
token = Assign;
nextch();
break;
case '+':
token = Add;
nextch();
break;
case '-':
token = Sub;
nextch();
break;
case '*':
token = Mul;
nextch();
break;
case '/':
token = Div;
nextch();
break;
case '(':
token = Lpar;
nextch();
break;
case ')':
token = Rpar;
nextch();
break;
case ';':
token = Semic;
nextch();
break;
case ',':
token = Comma;
nextch();
break;
case EOF:
token = Eof;
break;
default:
token = Others;
}
}
}
// 構文解析
Expr *expression(void);
Expr *expr1(void);
Expr *term(void);
Expr *factor(void);
Expr *expression(void)
{
Expr *e = expr1();
if (token == Assign) {
if (e->tag != Sym) error("invalid assign form");
get_token();
return make_op2(Assign2, e, expression());
}
return e;
}
Expr *expr1(void)
{
Expr *e = term();
while (true) {
switch (token) {
case Add:
get_token();
e = make_op2(Add2, e, term());
break;
case Sub:
get_token();
e = make_op2(Sub2, e, term());
break;
default:
return e;
}
}
}
Expr *term(void)
{
Expr *e = factor();
while (true) {
switch (token) {
case Mul:
get_token();
e = make_op2(Mul2, e, factor());
break;
case Div:
get_token();
e = make_op2(Div2, e, factor());
break;
default:
return e;
}
}
}
// 引数の取得
Cell *get_argument(void)
{
Cell *cp = NULL;
get_token();
if (token == Rpar) {
get_token();
return cp;
}
while (true) {
cp = cons(expression(), cp);
if (token == Rpar) {
get_token();
return cp;
} else if (token == Comma) {
get_token();
} else
error("unexpected token in argument list");
}
}
Expr *factor(void)
{
Symbol *sym;
switch (token) {
case Lpar:
get_token();
Expr *e = expression();
if (token == Rpar)
get_token();
else
error("')' expected");
return e;
case Number:
get_token();
return make_number(value);
case Add:
get_token();
return make_op1(Add1, factor());
case Sub:
get_token();
return make_op1(Sub1, factor());
case Ident:
sym = symbol;
get_token();
if (sym->type == 0)
return make_sym(sym);
else {
if (token != Lpar) error("'(' expected");
Cell *cp = get_argument();
if (sym->type == 1) {
if (length(cp) != 1)
error("wrong number of arguments");
return make_func(sym, Func1, cp);
} else if(sym->type == 2) {
if (length(cp) != 2)
error("wrong number of arguments");
return make_func(sym, Func2, cp);
} else {
if (length(cp) != length(car(sym->ref_val)))
error("wrong number of arguments");
return make_func(sym, FuncU, cp);
}
}
default:
error("unexpected token");
}
}
// プロトタイプ宣言
double eval(Expr *, Env *);
// 変数束縛
Env *add_bindings(Cell *para, Cell *args, Env *env)
{
Env *env1 = NULL;
while (para != NULL) {
env1 = acons(car(para), eval(car(args), env), env1);
para = cdr(para);
args = cdr(args);
}
return env1;
}
// 数式の評価
double eval(Expr *e, Env *env)
{
Symbol *sym;
Env *env1;
switch (e->tag) {
case Num: return e->num;
case Sym:
sym = e->ref_value;
env1 = assoc(sym, env);
if (env1 != NULL) return env1->val; // 局所変数
return sym->val; // 大域変数
case Add1: return eval(e->left, env);
case Sub1: return -eval(e->left, env);
case Add2: return eval(e->left, env) + eval(e->right, env);
case Sub2: return eval(e->left, env) - eval(e->right, env);
case Mul2: return eval(e->left, env) * eval(e->right, env);
case Div2: return eval(e->left, env) / eval(e->right, env);
case Assign2:
sym = e->left->ref_value;
return update(sym, eval(e->right, env), env);
case Func1:
{
Cell *cp = e->ref_value;
double (*func1)(double) = car(cp);
return func1(eval(second(cp), env));
}
case Func2:
{
Cell *cp = e->ref_value;
double (*func2)(double, double) = car(cp);
return func2(eval(third(cp), env), eval(second(cp), env));
}
case FuncU:
{
Cell *cp = e->ref_value;
Cell *fn = car(cp);
return eval(second(fn), add_bindings(car(fn), cdr(cp), env));
}
default:
fprintf(stderr, "invalid Expr tag %d\n", e->tag);
exit(1);
}
}
// 仮引数の取得
Cell *get_parameter(void)
{
Cell *cp = NULL;
get_token();
if (token == Rpar) {
get_token();
return cp;
}
while (true) {
Expr *e = expression();
if (e->tag != Sym)
error("invalid parameter list");
cp = cons(e->ref_value, cp);
if (token == Rpar) {
get_token();
return cp;
} else if (token == Comma) {
get_token();
} else
error("unexpected token in argument list");
}
}
void toplevel(void)
{
if (token == Def) {
// 関数定義
get_token();
if (token != Ident) error("Symbol expected");
Symbol *sym = symbol;
if (sym->type == 1 || sym->type == 2)
error("build-in function");
get_token();
if (token != Lpar) error("'(' expected");
Cell *para = get_parameter();
Expr *body = expression();
if (token != End) error("end expected");
sym->type = 3;
sym->ref_val = cons(para, cons(body, NULL));
printf("=> %s\nCalc> ", sym->name);
fflush(stdout);
} else {
Expr *e = expression();
if (token == Semic) {
printf("=> %.16g\nCalc> ", eval(e, NULL));
fflush(stdout);
} else {
error("invalid token");
}
}
}
int main(void)
{
init_func();
printf("Calc> ");
fflush(stdout);
nextch();
while (true) {
if (!setjmp(err)) {
get_token();
if (token == Eof) break;
toplevel();
} else {
// 入力のクリア
while (getch() != '\n') nextch();
printf("Calc> ");
fflush(stdout);
}
}
printf("bye\n");
return 0;
}