Functional Programming

電卓プログラムの作成

今回は簡単な電卓プログラムを例題にして、「字句解析 (lexical analysis)」と「構文解析 (syntax analysys)」の基本的な手法について説明します。

●プログラミング言語処理系の基本的な構造

簡単な電卓プログラムといっても、基本的な構造はプログラミング言語の処理系 (インタプリタやコンパイラ) と大きな違いはありません。たとえばコンパイラの場合、次のような構造に分けることができます。

ソースコード -> [字句解析] -> [構文解析] -> [意味解析] -> [コード生成] -> 目的コード


                        図 : コンパイラの構造

字句解析は入力された文字を順番に調べて、名前、数値、予約語、演算子など、意味のある「かたまり (トークン : token)」に分解します。構文解析はトークンの並びが構文規則にあっているかチェックします。構文解析を行うプログラムのことを「パーサ (parser)」と呼びます。構文的には正しいプログラムでも、意味のうえでは間違っている場合があります。これをチェックするのが意味解析です。コード生成はターゲットマシンで実行するためのコード (機械語) を生成します。機械語ではなくアセンブリコードを出力するコンパイラも多いです。

インタプリタの場合、字句解析、構文解析、意味解析まではコンパイラとほとんど同じです。コードを生成するかわりに、プログラムを解釈して実行する処理が必要になります。最も原始的な方法は、ソースコートを読み込みながら逐次実行していくことです。この場合、字句解析、構文解析、意味解析を何度も繰り返し行うことになります。簡単な方法ですが、ループなどの繰り返しがある場合、無駄な処理が多くなるため実行速度は遅くなります。

もうひとつは、字句解析、構文解析、意味解析まで行った情報を何らかの形で保存しておき、それを解釈しながら実行していくことです。一般的には、解析して得られた情報は「構文木」という形で保存されます。また、プログラムを実行するための仮想マシンを用意し、そのマシンが直接実行できるコード (バイトコードなど) を生成する方法もあります。この場合、仮想マシンがコードを読み込みながら実行していくことになります。

今回作成する電卓プログラムは式を計算するだけの簡単なものなので、字句解析と構文解析ともに難しいところはほとんどありません。構文解析は「再帰降下法」を使うと簡単にプログラムできます。

●文法の表現

ほとんどのプログラミング言語は、「文脈自由文法 (context free grammer : CFG)」という方法で文法を定義することができます。文脈自由文法は「生成文法」と呼ばれる文法の一種で、文を生成する規則を定義し、その規則によって生成される文はその文法を満たしていると考えます。逆に、文法を満たしていない文は、その規則では生成することができない、ということになります。文脈自由文法は BNF (Backus Naur Form)、それを拡張した EBNF や構文図などで表すことができます。

ここで用語について簡単に説明します。「終端記号」は対象となるプログラミング言語で使用する記号のことで、BNF や EBNF では "..." で表します。「非端記号」は BNF や EBNF で用いる記号のことで、BNF では <...> で表します。

BNF の場合、構文規則は次の形式で表します。

非端記号 ::= 定義1 | 定義2 | ... | 定義n

ただし、| は「または」を表す。定義は終端記号や非端記号からなる。

簡単な例を示しましょう。a がいくつか並んだあとに b がいくつか並んだ記号列 (aa...bb...) を BNF であらわすと次のようになります。

<SeqAB> ::= <SeqA> <SeqB>
<SeqA>  ::= "a" | "a" <SeqA>
<SeqB>  ::= "b" | "b" <SeqB>

記号列を <SeqAB> とすると、a が並んだ記号列 <SeqA> のあとに b が並んだ記号列 <SeqB> が続けばいいので、定義は <SeqA> <SeqB> になります。<SeqA> は記号 "a" だけではなく "a" のあとに <SeqA> が続くパターンがあります。定義は "a" | "a" <SeqA> となります。<SeqB> も同様です。ここで、<SeqA> と <SeqB> は再帰的に定義されていることに注意してください。

この規則を適用することで、<SeqAB> を満たす任意の記号列を生成することができます。次の例を見てください。

<SeqAB> => <SeqA> <SeqB> => "a" <SeqA> <SeqB> => "a" "a" <SeqA> <SeqB>
 => "a" "a" "a" <SeqB> => "a" "a" "a" "b" <SeqB> => "a" "a" "a" "b" "b"

<SeqA> に定義 "a" <SeqA> を適用すると、"a" が一つ多い <SeqA> を生成することができます。定義 "a" を適用すると、そこで <SeqA> の生成は終了します。同様に <SeqB> の定義を適用することで記号列 <SeqB> を生成し、最終的には記号列 <SeqAB> を生成することができます。

文法が複雑になると BNF では読みにくくなることがあります。このような場合、EBNF を使うと便利です。EBNF で用いられる主な規則を示します。

• 非端記号は <...> で囲まない
• ::= のかわりに = を使う
• 非端記号や終端記号を並べる場合はカンマ , で区切る
• 規則の最後に記号 (セミコロンやピリオドなど) を付加する
• { α } : αの 0 回以上の繰り返し
• [ α ] : αまたは空
• ( α ) : グループ化

EBNF で用いられる記号は正規表現と似ているので、正規表現がわかる方であれば EBNF を理解するのは難しくないでしょう。

<SeqAB> を EBNF で表すと次のようになります。

SeqAB = "a", { "a" }, "b", { "b" }.

BNF よりもわかりやすいと思います。

もうひとつ簡単な例を示しましょう。整数を EBNF で表すと、次のようになります。

整数       = ["+" | "-"], 無符号整数.
無符号整数 = 数字 | 非零数字, { 数字 }.
数字       = "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" | "0".
非零数字   = "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9".

        図 : 整数の EBNF

整数は +, - の符号が付いた (または省略された) 無符号整数で表すことができます。無符号整数は数字が 1 桁の場合と、2 桁以上ある場合に分けられます。桁が複数ある場合、先頭が 0 以外の数字 (非零数字) で、そのあとに数字がいくつか続きます。あとは、非零数字 と 数字 を定義するだけです。

●式の構文

次は数値と演算子 +, - *, / とカッコ ( ) を使った数式の構文を考えてみましょう。式は数値と演算子をつないだものです。演算子には優先順位があり、+, - よりも *, / の計算を先に行わなければなりません。そこで、*, / でつながれたものを「項 (term)」として定義することにします。すると、式は項を演算子 +, - でつないだものとして定義することができます。

次に項の定義について考えます。数値と演算子 *, / だけならば簡単ですが、カッコが出てきたら、その中を式として計算しなければなりません。そこで、演算子 *, / でつながれるものを「因子 (factor)」として定義します。そうすると、項は因子を演算子 *, / でつないだものとして定義することができます。最後に、因子を定義します。これは数値またはカッコで囲まれた式となります。

なお、演算子 +, -, *, / は左結合なので、同じ優先順位の演算子は左から順番に計算していくことに注意してください。この規則を BNF と EBNF で表すと次のようになります。

[BNF]
 <式>  ::= <項> | <式> "+" <項> | <式> "-" <項>
 <項>  ::= <因子> | <項> "*" <因子> | <項> "/" <因子>
<因子> ::= <数値> | "(" <式> ")"

[EBNF]
 式  = 項, { ("+" | "-"), 項 }.
 項  = 因子, { ("*" | "/"), 因子 }.
因子 = 数値 | "(", 式, ")".

[注意] 数値の定義は省略

たとえば、式 12 + 34 + 56 * 78 と (12 + 34 + 56) * 78 を構文木であらわすと、次のようになります。

構文木の場合、BNF の定義にそって構築すると簡単でわかりやすいでしょう。プログラムを作る場合は、EBNF の定義にそって行うと簡単です。EBNF で表した規則の左辺 (非端記号) を関数に割り当てます。右辺に出現する非端記号は対応する関数を呼び出します。終端記号は、正しい記号が現れていることを確認してそれを返します。選択 | は if や cond などで、{ } は繰り返しで表すことができます。

EBNF の定義が再帰的な構造になっているので、プログラムも再帰呼び出しの形になります。このような構文解析を「再帰降下法」と呼びます。具体的な説明はプログラムを作るところで行います。

●字句解析

それでは字句解析からプログラムを作っていきましょう。字句解析は入力ストリームから 1 記号ずつ読み取り、それをトークンに切り分けます。たとえば、数値を取得する場合、その数値が整数なのか実数なのか、また整数だとしてもそれが何桁あるのか、実際に記号を読み込んでみないとわかりません。このような場合、記号を先読みしておいて、それを大域変数に保存しておく方法がよく用いられます。

先読みした記号が数字であれば、さらに記号を読み込みます。そうでなければ、その記号を大域変数に保存しておいて、今まで読み込んだ記号から数値を生成します。そして、次の処理は大域変数に保存しておいた記号から始めればいいわけです。もちろん、記号を大域変数に保存しないで、記号を入力ストリームに戻す方法もあります。今回はオーソドックスに先読みした記号を大域変数に保存しておくことにしましょう。

記号を読み込むプログラムは次のようになります。

リスト : 記号の読み込み

;;; 大域変数
(define *ch*    #f)
(define *token* #f)
(define *value* #f)

;;; 記号の読み込み
(define (nextch)
  (set! *ch* (read-char))
  (when (eof-object? *ch*)
    (set! *ch* #\null)))

;;; 先読み記号の取得
(define (getch) *ch*)

大域変数 *ch* に先読みした記号 (文字型データ) を格納します。切り分けたトークンは *token* に、数値は *value* にセットします。トークンはシンボルで表します。下表にトークンで使用するシンボルを示します。

セミコロン ';' は数式を入力するときの区切り記号として使います。電卓プログラムはセミコロンを見つけたら、入力された数式を計算して返します。式の最後には必ずセミコロンを入力してください。

関数 nextch は標準入力から read-char で 1 バイト読み込み、それを *ch* にセットします。*ch* が eof-object であれば、*ch* を #\null 文字に書き換えます。関数 getch は *ch* の値を返すだけです。

トークンを切り分ける関数 get-token は次のようになります。

リスト : トークンの切り分け

(define (get-token)
  ;; 空白文字の読み飛ばし
  (do ()
      ((not (char-whitespace? (getch))))
    (nextch))
  (cond ((char-numeric? (getch))
         (set! *token* 'number)
         (set! *value* (get-number)))
        (else
         (case (getch)
          ((#\+)
           (set! *token* '+)
           (nextch))
          ((#\-)
           (set! *token* '-)
           (nextch))
          ((#\*)
           (set! *token* '*)
           (nextch))
          ((#\/)
           (set! *token* '/)
           (nextch))
          ((#\()
           (set! *token* 'lpar)
           (nextch))
          ((#\))
           (set! *token* 'rpar)
           (nextch))
          ((#\;)
           (set! *token* 'semic)
           (nextch))
          ((#\null)
           (set! *token* 'eof))
          (else
           (set! *token* 'others))))))

最初に空白文字を読み飛ばします。空白文字のチェックは関数 char-whitespace? で行います。改行文字も空白文字として認識されることに注意してください。空白文字の場合は nextch で次の文字を読み込みます。次に、関数 char-numeric? で先読みした記号が数字 (0 - 9) かチェックします。そうであれば、関数 get-number を呼び出して数値に変換して *value* にセットします。*token* にはシンボル number をセットします。

それ以外の場合は (getch) の値で処理を分岐します。#\+, #\-, #\*, #\- の場合は演算子なので、該当するシンボルを *token* にセットし、nextch で次の文字を読み込みます。#\( と #\) の場合はカッコを表すトークン lpar, rpar をセットします。#\; の場合はセミコロンを表すシンボル semic をセットします。#\null の場合はシンボル eof をセットします。この場合、nextch で次の文字を読み込む必要はありません。それ以外の場合はシンボル others をセットします。

次は数値を求める関数 get-number を作ります。

リスト : 数値を求める

(define (get-number)
  (let ((buff '()))
    ;; 整数を buff に格納
    (define (get-numeric)
      (do ()
          ((not (char-numeric? (getch))))
        (push! buff (getch))
        (nextch)))
    ;; 整数部
    (get-numeric)
    (case (getch)
      ((#\.)
       ;; 小数部
       (push! buff (getch))
       (nextch)
       (get-numeric)
       (case (getch)
         ((#\d #\D #\e #\E)
          ;; 指数部
          (push! buff (getch))
          (nextch)
          (when (or (eqv? (getch) #\+)
                    (eqv? (getch) #\-))
            (push! buff (getch))
            (nextch))
          ;; 指数の数字
          (get-numeric))))
      ((#\/)
       ;; 分数
       (push! buff (getch))
       (nextch)
       (get-numeric)))
    (string->number (list->string (reverse buff)))))

局所変数 buff に数値を表すデータを格納します。局所関数 get-numeric は数字 (0 - 9) を buff にセットします。最初に get-numeric で数字を取り出します。次に、文字が #\. であれば実数なので、#\. と小数部を表す整数を buff にセットします。そのあと、文字が #\d, #\D, #\e, #\E であれば、指数部の指定と判断してそれを buff にセットします。次に、符号 #\+, #\- があるかチェックし、指数部を表す整数を get-numeric で取得します。

整数部のあとに #\/ が続く場合は、それを分数の指定と判定します。#\/ を buff に格納して、分母を表す整数を get-numeric で取得します。最後に、buff を reverse で反転して、関数 list->string で文字列に変換し、それを関数 string->number で数値データに変換します。

●構文解析

次は構文解析を作りましょう。字句解析と構文解析は別々に処理することも可能ですが、今回のプログラムでは構文解析を行う処理から関数 get-token を呼び出し、そのつど字句解析を行うことにします。プログラムは次のようになります。

リスト : 構文解析

;;; 式
(define (expression)
  (let loop ((val (term)))
    (case *token*
      ((+)
       (get-token)
       (loop (+ val (term))))
      ((-)
       (get-token)
       (loop (- val (term))))
      (else val))))

;;; 項
(define (term)
  (let loop ((val (factor)))
    (case *token*
      ((*)
       (get-token)
       (loop (* val (factor))))
      ((/)
       (get-token)
       (loop (/ val (factor))))
      (else val))))

;;; 因子
(define (factor)
  (case *token*
    ((lpar)
     (get-token)
     (begin0
         (expression)
       (if (eq? *token* 'rpar)
           (get-token)
           (error "')' expected"))))
    ((number)
     (begin0 *value* (get-token)))
    (else
     (error "unexpected token " *token*))))

非端記号「式」に対応する関数が expression、「項」に対応する関数が term、「因子」に対応する関数が factor です。式の定義は EBNF で 項, { ("+" | "-"), 項 } です。最初に term を呼び出して項の値を val にセットします。{ } に対応するのが named-let による繰り返しです。*token* が +, - の場合、get-token で次のトークンを求め、term を呼び出して次の項の値を求め、val と演算を行います。*token* が +, - 以外の場合は val を返します。

関数 term も EBNF の定義 因子, { ("*" | "/"), 因子} と同じ処理になります。最初に factor を呼び出して因子の値を val にセットします。term と同様に { } に対応するのが named-let による繰り返しです。*token* が *, / の場合は、get-token で次のトークンを求め、factor を呼び出して次の因子の値を求め、val と演算を行います。*token* が *, / 以外の場合は val を返します。

関数 factor も EBNF の定義 数値 | "(" 式 ")" と同じ処理になります。*token* が lpar (左カッコ) の場合、get-token で次のトークンを求めてから、expression を再帰呼び出しして式の値を求めます。begin0 は begin と同様に引数を順番に実行しますが、第 1 引数の結果が begin0 の返り値になります。これは Common Lisp の prog1 と同じ動作で、Gauche には定義されていますが R7RS-small にはありません。Gauche の begin0 は多値に対応していますが、今回は多値に対応していない簡略版をマクロ定義しました。

次に、*token* の値が rpar (右カッコ) であることをチェックします。右カッコがない場合はエラーを送出します。rpar の場合は、get-token で次のトークンを求めてから val を返します。*token* が number の場合は *value* の値を返します。このとき、get-token で次のトークンを求めることに注意してください。*token* がそれ以外の値であればエラーを送出します。

●式の入力と評価

最後に式を入力して expression を評価する処理を作ります。次のリストを見てください。

リスト : 式の入力と評価

;;; 入力された式を評価する
(define (toplevel)
  (let ((val (expression)))
    (cond ((eq? *token* 'semic)
           (display "=> ")
           (display val)
           (newline)
           (display "Calc> ")
           (flush-output-port))
          (else
           (error "invalid token " *token*)))))

;;; 入力をクリアする
(define (clear-input-data)
  (do ()
      ((eqv? *ch* #\newline))
    (nextch))
  (display "Calc> ")
  (flush-output-port))

;;; 電卓プログラム
(define (calc)
  (display "Calc> ")
  (flush-output-port)
  (nextch)
  (call/cc
    (lambda (break)
      (let loop ()
        (guard (err
                (else (display "ERROR: ")
                      (display (error-object-message err))
                      (unless
                       (null? (error-object-irritants err))
                       (display (car (error-object-irritants err))))
                      (newline)
                      (clear-input-data)))
          (get-token)
          (when (eqv? *token* 'eof) (break #t))
          (toplevel))
        (loop)))))

;;; 実行
(calc)

関数 toplevel は expression を評価して入力された数式を計算します。そのあと、*token* がセミコロン (semic) かチェックします。セミコロンであれば、expression の返り値 val を表示します。そうでなければ、入力された数式に誤りがあるのでエラーを送出します。

関数 calc は電卓プログラムを実行します。まず最初にプロンプト "Calc> " を表示し、nextch で 1 記号先読みします。それから、数式の "入力 - 評価 - 表示" を繰り返し行います。継続 break は繰り返しから脱出するために使います。get-token で切り分けたトークンが eof ならば break を評価して電卓プログラムを終了します。そうでなければ toplevel を評価します。

guard は R7RS-small に定義されているエラーを捕捉するための構文です。簡単に説明すると、guard はエラーを補足すると、そのエラーに対応する節に定義されている S 式を評価します。calc の場合、display でエラーメッセージを表示して、関数 clear-input-date で入力されたデータをクリアし、clear-input-data の返り値をそのまま返します。エラーがない場合は、toplevel の返り値をそのまま返します。例外の詳細については拙作のページ Scheme 入門: 例外 をお読みください。

●実行例

それでは簡単な実行例を示します。

$ rlwrap gosh -r7 calc.scm
Calc> 1 - 2 + 3 * 4;
=> 11
Calc> (1 - 2 + 3) * 4;
=> 8
Calc> (1 - 2) * (3 + 4);
=> -7
Calc> 1.23456 * 1.11111;
=> 1.3717319616
Calc> 1.23456 / 1.11111;
=> 1.1111051111051111
Calc> 1/2 / 2/3;
=> 3/4
Calc> 1 + 2 * -3;
ERROR: unexpected token -
Calc> 1/2.0;
ERROR: invalid token others
Calc> 1 / 2.0;
=> 0.5
Calc>

このプログラムでは単項演算子 (+, -) をサポートしていないので、-3 を入力するとエラーになります。また、1/2.0 を入力すると、1/2 で分数を生成するので、ドット '.' の入力でエラーになります。1 / 2.0 のように空白で分けると正しく計算されます。

●単項演算子の追加

次は、単項演算子の + と - を追加しましょう。文法は次のようになります。

[EBNF]
 式  = 項 { ("+" | "-"), 項 }.
 項  = 因子 { ("*" | "/"), 因子 }.
因子 = 数値 | ("+" | "-"), 因子 | "(" 式 ")".

[注意] 数値の定義は省略

因子の定義に ("+" | "-"), 因子 を追加するだけです。これで +3 や -5 を処理することができます。プログラムは次のようになります。

リスト : 単項演算子の追加

;;; 因子
(define (factor)
  (case *token*
    ((lpar)
     (get-token)
     (begin0
         (expression)
       (if (eq? *token* 'rpar)
           (get-token)
           (error "')' expected"))))
    ((number)
     (begin0 *value* (get-token)))
    ((+)
     ;; 単項演算子
     (get-token)
     (factor))
    ((-)
     ;; 単項演算子
     (get-token)
     (- (factor)))
    (else
     (error "unexpected token " *token*))))

因子で *token* が + の場合は、get-token のあとに factor を再帰呼び出しするだけです。- の場合は get-token のあとに (- (factor)) を評価するだけです。とても簡単ですね。

●実行例 (2)

それでは簡単な実行例を示します。

Calc> -3;
=> -3
Calc> +3.14;
=> 3.14
Calc> 1 + 2 + -3;
=> 0
Calc> 1 + 2 + - 3 * - 4;
=> 15

正常に動作していますね。

今回はここまでです。次回は変数と組込み関数の機能を追加してみましょう。

●参考文献

1. 松田晋, 『実践アルゴリズム戦略 解法のテクニック 再帰降下型構文解析』, C MAGAZINE 1992 年 9 月号, ソフトバンク
2. 水野順, 『スクリプト言語を作ろう』, C MAGAZINE 2000 年 5 月号, ソフトバンク
3. 松浦健一郎, 『コンパイラの作成』, C MAGAZINE 2003 年 1 月号, ソフトバンク
4. 高田昌之, 『インタプリタ進化論』, ＣＱ出版社, 1992
5. 久野靖, 『言語プロセッサ』, 丸善株式会社, 1993

●プログラムリスト

;;;
;;; calc.scm : 電卓プログラム (R7RS-small 対応版)
;;;
;;;            Copyright (C) 2011-2021 Makoto Hiroi
;;;
(import (scheme base) (scheme cxr) (scheme char)
        (scheme read) (scheme write))

;;;
;;; マクロ定義
;;;

;;; データの追加
(define-syntax push!
  (syntax-rules ()
    ((_ place x) (set! place (cons x place)))))

;;; データの取得
(define-syntax pop!
  (syntax-rules ()
    ((_ place)
     (let ((x (car place)))
       (set! place (cdr place))
       x))))

;;;
;;; 大域変数
;;;
(define *ch*    #f)
(define *token* #f)
(define *value* #f)

;;;
;;; 入力処理
;;;

;;; 記号の読み込み
(define (nextch)
  (set! *ch* (read-char))
  (when (eof-object? *ch*)
    (set! *ch* #\null)))

;;; 先読み記号の取得
(define (getch) *ch*)

;;; 数値を求める
(define (get-number)
  (let ((buff '()))
    ;; 整数を buff に格納
    (define (get-numeric)
      (do ()
          ((not (char-numeric? (getch))))
        (push! buff (getch))
        (nextch)))
    ;; 整数部
    (get-numeric)
    (case (getch)
      ((#\.)
       ;; 小数部
       (push! buff (getch))
       (nextch)
       (get-numeric)
       (case (getch)
         ((#\d #\D #\e #\E)
          ;; 指数部
          (push! buff (getch))
          (nextch)
          (when (or (eqv? (getch) #\+)
                    (eqv? (getch) #\-))
            (push! buff (getch))
            (nextch))
          ;; 指数の数字
          (get-numeric))))
      ((#\/)
       ;; 分数
       (push! buff (getch))
       (nextch)
       (get-numeric)))
    (string->number (list->string (reverse buff)))))

;;; トークンの切り分け
(define (get-token)
  ;; 空白文字の読み飛ばし
  (do ()
      ((not (char-whitespace? (getch))))
    (nextch))
  (cond ((char-numeric? (getch))
         (set! *token* 'number)
         (set! *value* (get-number)))
        (else
         (case (getch)
          ((#\+)
           (set! *token* '+)
           (nextch))
          ((#\-)
           (set! *token* '-)
           (nextch))
          ((#\*)
           (set! *token* '*)
           (nextch))
          ((#\/)
           (set! *token* '/)
           (nextch))
          ((#\()
           (set! *token* 'lpar)
           (nextch))
          ((#\))
           (set! *token* 'rpar)
           (nextch))
          ((#\;)
           (set! *token* 'semic)
           (nextch))
          ((#\null)
           (set! *token* 'eof))
          (else
           (set! *token* 'others))))))

;;;
;;; 式の評価
;;;

;;; 式
(define (expression)
  (let loop ((val (term)))
    (case *token*
      ((+)
       (get-token)
       (loop (+ val (term))))
      ((-)
       (get-token)
       (loop (- val (term))))
      (else val))))

;;; 項
(define (term)
  (let loop ((val (factor)))
    (case *token*
      ((*)
       (get-token)
       (loop (* val (factor))))
      ((/)
       (get-token)
       (loop (/ val (factor))))
      (else val))))

;;; 因子
(define (factor)
  (case *token*
    ((lpar)
     (get-token)
     (begin0
         (expression)
       (if (eq? *token* 'rpar)
           (get-token)
           (error "')' expected"))))
    ((number)
     (begin0 *value* (get-token)))
    ((+)
     ;; 単項演算子
     (get-token)
     (factor))
    ((-)
     ;; 単項演算子
     (get-token)
     (- (factor)))
    (else
     (error "unexpected token " *token*))))

;;; 入力された式を評価する
(define (toplevel)
  (let ((val (expression)))
    (cond ((eq? *token* 'semic)
           (display "=> ")
           (display val)
           (newline)
           (display "Calc> ")
           (flush-output-port))
          (else
           (error "invalid token " *token*)))))

;;; 入力をクリアする
(define (clear-input-data)
  (do ()
      ((eqv? *ch* #\newline))
    (nextch))
  (display "Calc> ")
  (flush-output-port))

;;; 電卓プログラム
(define (calc)
  (display "Calc> ")
  (flush-output-port)
  (nextch)
  (call/cc
    (lambda (break)
      (let loop ()
        (guard (err
                (else (display "ERROR: ")
                      (display (error-object-message err))
                      (unless
                       (null? (error-object-irritants err))
                       (display (car (error-object-irritants err))))
                      (newline)
                      (clear-input-data)))
          (get-token)
          (when (eqv? *token* 'eof) (break #t))
          (toplevel))
        (loop)))))

;;; 実行
(calc)