Add mod (working) and exp (not eval'ed yet)

ast.ml

@@ -7,13 +7,17 @@ let typ_to_string = function
   | Unit -> "()"
 
 type binop =
-  | Add | Sub | Mul | Div
+  | Add | Sub | Mul | Div (* arithmetics *)
+  | Mod (* modular operation *)
+  | Exp (* exponentation *)
 
 let binop_to_string = function
   | Add -> "+"
   | Sub -> "-"
   | Mul -> "*"
   | Div -> "/"
+  | Mod -> "%"
+  | Exp -> "^"
 
 type t =
   | Value of typ

eval.ml

@@ -1,15 +1,19 @@
 open Ast
 
-let arith f a b =
+exception Invalid_type
+
+let arith intf a b =
   match a, b with
-  | Int a, Int b -> Int (f a b)
+  | Int a, Int b -> Int (intf a b)
-  | _ -> failwith "typecheck failed"
+  | _ -> raise Invalid_type
 
 let binop_to_func = function
   | Add -> arith Int.add
   | Sub -> arith Int.sub
   | Mul -> arith Int.mul
   | Div -> arith Int.div
+  | Mod -> arith Int.rem
+  | _ -> assert false
 
 let rec eval = function
   | Value v -> v
@@ -17,7 +21,7 @@ let rec eval = function
     let f = binop_to_func op in
     f (eval l) (eval r)
   | Set_binop_pre (op, l) ->
-    let l = match eval l with Int n -> n | _ -> failwith "not int" in 
+    let l = match eval l with Int n -> n | _ -> raise Invalid_type in
     Hashtbl.replace Parser.precedence op l;
     Unit
   | Get_binop_pre op ->

main.ml

@@ -8,6 +8,7 @@ let error_to_string e =
   try raise e with
   | Parser.Expected t -> sprintf "expected %s" t
   | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t
+  | Eval.Invalid_type -> "invalid type"
   | Failure f -> sprintf "error on %s" f
   | Division_by_zero -> "cannot divide by zero"
   | _ -> raise e

parser.ml

@@ -20,6 +20,8 @@ let precedence = [
   Sub, 10;
   Mul, 20;
   Div, 20;
+  Mod, 30;
+  Exp, 30;
 ] |> List.to_seq |> Hashtbl.of_seq
 
 let precedence_of op =
@@ -27,12 +29,15 @@ let precedence_of op =
 
 let is_left_to_right = function
   | Add | Sub | Mul | Div -> true
+  | _ -> assert false
 
 let token_to_op = function
   | Token.Plus -> Add
   | Minus -> Sub
   | Asterisk -> Mul
   | Slash -> Div
+  | Carret -> Exp
+  | Percent -> Mod
   | _ -> failwith "Parser.token_to_op"
 
 (* common parsers *)
@@ -84,7 +89,7 @@ let parse ts =
     match seq () with
     | Seq.Nil -> left, Seq.empty
     | Seq.Cons (x, seq) -> begin match x with
-        | Token.Plus | Minus | Asterisk | Slash as op ->
+        | Token.Plus | Minus | Asterisk | Slash | Percent as op ->
           let op = token_to_op op in
           let o = precedence_of op in 
           if o > pre then (* op has to be calculated first *)
@@ -93,6 +98,15 @@ let parse ts =
             binop pre (Ast.binop left op right) seq
           else
             left, Seq.cons x seq
+        | Carret as op ->
+          let op = token_to_op op in
+          let o = precedence_of op in 
+          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
+          else
+            left, Seq.cons x seq
         | RParen -> left, seq
         | _ -> unexpected_token x
       end

token.ml

@@ -5,6 +5,8 @@ type t =
   | Minus
   | Asterisk
   | Slash
+  | Carret
+  | Percent
   | LParen
   | RParen
 
@@ -13,6 +15,8 @@ let of_char = function
   | '-' -> Minus
   | '*' -> Asterisk
   | '/' -> Slash
+  | '^' -> Carret
+  | '%' -> Percent
   | '(' -> LParen
   | ')' -> RParen
   | _ -> invalid_arg "Token.of_char"
@@ -33,5 +37,7 @@ let to_string = function
   | Minus -> "-"
   | Asterisk -> "*"
   | Slash -> "/"
+  | Carret -> "^"
+  | Percent -> "%"
   | LParen -> "("
   | RParen -> ")"