Functional Programming

電卓プログラムの作成

今回は簡単な電卓プログラムを例題にして、「字句解析 (lexical analysis)」と「構文解析 (syntax analysys)」の基本的な手法について説明します。Haskell で字句解析と構文解析を行う場合、Parsec というモジュールを使用するのが定番のようですが、今回は字句解析と構文解析のお勉強ということで、Parsec を使わずにプログラムを作ってみましょう。

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

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

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


                        図 : コンパイラの構造

字句解析は入力された記号を順番に調べて、名前、数値、予約語、演算子など、意味のある「かたまり (トークン : 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 や case などで、{ } は繰り返しで表すことができます。

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

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

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

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

因子の定義に ("+" | "-"), 因子 を追加するだけです。これで +3 や -5 を処理することができます。

●字句解析

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

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

Haskell の場合、記号の読み込みは関数 hGetContents を使うと簡単です。hGetContents は記号をリスト (遅延ストリーム) に格納して返すので、入力された記号を大域変数に格納しておく必要はありません。切り分けたトークンはリストに格納して返すことにしましょう。

トークンの定義は次のようになります。

リスト : トークンの定義

-- 値
data Value = INT Integer | REAL Double deriving (Show, Eq)

-- トークンの定義
data Token = Number Value           -- 数値
           | Add | Sub | Mul | Div  -- 演算子
           | Lpar | Rpar            -- カッコ
           | Semic                  -- セミコロン
           | Eof                    -- ファイルの終了
           | Others Char            -- その他
  deriving (Show, Eq)

Value は式の値を表すデータ型です。整数は多倍長整数を扱う Integer を、実数は Double を使います。簡単な電卓プログラムなので、整数と整数の演算結果は整数、実数と実数の演算結果は実数とし、整数と実数の演算は整数を実数に変換してから計算することにします。

Token はトークンを表すデータ型です。Number が数値を、Add, Sub, Mul, Div が四則演算 (+, -, *, /) を表しています。Lpar と Rpar で左右のカッコを表します。Semic はセミコロン ';' を表し、数式を入力するときの区切り記号として使います。電卓プログラムはセミコロンを見つけたら、入力された数式を計算して返します。式の最後には必ずセミコロンを入力してください。

トークンをひとつ取り出す関数 getToken は次のようになります。

リスト : トークンの取得

-- 型の定義
type Lexer  = (Token, String)

-- トークンを取り出す
getToken :: String -> Lexer
getToken [] = (Eof, "")
getToken (x:xs)
  | isSpace x = getToken xs
  | isDigit x = let (s, ys@(y:_)) = span isDigit (x:xs)
                in if y == '.' || y == 'e' || y == 'E'
                   then case reads (x:xs) of
                          [] -> error "not number"  -- ありえないエラー
                          [(y', ys')] -> (Number (REAL y'), ys')
                   else (Number (INT (read s)), ys)
  | otherwise =
      case x of
        '+' -> (Add, xs)
        '-' -> (Sub, xs)
        '*' -> (Mul, xs)
        '/' -> (Div, xs)
        '(' -> (Lpar, xs)
        ')' -> (Rpar, xs)
        ';' -> (Semic, xs)
        _   -> (Others x, xs)

関数 getToken は文字列を受け取って、取り出したトークンと残りの文字列をタプルに格納して返します。Lexer は (Token, String) を表すデータ型です。引数が空リストであれば Eof を返します。次に、空白文字を読み飛ばします。空白文字のチェックはモジュール Data.Char にある関数 isSpace で行います。改行文字も空白文字として認識されることに注意してください。空白文字の場合は getToken を再帰呼び出しして空白文字を読み捨てます。

次の節で、先頭の記号が数字 (0 - 9) か関数 isDigit でチェックします。そうであれば、数字を表す記号を取り出して、数値に変換して返します。最初に、span isDigit で連続している数字を取り出します。次の記号 y がドット (.), e, E のどれかであれば浮動小数点数を表していると判断して、文字列 (x:xs) を reads で Double に変換します。先頭は数字を表す記号なので、この変換でエラーが発生することはありません。そうでなければ、取り出した文字列 s を read で Integer に変換します。

それ以外の場合は、変数 x の値で処理を分岐します。+, -, *, / の場合は演算子なので、該当するトークンを返します。( と ) の場合はカッコを表すトークン Lpar, Rpar を返します。; の場合はセミコロンを表す Semic を返します。それ以外の場合はトークン Others を返します。

数式をトークンリストに変換するプログラムは次のようになります。

リスト : 数式をトークンリストに変換する

lexer :: String -> ([Token], String)
lexer xs =
  let (t, ys) = getToken xs
  in case t of 
      Semic -> ([Semic], ys)
      Eof   -> ([Eof], ys)
      _     -> let (ts, zs) = lexer ys
               in ts `seq` zs `seq` (t:ts, zs)

関数 lexer は文字列を受け取り、それをトークンに切り分けてリストに格納して返します。返り値の型は ([Token], String) になります。プログラムは簡単で、getToken でトークンをひとつ取り出し、残りの文字列に対して lexer を再帰呼び出しします。その返り値のリストに取り出したトークンを追加するだけです。

トークンが Semic まはた Eof の場合は、トークンをリストに格納して返します。これが再帰呼び出しの停止条件になります。なお、数式の入力に hGetContents を使用すると、lexer の引数 xs には遅延リストが渡されます。今回は正格評価にしたいので、返り値 (t:ts, zs) を返す前に、seq で ts と zs を評価しています。

それでは実際に試してみましょう。

*Main> lexer "123456789;"
([Number (INT 123456789),Semic],"")
*Main> lexer "1234.5678;"
([Number (REAL 1234.5678),Semic],"")
*Main> lexer "1234.5678 / 9;"
([Number (REAL 1234.5678),Div,Number (INT 9),Semic],"")
*Main> lexer "1 + 2 * 3 - 4;"
([Number (INT 1),Add,Number (INT 2),Mul,Number (INT 3),Sub,Number (INT 4),Semic],"")
*Main> lexer "(1 + 2) * (3 - 4);"
([Lpar,Number (INT 1),Add,Number (INT 2),Rpar,Mul,Lpar,Number (INT 3),Sub,Number (INT 4),Rpar,Semic],"")

●構文解析

次は構文解析を作りましょう。Scheme 入門では構文解析のときに式の計算もいっしょに行っていましたが、今後の拡張のことを考えて、今回は簡単な「構文木」を組み立てることにします。Haskell や ML 系言語の場合、木構造の操作は簡単に行うことができるので、インタプリタやコンパイラは他の言語よりも作りやすいと思います。

最初に、構文木 (式) を表すデータ型 Expr を定義します。

リスト : 構文木の定義

data Expr = Num Value
          | Op1 (Value -> Value) Expr
          | Op2 (Value -> Value -> Value) Expr Expr

Num は数値 (Value) を表します。Op1 は単項演算子を、Op2 は二項演算子を表します。演算子は関数で表します。Op1 は 1 つの式を、Op2 は 2 つの式を格納します。

簡単な例を示しましょう。なお、二項演算子 (関数) は add, sub, mul で、単項演算子の - は neg で表しています。

1 + 2 - 3  => Op2(sub, Op2(add, Num (INT 1), Num (INT 2)), Num (INT 3))
1 + 2 * 3  => Op2(add, Num (INT 1), Op2(mul, Num (INT 2), Num (INT 3)))
1 + -2 * 3 => Op2(add, Num (INT 1), Op2(mul, Op1(neg, Num (INT 2)), Num (INT 3)))

1 + 2 * 3 は * の優先順位が高いので、Op2(mul, ...) が Op2(add, ...) の子になります。

プログラムは次のようになります。

リスト : 構文解析 (1)

-- 型の定義
type Calc a = Either String a

-- エラー
calcError :: String -> Calc a
calcError s = Left s

-- 数式の計算
factor :: [Token] -> Calc (Expr, [Token])
factor (Number x : xs) = return (Num x, xs)
factor (Lpar : xs) = expr xs >>= \(e, y:ys) ->
                       case y of
                         Rpar -> return (e, ys)
                         _    -> calcError "')' expected"
factor (Sub : xs) = expr xs >>= \(e, ys) -> return (Op1 neg e, ys)
factor (Add : xs) = expr xs
factor (Eof : xs) = calcError "end of file"
factor (x :_ )    = calcError ("unexpected token: " ++ show x)

入力された式に間違いがある場合、構文解析でそれを検出する必要があります。この処理を行うため、今回は Either モナドを使うことにします。type で Either String a に Calc a と別名をつけます。

構文解析において、非端記号「式」に対応する関数が expr、「項」に対応する関数が term、「因子」に対応する関数が factor です。これらの関数の型は [Token] -> Calc (Expr, [Token]) になります。タプルの第 1 要素が組み立てた構文木、第 2 要素が残りのトークンリストです。正常に解析できた場合は Right (Expr, [Token]) を返し、式に間違いがあった場合は Left String を返します。Left String を返す処理を関数 calcError ^[*1] で行います。

関数 factor は EBNF の定義と同じ処理になります。リストの先頭要素 (トークン) が Number x の場合は (Num x, xs) を返します。このとき、return を使って返り値を Either モナドに包みます。Lpar (左カッコ) の場合、expr を再帰呼び出しして式 e を求めます。そして、次のトークン y が Rpar (右カッコ) であることをチェックします。右カッコがない場合は エラー ')' expected を返します。Rpar の場合は、(e, ys) を Either モナドに包んで返します。

トークンが Sub の場合は、expr を再帰呼び出しして、その値を Op1 にセットして返します。neg は単項演算子 - を処理する関数です。Add の場合は expr の値を返すだけです。トークンが Eof の場合は エラー end of file を返します。それ以外のトークンの場合は、エラー unexpected token を返します。

次は関数 term と expr を作ります。

リスト : 構文解析 (2)

term :: [Token] -> Calc (Expr, [Token])
term xs = factor xs >>= term_sub
  where
    opList = [(Mul, mul), (Div, div')]
    term_sub zs@(e, y:ys) =
      case lookup y opList of
        Nothing -> return zs
        Just op -> factor ys >>= \(e', ys') -> term_sub (Op2 op e e', ys')

expr :: [Token] -> Calc (Expr, [Token])
expr xs = term xs >>= expr_sub
  where
    opList = [(Add, add), (Sub, sub)]
    expr_sub zs@(e, y:ys) =
      case lookup y opList of
        Nothing -> return zs
        Just op -> term ys >>= \(e', ys') -> expr_sub (Op2 op e e', ys')

関数 term も EBNF の定義と同じ処理になります。最初に factor を呼び出して因子の値を局所関数 term_sub に渡します。term_sub は再帰呼び出しで繰り返しを表します。トークンが Mul, Div の場合は、factor を呼び出して次の因子の値を求め、Op2 に格納して term_sub を再帰呼び出しします。トークンが Mul, Div 以外の場合は引数 zs を　Either モナドに包んで返します。

関数 expr は term とほとんと同じ処理で、対応するトークンが Add と Sub に変わっただけです。

次は関数 expr を呼び出す関数 expression を作ります。

リスト : 構文解析 (3)

expression :: [Token] -> Calc (Expr, [Token])
expression xs = expr xs >>= \(e, y:ys) ->
  case y of
    Semic -> return (e, ys)
    _     -> calcError "expression error"

expression は expr を呼び出して、トークンリストの先頭がセミコロン Semic で終わっていることを確認します。そうでなければ、式の入力に誤りがあるので エラー expression error を返します。

リスト : エラー

calcError :: String -> Calc a
calcError s = throwError $ strMsg s

●構文木の評価

次は構文木を評価して式の値を求める関数 evalExpr を作りましょう。次のリストを見てください。

リスト :  式の計算

evalExpr :: Expr -> Value
evalExpr (Num x) = x
evalExpr (Op1 op e) = op (evalExpr e)
evalExpr (Op2 op e1 e2) = op (evalExpr e1) (evalExpr e2)

引数が Num x の場合は数値 x を返します。Op1 の場合、式 e を evalExpr で評価し、その結果を関数 op に適用します。Op2 の場合、式 e1 と e2 を evalExpr で評価し、その結果を関数 op に適用します。

算術演算を行う関数は次のように定義します。

リスト : 算術演算

neg :: Value -> Value
neg (INT x)  = INT  (- x)
neg (REAL x) = REAL (- x)

add :: Value -> Value -> Value
add (INT x)  (INT y)  = INT (x + y)
add (REAL x) (REAL y) = REAL (x + y)
add (INT x)  (REAL y) = REAL (fromIntegral x + y)
add (REAL x) (INT y)  = REAL (x + fromIntegral y)

sub :: Value -> Value -> Value
sub (INT x)  (INT y)  = INT (x - y)
sub (REAL x) (REAL y) = REAL (x - y)
sub (INT x)  (REAL y) = REAL (fromIntegral x - y)
sub (REAL x) (INT y)  = REAL (x - fromIntegral y)

mul :: Value -> Value -> Value
mul (INT x)  (INT y)  = INT (x * y)
mul (REAL x) (REAL y) = REAL (x * y)
mul (INT x)  (REAL y) = REAL (fromIntegral x * y)
mul (REAL x) (INT y)  = REAL (x * fromIntegral y)

div' :: Value -> Value -> Value
div' (INT x)  (INT y)  = INT  (x `div` y)
div' (REAL x) (REAL y) = REAL (x / y)
div' (INT x)  (REAL y) = REAL (fromIntegral x / y)
div' (REAL x) (INT y)  = REAL (x / fromIntegral y)

net は単項演算子 - の処理、add, sub, mul, div' が +, -, *, / の処理です。整数と実数の計算は、整数を fromIntegral で Double に変換して行います。

●式の入力と評価

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

リスト : 式の入力と評価

toplevel :: String -> IO ()
toplevel xs = do
  putStr "Calc> "
  let (ys, xs') = lexer xs
  case expression ys of
    Left mes     -> do putStrLn mes
                       toplevel xs'
    Right (e, _) -> do case evalExpr e of
                         INT x  -> print x
                         REAL x -> print x
                       toplevel xs'

main :: IO ()
main = do
  xs <- hGetContents stdin
  toplevel xs

関数 toplevel は lexer で文字列をトークンに分解し、その結果を expression に渡して評価します。その結果が Left mes であればエラーメッセージ mes を表示して、toplevel を再帰呼び出しします。Right (e, _) であれば、構文木 e を evalExpr で評価して、その結果を表示します。それから toplevel を再帰呼び出しします。関数 main は hGetContents stdin の返り値を toplevel に渡すだけです。これで標準入力からデータを読み込むことができます。

●実行例

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

*Main> :main
Calc> 1 + 2 + 3 + 4;
10
Calc> (1 + 2) + (3 + 4);
10
Calc> (1 + 2) * (3 + 4);
21
Calc> 123456789 * 123456789;
15241578750190521
Calc> 1.23456789 * 1.11111111;
1.3717420986282578
Calc> 3 / 2;
1
Calc> 3 / 2.0;
1.5
Calc> 1.23456789 / 1.11111111;
1.111111102111111
Calc> -1;
-1
Calc> +1;
1
Calc> /1;
unexpected token: Div
Calc> 1 + * 2;
unexpected token: Mul
Calc> (1 + 2;
')' expected
Calc> 

電卓を終了する場合は CTRL-C を入力してください。

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

●参考文献

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

●プログラムリスト

--
-- calc0.hs : 電卓プログラム
--
--            Copyright (C) 2013-2021 Makoto Hiroi
--
import Data.Char
import System.IO

-- 値
data Value = INT Integer | REAL Double deriving (Show, Eq)

-- トークンの定義
data Token = Number Value           -- 数値
           | Add | Sub | Mul | Div  -- 演算子
           | Lpar | Rpar            -- カッコ
           | Semic                  -- セミコロン
           | Eof                    -- end of file
           | Others Char            -- その他
  deriving (Show, Eq)

-- 構文木の定義
data Expr = Num Value
          | Op1 (Value -> Value) Expr
          | Op2 (Value -> Value -> Value) Expr Expr

-- 型の定義
type Lexer  = (Token, String)
type Calc a = Either String a

-- エラー
calcError :: String -> Calc a
calcError s = Left s

-- トークンをひとつ取り出す
getToken :: String -> Lexer
getToken [] = (Eof, "")
getToken (x:xs)
  | isSpace x = getToken xs
  | isDigit x = let (s, ys@(y:_)) = span isDigit (x:xs)
                in if y == '.' || y == 'e' || y == 'E'
                   then case reads (x:xs) of
                          [] -> error "not number"  -- ありえないエラー
                          [(y', ys')] -> (Number (REAL y'), ys')
                   else (Number (INT (read s)), ys)
  | otherwise =
      case x of
        '+' -> (Add, xs)
        '-' -> (Sub, xs)
        '*' -> (Mul, xs)
        '/' -> (Div, xs)
        '(' -> (Lpar, xs)
        ')' -> (Rpar, xs)
        ';' -> (Semic, xs)
        _   -> (Others x, xs)

-- 文字列をトークンリストに変換する
lexer :: String -> ([Token], String)
lexer xs =
  let (t, ys) = getToken xs
  in case t of 
      Semic -> ([Semic], ys)
      Eof   -> ([Eof], ys)
      _     -> let (ts, zs) = lexer ys
               in ts `seq` zs `seq` (t:ts, zs)

-- 算術演算
neg :: Value -> Value
neg (INT x)  = INT  (- x)
neg (REAL x) = REAL (- x)

add :: Value -> Value -> Value
add (INT x)  (INT y)  = INT (x + y)
add (REAL x) (REAL y) = REAL (x + y)
add (INT x)  (REAL y) = REAL (fromIntegral x + y)
add (REAL x) (INT y)  = REAL (x + fromIntegral y)

sub :: Value -> Value -> Value
sub (INT x)  (INT y)  = INT (x - y)
sub (REAL x) (REAL y) = REAL (x - y)
sub (INT x)  (REAL y) = REAL (fromIntegral x - y)
sub (REAL x) (INT y)  = REAL (x - fromIntegral y)

mul :: Value -> Value -> Value
mul (INT x)  (INT y)  = INT (x * y)
mul (REAL x) (REAL y) = REAL (x * y)
mul (INT x)  (REAL y) = REAL (fromIntegral x * y)
mul (REAL x) (INT y)  = REAL (x * fromIntegral y)

div' :: Value -> Value -> Value
div' (INT x)  (INT y)  = INT  (x `div` y)
div' (REAL x) (REAL y) = REAL (x / y)
div' (INT x)  (REAL y) = REAL (fromIntegral x / y)
div' (REAL x) (INT y)  = REAL (x / fromIntegral y)

-- 構文解析
factor :: [Token] -> Calc (Expr, [Token])
factor (Number x : xs) = return (Num x, xs)
factor (Lpar : xs) = expr xs >>= \(e, y:ys) ->
                       case y of
                         Rpar -> return (e, ys)
                         _    -> calcError "')' expected"
factor (Sub : xs) = expr xs >>= \(e, ys) -> return (Op1 neg e, ys)
factor (Add : xs) = expr xs
factor (Eof : xs) = calcError "end of file"
factor (x :_ )    = calcError ("unexpected token: " ++ show x)

term :: [Token] -> Calc (Expr, [Token])
term xs = factor xs >>= term_sub
  where
    opList = [(Mul, mul), (Div, div')]
    term_sub zs@(e, y:ys) =
      case lookup y opList of
        Nothing -> return zs
        Just op -> factor ys >>= \(e', ys') -> term_sub (Op2 op e e', ys')

expr :: [Token] -> Calc (Expr, [Token])
expr xs = term xs >>= expr_sub
  where
    opList = [(Add, add), (Sub, sub)]
    expr_sub zs@(e, y:ys) =
      case lookup y opList of
        Nothing -> return zs
        Just op -> term ys >>= \(e', ys') -> expr_sub (Op2 op e e', ys')

expression :: [Token] -> Calc (Expr, [Token])
expression xs = expr xs >>= \(e, y:ys) ->
  case y of
    Semic -> return (e, ys)
    _     -> calcError "expression error"

-- 構文木の評価
evalExpr :: Expr -> Value
evalExpr (Num x) = x
evalExpr (Op1 op e) = op (evalExpr e)
evalExpr (Op2 op e1 e2) = op (evalExpr e1) (evalExpr e2)

--
toplevel :: String -> IO ()
toplevel xs = do
  putStr "Calc> "
  let (ys, xs') = lexer xs
  case expression ys of
    Left mes     -> do putStrLn mes
                       toplevel xs'
    Right (e, _) -> do case evalExpr e of
                         INT x  -> print x
                         REAL x -> print x
                       toplevel xs'

main :: IO ()
main = do
  xs <- hGetContents stdin
  toplevel xs