M.Hiroi's Home Page

Functional Programming

お気楽 Standard ML of New Jersey 入門

[ PrevPage | SML/NJ | NextPage ]

電卓プログラムの作成 (2)

前回は四則演算を行う簡単な電卓プログラムを作りました。今回は電卓プログラムに変数と関数の機能を追加してみましょう。

●変数

前回作成した電卓は、計算結果を表示したあとそれを保持していないので、計算結果を再利用することができません。一般の電卓のように、計算結果を記憶しておくメモリ機能があると便利です。この機能を「変数 (variable)」として実現することにします。プログラミング言語で言えば、大域変数 (グローバル変数) と同じ機能になります。

変数を実装するのであれば、変数に値を代入する操作が必要になります。文法に「文」を定義する、つまり「代入文」を追加する方法もありますが、今回は簡単な電卓プログラムなので、代入演算子 "=" を用意して式の中で処理することにしましょう。代入演算子は右辺の式の値を左辺の変数に代入するので、文法は次のように表すことができます。

[EBNF]
  式   = 代入式 | 式1.
代入式 = 変数, "=", 式.
 式1  = 項, { ("+" | "-"), 項 }.
  項   = 因子, { ("*" | "/"), 因子 }.
 因子  = 数値 | ("+" | "-"), 因子 | "(", 式, ")" | 変数.
 変数  = 識別子

[注意] 数値と識別子の定義は省略

演算子 = は他の演算子と違って右結合になることに注意してください。このため、他の演算子よりも優先順位を低くし、右辺の式の評価を優先して行います。そして、その結果を変数にセットします。文法では、式を 代入式 | 式1 に変更し、代入式で演算子 = の処理を行います。式1は今までの式の定義と同じです。これで演算子 = の優先順位を低くすることができます。あとは代入式の処理で、右辺の式を先に評価して、その結果を変数にセットすればいいわけです。

それから、因子に「変数」を追加します。変数の定義は「識別子」とし、識別子は先頭文字がアルファベットで、それ以降の文字はアルファベットだけではなく数字 (0 - 9) を含んでいてもかまいません。Scheme 入門で作成したプログラムと違って、今回のプログラムは構文木を組み立ててからそれを評価するので、構文解析の段階では変数をそのまま返すだけで OK です。

●関数

次は文法に関数を追加しましょう。関数の処理は「因子」に追加します。

[EBNF]
  式   = 代入式 | 式1.
代入式 = 変数, "=", 式.
 式1  = 項, { ("+" | "-"), 項 }.
  項   = 因子, { ("*" | "/"), 因子 }.
 因子  = 数値 | ("+" | "-"), 因子 | "(", 式, ")" | 変数 | 関数, "(", 引数リスト, ")".
 変数  = 識別子
 関数  = 識別子

引数リスト = 式, { ",", 式 }.

[注意] 数値と識別子の定義は省略

関数の名前は識別子とし、そのあとに引数をカッコで囲んで渡します。カッコの中は「引数リスト」として定義します。これは「式」をカンマで区切って並べたもので、一般的な手続き型言語の関数呼び出しと同じ形式になります。

ただし、変数と関数は同じ識別子なので、このままでは区別することができません。この場合、簡単な方法が 2 つあります。ひとつは関数として登録されている識別子を関数とする方法、もうひとつは次のトークンが左カッコ (lpar) であれば関数とする方法です。今回は前者の方法を採用することにしましょう。

●変数と関数の操作

それではプログラムを作ります。最初に、変数と関数を表すデータ型を定義します。次のリストを見てください。

リスト : データ型の定義

(* 演算子の定義 *)
datatype operator = Add | Sub | Mul | Quo | Assign

(* 関数の定義 *)
datatype func = F1 of value -> value
              | F2 of (value * value) -> value

(* トークンの定義 *)
datatype token = Number of value        (* 数 *)
               | Ident of string        (* 識別子 *)
               | Oper of operator       (* 演算子 *)
               | Lpar | Rpar            (* (, ) *)
               | Semic                  (* ; *)
               | Comma                  (* , *)
               | Quit                   (* 終了 *)
               | Others                 (* その他 *)

(* 式の定義 *)
datatype expr = Num of value                   (* 数値 *)
              | Var of string                  (* 変数 *)
              | Op1 of operator * expr         (* 単項演算子 *)
              | Op2 of operator * expr * expr  (* 二項演算子 *)
              | App of func * expr list        (* 関数の適用 *)

operator に代入演算子 = を表す Assign を追加します。関数を表すデータ型が func です。引数が 1 つの関数を F1 で、引数が 2 つの関数を F2 で表します。token には識別子を表す Ident とカンマ ( , ) を表す Comma を追加します。expr には変数を表す Var と関数呼び出しを表す App を追加します。関数の引数はリスト (expr list) に格納します。

次は、変数と関数を格納する大域変数とアクセス関数を定義します。

リスト : 関数と変数のアクセス関数

(* 変数を格納する配列 *)
val global_env : (string * value ref) list ref = ref []

(* 探索 *)
fun lookup(name) =
    let
      fun iter [] = NONE
      |   iter ((x as (n, _))::xs) =
          if n = name then SOME x else iter xs
    in
      iter(!global_env)
    end

(* 更新 *)
fun update(name, value) =
    case lookup(name) of
      NONE => global_env := (name, ref value) :: (!global_env)
    | SOME (_, v) => v:= value

(* value を real に変換 *)
fun toReal(Float(v)) = v
|   toReal(Integer(v)) = Real.fromLargeInt(v)

(* 関数を呼び出す *)
fun call_real_func1 f v = Float(f(toReal v))
fun call_real_func2 f (v, w) = Float(f(toReal v, toReal w))

(* 関数を格納する配列 *)
val func_table= [("sqrt",  F1 (call_real_func1 Math.sqrt)),
                 ("sin",   F1 (call_real_func1 Math.sin)),
                 ("cos",   F1 (call_real_func1 Math.cos)),
                 ("tan",   F1 (call_real_func1 Math.tan)),
                 ("asin",  F1 (call_real_func1 Math.asin)),
                 ("acos",  F1 (call_real_func1 Math.acos)),
                 ("atan",  F1 (call_real_func1 Math.atan)),
                 ("atan2", F2 (call_real_func2 Math.atan2)),
                 ("exp",   F1 (call_real_func1 Math.exp)),
                 ("pow",   F2 (call_real_func2 Math.pow)),
                 ("ln",    F1 (call_real_func1 Math.ln)),
                 ("log10", F1 (call_real_func1 Math.log10)),
                 ("sinh",  F1 (call_real_func1 Math.sinh)),
                 ("cosh",  F1 (call_real_func1 Math.cosh)),
                 ("tanh",  F1 (call_real_func1 Math.tanh))]

(* 関数の探索 *)
fun lookup_function(name) =
    let
      fun iter([]) = NONE
      |   iter((n, f)::xs) =
          if n = name then SOME f else iter(xs)
    in
      iter(func_table)
    end
val lookup = fn : string -> (string * value ref) option
val update = fn : string * value -> unit
val toReal = fn : value -> real
val call_real_func1 = fn : (real -> real) -> value -> value
val call_real_func2 = fn : (real * real -> real) -> value * value -> value
val lookup_function = fn : string -> func option

変数は大域変数 global_env に連想リストの形式で格納します。値を書き換えるので、要素のデータ型は string * value ref とします。関数 lookup は global_env から名前が name の変数を探索します。見つかった場合はタプルを option に格納して返します。見つからない場合は NONE を返します。関数 update は変数の値を更新します。変数 name が既に存在する場合は、タプルの第 2 要素 v を value に書き換えます。name が存在しない場合は、(name, ref value) を global_env に追加します。

組み込み関数は大域変数 func_table に連想リストの形式で格納します。関数 call_real_func1 と call_real_func2 は、型が real -> real, (real * real) -> real の関数を呼び出すために使います。引数 v, w を関数 toReal で real に変換して、引数に渡された関数 f を呼び出します。結果は Float に格納して返します。関数 lookup_function は名前が name の組み込み関数があるか func_table から探します。

●字句解析

次は関数 get_token を修正します。

リスト : 字句解析の修正

(* 識別子の切り出し *)
fun get_ident(s) =
    let fun iter a =
      if Char.isAlphaNum(valOf(lookahead(s))) then
        iter ((valOf(input1(s))) :: a)
      else Ident(implode(rev a))
    in
      iter []
    end

(* トークンの切り出し *)
fun get_token(s) =
    let val c = valOf(lookahead s) in
      if Char.isSpace(c) then (input1(s); get_token(s))
      else if Char.isDigit(c) then get_number(s)
      else if Char.isAlpha(c) then
        let val (id as Ident(name)) = get_ident(s) in
          if name = "quit" then
            tokenBuff := Quit
          else
            tokenBuff := id
        end
      else (
        input1(s); (* s から c を取り除く *)
        tokenBuff := (case c of
            #"+" => Oper(Add)
          | #"-" => Oper(Sub)
          | #"*" => Oper(Mul)
          | #"/" => Oper(Quo)
          | #"=" => Oper(Assign)
          | #"(" => Lpar
          | #")" => Rpar
          | #";" => Semic
          | #"," => Comma
          | _    => Others
        )
      )
    end
val get_ident = fn : instream -> token
val get_token = fn : instream -> unit

記号がアルファベットの場合は関数 get_ident で識別子を切り分けます。get_ident はアルファベットと数字を累積変数 a に格納し、それを implode で文字列に変換します。取り出した文字列が quit の場合、電卓の終了を表すトークン Quit を tokenBuff にセットします。そうでなければ Ident をそのまま tokenBuff にセットします。あとは、代入演算子 = とカンマ "," が入力された場合、それを表すトークン Oper(Assign) と Comma を tokenBuff にセットするだけです。

●構文解析

次は構文解析を修正します。まず最初に、代入演算子の処理を expression に追加します。次のリストを見てください。

リスト : expression の修正

fun expression(s) =
    let
      fun iter v =
        case !tokenBuff of
             Oper(Assign) => (
               case v of
                    Var(_) => (get_token(s); Op2(Assign, v, expression(s)))
                  | _ => raise Syntax_error("invalid assign form")
             )
           | _ => v
    in
      iter(expr1(s))
    end
and expr1(s) =
    let
      fun iter v =
          case !tokenBuff of
            Oper(Add) => (get_token(s); iter(Op2(Add, v, term(s))))
          | Oper(Sub) => (get_token(s); iter(Op2(Sub, v, term(s))))
          | _ => v
    in
      iter (term(s))
    end
and term(s) =
    let
      fun iter v =
          case !tokenBuff of
            Oper(Mul) => (get_token(s); iter(Op2(Mul, v, factor(s))))
          | Oper(Quo) => (get_token(s); iter(Op2(Quo, v, factor(s))))
          | _ => v
    in
      iter (factor(s))
    end
val expression = fn : instream -> expr
val expr1 = fn : instream -> expr
val term = fn : instream -> expr

演算子 +, - の処理は関数 expr1 で行い、演算子 = の処理を expression で行います。expression は最初に expr1 を評価して、その返り値を局所変数 iter の引数 v に渡します。tokenBuff が Assign の場合は代入式の処理を行います。v の値をチェックして、変数を表す Var でなければエラーを送出します。そして、expression を呼び出して右辺の式を評価して、その返り値を Op2 にセットします。expr1 は今までの expression と同じです。

次は関数 factor を修正します。

リスト : 因子の修正

and factor(s) =
    case !tokenBuff of
      Lpar => (
          get_token(s);
          let
            val v = expression(s)
          in
            case !tokenBuff of
              Rpar => (get_token(s); v)
            | _ => raise Syntax_error("')' expected")
          end
        )
    | Number(n) => (get_token(s); Num(n))
    | Quit => raise Calc_exit
    | Oper(Sub)  => (get_token(s); Op1(Sub, factor(s)))
    | Oper(Add)  => (get_token(s); Op1(Add, factor(s)))
    | Ident(name) => (
        get_token(s);
        case lookup_function(name) of
             NONE => Var(name)
           | SOME f => let val args = get_argument(s) in
                         case f of
                           F1 _ => if length(args) < 1
                                   then raise Syntax_error("not enough args")
                                   else ()
                         | F2_ => if length(args) < 2
                                   then raise Syntax_error("not enough args")
                                   else ();
                         App(f, args)
                       end
      )
    | _ => raise Syntax_error("unexpected token")
(* 実引数の取得 *)
and get_argument(s) =
    let
      fun iter a =
          let val v = expression(s) in
            case !tokenBuff of
              Rpar => (get_token(s); rev(v::a))
            | Comma => (get_token(s); iter(v::a))
            | _ => raise Syntax_error("unexpected token in argument list")
          end
    in
      case !tokenBuff of
           Lpar => (get_token(s); iter([]))
         | _ => raise Syntax_error("'(' expected")
    end
val factor = fn : instream -> expr
val get_argument = fn : instream -> expr list

tokenBuff が Ident の場合、変数または関数呼び出しの処理を行います。最初に lookup_function を呼び出し、識別子 name が組み込み関数かチェックします。そうであれば、組み込み関数を呼び出す App を生成します。get_token を呼び出して次のトークンを求め、関数 get_argument で引数を取り出します。あとは引数の数をチェックして、App(f, args) を返します。関数でなければ変数なので Var(name) を返します。

get_argument はカンマで区切られた式を expression で評価し、それをリストに格納して返します。expression を評価したあと、case で tokenBuff をチェックします。右カッコ (Rpar) であれば、引数 v を累積変数 a に追加して、rev で反転して返します。カンマ (Comma) であれば、まだ引数があるので次の式を評価します。そうでなければ、式に誤りがあるのでエラーを送出します。

●式の評価

次は式を評価する関数 eval_expr を修正します。

リスト : 式の計算

fun eval_expr(Num(n)) = n
|   eval_expr(Var(name)) = (
      case lookup(name) of
        NONE => raise Calc_run_error("unbound variable")
      | SOME (_, ref v) => v
    )
|   eval_expr(Op2(op2, expr1, expr2)) = 
    let
      val w = eval_expr(expr2)
    in
      case op2 of
           Add => eval_op(op +, op +, eval_expr(expr1), w)
         | Sub => eval_op(op -, op -, eval_expr(expr1), w)
         | Mul => eval_op(op *, op *, eval_expr(expr1), w)
         | Quo => eval_op(op div, op /, eval_expr(expr1), w)
         | Assign => case expr1 of
                          Var(name) => (update(name, w); w)
                        | _ => raise Calc_run_error("Illegal assign form")
    end
|   eval_expr(Op1(op1, expr1)) =
    let
      val v = eval_expr(expr1)
    in
      case (op1, v) of
           (Add, _) => v
         | (Sub, Integer(n)) => Integer(~n)
         | (Sub, Float(n)) => Float(~n)
         | _ => raise Syntax_error("Illegal expression")
    end
|   eval_expr(App(f, args)) =
    let
      val vs = map (fn e => eval_expr(e)) args
    in
      case f of
           F1 f1 => f1(hd vs)
         | F2 f2 => f2(hd vs, hd (tl vs))
    end
val eval_expr = fn : expr -> value

最初に、変数 Var(name) の値を求める処理を追加します。lookup で global_env から name の変数を求めます。見つからない場合、その変数は未束縛なのでエラー Calc_run_error を送出します。

次に、二項演算子 Op2 の処理に Assign を追加します。式 expr1 から変数名 name を取り出し、関数 update で name の値を式 expr2 の値 w に変更します。expr1 が変数でない場合はエラーを送出します。このエラーが発生する場合は構文解析でバグがあることになります。

最後に、関数を呼び出す App の処理を追加します。最初に args を eval_expr で評価して引数の値を求め、その値を関数に渡して呼び出すだけです。

あとの修正は簡単なので説明は割愛します。詳細は プログラムリスト をお読みください。

●実行例

それでは実行してみましょう。

Calc> a = 10;
10
Calc> a;
10
Calc> a * 10;
100
Calc> (b = 20) * 10;
200
Calc> b;
20
Calc> x = y = z = 0;
0
Calc> x;
0
Calc> y;
0
Calc> z;
0
Calc> p = p + 1;
ERROR: unbound variable
Calc> q = 1;
1
Calc> q;
1
Calc> q = q + 1;
2
Calc> q;
2

変数に値を代入すると、その値を使って式を評価することができます。また、式の中に演算子 = が入っていても、その式を評価することができます。x = y = z = 0; のように、多重代入することも可能です。ただし、新しい変数 p で p = p + 1; のようなことはできません。q = 1; を評価したあとならば、既に変数 q は定義されているので、q = q + 1; は評価することができます。

次は組み込み関数を実行してみましょう。

Calc> sqrt(2);
1.41421356237
Calc> pow(2, 32);
4294967296.0
Calc> pi = asin(0.5) * 6;
3.14159265359
Calc> sin(0);
0.0
Calc> sin(pi/2);
1.0
Calc> sin(pi);
~8.881784197E~16

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

今回はここまでです。次回はユーザが関数を定義する機能を追加してみましょう。

●参考文献


●プログラムリスト

(*
 * calc.sml : 電卓プログラム
 *
 *            Copyright (C) 2012-2021 Makoto Hiroi
 *
 * (1) 四則演算の実装
 * (2) 変数と組み込み関数の追加
 *
 *)

open TextIO

(* 例外 *)
exception Calc_exit
exception Syntax_error of string
exception Calc_run_error of string

(* 値の定義 *)
datatype value = Integer of IntInf.int | Float of real

(* 演算子の定義 *)
datatype operator = Add | Sub | Mul | Quo | Assign

(* 組み込み関数の定義 *)
datatype func = F1 of value -> value
              | F2 of (value * value) -> value

(* トークンの定義 *)
datatype token = Number of value        (* 数 *)
               | Ident of string        (* 識別子 *)
               | Oper of operator       (* 演算子 *)
               | Lpar | Rpar            (* (, ) *)
               | Semic                  (* ; *)
               | Comma                  (* , *)
               | Quit                   (* 終了 *)
               | Others                 (* その他 *)

(* 式の定義 *)
datatype expr = Num of value                   (* 数値 *)
              | Var of string                  (* 変数 *)
              | Op1 of operator * expr         (* 単項演算子 *)
              | Op2 of operator * expr * expr  (* 二項演算子 *)
              | App of func * expr list        (* 関数の適用 *)

(* グローバル変数を格納する配列 *)
val global_env : (string * value ref) list ref = ref []

(* 探索 *)
fun lookup(name) =
    let
      fun iter [] = NONE
      |   iter ((x as (n, _))::xs) =
          if n = name then SOME x else iter xs
    in
      iter(!global_env)
    end

(* 更新 *)
fun update(name, value) =
    case lookup(name) of
      NONE => global_env := (name, ref value) :: (!global_env)
    | SOME (_, v) => v:= value

(* value を real に変換 *)
fun toReal(Float(v)) = v
|   toReal(Integer(v)) = Real.fromLargeInt(v)

(* 関数を呼び出す *)
fun call_real_func1 f v = Float(f(toReal v))
fun call_real_func2 f (v, w) = Float(f(toReal v, toReal w))

(* 関数を格納する配列 *)
val func_table= [("sqrt",  F1 (call_real_func1 Math.sqrt)),
                 ("sin",   F1 (call_real_func1 Math.sin)),
                 ("cos",   F1 (call_real_func1 Math.cos)),
                 ("tan",   F1 (call_real_func1 Math.tan)),
                 ("asin",  F1 (call_real_func1 Math.asin)),
                 ("acos",  F1 (call_real_func1 Math.acos)),
                 ("atan",  F1 (call_real_func1 Math.atan)),
                 ("atan2", F2 (call_real_func2 Math.atan2)),
                 ("exp",   F1 (call_real_func1 Math.exp)),
                 ("pow",   F2 (call_real_func2 Math.pow)),
                 ("ln",    F1 (call_real_func1 Math.ln)),
                 ("log10", F1 (call_real_func1 Math.log10)),
                 ("sinh",  F1 (call_real_func1 Math.sinh)),
                 ("cosh",  F1 (call_real_func1 Math.cosh)),
                 ("tanh",  F1 (call_real_func1 Math.tanh))]

(* 関数の探索 *)
fun lookup_function(name) =
    let
      fun iter([]) = NONE
      |   iter((n, f)::xs) =
          if n = name then SOME f else iter(xs)
    in
      iter(func_table)
    end

(* 切り出したトークンを格納するバッファ *)
val tokenBuff = ref Others

(* 整数の切り出し *)
fun get_number(s) =
    let
      val buff = ref []
      fun get_numeric() =
          let val c = valOf(lookahead s) in
            if Char.isDigit(c) then (
              buff := valOf(input1(s)) :: (!buff);
              get_numeric()
            ) else ()
          end
      fun check_float(c) =
          case c of
            #"." => true
          | #"e" => true
          | #"E" => true
          | _ => false
    in
      get_numeric();    (* 整数部の取得 *)
      if check_float(valOf(lookahead s)) then (
        if valOf(lookahead s) = #"." then (
          (* 小数部の取得 *)
          buff := valOf(input1(s)) :: (!buff);
          get_numeric()
        ) else ();
        if Char.toUpper(valOf(lookahead s)) = #"E" then (
          (* 指数形式 *)
          buff := valOf(input1(s)) :: (!buff);
          let val c = valOf(lookahead s) in
            if c = #"+" orelse c = #"-" then
              buff := (valOf(input1(s))) :: (!buff)
            else ()
          end;
          get_numeric()
        ) else ();
        tokenBuff := Number(Float(valOf(Real.fromString(implode(rev (!buff))))))
      ) else
        tokenBuff := Number(Integer(valOf(IntInf.fromString(implode(rev (!buff))))))
    end

(* 識別子の切り出し *)
fun get_ident(s) =
    let fun iter a =
      if Char.isAlphaNum(valOf(lookahead(s))) then
        iter ((valOf(input1(s))) :: a)
      else Ident(implode(rev a))
    in
      iter []
    end

(* トークンの切り出し *)
fun get_token(s) =
    let val c = valOf(lookahead s) in
      if Char.isSpace(c) then (input1(s); get_token(s))
      else if Char.isDigit(c) then get_number(s)
      else if Char.isAlpha(c) then
        let val (id as Ident(name)) = get_ident(s) in
          if name = "quit" then
            tokenBuff := Quit
          else
            tokenBuff := id
        end
      else (
        input1(s); (* s から c を取り除く *)
        tokenBuff := (case c of
            #"+" => Oper(Add)
          | #"-" => Oper(Sub)
          | #"*" => Oper(Mul)
          | #"/" => Oper(Quo)
          | #"=" => Oper(Assign)
          | #"(" => Lpar
          | #")" => Rpar
          | #";" => Semic
          | #"," => Comma
          | _    => Others
        )
      )
    end

(* 構文木の組み立て *)
fun expression(s) =
    let
      fun iter v =
        case !tokenBuff of
             Oper(Assign) => (
               case v of
                    Var(_) => (get_token(s); Op2(Assign, v, expression(s)))
                  | _ => raise Syntax_error("invalid assign form")
             )
           | _ => v
    in
      iter(expr1(s))
    end
and expr1(s) =
    let
      fun iter v =
          case !tokenBuff of
            Oper(Add) => (get_token(s); iter(Op2(Add, v, term(s))))
          | Oper(Sub) => (get_token(s); iter(Op2(Sub, v, term(s))))
          | _ => v
    in
      iter (term(s))
    end
and term(s) =
    let
      fun iter v =
          case !tokenBuff of
            Oper(Mul) => (get_token(s); iter(Op2(Mul, v, factor(s))))
          | Oper(Quo) => (get_token(s); iter(Op2(Quo, v, factor(s))))
          | _ => v
    in
      iter (factor(s))
    end
and factor(s) =
    case !tokenBuff of
      Lpar => (
          get_token(s);
          let
            val v = expression(s)
          in
            case !tokenBuff of
              Rpar => (get_token(s); v)
            | _ => raise Syntax_error("')' expected")
          end
        )
    | Number(n) => (get_token(s); Num(n))
    | Quit => raise Calc_exit
    | Oper(Sub)  => (get_token(s); Op1(Sub, factor(s)))
    | Oper(Add)  => (get_token(s); Op1(Add, factor(s)))
    | Ident(name) => (
        get_token(s);
        case lookup_function(name) of
             NONE => Var(name)
           | SOME f => let val args = get_argument(s) in
                         case f of
                           F1 _ => if length(args) < 1
                                   then raise Syntax_error("not enough args")
                                   else ()
                         | F2_ => if length(args) < 2
                                   then raise Syntax_error("not enough args")
                                   else ();
                         App(f, args)
                       end
      )
    | _ => raise Syntax_error("unexpected token")
(* 実引数の取得 *)
and get_argument(s) =
    let
      fun iter a =
          let val v = expression(s) in
            case !tokenBuff of
              Rpar => (get_token(s); rev(v::a))
            | Comma => (get_token(s); iter(v::a))
            | _ => raise Syntax_error("unexpected token in argument list")
          end
    in
      case !tokenBuff of
           Lpar => (get_token(s); iter([]))
         | _ => raise Syntax_error("'(' expected")
    end

(* 式の計算 *)
fun eval_op(op1, op2, v, w) =
    case (v, w) of
         (Integer(n), Integer(m)) => Integer(op1(n, m))
       | (Integer(n), Float(m)) => Float(op2(Real.fromLargeInt(n), m))
       | (Float(n), Integer(m)) => Float(op2(n, Real.fromLargeInt(m)))
       | (Float(n), Float(m)) => Float(op2(n, m))

fun eval_expr(Num(n)) = n
|   eval_expr(Var(name)) = (
      case lookup(name) of
        NONE => raise Calc_run_error("unbound variable")
      | SOME (_, ref v) => v
    )
|   eval_expr(Op2(op2, expr1, expr2)) = 
    let
      val w = eval_expr(expr2)
    in
      case op2 of
           Add => eval_op(op +, op +, eval_expr(expr1), w)
         | Sub => eval_op(op -, op -, eval_expr(expr1), w)
         | Mul => eval_op(op *, op *, eval_expr(expr1), w)
         | Quo => eval_op(op div, op /, eval_expr(expr1), w)
         | Assign => case expr1 of
                          Var(name) => (update(name, w); w)
                        | _ => raise Calc_run_error("Illegal assign form")
    end
|   eval_expr(Op1(op1, expr1)) =
    let
      val v = eval_expr(expr1)
    in
      case (op1, v) of
           (Add, _) => v
         | (Sub, Integer(n)) => Integer(~n)
         | (Sub, Float(n)) => Float(~n)
         | _ => raise Syntax_error("Illegal expression")
    end
|   eval_expr(App(f, args)) =
    let
      val vs = map (fn e => eval_expr(e)) args
    in
      case f of
           F1 f1 => f1(hd vs)
         | F2 f2 => f2(hd vs, hd (tl vs))
    end

(* 実行 *)
fun toplevel() = (
    print "Calc> ";
    flushOut(stdOut);
    get_token(stdIn);
    let val result = expression(stdIn) in
      case !tokenBuff of
        Semic => ()
      | Quit  => raise Calc_exit
      | _ => raise Syntax_error("unexpected token");
      case eval_expr(result) of
        Integer(n) => print(IntInf.toString(n) ^ "\n")
      | Float(n) => print(Real.toString(n) ^ "\n")
    end
)

fun calc() =
    while true do (
      toplevel() handle 
        Syntax_error(mes) => (inputLine(stdIn); print("ERROR: " ^ mes ^ "\n"))
      | Calc_run_error(mes) => (inputLine(stdIn); print("ERROR: " ^ mes ^ "\n"))
      | Div => (inputLine(stdIn); print("ERROR: divide by zero\n"))
      | err => raise err
    )

初版 2012 年 8 月 12 日
改訂 2021 年 5 月 30 日

Copyright (C) 2012-2021 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]