diff --git a/ast.ml b/ast.ml index f7020a0..8ed3984 100644 --- a/ast.ml +++ b/ast.ml @@ -19,6 +19,7 @@ type t = | Value of typ | Binop of t * binop * t | Set_binop_pre of binop * t + | Get_binop_pre of binop let value v = Value v @@ -45,5 +46,7 @@ let print ast = pr "(set_pre %s " (binop_to_string op); aux pre; pr ")" + | Get_binop_pre op -> + pr "(get_pre %s)" (binop_to_string op) in aux ast; pr "\n" diff --git a/eval.ml b/eval.ml index 2f8d5a3..004834d 100644 --- a/eval.ml +++ b/eval.ml @@ -1,15 +1,15 @@ open Ast -let intop f a b = +let arith f a b = match a, b with | Int a, Int b -> Int (f a b) | _ -> failwith "typecheck failed" let binop_to_func = function - | Add -> intop Int.add - | Sub -> intop Int.sub - | Mul -> intop Int.mul - | Div -> intop Int.div + | Add -> arith Int.add + | Sub -> arith Int.sub + | Mul -> arith Int.mul + | Div -> arith Int.div let rec eval = function | Value v -> v @@ -18,5 +18,7 @@ let rec eval = function f (eval l) (eval r) | Set_binop_pre (op, l) -> let l = match eval l with Int n -> n | _ -> failwith "not int" in - Hashtbl.replace Parser.precedence (Ast.binop_to_string op) l; + Hashtbl.replace Parser.precedence op l; Unit + | Get_binop_pre op -> + Int (Hashtbl.find Parser.precedence op) diff --git a/main.ml b/main.ml index 384827b..d6f12dc 100644 --- a/main.ml +++ b/main.ml @@ -16,15 +16,15 @@ let rec repl () : unit = printf "> "; let line = read_line () in if line <> "quit" then begin - try - line - |> Lex.tokenize - |> Parser.parse - |> Eval.eval - |> Ast.typ_to_string - |> printf "%s\n" - with - | e -> print_error e; + (try + line + |> Lex.tokenize + |> Parser.parse + |> Eval.eval + |> Ast.typ_to_string + |> printf "%s\n" + with + | e -> print_error e); repl () end diff --git a/parser.ml b/parser.ml index 21cd61b..2716329 100644 --- a/parser.ml +++ b/parser.ml @@ -1,5 +1,7 @@ open Ast +module S = Set.Make(String) + exception Expected of string exception Unexpected_token of string @@ -14,14 +16,14 @@ let unexpected_token t = * precedency, but infering precedence relation from the graph is hard * and the graph can be made to have loops, I just used plain table. *) let precedence = [ - "+", 10; - "-", 10; - "*", 20; - "/", 20; + Add, 10; + Sub, 10; + Mul, 20; + Div, 20; ] |> List.to_seq |> Hashtbl.of_seq let precedence_of op = - Hashtbl.find precedence (Ast.binop_to_string op) + Hashtbl.find precedence op let is_left_to_right = function | Add | Sub | Mul | Div -> true @@ -52,7 +54,7 @@ let parse ts = | Token.Plus | Minus | Asterisk | Slash as op -> let op = token_to_op op in let o = precedence_of op in - if o > pre then + if o > pre then (* op has to be calculated first *) let v, seq = value seq in let right, seq = binop o v seq in binop pre (Ast.binop left op right) seq @@ -62,6 +64,16 @@ let parse ts = | _ -> unexpected_token x end + and ident set seq = + match seq () with + | Seq.Nil -> + let msg = "ident " ^ (S.elements set |> String.concat " or ") in + expected msg + | Seq.Cons (x, seq) -> begin match x with + | Token.Ident id when S.mem id set -> id, seq + | _ -> unexpected_token x + end + and operator seq = match seq () with | Seq.Nil -> expected "operator" @@ -69,22 +81,20 @@ let parse ts = try token_to_op x, seq with | _ -> expected "operator" - and set_conf seq = - match seq () with - | Seq.Nil -> expected "ident" - | Seq.Cons (x, seq) -> begin match x with - | Token.Ident "level" -> - let op, seq = operator seq in - let v, seq = value seq in - Set_binop_pre (op, v), seq - | _ -> expected "argument" - end + and level seq = + let id, seq = ident (S.of_list ["get"; "set"]) seq in + let op, seq = operator seq in + if id = "get" then + Get_binop_pre op, seq + else + let v, seq = value seq in + Set_binop_pre (op, v), seq and expr seq = match seq () with | Seq.Nil -> Value Unit, Seq.empty (* nop *) | Seq.Cons (x, s) -> begin match x with - | Ident "set" -> set_conf s + | Ident "level" -> level s | _ -> let left, seq = value seq in binop ~-1 left seq