This commit is contained in:
백현웅 2022-01-19 14:17:04 +09:00
parent 8e249614ee
commit 856c2b359e
4 changed files with 40 additions and 25 deletions

2
ast.ml
View file

@ -88,6 +88,7 @@ end
type t = type t =
| Value of Value.t | Value of Value.t
| Var of string
| Binop of t * Binop.t * t | Binop of t * Binop.t * t
| Set_binop_pre of Binop.t * t | Set_binop_pre of Binop.t * t
| Get_binop_pre of Binop.t | Get_binop_pre of Binop.t
@ -103,6 +104,7 @@ let print ast =
let pv v = pr "%s" @@ Value.to_string v in let pv v = pr "%s" @@ Value.to_string v in
let rec aux = function let rec aux = function
| Value n -> pv n | Value n -> pv n
| Var v -> pr "%s" v
| Binop (left, op, right) -> begin | Binop (left, op, right) -> begin
let op = Binop.to_string op in let op = Binop.to_string op in
pr "(%s " op; aux left; pr " "; aux right; pr ")"; pr "(%s " op; aux left; pr " "; aux right; pr ")";

38
eval.ml
View file

@ -2,6 +2,7 @@ open Ast
open Ast.Value open Ast.Value
exception No_operation exception No_operation
exception No_such_variable of string
let rec binop op l r = let rec binop op l r =
let tl = typeof l and tr = typeof r in let tl = typeof l and tr = typeof r in
@ -20,18 +21,25 @@ let rec binop op l r =
end end
| Some f -> f l r | Some f -> f l r
let rec eval = function let eval ans ast =
| Value v -> v let rec aux = function
| Binop (l, op, r) -> | Value v -> v
let l = eval l and r = eval r in | Var v ->
binop op l r if v = "ans"
| Set_binop_pre (op, l) -> then ans
let l = else raise @@ No_such_variable v
match eval l with | Binop (l, op, r) ->
| Int n -> n let l = aux l and r = aux r in
| v -> raise @@ Invalid_type (typeof v) binop op l r
in | Set_binop_pre (op, l) ->
Hashtbl.replace Parser.precedence op l; let l =
Nop match aux l with
| Get_binop_pre op -> | Int n -> n
Int (Hashtbl.find Parser.precedence op) | v -> raise @@ Invalid_type (typeof v)
in
Hashtbl.replace Parser.precedence op l;
Nop
| Get_binop_pre op ->
Int (Hashtbl.find Parser.precedence op)
in
aux ast

24
main.ml
View file

@ -10,6 +10,7 @@ let error_to_string e =
| Parser.Expected t -> sprintf "expected %s" t | Parser.Expected t -> sprintf "expected %s" t
| Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t
| Ast.Invalid_type t -> sprintf "invalid type %s" (Ast.Type.to_string t) | Ast.Invalid_type t -> sprintf "invalid type %s" (Ast.Type.to_string t)
| Eval.No_such_variable v -> sprintf "no such variable %s" v
| Failure f -> sprintf "error on %s" f | Failure f -> sprintf "error on %s" f
| Division_by_zero -> "cannot divide by zero" | Division_by_zero -> "cannot divide by zero"
| _ -> raise e | _ -> raise e
@ -18,32 +19,35 @@ let print_error e =
printf "error: %s\n" @@ error_to_string e printf "error: %s\n" @@ error_to_string e
(* read-eval-print *) (* read-eval-print *)
let rep () : unit = let rep ans : unit =
printf "> "; printf "> ";
let line = read_line () in let line = read_line () in
if line = "quit" then raise Exit; if line = "quit" then raise Exit;
let ans = let v =
line line
|> Lex.tokenize |> Lex.tokenize
|> Parser.parse |> Parser.parse
|> Eval.eval |> Eval.eval !ans
in in
match ans with match v with
| Nop -> () | Nop -> ()
| _ -> printf "%s\n" @@ Ast.Value.to_string ans | _ ->
ans := v;
printf "%s\n" @@ Ast.Value.to_string v
let init_repl () = let init_repl () =
let sigintf _ = raise Reset_line in let sigintf _ = raise Reset_line in
Sys.(set_signal sigint (Signal_handle sigintf)) Sys.(set_signal sigint (Signal_handle sigintf))
(* simple REPL with error handling *) (* simple REPL with error handling *)
let rec repl () : unit = let rec repl ans : unit =
try rep (); repl () with try rep ans; repl ans with
| Exit | End_of_file -> () | Exit | End_of_file -> ()
| Reset_line -> printf "\n"; repl () | Reset_line -> printf "\n"; repl ans
| e -> print_error e; repl () | e -> print_error e; repl ans
let () = let () =
let ans = ref @@ Ast.Value.Int 0 in
init_repl (); init_repl ();
printf "Configurable Evaluator %s\n" version; (* banner *) printf "Configurable Evaluator %s\n" version; (* banner *)
repl () repl ans

View file

@ -90,6 +90,7 @@ let parse ts =
| Seq.Cons (x, seq) -> begin match x with | Seq.Cons (x, seq) -> begin match x with
| Token.Int n -> Value (Int n), seq | Token.Int n -> Value (Int n), seq
| Float n -> Value (Float n), seq | Float n -> Value (Float n), seq
| Ident id -> Var id, seq
| LParen -> expr seq | LParen -> expr seq
| _ -> unexpected_token x | _ -> unexpected_token x
end end