Add ans
This commit is contained in:
parent
8e249614ee
commit
856c2b359e
4 changed files with 40 additions and 25 deletions
2
ast.ml
2
ast.ml
|
@ -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
38
eval.ml
|
@ -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
24
main.ml
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue