From dd2a1e160e192886571b613614b7ff9a2f741b8a Mon Sep 17 00:00:00 2001 From: Hyeonung Baek Date: Thu, 13 Jan 2022 01:13:41 +0900 Subject: [PATCH] Add mod (working) and exp (not eval'ed yet) --- ast.ml | 6 +++++- eval.ml | 12 ++++++++---- main.ml | 1 + parser.ml | 16 +++++++++++++++- token.ml | 6 ++++++ 5 files changed, 35 insertions(+), 6 deletions(-) diff --git a/ast.ml b/ast.ml index 8ed3984..3ce2e25 100644 --- a/ast.ml +++ b/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 diff --git a/eval.ml b/eval.ml index 004834d..5cb692c 100644 --- a/eval.ml +++ b/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) - | _ -> failwith "typecheck failed" + | Int a, Int b -> Int (intf a b) + | _ -> 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 -> diff --git a/main.ml b/main.ml index 9ca60af..33b7370 100644 --- a/main.ml +++ b/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 diff --git a/parser.ml b/parser.ml index de2caf1..1714b9a 100644 --- a/parser.ml +++ b/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 diff --git a/token.ml b/token.ml index b7e64ee..a153b20 100644 --- a/token.ml +++ b/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 -> ")"