今回は複数の式を順番に実行する begin 式と、処理を繰り返し実行する while 式を追加してみましょう。
最初に、begin と while の構文を示します。
begin 式1, 式2, ..., 式n end while 条件式 do 式 end
begin は複数の式を順番に評価し、最後に評価した式の返り値が begin の値になります。機能は Scheme の begin と同じです。while は条件式を評価して、その値が真であれば本体の式を繰り返し評価します。条件式が偽の場合は本体の式を評価しないで 0 を返します。
文法を EBNF で表すと次のようになります。
[EBNF] 文 = 関数定義 | 式. 関数定義 = "def", 関数, "(", [仮引数リスト], ")", 式, "end". 式 = 代入式 | 式1. 代入式 = 変数, "=", 式. 式1 = 式2, { ("and" | "or"), 式2}. 式2 = 式3, ("==" | "!=" | "<" | "<=" | ">" | ">="), 式3. 式3 = 項, { ("+" | "-"), 項 }. 項 = 因子, { ("*" | "/"), 因子 }. 因子 = 数値 | ("+" | "-" | "not"), 因子 | "(", 式, ")" | 変数 | 関数, "(", [引数リスト], ")" | if式 | begin式 | while式. if式 = "if", 式, "then", 式, ["else", 式], "end". begin式 = "begin", 式, { ",", 式 }, "end". while式 = "while", 式, "do", 式, "end". 変数 = 識別子 関数 = 識別子 仮引数リスト = 変数, { ",", 変数 }. 引数リスト = 式, { ",", 式 }. [注意] 数値と識別子の定義は省略
begin は式を連結リストに格納して、構文木 Expr の ref_value にセットします。タグは Bgn とします。while は条件式を構文木 Expr のメンバ変数 left に、本体の式を right に格納します。タグは Whl2 とします。トークンには while 式を表す While と do を、begin 式を表す Begin を追加します。
字句解析を行う関数 get_token の修正は簡単なので説明は割愛します。詳細はプログラムリストをお読みください。
begin と while の構文解析は関数 factor で行います。
リスト : 因子の処理 Expr *factor(void) { Symbol *sym; switch (token) { ・・・ 省略 ・・・ case Begin: get_token(); return make_begin(get_expr()); case While: { get_token(); Expr *test = expression(); if (token != Do) error("Do expected"); get_token(); Expr *body = expression(); if (token != End) error("End expected"); get_token(); return make_op2(Whl2, test, body); } ・・・ 省略 ・・・ } }
トークンが Begin の場合は関数 get_expr で式を取得して、それを関数 make_begin に渡して、begin 式を表す構文木を生成します。get_expr はあとで説明します。
トークンが While の場合、最初に expression で条件式を取り出し、変数 test にセットします。そして、トークンが Do であることを確認したら、expression で while 式の本体を取り出し、変数 body にセットします。最後にトークンが End であることを確認して、make_op2 で While 式を表す構文木を生成して返します。do や end がない場合はエラーを送出します。
関数 get_expr は次のようになります。
リスト : カンマで区切られた式を取得 Cell *get_expr() { Cell *xs = NULL; if (token == End) error("begin: empty expression"); while (true) { xs = cons(expression(), xs); if (token == End) { get_token(); return reverse(xs); } else if (token == Comma) { get_token(); } else { error("begin: unexpected token"); } } }
token が End の場合、式が無いのでエラーを送出します。そうでなければ、while ループの中で、式を expression で取得して、連結リストに格納します。このとき、式は逆順に格納されることに注意してください。token が End であれば、関数 reverse で連結リストを反転してから return で返します。token が Comma であれば、get_token で Comma を読み飛ばして、次の式を取得します。それ以外の場合はエラーを送出します。
リストを反転する関数 reverse は簡単です。次のリストを見てください。
リスト : リストの反転 Cell *reverse(Cell *xs) { Cell *ys = NULL; while (xs != NULL) { ys = cons(car(xs), ys); xs = cdr(xs); } return ys; }
引数のリスト xs の要素を順番に取り出して、リスト ys の先頭に追加していくだけです。これで xs を反転することができます。
最後に、式を評価する関数 eval_expr を修正します。
リスト : 式の評価 double eval(Expr *e, Env *env) { Symbol *sym; Env *env1; switch (e->tag) { ・・・ 省略 ・・・ case Bgn: { Cell *xs = e->ref_value; double val = 0; while (xs != NULL) { val = eval(car(xs), env); xs = cdr(xs); } return val; } case Whl2: while (eval(e->left, env) != 0) eval(e->right, env); return 0; ・・・ 省略 ・・・ } }
Whl2 の場合はC言語の while 文を使って簡単に実装できます。条件式 left を eval で評価し、結果が 0 以外 (真) であれば、本体を表す式 right を eval で評価します。繰り返しを終了したら 0 を返します。Bgn の場合も簡単です。リスト xs に格納された式を順番に eval で評価していくだけです。ただし、最後の式の評価結果を返すことに注意してください。
大きな修正はこれだけです。あとの修正は簡単なので説明は割愛します。プログラムの詳細はプログラムリストをお読みください。
それでは簡単な実行例を示します。
Calc> begin print(1), print(2), print(3) end; 1 2 3 => 3 Calc> a = 0; => 0 Calc> while a < 10 do begin print(a), a = a + 1 end end; 0 1 2 3 4 5 6 7 8 9 => 0 Calc> a; => 10
begin と while は正常に動作していますね。
次は while で階乗を計算する関数 fact を作ってみましょう。
Calc> def fact(n, a) begin a = 1, while n > 0 do begin a = a * n, n = n - 1 end end, a end end => fact Calc> n = 0; => 0 Calc> while n < 15 do begin print(fact(n, 0)), n = n + 1 end end; 1 1 2 6 24 120 720 5040 40320 362880 3628800 39916800 479001600 6227020800 87178291200 => 0
電卓プログラムは関数内で局所変数を定義できないので、局所変数の代用として関数の引数を使っています。fact は変数 a を 1 に初期化し、n が 0 よりも大きければ、a = a * n を計算して n の値を -1 します。最後に a を返します。これで階乗を計算することができます。
関数 fact を清書すると次のようになります。
リスト : 階乗 def fact(n, a) begin a = 1, while n > 0 do begin a = a * n, n = n - 1 end end, a end end
begin の中では式をカンマで区切っているので、見た目はちょっと変わっていますが、雰囲気はずいぶんとプログラミング言語らしくなってきましたね。関数本体や while 式の本体を暗黙の begin で囲めば、もう少し使いやすくなるでしょう。興味のある方はプログラムを改良してみてください。
// // calc7.c : 電卓プログラム (bigin, while の追加) // // 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; } // 反転 Cell *reverse(Cell *xs) { Cell *ys = NULL; while (xs != NULL) { ys = cons(car(xs), ys); xs = cdr(xs); } return ys; } // シンボル 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, Sel3, Eq2, Ne2, Lt2, Gt2, Le2, Ge2, And2, Or2, Not1, Bgn, Whl2}; // 構文木 typedef struct expr { int tag; union { double num; // 数値 void *ref_value; // 参照型 struct { // 構文木 struct expr *left; struct expr *right; }; // if struct { struct expr *test_c; // 条件節 struct expr *then_c; // then 節 struct expr *else_c; // else 節 }; }; } 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; } // if 文の生成 Expr *make_if(Expr *test_c, Expr *then_c, Expr *else_c) { Expr *e = GC_MALLOC(sizeof(Expr)); e->tag = Sel3; e->test_c = test_c; e->then_c = then_c; e->else_c = else_c; return e; } // begin 式の生成 Expr *make_begin(Cell *cp) { Expr *e = GC_MALLOC(sizeof(Expr)); e->tag = Bgn; e->ref_value = cp; return e; } // トークン enum {Eof, Number, Ident, Assign, Add, Sub, Mul, Div, Lpar, Rpar, Eq, Ne, Lt, Gt, Le, Ge, And, Or, Not, Comma, Semic, Def, End, If, Then, Else, Begin, While, Do, Others}; // 外部変数 int ch; // 記号 int token; // トークン double value; // 数値 Symbol *symbol; // シンボル jmp_buf err; // エラー脱出用 // トークン名 char *token_name[] = { "EOF", "Number", "Ident", "=", "+", "-", "*", "/", "(", ")", "==", "!=", "<", ">", "<=", ">=", "And", "Or", "Not", ",", ";", "Def", "End", "If", "Then", "Else", "Begin", "While", "Do", "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 if (strcmp(symbol->name, "if") == 0) token = If; else if (strcmp(symbol->name, "then") == 0) token = Then; else if (strcmp(symbol->name, "else") == 0) token = Else; else if (strcmp(symbol->name, "and") == 0) token = And; else if (strcmp(symbol->name, "or") == 0) token = Or; else if (strcmp(symbol->name, "not") == 0) token = Not; else if (strcmp(symbol->name, "begin") == 0) token = Begin; else if (strcmp(symbol->name, "while") == 0) token = While; else if (strcmp(symbol->name, "do") == 0) token = Do; else token = Ident; } else { switch(getch()){ case '=': nextch(); if (getch() == '=') { nextch(); token = Eq; } else token = Assign; break; case '!': nextch(); if (getch() == '=') { nextch(); token = Ne; } else token = Not; break; case '<': nextch(); if (getch() == '=') { nextch(); token = Le; } else token = Lt; break; case '>': nextch(); if (getch() == '=') { nextch(); token = Ge; } else token = Gt; 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 *expr2(void); // 比較演算子 Expr *expr3(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 = expr2(); while (true) { switch (token) { case And: get_token(); e = make_op2(And2, e, expr2()); break; case Or: get_token(); e = make_op2(Or2, e, expr2()); break; default: return e; } } } // 比較演算子 Expr *expr2(void) { Expr *e = expr3(); while (true) { switch (token) { case Eq: get_token(); e = make_op2(Eq2, e, expr3()); break; case Ne: get_token(); e = make_op2(Ne2, e, expr3()); break; case Lt: get_token(); e = make_op2(Lt2, e, expr3()); break; case Gt: get_token(); e = make_op2(Gt2, e, expr3()); break; case Le: get_token(); e = make_op2(Le2, e, expr3()); break; case Ge: get_token(); e = make_op2(Ge2, e, expr3()); break; default: return e; } } } // 加法演算子 Expr *expr3(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"); } } // カンマで区切られた式を取得 Cell *get_expr() { Cell *xs = NULL; if (token == End) error("begin: empty expression"); while (true) { xs = cons(expression(), xs); if (token == End) { get_token(); return reverse(xs); } else if (token == Comma) { get_token(); } else { error("begin: unexpected token"); } } } 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 Not: get_token(); return make_op1(Not1, factor()); case If: { get_token(); Expr *test_c = expression(); if (token != Then) error("invalid if form"); get_token(); Expr *then_c = expression(); Expr *else_c = NULL; if (token == Else) { get_token(); else_c = expression(); } if (token != End) error("end expected"); get_token(); return make_if(test_c, then_c, else_c); } case Begin: get_token(); return make_begin(get_expr()); case While: { get_token(); Expr *test = expression(); if (token != Do) error("Do expected"); get_token(); Expr *body = expression(); if (token != End) error("End expected"); get_token(); return make_op2(Whl2, test, body); } 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; // env で初期化するとダイナミックスコープになる 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 Not1: return eval(e->left, env) == 0 ? 1 : 0; 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 Eq2: return eval(e->left, env) == eval(e->right, env) ? 1 : 0; case Ne2: return eval(e->left, env) != eval(e->right, env) ? 1 : 0; case Lt2: return eval(e->left, env) < eval(e->right, env) ? 1 : 0; case Gt2: return eval(e->left, env) > eval(e->right, env) ? 1 : 0; case Le2: return eval(e->left, env) <= eval(e->right, env) ? 1 : 0; case Ge2: return eval(e->left, env) >= eval(e->right, env) ? 1 : 0; case And2: return eval(e->left, env) != 0 ? eval(e->right, env) : 0; case Or2: { double val = eval(e->left, env); return val == 0 ? eval(e->right, env) : val; } case Assign2: sym = e->left->ref_value; return update(sym, eval(e->right, env), env); case Sel3: if (eval(e->test_c, env) != 0) return eval(e->then_c, env); else if (e->else_c != NULL) return eval(e->else_c, env); else return 0; case Bgn: { Cell *xs = e->ref_value; double val = 0; while (xs != NULL) { val = eval(car(xs), env); xs = cdr(xs); } return val; } case Whl2: while (eval(e->left, env) != 0) eval(e->right, env); return 0; 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(); // 再帰定義対策 sym->type = 3; Cell *fn = cons(para, NULL); sym->ref_val = fn; Expr *body = expression(); if (token != End) { sym->type = 0; error("end expected"); } else { fn->next = 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; }