四則演算

EXTENDを使わないでCamlp4使って四則演算を作れるところまで何段階かに分けて書いてみました。

今はocamllex/ulex + menhir がよいらしいんですけど
ま、使ってみないと分からないし。

(*
$ ocamlc -pp camlp4o test2.ml
$ ./a.out
*)
open Format

(* 字句解析 *)

type token =
  | Number of float
  | Op of char

let print_token ppf = function
  | Number n -> fprintf ppf "Number(%f)@?" n
  | Op o -> fprintf ppf "Op(%c)@?" o

let rec lex = parser
  (* Skip any whitespace. *)
  | [< ' (' ' | '\n' | '\r' | '\t'); stream >] -> lex stream

  (* number: [0-9.]+ *)
  | [< ' ('0' .. '9' as c); stream >] ->
    let buffer = Buffer.create 1 in
    Buffer.add_char buffer c;
    lex_number buffer stream
  | [< ' (('+' | '*' | '-' | '/' | '(' | ')') as o); stream=lex >] -> [<' (Op o); stream >]
  (* end of stream. *)
  | [< >] -> [< >]

and lex_number buffer = parser
  | [< ' ('0' .. '9' | '.' as c); stream >] ->
    Buffer.add_char buffer c;
    lex_number buffer stream
  | [< stream=lex >] ->
    [< 'Number (float_of_string (Buffer.contents buffer)); stream >]

let _ = printf "tst\n"

(* mutable ハッシュテーブル *)

let ps:(string, int) Hashtbl.t = Hashtbl.create 10

let () = Hashtbl.add ps "+" 10
let () = Hashtbl.add ps "*" 20

let _ = printf "+ %d\n" (Hashtbl.find ps "+")
let _ = printf "* %d\n" (Hashtbl.find ps "*")
let _ =
  (*match Stream.peek(lex (Stream.of_channel stdin)) with*)
  (*match Stream.peek(lex [< ''1'; ''2'; ''3' >]) with*)
  match Stream.peek(lex (Stream.of_string "123")) with
  | Some t -> printf "%a\n" print_token t
  | None -> printf "ng\n"

(* parser関数と字句解析を使う *)

let are = parser
  | [<'Number n ; stream >] -> printf "are %f\n" n

let _ = are (lex [< ''1'; ''2'; ''3' >])
let _ = (parser [<'Number n ; stream >] -> printf "num %f\n" n) (lex [< ''1'; ''2'; ''3' >])

(* 文字列からパース *)

let parse2 = parser
  | [<'Number n ; 'Op '+'; 'Number n2; stream >] -> printf "parse2 %f + %f \n" n n2
let _ = parse2 (lex (Stream.of_string "1 + 2"))


(* 構文木を作る *)

type e =
| Num of float
| Bin of e * string * e

let rec print_e ppf = function
  | Num(n) -> fprintf ppf "Num(%f)@?" n
  | Bin(e1,op,e2) -> fprintf ppf "Bin(%a,\"%s\",%a)@?" print_e e1 op print_e e2

let rec parse3_prim = parser
  | [<'Number n >] -> Num n
let rec parse3 = parser
  | [< e1=parse3_prim ; 'Op '+'; e2=parse3_prim >] -> Bin(e1,"+",e2)
  | [< e1=parse3_prim>] -> e1

let _ = printf "%a\n" print_e (parse3 (lex (Stream.of_string "1 + 2")))

(* 右再帰 *)
let rec parse4_prim = parser
  | [<'Number n >] -> Num n

let rec parse4_bin lhs stream = 
  match Stream.peek stream with
  | Some (Op '+') ->
    Stream.junk stream;
    let rhs = parse4_prim stream in
    let rhs = parse4_bin rhs stream in
    let lhs = Bin (lhs,"+", rhs) in
    parse4_bin lhs stream
  | _ -> lhs

and parse4 = parser
  | [< lhs=parse4_prim; stream >] -> parse4_bin lhs stream

let _ = printf "%a\n" print_e (parse4 (lex (Stream.of_string "1 + 2 + 3")))

(* 左再帰 *)
let rec parse5_prim = parser
  | [<'Number n >] -> Num n

let rec parse5_bin lhs stream = 
  match Stream.peek stream with
  | Some (Op '+') ->
    Stream.junk stream;
    let rhs = parse5_prim stream in
    let lhs = Bin (lhs,"+", rhs) in
    parse5_bin lhs stream
  | _ -> lhs

and parse5 = parser
  | [< lhs=parse5_prim; stream >] -> parse5_bin lhs stream

let _ = printf "%a\n" print_e (parse5 (lex (Stream.of_string "1 + 2 + 3")))


(* 括弧 *)
let rec parse6_prim = parser
  | [<'Number n >] -> Num n
  | [<'Op '('; e=parse6; 'Op ')' >] -> e

and parse6_bin lhs stream = 
  match Stream.peek stream with
  | Some (Op '+') ->
    Stream.junk stream;
    let rhs = parse6_prim stream in
    let lhs = Bin (lhs,"+", rhs) in
    parse6_bin lhs stream
  | _ -> lhs

and parse6 = parser
  | [< lhs=parse6_prim; stream >] -> parse6_bin lhs stream

let _ = printf "%a\n" print_e (parse6 (lex (Stream.of_string "1 + (2 + 3)")))

(* 四則演算 *)
let rec parse7_prim = parser
  | [<'Number n >] -> Num n
  | [<'Op '('; e=parse7; 'Op ')' >] -> e

and parse7_mul stream = 
  let lhs = parse7_prim stream in
  let rec loop lhs =
    match Stream.peek stream with
    | Some (Op ('*' as op))
    | Some (Op ('/' as op)) ->
      Stream.junk stream;
      let rhs = parse7_prim stream in
      let lhs = Bin (lhs, sprintf "%c" op, rhs) in
      loop lhs
    | _ -> lhs
  in loop lhs

and parse7_add stream =
  let lhs = parse7_mul stream in
  let rec loop lhs =
    match Stream.peek stream with
    | Some (Op ('+' as op))
    | Some (Op ('-' as op)) ->
      Stream.junk stream;
      let rhs = parse7_mul stream in
      let lhs = Bin (lhs, sprintf "%c" op, rhs) in
      loop lhs
    | _ -> lhs
  in loop lhs

and parse7 stream = parse7_add stream

let _ = printf "parse7 %a\n" print_e (parse7 (lex (Stream.of_string "0-1 + 2 * 3 / 4")))