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 =
| Value of Value.t
| Var of string
| Binop of t * Binop.t * t
| Set_binop_pre of Binop.t * 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 rec aux = function
| Value n -> pv n
| Var v -> pr "%s" v
| Binop (left, op, right) -> begin
let op = Binop.to_string op in
pr "(%s " op; aux left; pr " "; aux right; pr ")";

38
eval.ml
View file

@ -2,6 +2,7 @@ open Ast
open Ast.Value
exception No_operation
exception No_such_variable of string
let rec binop op l r =
let tl = typeof l and tr = typeof r in
@ -20,18 +21,25 @@ let rec binop op l r =
end
| Some f -> f l r
let rec eval = function
| Value v -> v
| Binop (l, op, r) ->
let l = eval l and r = eval r in
binop op l r
| Set_binop_pre (op, l) ->
let l =
match eval l with
| Int n -> n
| v -> raise @@ Invalid_type (typeof v)
in
Hashtbl.replace Parser.precedence op l;
Nop
| Get_binop_pre op ->
Int (Hashtbl.find Parser.precedence op)
let eval ans ast =
let rec aux = function
| Value v -> v
| Var v ->
if v = "ans"
then ans
else raise @@ No_such_variable v
| Binop (l, op, r) ->
let l = aux l and r = aux r in
binop op l r
| Set_binop_pre (op, l) ->
let l =
match aux l with
| Int n -> n
| 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.Unexpected_token t -> sprintf "unexpected token \"%s\"" 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
| Division_by_zero -> "cannot divide by zero"
| _ -> raise e
@ -18,32 +19,35 @@ let print_error e =
printf "error: %s\n" @@ error_to_string e
(* read-eval-print *)
let rep () : unit =
let rep ans : unit =
printf "> ";
let line = read_line () in
if line = "quit" then raise Exit;
let ans =
let v =
line
|> Lex.tokenize
|> Parser.parse
|> Eval.eval
|> Eval.eval !ans
in
match ans with
match v with
| Nop -> ()
| _ -> printf "%s\n" @@ Ast.Value.to_string ans
| _ ->
ans := v;
printf "%s\n" @@ Ast.Value.to_string v
let init_repl () =
let sigintf _ = raise Reset_line in
Sys.(set_signal sigint (Signal_handle sigintf))
(* simple REPL with error handling *)
let rec repl () : unit =
try rep (); repl () with
let rec repl ans : unit =
try rep ans; repl ans with
| Exit | End_of_file -> ()
| Reset_line -> printf "\n"; repl ()
| e -> print_error e; repl ()
| Reset_line -> printf "\n"; repl ans
| e -> print_error e; repl ans
let () =
let ans = ref @@ Ast.Value.Int 0 in
init_repl ();
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
| Token.Int n -> Value (Int n), seq
| Float n -> Value (Float n), seq
| Ident id -> Var id, seq
| LParen -> expr seq
| _ -> unexpected_token x
end