Few things

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"

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)

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
 

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